[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pkg 545cf39307: Merge branch 'master' into feature/pkg
From: |
Gerd Moellmann |
Subject: |
feature/pkg 545cf39307: Merge branch 'master' into feature/pkg |
Date: |
Mon, 14 Nov 2022 02:07:50 -0500 (EST) |
branch: feature/pkg
commit 545cf3930712f1a3156c6010b2ad08528b019c9b
Merge: 1a235a2fd6 83a497ee87
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge branch 'master' into feature/pkg
---
.clang-format | 6 +-
.dir-locals.el | 3 +-
CONTRIBUTE | 7 +-
ChangeLog.1 | 2 +-
ChangeLog.2 | 2 +-
ChangeLog.3 | 28 +-
admin/authors.el | 2 +-
admin/emake | 17 +
admin/git-bisect-start | 40 +
admin/notes/repo | 4 +
configure.ac | 7 +
doc/emacs/ChangeLog.1 | 2 +-
doc/emacs/package.texi | 71 ++
doc/emacs/rmail.texi | 8 +
doc/emacs/search.texi | 25 +-
doc/emacs/text.texi | 2 +-
doc/lispref/control.texi | 2 +-
doc/lispref/edebug.texi | 29 +-
doc/lispref/help.texi | 4 +-
doc/lispref/intro.texi | 2 +
doc/lispref/processes.texi | 4 +
doc/lispref/searching.texi | 39 +-
doc/lispref/strings.texi | 2 +-
doc/misc/ChangeLog.1 | 2 +-
doc/misc/cl.texi | 4 +-
doc/misc/ede.texi | 164 ++--
doc/misc/efaq.texi | 2 +-
doc/misc/eglot.texi | 39 +-
doc/misc/eshell.texi | 9 +-
doc/misc/eudc.texi | 143 +++-
doc/misc/flymake.texi | 2 +-
doc/misc/gnus.texi | 39 +-
doc/misc/modus-themes.org | 6 +-
doc/misc/reftex.texi | 2 +-
doc/misc/transient.texi | 2 +-
etc/ERC-NEWS | 18 +-
etc/NEWS | 133 +++-
etc/NEWS.27 | 2 +-
etc/NEWS.28 | 2 +-
etc/TODO | 2 +-
etc/publicsuffix.txt | 259 +++---
lisp/ChangeLog.15 | 4 +-
lisp/ChangeLog.16 | 6 +-
lisp/ChangeLog.17 | 2 +-
lisp/ChangeLog.7 | 8 +-
lisp/ansi-osc.el | 2 +-
lisp/apropos.el | 3 +-
lisp/bindings.el | 8 +
lisp/bs.el | 12 +-
lisp/calendar/diary-lib.el | 4 +-
lisp/cedet/ede.el | 2 +-
lisp/cedet/semantic/symref/grep.el | 11 +-
lisp/cus-edit.el | 58 +-
lisp/cus-theme.el | 40 +-
lisp/dired-aux.el | 15 +-
lisp/dired.el | 14 +-
lisp/dom.el | 68 +-
lisp/elide-head.el | 4 +-
lisp/emacs-lisp/bytecomp.el | 16 +-
lisp/emacs-lisp/comp.el | 11 +-
lisp/emacs-lisp/hierarchy.el | 2 +-
lisp/emacs-lisp/multisession.el | 11 +
lisp/emacs-lisp/oclosure.el | 6 +-
lisp/emacs-lisp/package-vc.el | 726 +++++++++++++++++
lisp/emacs-lisp/package.el | 285 +++++--
lisp/emacs-lisp/smie.el | 2 +-
lisp/emacs-lisp/text-property-search.el | 10 +-
lisp/erc/ChangeLog.1 | 4 +-
lisp/erc/erc-backend.el | 129 ++-
lisp/erc/erc-common.el | 271 +++++++
lisp/erc/erc-compat.el | 12 +
lisp/erc/erc-dcc.el | 7 +-
lisp/erc/erc-goodies.el | 17 +-
lisp/erc/erc-networks.el | 28 +-
lisp/erc/erc.el | 365 ++-------
lisp/eshell/em-tramp.el | 94 ++-
lisp/eshell/esh-util.el | 13 +-
lisp/face-remap.el | 30 +-
lisp/gnus/ChangeLog.1 | 2 +-
lisp/gnus/ChangeLog.3 | 4 +-
lisp/gnus/gnus-art.el | 1 -
lisp/gnus/message.el | 1 +
lisp/gnus/nnimap.el | 2 +-
lisp/icomplete.el | 2 +-
lisp/international/emoji.el | 3 +-
lisp/international/mule-cmds.el | 93 +--
lisp/jka-compr.el | 2 +-
lisp/language/ind-util.el | 4 +-
lisp/language/misc-lang.el | 2 +-
lisp/ldefs-boot.el | 109 ++-
lisp/leim/quail/indian.el | 2 +-
lisp/leim/quail/misc-lang.el | 2 +-
lisp/mail/feedmail.el | 11 +-
lisp/mail/mail-hist.el | 23 +-
lisp/mail/rmail.el | 10 +-
lisp/man.el | 83 +-
lisp/mh-e/ChangeLog.1 | 2 +-
lisp/minibuffer.el | 83 +-
lisp/net/ange-ftp.el | 4 +-
lisp/net/dbus.el | 1 +
lisp/net/dictionary.el | 7 +-
lisp/net/eudc-vars.el | 16 +-
lisp/net/eudc.el | 24 +-
lisp/net/eudcb-ecomplete.el | 108 +++
lisp/net/eudcb-mailabbrev.el | 127 +++
lisp/net/eww.el | 6 +-
lisp/net/network-stream.el | 4 +
lisp/net/newst-backend.el | 1 -
lisp/net/rcirc.el | 3 +-
lisp/net/tramp.el | 22 +-
lisp/nxml/rng-cmpct.el | 22 +-
lisp/org/ChangeLog.1 | 8 +-
lisp/org/org-ctags.el | 2 -
lisp/org/org-protocol.el | 1 -
lisp/outline.el | 8 +-
lisp/profiler.el | 131 ++-
lisp/progmodes/cc-bytecomp.el | 2 +-
lisp/progmodes/cc-defs.el | 2 +-
lisp/progmodes/cc-engine.el | 32 +-
lisp/progmodes/cc-mode.el | 8 +-
lisp/progmodes/cperl-mode.el | 66 +-
lisp/progmodes/cpp.el | 101 +--
lisp/progmodes/dcl-mode.el | 60 +-
lisp/progmodes/ebnf2ps.el | 2 -
lisp/progmodes/eglot.el | 138 ++--
lisp/progmodes/etags.el | 22 +-
lisp/progmodes/hideshow.el | 106 ++-
lisp/progmodes/mixal-mode.el | 3 -
lisp/progmodes/octave.el | 72 +-
lisp/progmodes/perl-mode.el | 4 +-
lisp/progmodes/project.el | 43 +-
lisp/progmodes/ps-mode.el | 50 +-
lisp/progmodes/python.el | 1 +
lisp/progmodes/simula.el | 42 +-
lisp/progmodes/sql.el | 62 +-
lisp/replace.el | 2 +-
lisp/rot13.el | 11 +-
lisp/savehist.el | 6 +-
lisp/simple.el | 33 +-
lisp/subr.el | 18 +-
lisp/tab-bar.el | 192 ++++-
lisp/tab-line.el | 34 +-
lisp/textmodes/css-mode.el | 38 +-
lisp/textmodes/flyspell.el | 4 +-
lisp/textmodes/table.el | 4 +-
lisp/thingatpt.el | 2 +-
lisp/thread.el | 26 +-
lisp/url/url-util.el | 37 +-
lisp/vc/smerge-mode.el | 5 +-
lisp/vc/vc-bzr.el | 6 +
lisp/vc/vc-git.el | 37 +-
lisp/vc/vc-hg.el | 6 +
lisp/vc/vc-svn.el | 9 +-
lisp/vc/vc.el | 54 +-
lisp/vcursor.el | 82 +-
lisp/whitespace.el | 2 +-
lisp/winner.el | 8 +
lisp/xwidget.el | 10 +-
nt/inc/ms-w32.h | 2 +-
src/ChangeLog.13 | 2 +-
src/ChangeLog.7 | 8 +-
src/alloc.c | 2 +-
src/buffer.c | 90 ++-
src/buffer.h | 1 -
src/callproc.c | 1 +
src/emacs-module.c | 2 +-
src/emacs.c | 10 +-
src/eval.c | 15 +-
src/gnutls.c | 12 +-
src/haiku_support.cc | 18 +
src/image.c | 30 +-
src/insdel.c | 57 +-
src/itree.c | 123 +--
src/itree.h | 8 +-
src/keyboard.c | 4 +-
src/lisp.h | 12 +-
src/lread.c | 6 +-
src/nsimage.m | 2 +
src/nsterm.m | 33 +-
src/pdumper.c | 8 +-
src/pgtkterm.c | 126 ++-
src/print.c | 4 +-
src/process.c | 3 +-
src/search.c | 37 +-
src/sqlite.c | 51 +-
src/w32fns.c | 5 +-
src/xdisp.c | 30 +-
src/xselect.c | 7 +
src/xterm.c | 612 +++++++++-----
test/lisp/dired-tests.el | 11 +
test/lisp/elide-head-tests.el | 21 +-
test/lisp/erc/erc-dcc-tests.el | 119 ++-
test/lisp/erc/erc-networks-tests.el | 2 +-
test/lisp/erc/erc-services-tests.el | 24 +-
test/lisp/erc/erc-tests.el | 22 -
test/lisp/eshell/em-tramp-tests.el | 75 ++
test/lisp/eshell/esh-util-tests.el | 57 ++
test/lisp/eshell/esh-var-tests.el | 20 +-
test/lisp/net/eudc-resources/ecompleterc | 7 +
test/lisp/net/eudc-resources/mailrc | 3 +
test/lisp/net/eudc-tests.el | 116 +++
test/lisp/net/tramp-tests.el | 11 +-
test/lisp/progmodes/python-tests.el | 17 +
test/lisp/simple-tests.el | 23 +
test/lisp/thingatpt-tests.el | 3 +
test/manual/noverlay/Makefile.in | 41 +-
test/manual/noverlay/check-sanitize.sh | 28 +-
test/manual/noverlay/emacs-compat.h | 36 +-
test/manual/noverlay/itree-tests.c | 1284 ++++++++++++++----------------
test/src/buffer-tests.el | 245 ++++--
210 files changed, 6180 insertions(+), 3122 deletions(-)
diff --git a/.clang-format b/.clang-format
index ac9f95c88a..464375bd41 100644
--- a/.clang-format
+++ b/.clang-format
@@ -6,7 +6,10 @@ BreakBeforeBinaryOperators: All
BreakBeforeBraces: GNU
ColumnLimit: 70
ContinuationIndentWidth: 2
-ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE, ITREE_FOREACH]
+ForEachMacros: [FOR_EACH_TAIL,
+ FOR_EACH_TAIL_SAFE,
+ FOR_EACH_LIVE_BUFFER,
+ ITREE_FOREACH]
IncludeCategories:
- Regex: '^<config\.h>$'
Priority: -1
@@ -21,6 +24,7 @@ MaxEmptyLinesToKeep: 1
PenaltyBreakBeforeFirstCallParameter: 2000
SpaceAfterCStyleCast: true
SpaceBeforeParens: Always
+UseTab: Always
# Local Variables:
# mode: yaml
diff --git a/.dir-locals.el b/.dir-locals.el
index f7c73031cc..a85769b534 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -9,7 +9,8 @@
(bug-reference-url-format . "https://debbugs.gnu.org/%s")
(diff-add-log-use-relative-names . t)))
(c-mode . ((c-file-style . "GNU")
- (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"))
+ (c-noise-macro-names . ("INLINE" "NO_INLINE"
"ATTRIBUTE_NO_SANITIZE_UNDEFINED"
+ "UNINIT" "CALLBACK" "ALIGN_STACK"))
(electric-quote-comment . nil)
(electric-quote-string . nil)
(indent-tabs-mode . t)
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 94d757daaf..c226645bd7 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -202,9 +202,10 @@ them right the first time, so here are guidelines for
formatting them:
you can put a paragraph (after the empty line and before the
individual ChangeLog entries) that further describes the commit.
-- Limit lines in commit messages to 78 characters, unless they consist
- of a single word of at most 140 characters; this is enforced by a
- commit hook.
+- Lines in ChangeLog entries should preferably be not longer than 63
+ characters, and must not exceed 78 characters, unless they consist
+ of a single word of at most 140 characters; this 78/140 limit is
+ enforced by a commit hook.
- If only a single file is changed, the summary line can be the normal
file first line (starting with the asterisk). Then there is no
diff --git a/ChangeLog.1 b/ChangeLog.1
index 35533d60ff..a8df1c0420 100644
--- a/ChangeLog.1
+++ b/ChangeLog.1
@@ -930,7 +930,7 @@
(mostlyclean_dirs, clean_dirs, distclean_dirs, maintainer_clean_dirs):
New variables.
(mostlyclean, clean, distclean, bootstrap-clean, maintainer-clean)
- (extraclean): Define using each subdirectory as a prequisite.
+ (extraclean): Define using each subdirectory as a prerequisite.
* lib/Makefile.am (bootstrap-clean): New.
2014-06-15 Paul Eggert <eggert@cs.ucla.edu>
diff --git a/ChangeLog.2 b/ChangeLog.2
index 5a73d53b8b..fc038033ec 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -26343,7 +26343,7 @@
(verilog-type-font-keywords): Cycle delay operators like ##1 and
##[0:$] are now highlighted in their entirety similarly to the #
delay-control operator. Likewise, the followed-by operators #-#
- and #=# are no longer partially highlighed.
+ and #=# are no longer partially highlighted.
(verilog-backward-syntactic-ws-quick)
(verilog-skip-backward-comments): Minor performance improvements
to buffer traversal functions for reduced latency.
diff --git a/ChangeLog.3 b/ChangeLog.3
index f2245a4ed5..d90b261da7 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -5731,7 +5731,7 @@
2021-10-09 Dmitry Gutov <dgutov@yandex.ru>
- Slight simplificaiton
+ Slight simplification
* lisp/progmodes/xref.el (xref--insert-xrefs):
Compute log only once. Use 'dolist'.
@@ -35728,7 +35728,7 @@
(comp-arithm-cmp-fun-p, comp-negate-arithm-cmp-fun)
(comp-reverse-arithm-fun): Rename and add '=' '!='.
(comp-emit-assume, comp-add-cond-cstrs, comp-fwprop-insn): Update
- for new function nameing and to handle '='.
+ for new function naming and to handle '='.
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-=): New function.
* test/src/comp-tests.el (comp-tests-type-spec-tests): Add a bunch
of '=' specific tests.
@@ -39854,7 +39854,7 @@
* lisp/net/mairix.el: Use lexical-binding.
Remove redundant `:group` args.
- (mairix-widget-create-query): Remove unnused var `allwidgets`.
+ (mairix-widget-create-query): Remove unused var `allwidgets`.
2021-02-09 Juri Linkov <juri@linkov.net>
@@ -49106,7 +49106,7 @@
(comp-split-pos-neg): Minor.
(comp-normalize-typeset): Logic update.
(comp-union-typesets): Minor.
- (comp-intersect-two-typesets): New functio.
+ (comp-intersect-two-typesets): New function.
(comp-intersect-typesets): Logic update.
(comp-range-union, comp-range-intersection): Minor.
(comp-cstr-union-homogeneous, comp-cstr-union-1-no-mem)
@@ -50911,7 +50911,7 @@
2020-12-12 Lars Ingebrigtsen <larsi@gnus.org>
- Alter the "Redundant pcase patter" warning message
+ Alter the "Redundant pcase pattern" warning message
* lisp/emacs-lisp/pcase.el (pcase--expand): Make the "Redundant
pcase pattern" warning less vague (bug#31350).
@@ -77634,7 +77634,7 @@
Add an initial implementation to support dynamic scope. Arg
parsing/binding it's done using the existing code in use for
- bytecode (no ad-hoc code is synthetized for that).
+ bytecode (no ad-hoc code is synthesized for that).
* src/lisp.h (struct Lisp_Subr): Add lambda_list field.
(SUBR_NATIVE_COMPILED_DYNP): New inliner.
@@ -118316,7 +118316,7 @@
* lisp/mh-e/mh-speed.el (mh-speed-parse-flists-output):
* lisp/mh-e/mh-search.el (mh-index-parse-search-regexp): Avoid
- warning about `values-list' by using `cl-values-list' insead.
+ warning about `values-list' by using `cl-values-list' instead.
2019-07-29 Lars Ingebrigtsen <larsi@gnus.org>
@@ -126255,7 +126255,7 @@
Suppress warning about non-prefixed variable in mailalias.el
- * lisp/mail/mailalias.el (patters): Suppress warning about
+ * lisp/mail/mailalias.el (pattern): Suppress warning about
non-prefixed variable used by `mail-complete-alist'.
2019-06-15 Lars Ingebrigtsen <larsi@gnus.org>
@@ -130524,7 +130524,7 @@
2019-05-16 Lars Ingebrigtsen <larsi@gnus.org>
- Avoind string-as-multibyte in ps-output-string-prim
+ Avoid string-as-multibyte in ps-output-string-prim
* lisp/ps-print.el (ps-output-string-prim): Avoid
`string-as-multibyte', and encode as utf-8 instead if multibyte.
@@ -156879,7 +156879,7 @@
Merge from origin/emacs-26
90bea37 ; * etc/PROBLEMS: Fix fvwm version number in last commit
- af82d1f * etc/PROBLEMS: Document stickyness problem with FVWM (Bug#31...
+ af82d1f * etc/PROBLEMS: Document stickiness problem with FVWM (Bug#31...
4a3aed2 Update Emacs Lisp Intro to match current behavior
21f2247 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emac...
3257085 Fix previous commit
@@ -176909,7 +176909,7 @@
2018-06-02 Martin Rudalics <rudalics@gmx.at>
- * etc/PROBLEMS: Document stickyness problem with FVWM (Bug#31650)
+ * etc/PROBLEMS: Document stickiness problem with FVWM (Bug#31650)
2018-06-01 Eli Zaretskii <eliz@gnu.org>
@@ -221327,8 +221327,8 @@
is never used. Hardcode the syntax so that the compilar can detect such
dead code and remove it from compiled code.
- The only exception is RE_NO_POSIX_BACKTRACKING which can be separatelly
- specified. Handle this separatelly with a function argument (replacing
+ The only exception is RE_NO_POSIX_BACKTRACKING which can be separately
+ specified. Handle this separately with a function argument (replacing
now unnecessary syntax argument).
With this patchset, size of Emacs binary on x86_64 machine is reduced by
@@ -227801,7 +227801,7 @@
* lisp/auth-source.el
(auth-source-macos-keychain-search-items): Handle keychain
- output correctly when has special chararcters (bug#22824).
+ output correctly when has special characters (bug#22824).
2016-04-24 Magnus Henoch <magnus.henoch@gmail.com>
diff --git a/admin/authors.el b/admin/authors.el
index 12fe25fa4e..fd8ba9cb01 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -990,7 +990,7 @@ in the repository.")
;; to how a file was mentioned in the respective ChangeLog. It is
;; advisable to run a Grep command such as
;;
-;; fgrep -R BASENAME . --include='ChangeLog*'
+;; grep -F -R BASENAME . --include='ChangeLog*'
;;
;; where BASENAME is the old basename of the renamed file. This will
;; show all the different reference forms of the file in the various
diff --git a/admin/emake b/admin/emake
index e2f38501e9..09f7410779 100755
--- a/admin/emake
+++ b/admin/emake
@@ -1,5 +1,22 @@
#!/bin/bash
+# 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/>.
+
# This script is meant to be used as ./admin/emake, and will compile
# the Emacs tree with virtually all of the informational messages
# removed, and with errors/warnings highlighted in red. It'll give a
diff --git a/admin/git-bisect-start b/admin/git-bisect-start
new file mode 100755
index 0000000000..cf0c8cde41
--- /dev/null
+++ b/admin/git-bisect-start
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+### Start a git bisection, and prune the branches that are the result of
+### merging external trees into the Emacs repository.
+
+## 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/>.
+
+### Commentary:
+
+## Marking the last commits of external tree merges as "good" ensures
+## that all the commits between the external tree root and the merge
+## (excluding the merge-commit itself) are regarded as "good", so "git
+## bisect" will never descend into these branches, which only have the
+## files of the external tree, and in which Emacs can therefore not be
+## built. The last commit is the parent of the merge commit in the
+## external tree, that is, the parent of the merge commit that is not
+## on master.
+
+### Code:
+
+git bisect start
+
+# Prune commits 1e5b753bf4..806734c1b1 introduced by 0186faf2a1 (Eglot
+# merge on Oct 20 2022)
+git bisect good 806734c1b1f433de43d59d9a5e3a1e89d64315f6
diff --git a/admin/notes/repo b/admin/notes/repo
index 2185c5a003..97f02ab605 100644
--- a/admin/notes/repo
+++ b/admin/notes/repo
@@ -128,6 +128,10 @@ again.
This is a semi-automated way to find the revision that introduced a bug.
Browse 'git help bisect' for technical instructions.
+It is recommended to start a bisection with the admin/git-bisect-start
+script. This script prunes the branches that are the result of
+merging external trees into the Emacs repository.
+
* Maintaining ChangeLog history
Older ChangeLog entries are kept in history files named ChangeLog.1,
diff --git a/configure.ac b/configure.ac
index 63cb9c412e..b656dba4d9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1170,6 +1170,13 @@ if test "$emacs_cv_clang" = yes; then
gl_WARN_ADD([-Wno-tautological-constant-out-of-range-compare])
fi
+# Suppress deprecation warnings from using sprintf variants,
+# starting with Xcode 14.1 on macOS 13.
+# These warnings are false alarms, as Emacs usage of sprintf is safe.
+if test $opsys = darwin; then
+ gl_WARN_ADD([-Wno-deprecated-declarations])
+fi
+
# Use a slightly smaller set of warning options for lib/.
nw=
nw="$nw -Wunused-macros"
diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1
index 048b7bd99a..5647538a24 100644
--- a/doc/emacs/ChangeLog.1
+++ b/doc/emacs/ChangeLog.1
@@ -2711,7 +2711,7 @@
of list-faces-display here, from Standard Faces node.
Note special role of `default' background.
(Standard Faces): Note special role of `default' background.
- Note that region face may be taken fom GTK. Add xref to Text Display.
+ Note that region face may be taken from GTK. Add xref to Text Display.
(Text Scale): Rename from "Temporary Face Changes".
Callers changed. Don't bother documenting variable-pitch-mode.
(Font Lock): Copyedits. Remove font-lock-maximum-size.
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 420da09097..f9fa28074f 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -49,6 +49,7 @@ Manual}.
* Package Statuses:: Which statuses a package can have.
* Package Installation:: Options for package installation.
* Package Files:: Where packages are installed.
+* Fetching Package Sources:: Managing packages directly from source.
@end menu
@node Package Menu
@@ -530,3 +531,73 @@ are laid out in the same way as in @code{package-user-dir}.
corresponding package subdirectory. This only works for packages
installed in @code{package-user-dir}; if told to act on a package in a
system-wide package directory, the deletion command signals an error.
+
+@node Fetching Package Sources
+@section Fetching Package Sources
+@cindex package development source
+@cindex upstream source, for packages
+@cindex git source of package @c "git" is not technically correct
+
+ By default @code{package-install} downloads a Tarball from a package
+archive and installs its files. This might be inadequate if you wish
+to hack on the package sources and share your changes with others. In
+that case, you may prefer to directly fetch and work on the upstream
+source. This often makes it easier to develop patches and report
+bugs.
+
+@findex package-vc-install
+@findex package-vc-checkout
+ One way to do this is to use @code{package-vc-install}, to fetch the
+source code for a package directly from source. The command will also
+automatically ensure that all files are byte-compiled and auto-loaded,
+just like with a regular package. Packages installed this way behave
+just like any other package. You can update them using
+@code{package-update} or @code{package-update-all} and delete them
+again using @code{package-delete}. They are even displayed in the
+regular package listing. If you just wish to clone the source of a
+package, without adding it to the package list, use
+@code{package-vc-checkout}.
+
+@vindex package-vc-selected-packages
+@findex package-vc-ensure-packages
+ An alternative way to use @code{package-vc-install} is via the
+@code{package-vc-selected-packages} user option. This is an alist of
+packages to install, where each key is a package name and the value is
+@code{nil}, indicating that any revision is to install, a string,
+indicating a specific revision or a package specification plist. The
+side effect of setting the user option is to install the package, but
+the process can also be manually triggered using the function
+@code{package-vc-ensure-packages}. Here is an example of how the user
+option:
+
+@example
+@group
+(setopt package-vc-selected-packages
+ '((modus-themes . "0f39eb3fd9") ;specific revision
+ (auctex . nil) ;any revision
+ (foo ;a package specification
+ :url "https://git.sv.gnu.org/r/foo-mode.git"
+ :branch "trunk")))
+@end group
+@end example
+
+@findex package-report-bug
+@findex package-vc-prepare-patch
+ With the source checkout, you might want to reproduce a bug against
+the current development head or implement a new feature to scratch an
+itch. If the package metadata indicates how to contact the
+maintainer, you can use the command @code{package-report-bug} to
+report a bug via Email. This report will include all the user options
+that you have customized. If you have made a change you wish to share
+with the maintainers, first commit your changes then use the command
+@code{package-vc-prepare-patch} to share it. @xref{Preparing Patches}.
+
+@findex package-vc-install-from-checkout
+@findex package-vc-refresh
+ If you maintain your own packages you might want to use a local
+checkout instead of cloning a remote repository. You can do this by
+using @code{package-vc-install-from-checkout}, which creates a symbolic link
+from the package directory (@pxref{Package Files}) to your checkout
+and initializes the code. Note that you might have to use
+@code{package-vc-refresh} to repeat the initialization and update the
+autoloads.
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index e38bde036a..7414cdb079 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1409,6 +1409,14 @@ might use rot13 to hide important plot points.
rot13-other-window}. This displays the current buffer in another window
which applies the code when displaying the text.
+@findex rot13-region
+ If you are only interested in a region, the command @kbd{M-x
+rot13-region} might be preferable. This will encrypt/decrypt the
+active region in-place. If the buffer is read-only, it will attempt
+to display the plain text in the echo area. If the text is too long
+for the echo area, the command will pop up a temporary buffer with the
+encrypted/decrypted text.
+
@node Movemail
@section @command{movemail} program
@cindex @command{movemail} program
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 582e764c55..63541d78a5 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1348,18 +1348,19 @@ tailor them to your needs.
@kindex SPC @r{(Incremental search)}
@findex isearch-toggle-lax-whitespace
@vindex search-whitespace-regexp
- By default, search commands perform @dfn{lax space matching}:
-each space, or sequence of spaces, matches any sequence of one or more
-whitespace characters in the text. (Incremental regexp search has a
-separate default; see @ref{Regexp Search}.) Hence, @w{@samp{foo bar}}
-matches @w{@samp{foo bar}}, @w{@samp{foo@ @ bar}},
-@w{@samp{foo@ @ @ bar}}, and so on (but not @samp{foobar}). More
-precisely, Emacs matches each sequence of space characters in the
-search string to a regular expression specified by the variable
-@code{search-whitespace-regexp}. For example, to make spaces match
-sequences of newlines as well as spaces, set it to the regular expression
-@samp{[[:space:]\n]+}. The default value of this variable considers
-any sequence of spaces and tab characters as whitespace.
+ By default, search commands perform @dfn{lax space matching}: each
+space, or sequence of spaces, matches any sequence of one or more
+whitespace characters in the text. More precisely, Emacs matches each
+sequence of space characters in the search string to a regular
+expression specified by the user option
+@code{search-whitespace-regexp}. The default value of this option
+considers any sequence of spaces and tab characters as whitespace.
+Hence, @w{@samp{foo bar}} matches @w{@samp{foo bar}}, @w{@samp{foo@ @
+bar}}, @w{@samp{foo@ @ @ bar}}, and so on (but not @samp{foobar}). If
+you want to make spaces match sequences of newlines as well as spaces
+and tabs, customize the option to make its value be the regular
+expression @samp{[ \t\n]+}. (The default behavior of the
+incremental regexp search is different; see @ref{Regexp Search}.)
If you want whitespace characters to match exactly, you can turn lax
space matching off by typing @kbd{M-s @key{SPC}}
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 0f1c4da0c6..27abe5caaa 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -460,7 +460,7 @@ variables.
@vindex electric-quote-replace-double
You can also set the option @code{electric-quote-replace-double} to
-a non-@code{nil} value. Then, typing @kbd{"} insert an appropriate
+a non-@code{nil} value. Then, typing @kbd{"} inserts an appropriate
curved double quote depending on context: @t{“} at the beginning of
the buffer or after a line break, whitespace, opening parenthesis, or
quote character, and @t{”} otherwise.
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 9035e7f6bb..3c874ee3fe 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1534,7 +1534,7 @@ iterator with @code{iter-next} for anything interesting
to happen.
Each call to a generator function produces a @emph{different}
iterator, each with its own state.
-@defun iter-next iterator value
+@defun iter-next iterator &optional value
Retrieve the next value from @var{iterator}. If there are no more
values to be generated (because @var{iterator}'s generator function
returned), @code{iter-next} signals the @code{iter-end-of-sequence}
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 6a51489d8a..1562a37842 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1076,16 +1076,25 @@ current buffer, are saved and restored.
@cindex window configuration (Edebug)
The outside window configuration is saved and restored if
@code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Options}).
+If the value of @code{edebug-save-windows} is a list, only the listed
+windows are saved and restored.
The window configuration is not restored on error or quit, but the
outside selected window @emph{is} reselected even on error or quit in
-case a @code{save-excursion} is active. If the value of
-@code{edebug-save-windows} is a list, only the listed windows are saved
-and restored.
+case a @code{save-excursion} is active.
The window start and horizontal scrolling of the source code buffer are
not restored, however, so that the display remains coherent within Edebug.
+@cindex buffer point changed by Edebug
+@cindex edebug overwrites buffer point position
+Saving and restoring the outside window configuration can sometimes
+change the positions of point in the buffers on which the Lisp program
+you are debugging operates, especially if your program moves point.
+If this happens and interferes with your debugging, we recommend to
+set @code{edebug-save-windows} to @code{nil}
+(@pxref{Edebug Options}).
+
@item
The value of point in each displayed buffer is saved and restored if
@code{edebug-save-displayed-buffer-points} is non-@code{nil}.
@@ -1655,10 +1664,16 @@ specify an Edebug form specification.
If this is non-@code{nil}, Edebug saves and restores the window
configuration. That takes some time, so if your program does not care
what happens to the window configurations, it is better to set this
-variable to @code{nil}.
-
-If the value is a list, only the listed windows are saved and
-restored.
+variable to @code{nil}. We also recommend to set this to @code{nil}
+if the default value causes Edebug to overwrite the positions of point
+in buffers that are involved in the program you are debugging, as
+result of saving and restoring the window configuration; this could
+happen if your program moves point in one or more of those buffers.
+Another option to try to customize in this case is
+@code{edebug-save-displayed-buffer-points}, described below.
+
+If the value of @code{edebug-save-windows} is a list, only the listed
+windows are saved and restored.
You can use the @kbd{W} command in Edebug to change this variable
interactively. @xref{Edebug Display Update}.
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 65ad5f0554..ee6fdb0dbb 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -980,8 +980,8 @@ In addition to function descriptions, the list can also
have string
elements, which are used to divide a documentation group into
sections.
-@defun shortdoc-add-function shortdoc-add-function group section elem
-Lisp packages can add functions to groups with this command. Each
+@defun shortdoc-add-function group section elem
+Lisp packages can add functions to groups with this function. Each
@var{elem} should be a function description, as described above.
@var{group} is the function group, and @var{section} is what section
in the function group to insert the function into.
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 975215d697..eccc8deb63 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -34,7 +34,9 @@ specifically to editing.
This is
@iftex
+@ifset VERSION
edition @value{VERSION} of
+@end ifset
@end iftex
the @cite{GNU Emacs Lisp Reference Manual},
corresponding to Emacs version @value{EMACSVER}.
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index da8df96854..adc6909aca 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2585,6 +2585,10 @@ that are mainly relevant to encrypted connections:
@item :nowait @var{boolean}
If non-@code{nil}, try to make an asynchronous connection.
+@item :noquery @var{query-flag}
+Initialize the process query flag to @var{query-flag}.
+@xref{Query Before Exit}.
+
@item :coding @var{coding}
Use this to set the coding systems used by the network process, in
preference to binding @code{coding-system-for-read} or
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 743718b560..ad7f2856de 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -395,13 +395,12 @@ range should not be the starting point of another one;
for example,
@samp{[a-m-z]} should be avoided.
A character alternative can also specify named character classes
-(@pxref{Char Classes}). This is a POSIX feature. For example,
-@samp{[[:ascii:]]} matches any @acronym{ASCII} character.
-Using a character class is equivalent to mentioning each of the
-characters in that class; but the latter is not feasible in practice,
-since some classes include thousands of different characters.
-A character class should not appear as the lower or upper bound
-of a range.
+(@pxref{Char Classes}). For example, @samp{[[:ascii:]]} matches any
+@acronym{ASCII} character. Using a character class is equivalent to
+mentioning each of the characters in that class; but the latter is not
+feasible in practice, since some classes include thousands of
+different characters. A character class should not appear as the
+lower or upper bound of a range.
The usual regexp special characters are not special inside a
character alternative. A completely different set of characters is
@@ -617,7 +616,7 @@ This matches any character whose code is in the range 0--31.
This matches @samp{0} through @samp{9}. Thus, @samp{[-+[:digit:]]}
matches any digit, as well as @samp{+} and @samp{-}.
@item [:graph:]
-This matches graphic characters---everything except whitespace,
+This matches graphic characters---everything except spaces,
@acronym{ASCII} and non-@acronym{ASCII} control characters,
surrogates, and codepoints unassigned by Unicode, as indicated by the
Unicode @samp{general-category} property (@pxref{Character
@@ -625,29 +624,39 @@ Properties}).
@item [:lower:]
This matches any lower-case letter, as determined by the current case
table (@pxref{Case Tables}). If @code{case-fold-search} is
-non-@code{nil}, this also matches any upper-case letter.
+non-@code{nil}, this also matches any upper-case letter. Note that a
+buffer can have its own local case table different from the default
+one.
@item [:multibyte:]
This matches any multibyte character (@pxref{Text Representations}).
@item [:nonascii:]
This matches any non-@acronym{ASCII} character.
@item [:print:]
-This matches any printing character---either whitespace, or a graphic
-character matched by @samp{[:graph:]}.
+This matches any printing character---either spaces or graphic
+characters matched by @samp{[:graph:]}.
@item [:punct:]
This matches any punctuation character. (At present, for multibyte
-characters, it matches anything that has non-word syntax.)
+characters, it matches anything that has non-word syntax, and thus its
+exact definition can vary from one major mode to another, since the
+syntax of a character depends on the major mode.)
@item [:space:]
This matches any character that has whitespace syntax
-(@pxref{Syntax Class Table}).
+(@pxref{Syntax Class Table}). Note that the syntax of a character,
+and thus which characters are considered ``whitespace'',
+depends on the major mode.
@item [:unibyte:]
This matches any unibyte character (@pxref{Text Representations}).
@item [:upper:]
This matches any upper-case letter, as determined by the current case
table (@pxref{Case Tables}). If @code{case-fold-search} is
-non-@code{nil}, this also matches any lower-case letter.
+non-@code{nil}, this also matches any lower-case letter. Note that a
+buffer can have its own local case table different from the default
+one.
@item [:word:]
This matches any character that has word syntax (@pxref{Syntax Class
-Table}).
+Table}). Note that the syntax of a character, and thus which
+characters are considered ``word-constituent'', depends on the major
+mode.
@item [:xdigit:]
This matches the hexadecimal digits: @samp{0} through @samp{9}, @samp{a}
through @samp{f} and @samp{A} through @samp{F}.
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index cf961e9e7c..4454188cc4 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -484,7 +484,7 @@ is a multibyte string, we recommend to make sure
@var{string} is also
multibyte, even if it's pure-@acronym{ASCII}.
Since it is impossible to change the number of characters in an
-existing string, it is en error if @var{obj} consists of more
+existing string, it is an error if @var{obj} consists of more
characters than would fit in @var{string} starting at character index
@var{idx}.
@end defun
diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1
index 1ee3c14fb9..48637ab608 100644
--- a/doc/misc/ChangeLog.1
+++ b/doc/misc/ChangeLog.1
@@ -1460,7 +1460,7 @@
2013-10-24 Michael Albinus <michael.albinus@gmx.de>
- * ert.texi (Running Tests Interactively): Adapt examle output.
+ * ert.texi (Running Tests Interactively): Adapt example output.
(Tests and Their Environment): Mention skip-unless.
2013-10-23 Glenn Morris <rgm@gnu.org>
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index e4b344f267..41499d1953 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3381,9 +3381,9 @@ true for all elements.
@defun cl-reduce function seq @t{&key :from-end :start :end :initial-value
:key}
This function returns the result of calling @var{function} on the
-first and second element of @var{seq}, then calling @var{function}
+first and second elements of @var{seq}, then calling @var{function}
with that result and the third element of @var{seq}, then with that
-result and the third element of @var{seq}, etc.
+result and the fourth element of @var{seq}, etc.
Here is an example. Suppose @var{function} is @code{*} and @var{seq}
is the list @code{(2 3 4 5)}. The first two elements of the list are
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index c0c2ef93d9..7a26fe0e57 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -1432,7 +1432,7 @@ See @file{ede-proj-obj.el} for examples of the
combination.
@item ede-project-placeholder
@table @asis
@item Children:
-@w{@xref{ede-project}.}
+@xref{ede-project}.
@end table
@end table
@end table
@@ -1515,12 +1515,12 @@ Make sure placeholder @var{THIS} is replaced with the
real thing, and pass throu
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
@item ede-project
@table @asis
@item Children:
-@w{@xref{ede-cpp-root-project},} @w{ede-emacs-project,} @w{ede-linux-project,}
@w{ede-maven-project,} @w{@xref{ede-simple-project},}
@w{@xref{ede-simple-base-project},} @w{@xref{ede-proj-project},}
@w{@xref{project-am-makefile},} @w{@xref{ede-step-project}.}
+@xref{ede-cpp-root-project}, @w{ede-emacs-project,} @w{ede-linux-project,}
@w{ede-maven-project,} @xref{ede-simple-project},
@xref{ede-simple-base-project}, @xref{ede-proj-project},
@xref{project-am-makefile}, @xref{ede-step-project}.
@end table
@end table
@end table
@@ -1801,9 +1801,9 @@ Commit change to local variables in @var{PROJ}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-cpp-root-project
No children
@@ -1923,9 +1923,9 @@ This knows details about or source tree.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-simple-project
No children
@@ -1953,9 +1953,9 @@ Commit any change to @var{PROJ} to its file.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-simple-base-project
No children
@@ -1983,9 +1983,9 @@ This one project could control a tree of subdirectories.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-proj-project
No children
@@ -2173,9 +2173,9 @@ Commit change to local variables in @var{PROJ}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item project-am-makefile
No children
@@ -2215,9 +2215,9 @@ buffer being in order to provide a smart default target
type.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-step-project
No children
@@ -2371,7 +2371,7 @@ Commit change to local variables in @var{PROJ}.
@item ede-target
@table @asis
@item Children:
-@w{ede-cpp-root-target,} @w{ede-emacs-target-c,} @w{ede-emacs-target-el,}
@w{ede-emacs-target-misc,} @w{ede-linux-target-c,} @w{ede-linux-target-misc,}
@w{ede-maven-target-java,} @w{ede-maven-target-c,} @w{ede-maven-target-misc,}
@w{ede-simple-target,} @w{@xref{ede-proj-target},} @w{@xref{project-am-target}.}
+@w{ede-cpp-root-target,} @w{ede-emacs-target-c,} @w{ede-emacs-target-el,}
@w{ede-emacs-target-misc,} @w{ede-linux-target-c,} @w{ede-linux-target-misc,}
@w{ede-maven-target-java,} @w{ede-maven-target-c,} @w{ede-maven-target-misc,}
@w{ede-simple-target,} @xref{ede-proj-target}, @xref{project-am-target}.
@end table
@end table
@end table
@@ -2577,12 +2577,12 @@ Retrieves the slot @code{menu} from an object of class
@code{ede-target}
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
@item ede-proj-target
@table @asis
@item Children:
-@w{@xref{ede-proj-target-makefile},} @w{ede-proj-target-aux,}
@w{@xref{ede-proj-target-scheme}.}
+@xref{ede-proj-target-makefile}, @w{ede-proj-target-aux,}
@xref{ede-proj-target-scheme}.
@end table
@end table
@end table
@@ -2766,14 +2766,14 @@ sources variable.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
@item ede-proj-target-makefile
@table @asis
@item Children:
-@w{@xref{semantic-ede-proj-target-grammar},}
@w{@xref{ede-proj-target-makefile-objectcode},}
@w{@xref{ede-proj-target-elisp},}
@w{@xref{ede-proj-target-makefile-miscelaneous},}
@w{@xref{ede-proj-target-makefile-info}.}
+@xref{semantic-ede-proj-target-grammar},
@xref{ede-proj-target-makefile-objectcode}, @xref{ede-proj-target-elisp},
@xref{ede-proj-target-makefile-miscelaneous},
@xref{ede-proj-target-makefile-info}.
@end table
@end table
@end table
@@ -2864,11 +2864,11 @@ Use @var{CONFIGURATION} as the current configuration to
query.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item semantic-ede-proj-target-grammar
No children
@@ -2918,16 +2918,16 @@ Argument @var{THIS} is the target that should insert
stuff.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-makefile-objectcode
@table @asis
@item Children:
-@w{@xref{ede-proj-target-makefile-archive},}
@w{@xref{ede-proj-target-makefile-program}.}
+@xref{ede-proj-target-makefile-archive},
@xref{ede-proj-target-makefile-program}.
@end table
@end table
@end table
@@ -2980,13 +2980,13 @@ Argument @var{THIS} is the target to get sources from.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-objectcode}.}
+@item @xref{ede-proj-target-makefile-objectcode}.
@table @code
@item ede-proj-target-makefile-archive
No children
@@ -3023,18 +3023,18 @@ Makefile.am generator, so use it to add this important
bin program.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-objectcode}.}
+@item @xref{ede-proj-target-makefile-objectcode}.
@table @code
@item ede-proj-target-makefile-program
@table @asis
@item Children:
-@w{@xref{ede-proj-target-makefile-shared-object}.}
+@xref{ede-proj-target-makefile-shared-object}.
@end table
@end table
@end table
@@ -3102,15 +3102,15 @@ Insert bin_PROGRAMS variables needed by target
@var{THIS}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-objectcode}.}
+@item @xref{ede-proj-target-makefile-objectcode}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-program}.}
+@item @xref{ede-proj-target-makefile-program}.
@table @code
@item ede-proj-target-makefile-shared-object
No children
@@ -3162,16 +3162,16 @@ Makefile.am generator, so use it to add this important
bin program.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-elisp
@table @asis
@item Children:
-@w{@xref{ede-proj-target-elisp-autoloads}.}
+@xref{ede-proj-target-elisp-autoloads}.
@end table
@end table
@end table
@@ -3238,13 +3238,13 @@ is found, such as a @code{-version} variable, or the
standard header.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-elisp}.}
+@item @xref{ede-proj-target-elisp}.
@table @code
@item ede-proj-target-elisp-autoloads
No children
@@ -3353,11 +3353,11 @@ sources variable.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-makefile-miscelaneous
No children
@@ -3409,11 +3409,11 @@ Return a list of files which @var{THIS} target depends
on.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-makefile-info
No children
@@ -3495,9 +3495,9 @@ when working in Automake mode.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
@item ede-proj-target-scheme
No children
@@ -3539,12 +3539,12 @@ Tweak the configure file (current buffer) to
accommodate @var{THIS}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
@item project-am-target
@table @asis
@item Children:
-@w{@xref{project-am-objectcode},} @w{project-am-header,}
@w{@xref{project-am-lisp},} @w{@xref{project-am-texinfo},}
@w{@xref{project-am-man}.}
+@xref{project-am-objectcode}, @w{project-am-header,} @xref{project-am-lisp},
@xref{project-am-texinfo}, @xref{project-am-man}.
@end table
@end table
@end table
@@ -3577,14 +3577,14 @@ Edit the target associated w/ this file.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-objectcode
@table @asis
@item Children:
-@w{@xref{project-am-program},} @w{project-am-lib.}
+@xref{project-am-program}, @w{project-am-lib.}
@end table
@end table
@end table
@@ -3622,11 +3622,11 @@ There are no default header files.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
-@item @w{@xref{project-am-objectcode}.}
+@item @xref{project-am-objectcode}.
@table @code
@item project-am-program
No children
@@ -3660,9 +3660,9 @@ Additional LD args.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item @w{project-am-header.}
@table @code
@@ -3693,9 +3693,9 @@ Return the default macro to 'edit' for this object.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item @w{project-am-header.}
@table @code
@@ -3726,9 +3726,9 @@ Return the default macro to 'edit' for this object.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-lisp
No children
@@ -3756,9 +3756,9 @@ Return the default macro to 'edit' for this object.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-texinfo
No children
@@ -3808,9 +3808,9 @@ files in the project.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-man
No children
@@ -3963,7 +3963,7 @@ compile commands.
@item ede-compilation-program
@table @asis
@item Children:
-@w{@xref{ede-compiler},} @w{@xref{ede-linker}.}
+@xref{ede-compiler}, @xref{ede-linker}.
@end table
@end table
@end table
@@ -4071,12 +4071,12 @@ Tweak the configure file (current buffer) to
accommodate @var{THIS}.
@table @code
@item eieio-instance-inheritor
@table @code
-@item @w{@xref{ede-compilation-program}.}
+@item @xref{ede-compilation-program}.
@table @code
@item ede-compiler
@table @asis
@item Children:
-@w{@xref{ede-object-compiler},} @w{semantic-ede-grammar-compiler-class.}
+@xref{ede-object-compiler}, @w{semantic-ede-grammar-compiler-class.}
@end table
@end table
@@ -4179,9 +4179,9 @@ Return a string based on @var{THIS} representing a make
object variable.
@table @code
@item eieio-instance-inheritor
@table @code
-@item @w{@xref{ede-compilation-program}.}
+@item @xref{ede-compilation-program}.
@table @code
-@item @w{@xref{ede-compiler}.}
+@item @xref{ede-compiler}.
@table @code
@item ede-object-compiler
No children
@@ -4222,7 +4222,7 @@ Insert variables needed by the compiler @var{THIS}.
@table @code
@item eieio-instance-inheritor
@table @code
-@item @w{@xref{ede-compilation-program}.}
+@item @xref{ede-compilation-program}.
@table @code
@item ede-linker
No children
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 23e3b086a3..3f5c2bc1a7 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -2668,7 +2668,7 @@ To disable or change the way backups are made,
@cindex Backup files in a single directory
You can control where Emacs puts backup files by customizing the
variable @code{backup-directory-alist}. This variable's value
-specifies that files whose names match specific patters should have
+specifies that files whose names match specific patterns should have
their backups put in certain directories. A typical use is to add the
element @code{("." . @var{dir})} to force Emacs to put @strong{all}
backup files in the directory @file{dir}.
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index 5a20028702..04bdcc6161 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -264,8 +264,9 @@ Emacs major-mode @code{foo-mode}, you can add it to the
alist like
this:
@lisp
-(add-to-list 'eglot-server-programs
- '(foo-mode . ("fools" "--stdio")))
+(with-eval-after-load 'eglot
+ (add-to-list 'eglot-server-programs
+ '(foo-mode . ("fools" "--stdio"))))
@end lisp
This will invoke the program @command{fools} with the command-line
@@ -277,6 +278,24 @@ mentioned by the @code{exec-path} variable
(@pxref{Subprocess
Creation,,, elisp, GNU Emacs Lisp Reference Manual}), for Eglot to be
able to find it.
+Sometimes, multiple servers are acceptable alternatives for handling a
+given major-mode. In those cases, you may combine the helper function
+@code{eglot-alternatives} with the funcional form of
+@code{eglot-server-programs}.
+
+@lisp
+(with-eval-after-load 'eglot
+ (add-to-list 'eglot-server-programs
+ `(foo-mode . ,(eglot-alternatives
+ '(("fools" "--stdio")
+ ("phewls" "--fast"))))))
+@end lisp
+
+If you have @command{fools} and @command{phewls} installed, the
+function produced by @code{eglot-alternatives} will prompt for the
+server to use in @code{foo-mode} buffers. Else it will use whichever
+is available.
+
@node Starting Eglot
@section Starting Eglot
@cindex starting Eglot
@@ -872,7 +891,7 @@ Eglot supports and enhances (@pxref{Eglot Features}). For
example:
@item
To configure the face used for server-derived errors and warnings,
customize the Flymake faces @code{flymake-error} and
-@code{flymake-error}.
+@code{flymake-warning}.
@item
To configure the amount of space taken up by documentation in the
@@ -945,9 +964,9 @@ provide per-project settings, as described below in more
detail.
Some language servers need to know project-specific settings, which
the LSP calls @dfn{workspace configuration}. Eglot allows such fine
tuning of per-project settings via the variable
-@code{eglot-workspace-configuration}. Eglot sends the portion of the
-settings contained in this variable to each server for which such
-settings were defined in the variable. These settings are
+@code{eglot-workspace-configuration}. Eglot sends the settings in
+this variable to each server, and each server applies the portion of the
+settings relevant to it and ignores the rest. These settings are
communicated to the server initially (upon establishing the
connection) or when the settings are changed, or in response to a
configuration request from the server.
@@ -1022,8 +1041,8 @@ Alternatively, the same configuration could be defined as
follows:
@end lisp
This is an equivalent setup which sets the value for all the
-major-modes inside the project; Eglot will use for each server only
-the section of the parameters intended for that server.
+major-modes inside the project; each server will use only the section
+of the parameters intended for that server, and ignore the rest.
As yet another alternative, you can set the value of
@code{eglot-workspace-configuration} programmatically, via the
@@ -1046,8 +1065,10 @@ Eglot via Elisp to adapt to it, by defining a suitable
Here's an example:
@lisp
+(require 'eglot)
+
(add-to-list 'eglot-server-programs
- '((c++ mode c-mode) . (eglot-cquery "cquery")))
+ '((c++-mode c-mode) . (eglot-cquery "cquery")))
(defclass eglot-cquery (eglot-lsp-server) ()
:documentation "A custom class for cquery's C/C++ langserver.")
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index ff368c9dc4..96873a3f9a 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -717,9 +717,12 @@ current environment.
@cmindex su
@itemx sudo
@cmindex sudo
-Uses TRAMP's @command{su} or @command{sudo} method @pxref{Inline methods, , ,
tramp}
-to run a command via @command{su} or @command{sudo}. These commands
-are in the eshell-tramp module, which is disabled by default.
+@itemx doas
+@cmindex doas
+Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method
+@pxref{Inline methods, , , tramp} to run a command via @command{su},
+@command{sudo}, or @command{doas}. These commands are in the
+eshell-tramp module, which is disabled by default.
@item substitute
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index 0037ba78d3..7293f48f41 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -85,6 +85,10 @@ LDAP, Lightweight Directory Access Protocol
BBDB, Big Brother's Insidious Database
@item
macOS Contacts
+@item
+@code{ecomplete}, Emacs's electrical completion
+@item
+@code{mailabbrev}, Emacs's abbrev-expansion of mail aliases
@end itemize
The main features of the EUDC interface are:
@@ -110,6 +114,8 @@ Interface to BBDB to let you insert server records into
your own BBDB database
* LDAP:: What is LDAP ?
* BBDB:: What is BBDB ?
* macOS Contacts:: What is macOS Contacts ?
+* ecomplete:: What is @code{ecomplete} ?
+* mailabbrev:: What is @code{mailabbrev}?
@end menu
@@ -173,14 +179,73 @@ Address Book; the EUDC macOS Contacts back end also works
on those
older versions.
+@node ecomplete
+@section @code{ecomplete}
+
+@code{ecomplete} is Emacs's ``electric completion'', and it is part of
+Emacs. It stores all information in an @file{ecompleterc} file, whose
+location, and name can be configured via the variable
+@code{ecomplete-database-file} (which see). The format of the file
+is:
+
+@display
+((TYPE_1 ITEM_1 ITEM_2 ...)
+ (TYPE_2 ITEM_N+1 ITEM_N+2 ...)
+ ...)
+@end display
+
+That is, it is an alist map where the key is the type of match (so
+that you can have one list of things for ``mail'', and one for, say,
+``mastodon''). In each of these sections you then have a list where
+each item is of the form:
+
+@display
+(KEY TIMES-USED LAST-TIME-USED STRING)
+@end display
+
+When performing a query, the result will be all items where the search
+term matches all, or part of STRING.
+
+When EUDC performs queries with @code{ecomplete}, the name of each
+attribute making up the query is used as the type in which the lookup
+is performed. The mapping from EUDC attribute names to
+@code{ecomplete} type names is performed according to the variable
+@code{eudc-ecomplete-attributes-translation-alist} (which see).
+
+
+@node mailabbrev
+@section @code{mailabbrev}
+
+@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and
+it is part of Emacs. It stores all information in a @file{mailrc}
+file, whose location, and name can be configured via the variable
+@code{mail-personal-alias-file} (which see). The @file{mailrc} file
+has the same format as the @command{mail} and @command{mailx} commands
+use for their startup configuration file. @code{mailabbrev} processes
+@samp{alias}, and @samp{source} statements in the @file{mailrc} file.
+@samp{alias} statements can define simple aliases and distribution
+lists, and and can be nested in that the alias expansion can contain
+references to other alias definitions. Forward references, that is
+references to aliases before they are actually defined, are possible,
+too.
+
+Originally, @code{mailabbrev} was designed to be used with
+@code{abbrev-mode}. The @code{mailabbrev} EUDC backend does not use
+@code{abbrev-mode}, but queries @code{mailabbrev} for alias entries
+only, and returns these as EUDC results. All entries where the alias
+name exactly equals either the @code{email}, @code{name}, or
+@code{firstname} attribute value in the EUDC query, will be returned
+as matches. When a @file{mailrc} alias defines a distribution list,
+that is it expands to more than one email address, the EUDC result
+will contain a single entry, which will contain an email attribute
+only, whose value will be a comma-separated list of RFC 5322 formatted
+recipient specifications.
+
+
@node Installation
@chapter Installation
-Add the following to your @file{.emacs} init file:
-@lisp
-(require 'eudc)
-@end lisp
-This will install EUDC at startup.
+EUDC is built-in to Emacs, and its main functions are autoloaded.
After installing EUDC you will find (the next time you launch Emacs) a
new @code{Directory Search} submenu in the @samp{Tools} menu that will
@@ -200,6 +265,8 @@ email composition buffers (@pxref{Inline Query Expansion})
@menu
* LDAP Configuration:: EUDC needs external support for LDAP
* macOS Contacts Configuration:: Enable the macOS Contacts backend
+* ecomplete Configuration:: Enable the ecomplete backend
+* mailabbrev Configuration:: Enable the mailabbrev backend
@end menu
@node LDAP Configuration
@@ -256,7 +323,7 @@ will return all LDAP entries with surnames that begin with
@code{Smith}. In every LDAP query it makes, EUDC implicitly appends
the wildcard character to the end of the last word, except if the word
corresponds to an attribute which is a member of
-`eudc-ldap-no-wildcard-attributes'.
+@code{eudc-ldap-no-wildcard-attributes}.
@menu
* Emacs-only Configuration:: Configure with @file{.emacs}
@@ -406,9 +473,9 @@ level to 5 by appending @code{-d 5} to the command line.
macOS Contacts support is added by means of @file{eudcb-mab.el}, or
@file{eudcb-macos-contacts.el} which are part of Emacs.
-To enable a macOS Contacts backend, first `require' the respective
-library to load it, and then set the `eudc-server' to localhost in
-your init file:
+To enable a macOS Contacts backend, first @code{require} the
+respective library to load it, and then set the @code{eudc-server} to
+localhost in your init file:
@lisp
(require 'eudcb-macos-contacts)
(eudc-macos-contacts-set-server "localhost")
@@ -433,6 +500,32 @@ command-line utility before upgrading to a new version of
macOS.
existing configurations, and may be removed in a future release.
+@node ecomplete Configuration
+@section @code{ecomplete} Configuration
+
+@code{ecomplete} is Emacs's ``electrical completion'', and is part of
+Emacs. To use it, you will need to set up a database file
+(@pxref{ecomplete}) first.
+
+It will be autoloaded on demand.
+
+You can also enable multi-server queries as described in
+@pxref{Multi-server Queries}.
+
+
+@node mailabbrev Configuration
+@section @code{mailabbrev} Configuration
+
+@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and
+it is part of Emacs. To use it, you will need to set up a database file
+(@pxref{mailabbrev}) first.
+
+It will be autoloaded on demand.
+
+You can also enable multi-server queries as described in
+@pxref{Multi-server Queries}.
+
+
@node Usage
@chapter Usage
@@ -916,13 +1009,23 @@ in other places, like for example the body of the
message.
@section The Server Hotlist
EUDC lets you maintain a list of frequently used servers so that you
-can easily switch from one to another. This hotlist appears in the
-@samp{Server} submenu. You select a server in this list by clicking on
-its name. You can add the current server to the list with the command
-@kbd{M-x eudc-bookmark-current-server}. The list is contained in the variable
-@code{eudc-server-hotlist} which is stored in and retrieved from the file
-designated by @code{eudc-options-file}. EUDC also provides a facility to
-edit the hotlist interactively (@pxref{The Hotlist Edit Buffer}).
+can easily switch from one to another. Most users should configure
+the hotlist via Customize, and store the configuration in the main
+Emacs initialization file. Configuring it dynamically can be
+confusing, particularly if the hotlist settings are saved to
+@code{eudc-options-file} automatically. @code{eudc-options-file} is
+historical and support for it is still maintained, but new EUDC users
+should set @code{eudc-ignore-options-file} to @code{t}.
+
+However, this hotlist also appears in the @samp{Server} submenu. You
+select a server in this list by clicking on its name. You can add the
+current server to the list with the command @kbd{M-x
+eudc-bookmark-current-server}. The list is contained in the variable
+@code{eudc-server-hotlist} which is stored in and retrieved from the
+file designated by @code{eudc-options-file}, or normal Emacs
+initialization if @code{eudc-ignore-options-file} is non-nil. EUDC
+also provides a facility to edit the hotlist interactively (@pxref{The
+Hotlist Edit Buffer}).
The hotlist is also used to make queries on multiple servers
successively (@pxref{Multi-server Queries}). The order in which the
@@ -937,6 +1040,14 @@ Add @var{server} to the hotlist of servers
Add the current server to the hotlist of servers
@end deffn
+@defvar eudc-ignore-options-file
+If non-nil, then EUDC ignores @code{eudc-options-file} and warns or
+issues an error when an attempt is made to use it. Most users should
+set this, and keep their EUDC configuration in the main Emacs
+initialization file instead. The separate eudc-options file has
+created confusion for users in the past.
+@end defvar
+
@defvar eudc-options-file
The name of a file where EUDC stores its internal variables (the
hotlist and the current server). EUDC will try to load that file upon
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index da1695099a..c075f0298a 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -615,7 +615,7 @@ delimited by @var{beg} and @var{end}. @var{type} is a
diagnostic
symbol (@pxref{Flymake error types}), and @var{text} is a description
of the problem detected in this region. Most commonly @var{locus} is
the buffer object designating for the current buffer being
-syntax-checked. However, it may be a string nameing a file relative
+syntax-checked. However, it may be a string naming a file relative
to the current working directory. @xref{Foreign and list-only
diagnostics}, for when this may be useful. Depending on the type of
@var{locus}, @var{beg} and @var{end} are both either buffer positions
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 7bcf334297..c4705928d3 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -21592,11 +21592,10 @@ details on Gnus' query language, see @ref{Search
Queries}.
In order to search for messages from any given server, that server
must have a search engine associated with it. IMAP servers do their
-own searching (theoretically it is possible to use a different engine
-to search an IMAP store, but we don't recommend it), but in all other
-cases the user will have to manually specify an engine to use. This
-can be done at two different levels: by server type, or on a
-per-server basis.
+own searching, and searching IMAP groups will work with no additional
+configuration, but in all other cases the user will have to manually
+specify an engine to use. This can be done at two different levels:
+by server type, or on a per-server basis.
@vindex gnus-search-default-engines
The option @code{gnus-search-default-engines} assigns search engines
@@ -21900,14 +21899,13 @@ be found at
@uref{http://www.rpcurnow.force9.co.uk/mairix/index.html}
Though mairix might not be as flexible as other search tools like
-swish++ or namazu, which you can use via the @code{nnir} back end, it
-has the prime advantage of being incredibly fast. On current systems, it
-can easily search through headers and message bodies of thousands and
-thousands of mails in well under a second. Building the database
-necessary for searching might take a minute or two, but only has to be
-done once fully. Afterwards, the updates are done incrementally and
-therefore are really fast, too. Additionally, mairix is very easy to set
-up.
+swish++ or namazu, it has the prime advantage of being incredibly
+fast. On current systems, it can easily search through headers and
+message bodies of thousands and thousands of mails in well under a
+second. Building the database necessary for searching might take a
+minute or two, but only has to be done once fully. Afterwards, the
+updates are done incrementally and therefore are really fast, too.
+Additionally, mairix is very easy to set up.
For maximum speed though, mairix should be used with mails stored in
@code{Maildir} or @code{MH} format (this includes the @code{nnml} back
@@ -22545,6 +22543,21 @@ to you, using @kbd{G b u} and updating the group will
usually fix this.
@end itemize
+@node nnir
+@section Migrating from nnir
+
+@cindex nnir
+
+Gnus' previous search engine was called nnir, and is obsolete as of
+Emacs version 28. If you've upgraded Emacs and are now getting
+obsolete-variable warnings about @code{nnir-*} variables, migration is
+fairly straightforward. In addition to the variables raised by the
+warnings, all previous engine-specific variables can be updated by
+simply replacing the @code{nnir-} prefix with @code{gnus-search-}.
+For instance, @code{nnir-notmuch-program} is now
+@code{gnus-search-notmuch-program}.
+
+
@iftex
@iflatex
@chapter Message
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index c5accd0789..56ba5fd348 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -2834,7 +2834,7 @@ To reset the changes, we apply this and reload the theme:
Users who wish to leverage such a mechanism can opt to implement it
on-demand by means of a global minor mode. The following snippet covers
-both themes and expands to some more assosiations in the palette:
+both themes and expands to some more associations in the palette:
#+begin_src emacs-lisp
(define-minor-mode my-modus-themes-tinted
@@ -5878,7 +5878,7 @@ interface virtually unusable.
[[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]].
-Again, one must exercise judgement in order to avoid discrimination,
+Again, one must exercise judgment in order to avoid discrimination,
where "discrimination" refers to:
+ The treatment of substantially different magnitudes as if they were of
@@ -5951,7 +5951,7 @@ the themes, which is partially fleshed out in this manual.
With regard to the artistic aspect (where "art" qua skill may amount to
an imprecise science), there is no hard-and-fast rule in effect as it
-requires one to exercize discretion and make decisions based on
+requires one to exercise discretion and make decisions based on
context-dependent information or constraints. As is true with most
things in life, when in doubt, do not cling on to the letter of the law
but try to understand its spirit.
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index b30e5aeaa4..e85f096f99 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -3605,7 +3605,7 @@ menu. @xref{Key Bindings}.
@deffn Command reftex-toc
Show the table of contents for the current document. When called with
-one ore two @kbd{C-u} prefixes, rescan the document first.
+one or two @kbd{C-u} prefixes, rescan the document first.
@end deffn
@deffn Command reftex-label
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index a6745131d8..e5e7cccbe8 100644
--- a/doc/misc/transient.texi
+++ b/doc/misc/transient.texi
@@ -1957,7 +1957,7 @@ probably don't want that.
@item
@code{transient-suffix} and @code{transient-non-suffix} play a part when
determining whether the currently active transient prefix command
-remains active/transient when a suffix or abitrary non-suffix
+remains active/transient when a suffix or arbitrary non-suffix
command is invoked. @xref{Transient State}.
@item
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 988eb1e09c..5cabb9b015 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -98,6 +98,11 @@ Although rare, server passwords containing white space are
now handled
correctly.
** Miscellaneous behavioral changes in the library API.
+A number of core macros and other definitions have been moved to a new
+file called erc-common.el. This was done to further lessen the
+various complications arising from the mutual dependency between 'erc'
+and 'erc-backend'.
+
The function 'erc-network' always returns non-nil in server and target
buffers belonging to a successfully established IRC connection, even
after that connection has been closed.
@@ -109,11 +114,14 @@ network-context identifiers via a new ':id' keyword. The
latter
carries wider significance beyond autojoin and can be used for
unequivocally identifying a connection in a human-readable way.
-The function 'erc-auto-query', unused internally, and basically
-inscrutable when read, has been deprecated with no public replacement.
-This raises a related issue: if you use ERC as a library and need
-something only offered internally, please lobby to have it exported by
-writing to emacs-erc@gnu.org.
+The function 'erc-auto-query' was deemed too difficult to reason
+through and has thus been deprecated with no public replacement; it
+has also been removed from the client code path.
+
+A few internal variables have been introduced that could just as well
+have been made public, possibly as user options. Likewise for some
+internal functions. As always, users needing such functionality
+officially exposed are encouraged to write to emacs-erc@gnu.org.
* Changes in ERC 5.4.1
diff --git a/etc/NEWS b/etc/NEWS
index bf50c900ea..7cd192b9d3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -105,29 +105,21 @@ configuration on X is known to have problems, such as
undesirable
frame positioning and various issues with keyboard input of sequences
such as 'C-;' and 'C-S-u'.
+---
+** The implementation of overlays has changed.
+Emacs now uses an implementation of overlays that is much more
+efficient than the original one, and should speed up all the
+operations that involve overlays, especially when there are lots of
+them in a buffer. However, no changes in behavior of overlays should
+be visible on the Lisp or user level, with the exception of better
+performance and the order of overlays returned by functions that don't
+promise any particular order.
+
---
** The docstrings of preloaded files are not in "etc/DOC" any more.
Instead, they're fetched as needed from the corresponding ".elc" file,
as was already the case for all the non-preloaded files.
-** Emacs Sessions (Desktop)
-
-+++
-*** New user option to load a locked desktop if locking Emacs is not running.
-The option 'desktop-load-locked-desktop' can now be set to the value
-'check-pid', which means to allow loading a locked ".emacs.desktop"
-file if the Emacs process which locked it is no longer running on the
-local machine. This allows avoiding questions about locked desktop
-files when the Emacs session which locked it crashes, or was otherwise
-interrupted, and didn't exit gracefully. See the "(emacs) Saving
-Emacs Sessions" node in the Emacs manual for more details.
-
-** Miscellaneous
-
-+++
-*** User option 'minibuffer-eldef-shorten-default' is now obsolete.
-Customize the user option 'minibuffer-default-prompt-format' instead.
-
* Startup Changes in Emacs 29.1
@@ -173,7 +165,7 @@ time.
+++
*** New variable 'inhibit-automatic-native-compilation'.
If set, Emacs will inhibit native compilation (and won't write
-anything to the eln cache automatically). The variable is initialised
+anything to the eln cache automatically). The variable is initialized
from the 'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION' environment
variable on Emacs startup.
@@ -379,6 +371,11 @@ node in the Eshell manual for more details.
*** Eshell pipelines now only pipe stdout by default.
To pipe both stdout and stderr, use the '|&' operator instead of '|'.
+*** New eshell built-in command 'doas'.
+The privilege-escalation program 'doas' has been added to the existing
+'su' and 'sudo' commands from the 'eshell-tramp' module. The external
+command may still be accessed by using '*doas'.
+
---
** The 'delete-forward-char' command now deletes by grapheme clusters.
This command is by default bound to the <Delete> function key
@@ -715,6 +712,15 @@ part of the buffer.
+++
** 'count-words' will now report sentence count when used interactively.
+** New user option 'set-message-functions'.
+It allows selecting more functions for 'set-message-function'
+in addition to the default function that handles messages
+in the active minibuffer. The most useful are 'inhibit-message'
+that allows specifying a list of messages to inhibit via
+'inhibit-message-regexps', and 'set-multi-message' that
+accumulates recent messages and displays them stacked
+in the echo area.
+
---
** New user option 'find-library-include-other-files'.
If set to nil, commands like 'find-library' will only include library
@@ -1085,6 +1091,13 @@ the corresponding deleted frame.
** Tab Bars and Tab Lines
+---
+*** New user option 'tab-bar-auto-width' to automatically determine tab width.
+This option is non-nil by default, which resizes tab-bar tabs so that
+their width is evenly distributed across the tab bar. A companion
+option 'tab-bar-auto-width-max' controls the maximum width of a tab
+before its name on display is truncated.
+
---
*** 'C-x t RET' creates a new tab when the provided tab name doesn't exist.
@@ -1478,6 +1491,10 @@ This controls how statements like the following are
indented:
It is enabled by default, but requires that the external "shellcheck"
command is installed.
+** CC Mode
+---
+*** C++ Mode now supports most of the new features in the C++20 standard.
+
** Cperl Mode
---
@@ -1557,6 +1574,48 @@ These commands can be useful if the ".elc" files are out
of date
If no packages are marked, 'x' will install the package under point if
it isn't already, and remove it if it is installed.
++++
+*** New command 'package-vc-install'
+Packages can now be installed directly from source by cloning from a
+repository.
+
++++
+*** New command 'package-vc-install-from-checkout'
+An existing checkout can now be loaded via package.el, by creating a
+symbolic link from the usual package directory to the checkout.
+
++++
+*** New command 'package-vc-checkout'
+Used to fetch the source of a package by cloning a repository without
+activating the package.
+
++++
+*** New command 'package-vc-prepare-patch'
+This command allows you to send patches to package maintainers, for
+packages checked out using 'package-vc-install'.
+
++++
+*** New command 'package-report-bug'
+This command helps you compose an email for sending bug reports to
+package maintainers.
+
++++
+*** New user option 'package-vc-selected-packages'
+By customizing this user option you can specify specific packages to
+install.
+
+** Emacs Sessions (Desktop)
+
++++
+*** New user option to load a locked desktop if locking Emacs is not running.
+The option 'desktop-load-locked-desktop' can now be set to the value
+'check-pid', which means to allow loading a locked ".emacs.desktop"
+file if the Emacs process which locked it is no longer running on the
+local machine. This allows avoiding questions about locked desktop
+files when the Emacs session which locked it crashes, or was otherwise
+interrupted, and didn't exit gracefully. See the "(emacs) Saving
+Emacs Sessions" node in the Emacs manual for more details.
+
** Miscellaneous
+++
@@ -1695,6 +1754,10 @@ but completes on the history items instead of the
default completion
table. 'minibuffer-complete-defaults' ('C-x <down>') completes
on the list of default items.
++++
+*** User option 'minibuffer-eldef-shorten-default' is now obsolete.
+Customize the user option 'minibuffer-default-prompt-format' instead.
+
+++
*** New user option 'completions-sort'.
This option controls the sorting of the completion candidates in
@@ -1851,8 +1914,6 @@ with the changes against the last commit, e.g. with 'C-x
v D'
want to commit. Finally, type 'C-x v v' in that diff buffer to commit
only part of your changes, those whose hunks were left in the buffer.
-Currently this feature works only with the Git as 'vc-backend'.
-
---
*** 'C-x v v' on an unregistered file will now use the most specific backend.
Previously, if you had an SVN-covered "~/" directory, and a Git-covered
@@ -1917,6 +1978,13 @@ It narrows to the current node.
** EUDC
++++
+*** New user option 'eudc-ignore-options-file' that defaults to 'nil'
+The 'eudc-ignore-options-file' user option can be configured to ignore
+the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most
+users should configure this to 't' and put EUDC configuration in the
+main Emacs initialization file (".emacs" or "~/.emacs.d/init.el").
+
+++
*** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'.
'eudc-expansion-overwrites-query' is renamed to
@@ -1963,6 +2031,25 @@ The EUDC back-end for the macOS Contacts app now
provides a wider set
of attributes to use for queries, and delivers more attributes in
query results.
++++
+*** New back-end for ecomplete
+A new back-end for ecomplete allows information from that database to
+be queried by EUDC, too. The attributes present in the EUDC query are
+used to select the entry type in the ecomplete database.
+
++++
+*** New back-end for mailabbrev
+A new back-end for mailabbrev allows information from that database to
+be queried by EUDC, too. The attributes email, name, and firstname
+are supported only.
+
++++
+*** New default for 'eudc-server-hotlist' includes built-in backends
+The 'eudc-server-hotlist' user option now defaults to including
+entries for the new built-in ecomplete and mailabbrev EUDC backends.
+As a result, 'C-u M-x eudc-expand-try-all' will query both of these
+backends for email address completions, by default.
+
** EWW/SHR
+++
@@ -2876,7 +2963,7 @@ normal.
---
** Themes have special autoload cookies.
-All build-in themes are scraped for ';;;###theme-autoload' cookies
+All built-in themes are scraped for ';;;###theme-autoload' cookies
that are loaded along with the regular auto-loaded code.
+++
@@ -4245,5 +4332,5 @@ Local variables:
coding: utf-8
mode: outline
mode: emacs-news
-paragraph-separate: "[ ]*$"
+paragraph-separate: "[ ]"
end:
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index f67a8c70d4..f4fb4e3121 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -2763,7 +2763,7 @@ not waiting for a process to be set up.
This variable determines how many bytes can be read from a sub-process
in one read operation. The default, 4096 bytes, was previously a
hard-coded constant. Setting it to a larger value might enhance
-throughput of reading from sub-processes that produces vast
+throughput of reading from sub-processes that produce vast
(megabytes) amounts of data in one go.
** The new user option 'quit-window-hook' is now run first when
diff --git a/etc/NEWS.28 b/etc/NEWS.28
index 1edf4e85b0..8eab05a763 100644
--- a/etc/NEWS.28
+++ b/etc/NEWS.28
@@ -199,7 +199,7 @@ lacks the terminfo database, you can instruct Emacs to
support 24-bit
true color by setting 'COLORTERM=truecolor' in the environment. This is
useful on systems such as FreeBSD which ships only with "etc/termcap".
-** File names given on the command line are now be pushed onto history.
+** File names given on the command line are now pushed onto history.
The file names will be pushed onto 'file-name-history', like the names
of files visited via 'C-x C-f' and other commands.
diff --git a/etc/TODO b/etc/TODO
index cd02cf7023..bf30436270 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -1770,7 +1770,7 @@ The MPX code has not been tested under X toolkit or GTK+
2.x builds
and is not expected to work there.
** Framework for doing animations
-Emacs does animations all over the place, usually "pluse" animations.
+Emacs does animations all over the place, usually "pulse" animations.
These currently animate by waiting for a small but fixed amount of
time between each redisplay, which causes screen tearing by not
synchronizing with the vertical refresh. Frame synchronization works
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index 5676a31c3a..025cf47274 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -7171,7 +7171,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-09-15T15:17:34Z
+// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-10-29T15:16:24Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -7341,7 +7341,7 @@ arab
// aramco : 2014-11-20 Aramco Services Company
aramco
-// archi : 2014-02-06 Afilias Limited
+// archi : 2014-02-06 Identity Digital Limited
archi
// army : 2014-03-06 Dog Beach, LLC
@@ -7389,7 +7389,7 @@ auto
// autos : 2014-01-09 XYZ.COM LLC
autos
-// avianca : 2015-01-08 Avianca Holdings S.A.
+// avianca : 2015-01-08 Avianca Inc.
avianca
// aws : 2015-06-25 AWS Registry LLC
@@ -7485,7 +7485,7 @@ best
// bestbuy : 2015-07-31 BBY Solutions, Inc.
bestbuy
-// bet : 2015-05-07 Afilias Limited
+// bet : 2015-05-07 Identity Digital Limited
bet
// bharti : 2014-01-09 Bharti Enterprises (Holding) Private Limited
@@ -7506,10 +7506,10 @@ bing
// bingo : 2014-12-04 Binky Moon, LLC
bingo
-// bio : 2014-03-06 Afilias Limited
+// bio : 2014-03-06 Identity Digital Limited
bio
-// black : 2014-01-16 Afilias Limited
+// black : 2014-01-16 Identity Digital Limited
black
// blackfriday : 2014-01-16 Registry Services, LLC
@@ -7524,7 +7524,7 @@ blog
// bloomberg : 2014-07-17 Bloomberg IP Holdings LLC
bloomberg
-// blue : 2013-11-07 Afilias Limited
+// blue : 2013-11-07 Identity Digital Limited
blue
// bms : 2014-10-30 Bristol-Myers Squibb Company
@@ -7596,9 +7596,6 @@ brother
// brussels : 2014-02-06 DNS.be vzw
brussels
-// bugatti : 2015-07-23 Bugatti International SA
-bugatti
-
// build : 2013-11-07 Plan Bee LLC
build
@@ -7641,9 +7638,6 @@ camera
// camp : 2013-11-07 Binky Moon, LLC
camp
-// cancerresearch : 2014-05-15 Australian Cancer Research Foundation
-cancerresearch
-
// canon : 2014-09-12 Canon Inc.
canon
@@ -7782,7 +7776,7 @@ claims
// cleaning : 2013-12-05 Binky Moon, LLC
cleaning
-// click : 2014-06-05 UNR Corp.
+// click : 2014-06-05 Internet Naming Company LLC
click
// clinic : 2014-03-20 Binky Moon, LLC
@@ -8436,7 +8430,7 @@ graphics
// gratis : 2014-03-20 Binky Moon, LLC
gratis
-// green : 2014-05-08 Afilias Limited
+// green : 2014-05-08 Identity Digital Limited
green
// gripe : 2014-03-06 Binky Moon, LLC
@@ -8751,7 +8745,7 @@ kia
// kids : 2021-08-13 DotKids Foundation Limited
kids
-// kim : 2013-09-23 Afilias Limited
+// kim : 2013-09-23 Identity Digital Limited
kim
// kinder : 2014-11-07 Ferrero Trading Lux S.A.
@@ -8856,7 +8850,7 @@ lego
// lexus : 2015-04-23 TOYOTA MOTOR CORPORATION
lexus
-// lgbt : 2014-05-08 Afilias Limited
+// lgbt : 2014-05-08 Identity Digital Limited
lgbt
// lidl : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG
@@ -8904,7 +8898,7 @@ live
// living : 2015-07-30 Lifestyle Domain Holdings, Inc.
living
-// llc : 2017-12-14 Afilias Limited
+// llc : 2017-12-14 Identity Digital Limited
llc
// llp : 2019-08-26 Intercap Registry Inc.
@@ -8934,7 +8928,7 @@ london
// lotte : 2014-11-07 Lotte Holdings Co., Ltd.
lotte
-// lotto : 2014-04-10 Afilias Limited
+// lotto : 2014-04-10 Identity Digital Limited
lotto
// love : 2014-12-22 Merchant Law Group LLP
@@ -9282,7 +9276,7 @@ oracle
// orange : 2015-03-12 Orange Brand Services Limited
orange
-// organic : 2014-03-27 Afilias Limited
+// organic : 2014-03-27 Identity Digital Limited
organic
// origins : 2015-10-01 The Estée Lauder Companies Inc.
@@ -9330,7 +9324,7 @@ pay
// pccw : 2015-05-14 PCCW Enterprises Limited
pccw
-// pet : 2015-05-07 Afilias Limited
+// pet : 2015-05-07 Identity Digital Limited
pet
// pfizer : 2015-09-11 Pfizer Inc.
@@ -9378,7 +9372,7 @@ pin
// ping : 2015-06-11 Ping Registry Provider, Inc.
ping
-// pink : 2013-10-01 Afilias Limited
+// pink : 2013-10-01 Identity Digital Limited
pink
// pioneer : 2015-07-16 Pioneer Corporation
@@ -9408,7 +9402,7 @@ pnc
// pohl : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG
pohl
-// poker : 2014-07-03 Afilias Limited
+// poker : 2014-07-03 Identity Digital Limited
poker
// politie : 2015-08-20 Politie Nederland
@@ -9441,7 +9435,7 @@ prof
// progressive : 2015-07-23 Progressive Casualty Insurance Company
progressive
-// promo : 2014-12-18 Afilias Limited
+// promo : 2014-12-18 Identity Digital Limited
promo
// properties : 2013-12-05 Binky Moon, LLC
@@ -9495,7 +9489,7 @@ realty
// recipes : 2013-10-17 Binky Moon, LLC
recipes
-// red : 2013-11-07 Afilias Limited
+// red : 2013-11-07 Identity Digital Limited
red
// redstone : 2014-10-31 Redstone Haute Couture Co., Ltd.
@@ -9744,7 +9738,7 @@ shell
// shia : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.
shia
-// shiksha : 2013-11-14 Afilias Limited
+// shiksha : 2013-11-14 Identity Digital Limited
shiksha
// shoes : 2013-10-02 Binky Moon, LLC
@@ -9777,7 +9771,7 @@ singles
// site : 2015-01-15 Radix FZC
site
-// ski : 2015-04-09 Afilias Limited
+// ski : 2015-04-09 Identity Digital Limited
ski
// skin : 2015-01-15 XYZ.COM LLC
@@ -10218,7 +10212,7 @@ wanggou
// watch : 2013-11-14 Binky Moon, LLC
watch
-// watches : 2014-12-22 Afilias Limited
+// watches : 2014-12-22 Identity Digital Limited
watches
// weather : 2015-01-08 International Business Machines Corporation
@@ -10353,7 +10347,7 @@ xin
// xn--5tzm5g : 2014-12-22 Global Website TLD Asia Limited
网站
-// xn--6frz82g : 2013-09-23 Afilias Limited
+// xn--6frz82g : 2013-09-23 Identity Digital Limited
移动
// xn--6qq986b3xl : 2013-09-13 Tycoon Treasure Limited
@@ -10660,6 +10654,10 @@ graphox.us
// Submitted by accesso Team <accessoecommerce@accesso.com>
*.devcdnaccesso.com
+// Acorn Labs : https://acorn.io
+// Submitted by Craig Jellick <domains@acorn.io>
+*.on-acorn.io
+
// Adobe : https://www.adobe.com/
// Submitted by Ian Boston <boston@adobe.com> and Lars Trieloff
<trieloff@adobe.com>
adobeaemcloud.com
@@ -10704,51 +10702,49 @@ altervista.org
// Submitted by Cyril <admin@alwaysdata.com>
alwaysdata.net
-// Amazon CloudFront : https://aws.amazon.com/cloudfront/
+// Amazon : https://www.amazon.com/
+// Submitted by AWS Security <psl-maintainers@amazon.com>
+// Subsections of Amazon/subsidiaries will appear until "concludes" tag
+
+// Amazon CloudFront
// Submitted by Donavan Miller <donavanm@amazon.com>
+// Reference: 54144616-fd49-4435-8535-19c6a601bdb3
cloudfront.net
-// Amazon Elastic Compute Cloud : https://aws.amazon.com/ec2/
+// Amazon EC2
// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: 4c38fa71-58ac-4768-99e5-689c1767e537
*.compute.amazonaws.com
*.compute-1.amazonaws.com
*.compute.amazonaws.com.cn
us-east-1.amazonaws.com
-// Amazon Elastic Beanstalk : https://aws.amazon.com/elasticbeanstalk/
-// Submitted by Luke Wells <psl-maintainers@amazon.com>
-cn-north-1.eb.amazonaws.com.cn
-cn-northwest-1.eb.amazonaws.com.cn
-elasticbeanstalk.com
-ap-northeast-1.elasticbeanstalk.com
-ap-northeast-2.elasticbeanstalk.com
-ap-northeast-3.elasticbeanstalk.com
-ap-south-1.elasticbeanstalk.com
-ap-southeast-1.elasticbeanstalk.com
-ap-southeast-2.elasticbeanstalk.com
-ca-central-1.elasticbeanstalk.com
-eu-central-1.elasticbeanstalk.com
-eu-west-1.elasticbeanstalk.com
-eu-west-2.elasticbeanstalk.com
-eu-west-3.elasticbeanstalk.com
-sa-east-1.elasticbeanstalk.com
-us-east-1.elasticbeanstalk.com
-us-east-2.elasticbeanstalk.com
-us-gov-west-1.elasticbeanstalk.com
-us-west-1.elasticbeanstalk.com
-us-west-2.elasticbeanstalk.com
-
-// Amazon Elastic Load Balancing : https://aws.amazon.com/elasticloadbalancing/
-// Submitted by Luke Wells <psl-maintainers@amazon.com>
-*.elb.amazonaws.com
-*.elb.amazonaws.com.cn
-
-// Amazon Global Accelerator : https://aws.amazon.com/global-accelerator/
-// Submitted by Daniel Massaguer <psl-maintainers@amazon.com>
-awsglobalaccelerator.com
-
-// Amazon S3 : https://aws.amazon.com/s3/
+// Amazon S3
// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: d068bd97-f0a9-4838-a6d8-954b622ef4ae
+s3.cn-north-1.amazonaws.com.cn
+s3.dualstack.ap-northeast-1.amazonaws.com
+s3.dualstack.ap-northeast-2.amazonaws.com
+s3.ap-northeast-2.amazonaws.com
+s3-website.ap-northeast-2.amazonaws.com
+s3.dualstack.ap-south-1.amazonaws.com
+s3.ap-south-1.amazonaws.com
+s3-website.ap-south-1.amazonaws.com
+s3.dualstack.ap-southeast-1.amazonaws.com
+s3.dualstack.ap-southeast-2.amazonaws.com
+s3.dualstack.ca-central-1.amazonaws.com
+s3.ca-central-1.amazonaws.com
+s3-website.ca-central-1.amazonaws.com
+s3.dualstack.eu-central-1.amazonaws.com
+s3.eu-central-1.amazonaws.com
+s3-website.eu-central-1.amazonaws.com
+s3.dualstack.eu-west-1.amazonaws.com
+s3.dualstack.eu-west-2.amazonaws.com
+s3.eu-west-2.amazonaws.com
+s3-website.eu-west-2.amazonaws.com
+s3.dualstack.eu-west-3.amazonaws.com
+s3.eu-west-3.amazonaws.com
+s3-website.eu-west-3.amazonaws.com
s3.amazonaws.com
s3-ap-northeast-1.amazonaws.com
s3-ap-northeast-2.amazonaws.com
@@ -10763,48 +10759,25 @@ s3-eu-west-3.amazonaws.com
s3-external-1.amazonaws.com
s3-fips-us-gov-west-1.amazonaws.com
s3-sa-east-1.amazonaws.com
-s3-us-gov-west-1.amazonaws.com
s3-us-east-2.amazonaws.com
+s3-us-gov-west-1.amazonaws.com
s3-us-west-1.amazonaws.com
s3-us-west-2.amazonaws.com
-s3.ap-northeast-2.amazonaws.com
-s3.ap-south-1.amazonaws.com
-s3.cn-north-1.amazonaws.com.cn
-s3.ca-central-1.amazonaws.com
-s3.eu-central-1.amazonaws.com
-s3.eu-west-2.amazonaws.com
-s3.eu-west-3.amazonaws.com
-s3.us-east-2.amazonaws.com
-s3.dualstack.ap-northeast-1.amazonaws.com
-s3.dualstack.ap-northeast-2.amazonaws.com
-s3.dualstack.ap-south-1.amazonaws.com
-s3.dualstack.ap-southeast-1.amazonaws.com
-s3.dualstack.ap-southeast-2.amazonaws.com
-s3.dualstack.ca-central-1.amazonaws.com
-s3.dualstack.eu-central-1.amazonaws.com
-s3.dualstack.eu-west-1.amazonaws.com
-s3.dualstack.eu-west-2.amazonaws.com
-s3.dualstack.eu-west-3.amazonaws.com
-s3.dualstack.sa-east-1.amazonaws.com
-s3.dualstack.us-east-1.amazonaws.com
-s3.dualstack.us-east-2.amazonaws.com
-s3-website-us-east-1.amazonaws.com
-s3-website-us-west-1.amazonaws.com
-s3-website-us-west-2.amazonaws.com
s3-website-ap-northeast-1.amazonaws.com
s3-website-ap-southeast-1.amazonaws.com
s3-website-ap-southeast-2.amazonaws.com
s3-website-eu-west-1.amazonaws.com
s3-website-sa-east-1.amazonaws.com
-s3-website.ap-northeast-2.amazonaws.com
-s3-website.ap-south-1.amazonaws.com
-s3-website.ca-central-1.amazonaws.com
-s3-website.eu-central-1.amazonaws.com
-s3-website.eu-west-2.amazonaws.com
-s3-website.eu-west-3.amazonaws.com
+s3-website-us-east-1.amazonaws.com
+s3-website-us-west-1.amazonaws.com
+s3-website-us-west-2.amazonaws.com
+s3.dualstack.sa-east-1.amazonaws.com
+s3.dualstack.us-east-1.amazonaws.com
+s3.dualstack.us-east-2.amazonaws.com
+s3.us-east-2.amazonaws.com
s3-website.us-east-2.amazonaws.com
-// AWS Cloud9 : https://aws.amazon.com/cloud9/
+// AWS Cloud9
// Submitted by: AWS Security <psl-maintainers@amazon.com>
// Reference: 2b6dfa9a-3a7f-4367-b2e7-0321e77c0d59
vfs.cloud9.af-south-1.amazonaws.com
@@ -10850,6 +10823,49 @@ webview-assets.cloud9.us-west-1.amazonaws.com
vfs.cloud9.us-west-2.amazonaws.com
webview-assets.cloud9.us-west-2.amazonaws.com
+// AWS Elastic Beanstalk
+// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: aa202394-43a0-4857-b245-8db04549137e
+cn-north-1.eb.amazonaws.com.cn
+cn-northwest-1.eb.amazonaws.com.cn
+elasticbeanstalk.com
+ap-northeast-1.elasticbeanstalk.com
+ap-northeast-2.elasticbeanstalk.com
+ap-northeast-3.elasticbeanstalk.com
+ap-south-1.elasticbeanstalk.com
+ap-southeast-1.elasticbeanstalk.com
+ap-southeast-2.elasticbeanstalk.com
+ca-central-1.elasticbeanstalk.com
+eu-central-1.elasticbeanstalk.com
+eu-west-1.elasticbeanstalk.com
+eu-west-2.elasticbeanstalk.com
+eu-west-3.elasticbeanstalk.com
+sa-east-1.elasticbeanstalk.com
+us-east-1.elasticbeanstalk.com
+us-east-2.elasticbeanstalk.com
+us-gov-west-1.elasticbeanstalk.com
+us-west-1.elasticbeanstalk.com
+us-west-2.elasticbeanstalk.com
+
+// (AWS) Elastic Load Balancing
+// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: 12a3d528-1bac-4433-a359-a395867ffed2
+*.elb.amazonaws.com.cn
+*.elb.amazonaws.com
+
+// AWS Global Accelerator
+// Submitted by Daniel Massaguer <psl-maintainers@amazon.com>
+// Reference: d916759d-a08b-4241-b536-4db887383a6a
+awsglobalaccelerator.com
+
+// eero
+// Submitted by Yue Kang <eero-dynamic-dns@amazon.com>
+// Reference: 264afe70-f62c-4c02-8ab9-b5281ed24461
+eero.online
+eero-stage.online
+
+// concludes Amazon
+
// Amune : https://amune.org/
// Submitted by Team Amune <cert@amune.org>
t3l3p0rt.net
@@ -11745,11 +11761,6 @@ e4.cz
easypanel.app
easypanel.host
-// eero : https://eero.com/
-// Submitted by Yue Kang <eero-dynamic-dns@amazon.com>
-eero.online
-eero-stage.online
-
// Elementor : Elementor Ltd.
// Submitted by Anton Barkan <antonb@elementor.com>
elementor.cloud
@@ -11963,6 +11974,10 @@ a.ssl.fastly.net
b.ssl.fastly.net
global.ssl.fastly.net
+// Fastmail : https://www.fastmail.com/
+// Submitted by Marc Bradshaw <marc@fastmailteam.com>
+*.user.fm
+
// FASTVPS EESTI OU : https://fastvps.ru/
// Submitted by Likhachev Vasiliy <lihachev@fastvps.ru>
fastvps-server.com
@@ -12973,25 +12988,6 @@ cust.retrosnub.co.uk
// Submitted by Paulus Schoutsen <infra@nabucasa.com>
ui.nabu.casa
-// Names.of.London : https://names.of.london/
-// Submitted by James Stevens <registry[at]names.of.london> or
<publiclist[at]jrcs.net>
-pony.club
-of.fashion
-in.london
-of.london
-from.marketing
-with.marketing
-for.men
-repair.men
-and.mom
-for.mom
-for.one
-under.one
-for.sale
-that.win
-from.work
-to.work
-
// Net at Work Gmbh : https://www.netatwork.de
// Submitted by Jan Jaeschke <jan.jaeschke@netatwork.de>
cloud.nospamproxy.com
@@ -13188,7 +13184,26 @@ omniwe.site
// One.com: https://www.one.com/
// Submitted by Jacob Bunk Nielsen <jbn@one.com>
+123hjemmeside.dk
+123hjemmeside.no
+123homepage.it
+123kotisivu.fi
+123minsida.se
+123miweb.es
+123paginaweb.pt
+123sait.ru
+123siteweb.fr
+123webseite.at
+123webseite.de
+123website.be
+123website.ch
+123website.lu
+123website.nl
service.one
+simplesite.com
+simplesite.com.br
+simplesite.gr
+simplesite.pl
// One Fold Media : http://www.onefoldmedia.com/
// Submitted by Eddie Jones <eddie@onefoldmedia.com>
@@ -13457,7 +13472,9 @@ app.render.com
onrender.com
// Repl.it : https://repl.it
-// Submitted by Mason Clayton <mason@repl.it>
+// Submitted by Lincoln Bergeson <lincoln@replit.com>
+firewalledreplit.co
+id.firewalledreplit.co
repl.co
id.repl.co
repl.run
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 23e61ff787..9aa4caedfe 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -11955,7 +11955,7 @@
(verilog-skip-backward-comments, verilog-skip-forward-comment-p):
fix bug for /* / comments.
(verilog-backward-syntactic-ws, verilog-forward-syntactic-ws):
- Speed up and simplfy as this is never called with a bound.
+ Speed up and simplify as this is never called with a bound.
(verilog-pretty-declarations): Enhance to line up declarations
inside a parameter list, suggested by Alan Morgan.
(verilog-pretty-expr): Tune assignment regular expression match
@@ -15783,7 +15783,7 @@
* simple.el (with-wrapper-hook): Fix thinko.
* hfy-cmap.el (hfy-rgb-file): Use locate-file.
- (htmlfontify-load-rgb-file): Remove unnused var `ff'.
+ (htmlfontify-load-rgb-file): Remove unused var `ff'.
Use with-current-buffer and string-to-number.
(hfy-fallback-colour-values): Use assoc-string.
* htmlfontify.el (hfy-face-to-css): Remove unused var `style'.
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index f0a50bb4bc..ef59698317 100644
--- a/lisp/ChangeLog.16
+++ b/lisp/ChangeLog.16
@@ -2814,7 +2814,7 @@
2012-12-12 Jonas Bernoulli <jonas@bernoul.li>
* emacs-lisp/eieio.el: Prettier object pretty-printing (bug#13115).
- (eieio-override-prin1): Don't quote kewords and booleans.
+ (eieio-override-prin1): Don't quote keywords and booleans.
(object-write) <eieio-default-superclass>: Don't put closing parens
on new line, avoid needless empty lines, align values that are objects
with the slot keyword (instead of beginning on the same line).
@@ -10765,7 +10765,7 @@
* play/zone.el (zone-hiding-mode-line): Rename from
zone-hiding-modeline. All callers changed.
- (zone): Remove unusued `modeline-hidden-level' property.
+ (zone): Remove unused `modeline-hidden-level' property.
* progmodes/xscheme.el (xscheme-mode-line-initialize): Rename from
xscheme-modeline-initialize. All callers changed.
@@ -24104,7 +24104,7 @@
* emacs-lisp/lisp-mode.el (eval-defun-2): Use eval-sexp-add-defvars.
- * htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile.
+ * htmlfontify.el (hfy-etags-cmd): Remove inoperative eval-and-compile.
(hfy-e2x-etags-cmd, hfy-etags-cmd-alist-default)
(hfy-etags-cmd-alist): Don't eval-and-compile any more.
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17
index df731fe9ed..c494f43896 100644
--- a/lisp/ChangeLog.17
+++ b/lisp/ChangeLog.17
@@ -917,7 +917,7 @@
* desktop.el (desktop-buffer-info): Write docstring.
(desktop-buffer-info): Use `pushnew' instead of `add-to-list' and
- unquote lamda.
+ unquote lambda.
* emacs-lisp/package.el (package-refresh-contents): Update doc.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 747a9ffab9..c81968e6ee 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -3147,20 +3147,20 @@
* international/ccl.el: Change term translate-XXX-map to map-XXX
throughout the file. Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
* international/quail.el (quail-completion): Consecutive call of
this command scrolls the Quail completion buffer.
* international/mule.el: Change term unification to translation
- throughtout the file.
+ throughout the file.
(set-clipboard-coding-system): New function.
* international/mule-conf.el: Change term unification to
- translation throughtout the file.
+ translation throughout the file.
* international/mule-util.el: Change term unification to
- translation throughtout the file.
+ translation throughout the file.
1998-05-17 Richard Stallman <rms@psilocin.ai.mit.edu>
diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el
index 499c9dce73..a8523fc9dc 100644
--- a/lisp/ansi-osc.el
+++ b/lisp/ansi-osc.el
@@ -141,7 +141,7 @@ and `shell-dirtrack-mode'."
(defun ansi-osc-hyperlink-handler (_ text)
"Create a hyperlink from an OSC 8 escape sequence.
-This function is intended to be included as an elemnt of the list
+This function is intended to be included as an element of the list
that is the value of `ansi-osc-handlers'."
(when ansi-osc-hyperlink--state
(let ((start (car ansi-osc-hyperlink--state))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 624c29cb41..62a37df820 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -25,8 +25,7 @@
;;; Commentary:
;; The ideas for this package were derived from the C code in
-;; src/keymap.c and elsewhere. The functions in this file should
-;; always be byte-compiled for speed.
+;; src/keymap.c and elsewhere.
;; The idea for super-apropos is based on the original implementation
;; by Lynn Slater <lrs@esl.com>.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 2e32128274..c1ad5f7520 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1029,6 +1029,14 @@ if `inhibit-field-text-motion' is non-nil."
(define-key global-map [XF86Back] 'previous-buffer)
(put 'previous-buffer :advertised-binding [?\C-x left])
+(defvar-keymap buffer-navigation-repeat-map
+ :doc "Keymap to repeat `next-buffer' and `previous-buffer'. Used in
`repeat-mode'."
+ "<right>" #'next-buffer
+ "<left>" #'previous-buffer)
+
+(put 'next-buffer 'repeat-map 'buffer-navigation-repeat-map)
+(put 'previous-buffer 'repeat-map 'buffer-navigation-repeat-map)
+
(let ((map minibuffer-local-map))
(define-key map "\en" 'next-history-element)
(define-key map [next] 'next-history-element)
diff --git a/lisp/bs.el b/lisp/bs.el
index aabc2dc558..060bae6fdd 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -823,10 +823,14 @@ Leave Buffer Selection Menu."
"Visit the tags table in the buffer on this line.
See `visit-tags-table'."
(interactive)
- (let ((file (buffer-file-name (bs--current-buffer))))
- (if file
- (visit-tags-table file)
- (error "Specified buffer has no file"))))
+ (let* ((buf (bs--current-buffer))
+ (file (buffer-file-name buf)))
+ (cond
+ ((not file) (error "Specified buffer has no file"))
+ ((and buf (with-current-buffer buf
+ (etags-verify-tags-table)))
+ (visit-tags-table file))
+ (t (error "Specified buffer is not a tags-table")))))
(defun bs-toggle-current-to-show ()
"Toggle status of showing flag for buffer in current line."
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 98e91aaa75..0ebfc4bb8d 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -92,7 +92,7 @@ are holidays."
This is used by `diary-pull-attrs' to fontify certain diary
elements. REGEXP is a regular expression to for, and SUBEXP is
the numbered sub-expression to extract. `diary-glob-file-regexp-prefix'
-is pre-pended to REGEXP for file-wide specifiers. ATTRIBUTE
+is prepended to REGEXP for file-wide specifiers. ATTRIBUTE
specifies which face attribute (e.g. `:foreground') to modify, or
that this is a face (`:face') to apply. TYPE is the type of
attribute being applied. Available TYPES (see `diary-attrtype-convert')
@@ -109,7 +109,7 @@ are: `string', `symbol', `int', `tnil', `stringtnil'."
:group 'diary)
(defcustom diary-glob-file-regexp-prefix "^#"
- "Regular expression pre-pended to `diary-face-attrs' for file-wide
specifiers."
+ "Regular expression prepended to `diary-face-attrs' for file-wide
specifiers."
:type 'regexp
:group 'diary)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index e6bfd0b1e8..1118235757 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -598,7 +598,7 @@ an EDE controlled project."
"\\.#"
"~$"
)
- "List of file name patters that EDE will never ask about.")
+ "List of file name patterns that EDE will never ask about.")
(defun ede-ignore-file (filename)
"Should we ignore FILENAME?"
diff --git a/lisp/cedet/semantic/symref/grep.el
b/lisp/cedet/semantic/symref/grep.el
index 27ea80fc32..076775bfec 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -139,6 +139,8 @@ This shell should support pipe redirect syntax."
(lambda (s) (concat "\\" s))
string nil t))
+(defvar semantic-symref-grep--local-dir nil)
+
(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
"Perform a search with Grep."
;; Grep doesn't support some types of searches.
@@ -170,11 +172,12 @@ This shell should support pipe redirect syntax."
(erase-buffer)
(setq default-directory rootdir)
(let ((cmd (semantic-symref-grep-use-template
- (directory-file-name (file-local-name rootdir))
+ "."
filepattern grepflags greppat)))
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd)))
- (setq ans (semantic-symref-parse-tool-output tool b))
+ (let ((semantic-symref-grep--local-dir (directory-file-name
(file-local-name rootdir))))
+ (setq ans (semantic-symref-parse-tool-output tool b)))
;; Return the answer
ans))
@@ -190,12 +193,12 @@ Moves cursor to end of the match."
((eq (oref tool resulttype) 'line-and-text)
(when (re-search-forward grep-re nil t)
(list (string-to-number (match-string line-group))
- (match-string file-group)
+ (concat semantic-symref-grep--local-dir (substring
(match-string file-group) 1))
(buffer-substring-no-properties (point)
(line-end-position)))))
(t
(when (re-search-forward grep-re nil t)
(cons (string-to-number (match-string line-group))
- (match-string file-group))
+ (concat semantic-symref-grep--local-dir (substring
(match-string file-group) 1)))
)))))
(provide 'semantic/symref/grep)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index e043d9bc17..00ee9504c2 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1,7 +1,7 @@
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*-
lexical-binding:t -*-
-;;
-;; Copyright (C) 1996-1997, 1999-2022 Free Software Foundation, Inc.
-;;
+
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
+
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
@@ -23,7 +23,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; This file implements the code to create and edit customize buffers.
;;
;; See `custom.el'.
@@ -428,32 +428,30 @@ Use group `text' for this instead. This group is
deprecated."
;;; Custom mode keymaps
-(defvar custom-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map [remap self-insert-command] 'Custom-no-edit)
- (define-key map "\^m" 'Custom-newline)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\177" 'scroll-down-command)
- (define-key map "\C-c\C-c" 'Custom-set)
- (define-key map "\C-x\C-s" 'Custom-save)
- (define-key map "q" 'Custom-buffer-done)
- (define-key map "u" 'Custom-goto-parent)
- (define-key map "n" 'widget-forward)
- (define-key map "p" 'widget-backward)
- (define-key map "H" 'custom-toggle-hide-all-widgets)
- map)
- "Keymap for `Custom-mode'.")
-
-(defvar custom-mode-link-map
- (let ((map (make-keymap)))
- (set-keymap-parent map custom-mode-map)
- (define-key map [down-mouse-2] nil)
- (define-key map [down-mouse-1] 'mouse-drag-region)
- (define-key map [mouse-2] 'widget-move-and-invoke)
- map)
- "Local keymap for links in `Custom-mode'.")
+(defvar-keymap custom-mode-map
+ :doc "Keymap for `Custom-mode'."
+ :full t
+ :parent widget-keymap
+ "<remap> <self-insert-command>" #'Custom-no-edit
+ "RET" #'Custom-newline
+ "SPC" #'scroll-up-command
+ "S-SPC" #'scroll-down-command
+ "DEL" #'scroll-down-command
+ "C-c C-c" #'Custom-set
+ "C-x C-s" #'Custom-save
+ "q" #'Custom-buffer-done
+ "u" #'Custom-goto-parent
+ "n" #'widget-forward
+ "p" #'widget-backward
+ "H" #'custom-toggle-hide-all-widgets)
+
+(defvar-keymap custom-mode-link-map
+ :doc "Local keymap for links in `Custom-mode'."
+ :full t
+ :parent custom-mode-map
+ "<down-mouse-2>" nil
+ "<down-mouse-1>" #'mouse-drag-region
+ "<mouse-2>" #'widget-move-and-invoke)
(defvar custom-field-keymap
(let ((map (copy-keymap widget-field-keymap)))
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index b891f24154..0260ad4a50 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -32,17 +32,15 @@
(eval-when-compile
(require 'wid-edit))
-(defvar custom-new-theme-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map (make-composed-keymap widget-keymap
- special-mode-map))
- (suppress-keymap map)
- (define-key map "\C-x\C-s" 'custom-theme-write)
- (define-key map "q" 'Custom-buffer-done)
- (define-key map "n" 'widget-forward)
- (define-key map "p" 'widget-backward)
- map)
- "Keymap for `custom-new-theme-mode'.")
+(defvar-keymap custom-new-theme-mode-map
+ :doc "Keymap for `custom-new-theme-mode'."
+ :full t
+ :suppress t
+ :parent (make-composed-keymap widget-keymap special-mode-map)
+ "C-x C-s" #'custom-theme-write
+ "q" #'Custom-buffer-done
+ "n" #'widget-forward
+ "p" #'widget-backward)
(define-derived-mode custom-new-theme-mode nil "Custom-Theme"
"Major mode for editing Custom themes.
@@ -534,17 +532,15 @@ It includes all faces in list FACES."
:type 'boolean
:group 'custom-buffer)
-(defvar custom-theme-choose-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map (make-composed-keymap widget-keymap
- special-mode-map))
- (suppress-keymap map)
- (define-key map "\C-x\C-s" 'custom-theme-save)
- (define-key map "n" 'widget-forward)
- (define-key map "p" 'widget-backward)
- (define-key map "?" 'custom-describe-theme)
- map)
- "Keymap for `custom-theme-choose-mode'.")
+(defvar-keymap custom-theme-choose-mode-map
+ :doc "Keymap for `custom-theme-choose-mode'."
+ :full t
+ :suppress t
+ :parent (make-composed-keymap widget-keymap special-mode-map)
+ "C-x C-s" #'custom-theme-save
+ "n" #'widget-forward
+ "p" #'widget-backward
+ "?" #'custom-describe-theme)
(define-derived-mode custom-theme-choose-mode special-mode "Themes"
"Major mode for selecting Custom themes.
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 327a4f038b..5e1745069f 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1025,8 +1025,9 @@ If PROGRAM exits successfully, display \"MSG...done\" and
return nil.
If PROGRAM exits abnormally, save in `dired-log-buffer' the command
that invoked PROGRAM and the messages it emitted, and return either
the offending ARGUMENTS or PROGRAM if no ARGUMENTS were provided."
- (let (err-buffer err (dir default-directory))
- (message "%s..." msg)
+ (let ((dir default-directory)
+ (reporter (make-progress-reporter msg))
+ err-buffer err)
(save-excursion
;; Get a clean buffer for error output:
(setq err-buffer (get-buffer-create " *dired-check-process output*"))
@@ -1041,8 +1042,8 @@ the offending ARGUMENTS or PROGRAM if no ARGUMENTS were
provided."
(dired-log err-buffer)
(or arguments program t))
(kill-buffer err-buffer)
- (message "%s...done" msg)
- nil))))
+ (progress-reporter-done reporter)
+ nil))))
(defun dired-shell-command (cmd)
"Run CMD, and check for output.
@@ -3718,9 +3719,9 @@ function works."
;;;###autoload
(defun dired-show-file-type (file &optional deref-symlinks)
"Print the type of FILE, according to the `file' command.
-If you give a prefix to this command, and FILE is a symbolic
-link, then the type of the file linked to by FILE is printed
-instead."
+If you give a prefix argument \\[universal-argument] to this command, and
+FILE is a symbolic link, then the command will print the type
+of the target of the link instead."
(interactive (list (dired-get-filename t) current-prefix-arg))
(let (process-file-side-effects)
(with-temp-buffer
diff --git a/lisp/dired.el b/lisp/dired.el
index 85a7131570..8995c48df7 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1457,9 +1457,9 @@ wildcards, erases the buffer, and builds the subdir-alist
anew
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
attributes))))
- (set-buffer-modified-p nil)
(when dired-make-directory-clickable
(dired--make-directory-clickable))
+ (set-buffer-modified-p nil)
;; No need to narrow since the whole buffer contains just
;; dired-readin's output, nothing else. The hook can
;; successfully use dired functions (e.g. dired-get-filename)
@@ -1911,11 +1911,15 @@ mouse-2: visit this file in other window"
(defun dired--make-directory-clickable ()
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "^ /" nil t 1)
+ (while (re-search-forward
+ (if (memq system-type '(windows-nt ms-dos))
+ "^ \\([a-zA-Z]:/\\|//\\)"
+ "^ /")
+ nil t 1)
(let ((bound (line-end-position))
(segment-start (point))
(inhibit-read-only t)
- (dir "/"))
+ (dir (substring (match-string 0) 2)))
(while (search-forward "/" bound t 1)
(setq dir (concat dir (buffer-substring segment-start (point))))
(add-text-properties
@@ -3024,13 +3028,13 @@ See options: `dired-hide-details-hide-symlink-targets'
and
;; The old code used selective-display which only works at
;; a line-granularity, so it used start and end positions that where
;; approximate ("anywhere on the line is fine").
- ;; FIXME: This also removes other invisible properties!
(save-excursion
(let ((inhibit-read-only t))
(remove-list-of-text-properties
(progn (goto-char start) (line-end-position))
(progn (goto-char end) (line-end-position))
- '(invisible)))))
+ '(invisible))
+ (dired-insert-set-properties start end))))
;;; Functions for finding the file name in a dired buffer line
diff --git a/lisp/dom.el b/lisp/dom.el
index f8c794a300..01bdef3a07 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -30,23 +30,17 @@
(defsubst dom-tag (node)
"Return the NODE tag."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (caar node)
- (car node)))
+ (car (if (consp (car node)) (car node) node)))
(defsubst dom-attributes (node)
"Return the NODE attributes."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (cadr (car node))
- (cadr node)))
+ (cadr (if (consp (car node)) (car node) node)))
(defsubst dom-children (node)
"Return the NODE children."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (cddr (car node))
- (cddr node)))
+ (cddr (if (consp (car node)) (car node) node)))
(defun dom-non-text-children (node)
"Return all non-text-node children of NODE."
@@ -62,10 +56,11 @@
(defun dom-set-attribute (node attribute value)
"Set ATTRIBUTE in NODE to VALUE."
(setq node (dom-ensure-node node))
- (let ((old (assoc attribute (cadr node))))
+ (let* ((attributes (cadr node))
+ (old (assoc attribute attributes)))
(if old
(setcdr old value)
- (setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+ (setcar (cdr node) (cons (cons attribute value) attributes)))))
(defun dom-remove-attribute (node attribute)
"Remove ATTRIBUTE from NODE."
@@ -80,7 +75,7 @@ A typical attribute is `href'."
(defun dom-text (node)
"Return all the text bits in the current node concatenated."
- (mapconcat 'identity (cl-remove-if-not 'stringp (dom-children node)) " "))
+ (mapconcat #'identity (cl-remove-if-not #'stringp (dom-children node)) " "))
(defun dom-texts (node &optional separator)
"Return all textual data under NODE concatenated with SEPARATOR in-between."
@@ -195,9 +190,7 @@ ATTRIBUTE would typically be `class', `id' or the like."
(defun dom-node (tag &optional attributes &rest children)
"Return a DOM node with TAG and ATTRIBUTES."
- (if children
- `(,tag ,attributes ,@children)
- (list tag attributes)))
+ `(,tag ,attributes ,@children))
(defun dom-append-child (node child)
"Append CHILD to the end of NODE's children."
@@ -215,11 +208,7 @@ If BEFORE is nil, make CHILD NODE's first child."
(let ((pos (if before
(cl-position before children)
0)))
- (if (zerop pos)
- ;; First child.
- (setcdr (cdr node) (cons child (cddr node)))
- (setcdr (nthcdr (1- pos) children)
- (cons child (nthcdr pos children))))))
+ (push child (nthcdr (+ 2 pos) node))))
node)
(defun dom-ensure-node (node)
@@ -247,7 +236,7 @@ white-space."
(insert (format "(%S . %S)" (car elem) (cdr elem)))
(if (zerop (cl-decf times))
(insert ")")
- (insert "\n" (make-string column ? ))))))
+ (insert "\n" (make-string column ?\s))))))
(let* ((children (if remove-empty
(cl-remove-if
(lambda (child)
@@ -258,16 +247,16 @@ white-space."
(times (length children)))
(if (null children)
(insert ")")
- (insert "\n" (make-string (1+ column) ? ))
+ (insert "\n" (make-string (1+ column) ?\s))
(dolist (child children)
(if (stringp child)
- (if (or (not remove-empty)
- (not (string-match "\\`[\n\r\t ]*\\'" child)))
+ (if (not (and remove-empty
+ (string-match "\\`[\n\r\t ]*\\'" child)))
(insert (format "%S" child)))
(dom-pp child remove-empty))
(if (zerop (cl-decf times))
(insert ")")
- (insert "\n" (make-string (1+ column) ? ))))))))
+ (insert "\n" (make-string (1+ column) ?\s))))))))
(defun dom-print (dom &optional pretty xml)
"Print DOM at point as HTML/XML.
@@ -279,18 +268,19 @@ If XML, generate XML instead of HTML."
(dolist (elem attr)
;; In HTML, these are boolean attributes that should not have
;; an = value.
- (if (and (memq (car elem)
- '(async autofocus autoplay checked
- contenteditable controls default
- defer disabled formNoValidate frameborder
- hidden ismap itemscope loop
- multiple muted nomodule novalidate open
- readonly required reversed
- scoped selected typemustmatch))
- (cdr elem)
- (not xml))
- (insert (format " %s" (car elem)))
- (insert (format " %s=%S" (car elem) (cdr elem))))))
+ (insert (if (and (memq (car elem)
+ '(async autofocus autoplay checked
+ contenteditable controls default
+ defer disabled formNoValidate frameborder
+ hidden ismap itemscope loop
+ multiple muted nomodule novalidate open
+ readonly required reversed
+ scoped selected typemustmatch))
+ (cdr elem)
+ (not xml))
+ (format " %s" (car elem))
+ (format " %s=\"%s\"" (car elem)
+ (url-insert-entities-in-string (cdr elem)))))))
(let* ((children (dom-children dom))
(non-text nil))
(if (null children)
@@ -301,7 +291,7 @@ If XML, generate XML instead of HTML."
(insert child)
(setq non-text t)
(when pretty
- (insert "\n" (make-string (+ column 2) ? )))
+ (insert "\n" (make-string (+ column 2) ?\s)))
(dom-print child pretty xml)))
;; If we inserted non-text child nodes, or a text node that
;; ends with a newline, then we indent the end tag.
@@ -310,7 +300,7 @@ If XML, generate XML instead of HTML."
non-text))
(unless (bolp)
(insert "\n"))
- (insert (make-string column ? )))
+ (insert (make-string column ?\s)))
(insert (format "</%s>" (dom-tag dom)))))))
(provide 'dom)
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 90bf1fe35b..75a3612df9 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -53,8 +53,8 @@
`(;; GNU GPL
("is free software[:;] you can redistribute it" .
,(rx (or (seq "If not, see " (? "<")
- "http" (? "s") "://www.gnu.org/licenses/"
- (? ">") (? " "))
+ "http" (? "s") "://www.gnu.org/licenses"
+ (? "/") (? ">") (? " "))
(seq "Boston, MA " (? " ")
"0211" (or "1-1307" "0-1301")
(or " " ", ") "USA")
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 994e6731af..39a7739dc5 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1882,6 +1882,9 @@ Files in subdirectories of DIRECTORY are processed also."
(interactive "DByte force recompile (directory): ")
(byte-recompile-directory directory nil t))
+(defvar byte-compile-ignore-files nil
+ "List of regexps for files to ignore during byte compilation.")
+
;;;###autoload
(defun byte-recompile-directory (directory &optional arg force follow-symlinks)
"Recompile every `.el' file in DIRECTORY that needs recompilation.
@@ -1938,14 +1941,23 @@ also be compiled."
;; This file is a subdirectory. Handle them differently.
(or (null arg) (eq 0 arg)
(y-or-n-p (concat "Check " source "? ")))
- (setq directories (nconc directories (list source))))
+ (setq directories (nconc directories (list source)))
+ ;; Directory is requested to be ignored
+ (string-match-p
+ (regexp-opt byte-compile-ignore-files)
+ source)
+ (setq directories (nconc directories (list source))))
;; It is an ordinary file. Decide whether to compile it.
(if (and (string-match emacs-lisp-file-regexp source)
;; The next 2 tests avoid compiling lock files
(file-readable-p source)
(not (string-match "\\`\\.#" file))
(not (auto-save-file-name-p source))
- (not (member source (dir-locals--all-files
directory))))
+ (not (member source (dir-locals--all-files directory)))
+ ;; File is requested to be ignored
+ (not (string-match-p
+ (regexp-opt byte-compile-ignore-files)
+ source)))
(progn (cl-incf
(pcase (byte-recompile-file source force arg)
('no-byte-compile skip-count)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 3987692f6f..863e895efd 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -57,7 +57,7 @@
:safe #'integerp
:version "28.1")
-(defcustom native-comp-debug (if (eq 'windows-nt system-type) 1 0)
+(defcustom native-comp-debug 0
"Debug level for native compilation, a number between 0 and 3.
This is intended for debugging the compiler itself.
0 no debug output.
@@ -67,7 +67,7 @@ This is intended for debugging the compiler itself.
passes and libgccjit log file."
:type 'natnum
:safe #'natnump
- :version "28.1")
+ :version "29.1")
(defcustom native-comp-verbose 0
"Compiler verbosity for native compilation, a number between 0 and 3.
@@ -2057,9 +2057,10 @@ and the annotation emission."
"Lexically-scoped FUNCTION."
(let ((args (comp-func-l-args function)))
(cons (make-comp-mvar :constant (comp-args-base-min args))
- (make-comp-mvar :constant (if (comp-args-p args)
- (comp-args-max args)
- 'many)))))
+ (make-comp-mvar :constant (cond
+ ((comp-args-p args) (comp-args-max args))
+ ((comp-nargs-rest args) 'many)
+ (t (comp-nargs-nonrest args)))))))
(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d))
"Dynamically scoped FUNCTION."
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index 4cb5ba64a8..fb5d518b22 100644
--- a/lisp/emacs-lisp/hierarchy.el
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -567,7 +567,7 @@ LABELFN is the same function passed to
`hierarchy-convert-to-tree-widget'.
INDENT is the same function passed to `hierarchy-convert-to-tree-widget'.
CHILDRENFN is the function used to discover the children of ELEM."
- (lambda (widget)
+ (lambda (_widget)
(mapcar
(lambda (item)
(widget-convert
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index d6f1ab98fa..9d6e8c0d88 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -19,7 +19,18 @@
;;; Commentary:
+;; This library provides multisession variables for Emacs Lisp, to
+;; make them persist between sessions.
;;
+;; Use `define-multisession-variable' to define a multisession
+;; variable, and `multisession-value' to read its value. Use
+;; `list-multisession-values' to list multisession variables.
+;;
+;; Users might want to customize `multisession-storage' and
+;; `multisession-directory'.
+;;
+;; See Info node `(elisp) Multisession Variables' for more
+;; information.
;;; Code:
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index c77ac151d7..a17fdb7e35 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -216,7 +216,7 @@ is a list of additional properties among the following:
function) named COPIER. It will take an object of type NAME as first
argument followed by ARGS. ARGS lists the names of the slots that will
be updated with the value of the corresponding argument.
-SLOTS is a list if slot descriptions. Each slot can be a single symbol
+SLOTS is a list of slot descriptions. Each slot can be a single symbol
which is the name of the slot, or it can be of the form (SLOT-NAME . SPROPS)
where SLOT-NAME is then the name of the slot and SPROPS is a property
list of slot properties. The currently known properties are the following:
@@ -341,11 +341,11 @@ list of slot properties. The currently known properties
are the following:
(defmacro oclosure--lambda (type bindings mutables args &rest body)
"Low level construction of an OClosure object.
-TYPE should be a form returning an OClosure type (a symbol)
+TYPE should be a form returning an OClosure type (a symbol).
BINDINGS should list all the slots expected by this type, in the proper order.
MUTABLE is a list of symbols indicating which of the BINDINGS
should be mutable.
-No checking is performed,"
+No checking is performed."
(declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body)))
;; FIXME: Fundamentally `oclosure-lambda' should be a special form.
;; We define it here as a macro which expands to something that
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
new file mode 100644
index 0000000000..a0b4b03118
--- /dev/null
+++ b/lisp/emacs-lisp/package-vc.el
@@ -0,0 +1,726 @@
+;;; package-vc.el --- Manage packages from VC checkouts -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; While packages managed by package.el use tarballs for distributing
+;; the source code, this extension allows for packages to be fetched
+;; and updated directly from a version control system.
+;;
+;; To install a package from source use `package-vc-install'. If you
+;; aren't interested in activating a package, you can use
+;; `package-vc-checkout' instead, which will prompt you for a target
+;; directory. If you wish to re-use an existing checkout, the command
+;; `package-vc-install-from-checkout' will create a symbolic link and
+;; prepare the package.
+;;
+;; If you make local changes that you wish to share with an upstream
+;; maintainer, the command `package-vc-prepare-patch' can prepare
+;; these as patches to send via Email.
+
+;;; TODO:
+
+;; - Allow maintaining patches that are ported back onto regular
+;; packages and maintained between versions.
+
+;;; Code:
+
+(eval-when-compile (require 'rx))
+(eval-when-compile (require 'inline))
+(eval-when-compile (require 'map))
+(require 'package)
+(require 'lisp-mnt)
+(require 'vc)
+(require 'seq)
+(require 'xdg)
+
+(defgroup package-vc nil
+ "Manage packages from VC checkouts."
+ :group 'package
+ :link '(custom-manual "(emacs) Package from Source")
+ :prefix "package-vc-"
+ :version "29.1")
+
+(defconst package-vc--elpa-packages-version 1
+ "Version number of the package specification format understood by
package-vc.")
+
+(defcustom package-vc-heuristic-alist
+ `((,(rx bos "http" (? "s") "://"
+ (or (: (? "www.") "github.com"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "codeberg.org"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: (? "www.") "gitlab" (+ "." (+ alnum))
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
+ (or "r" "git") "/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ (or (? "/") ".git") eos)
+ . Git)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "hg.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Hg)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Bzr))
+ "Heuristic mapping URL regular expressions to VC backends."
+ :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
+ :value-type (choice :tag "VC Backend"
+ ,@(mapcar (lambda (b) `(const ,b))
+ vc-handled-backends)))
+ :version "29.1")
+
+(defcustom package-vc-repository-store
+ (expand-file-name "emacs/vc-packages" (xdg-data-home))
+ "Directory used by `package-vc--unpack' to store repositories."
+ :type 'directory
+ :version "29.1")
+
+(defcustom package-vc-default-backend 'Git
+ "Default VC backend used when cloning a package repository.
+If no repository type was specified or could be guessed by
+`package-vc-heuristic-alist', this is the default VC backend
+used as fallback. The value must be a member of
+`vc-handled-backends' and the named backend must implement
+the `clone' function."
+ :type `(choice ,@(mapcar (lambda (b) (list 'const b))
+ vc-handled-backends))
+ :version "29.1")
+
+(defvar package-vc-selected-packages) ; pacify byte-compiler
+(defun package-vc-ensure-packages ()
+ "Ensure packages specified in `package-vc-selected-packages' are installed."
+ (pcase-dolist (`(,(and (pred symbolp) name) . ,spec)
+ package-vc-selected-packages)
+ (let ((pkg-desc (cadr (assoc name package-alist #'string=))))
+ (unless (and name (package-installed-p name)
+ (package-vc-p pkg-desc))
+ (cond
+ ((null spec)
+ (package-vc-install name))
+ ((stringp spec)
+ (package-vc-install name nil spec))
+ ((listp spec)
+ (package-vc--archives-initialize)
+ (package-vc--unpack pkg-desc spec)))))))
+
+;;;###autoload
+(defcustom package-vc-selected-packages '()
+ "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."
+ :type '(alist :tag "List of packages you want to be installed"
+ :key-type (symbol :tag "Package")
+ :value-type
+ (choice (const :tag "Any revision" nil)
+ (string :tag "Specific revision")
+ (plist :options ((:url string)
+ (:branch string)
+ (:lisp-dir string)
+ (:main-file string)
+ (:vc-backend symbol)))))
+ :set (lambda (sym val)
+ (custom-set-default sym val)
+ (package-vc-ensure-packages))
+ :version "29.1")
+
+(defvar package-vc--archive-spec-alist nil
+ "List of package specifications for each archive.
+The list maps each package name, as a string, to a plist.
+Valid keys and the corresponding value types are:
+
+ `:url' (string)
+ The URL of the repository used to fetch the package source.
+
+ `:branch' (string)
+ If given, the name of the branch to checkout after cloning the directory.
+
+ `:lisp-dir' (string)
+ The repository-relative name of the directory to use for loading the Lisp
+ sources. If not given, the value defaults to the root directory
+ of the repository.
+
+ `:main-file' (string)
+ The main file of the project, relevant to gather package metadata.
+ If not given, the assumed default is the package name with \".el\"
+ appended to it.
+
+ `:vc-backend' (symbol)
+ A symbol of the VC backend to use for cloning the package. The
+ value ought to be a member of `vc-handled-backends'. If omitted,
+ `vc-clone' will fall back onto the archive default or on
+ `package-vc-default-backend'.
+
+All other values are ignored.")
+
+(defvar package-vc--archive-data-alist nil
+ "List of package specification metadata for archives.
+Each element of the list has the form (ARCHIVE . PLIST), where
+PLIST keys are one of:
+
+ `:version' (integer)
+ Indicates the version of the file formatting, to be compared
+ with `package-vc--elpa-packages-version'.
+
+ `:vc-backend' (symbol)
+ A symbol of the default VC backend to use if a package specification
+ does not indicate a backend. The value ought to be a member of
+ `vc-handled-backends'. If omitted, `vc-clone' will fall back on
+ `package-vc-default-backend'.
+
+All other values are ignored.")
+
+(defun package-vc--desc->spec (pkg-desc &optional name)
+ "Retrieve the package specification for PKG-DESC.
+The optional argument NAME can be used to override the default
+name for PKG-DESC."
+ (alist-get
+ (or name (package-desc-name pkg-desc))
+ (if (package-desc-archive pkg-desc)
+ (alist-get (intern (package-desc-archive pkg-desc))
+ package-vc--archive-spec-alist)
+ (mapcan #'append (mapcar #'cdr package-vc--archive-spec-alist)))
+ nil nil #'string=))
+
+(define-inline package-vc--query-spec (pkg-desc prop)
+ "Query the property PROP for the package specification of PKG-DESC.
+If no package specification can be determined, the function will
+return nil."
+ (inline-letevals (pkg-desc prop)
+ (inline-quote (plist-get (package-vc--desc->spec ,pkg-desc) ,prop))))
+
+(defun package-vc--read-archive-data (archive)
+ "Update `package-vc--archive-spec-alist' for ARCHIVE.
+This function is meant to be used as a hook for `package--read-archive-hook'."
+ (let ((contents-file (expand-file-name
+ (format "archives/%s/elpa-packages.eld" archive)
+ package-user-dir)))
+ (when (file-exists-p contents-file)
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8))
+ (insert-file-contents contents-file)
+ ;; The response from the server is expected to have the form
+ ;;
+ ;; ((("foo" :url "..." ...) ...)
+ ;; :version 1
+ ;; :default-vc Git)
+ (let ((spec (read (current-buffer))))
+ (when (eq package-vc--elpa-packages-version
+ (plist-get (cdr spec) :version))
+ (setf (alist-get (intern archive) package-vc--archive-spec-alist)
+ (car spec)))
+ (setf (alist-get (intern archive) package-vc--archive-data-alist)
+ (cdr spec))
+ (when-let ((default-vc (plist-get (cdr spec) :default-vc))
+ ((not (memq default-vc vc-handled-backends))))
+ (warn "Archive `%S' expects missing VC backend %S"
+ archive (plist-get (cdr spec) :default-vc)))))))))
+
+(defun package-vc--download-and-read-archives (&optional async)
+ "Download specifications of all `package-archives' and read them.
+Populate `package-vc--archive-spec-alist' with the result.
+
+If optional argument ASYNC is non-nil, perform the downloads
+asynchronously."
+ (dolist (archive package-archives)
+ (condition-case-unless-debug nil
+ (package--download-one-archive archive "elpa-packages.eld" async)
+ (error (message "Failed to download `%s' archive." (car archive))))))
+
+(add-hook 'package-read-archive-hook #'package-vc--read-archive-data 20)
+(add-hook 'package-refresh-contents-hook
#'package-vc--download-and-read-archives 20)
+
+(defun package-vc-commit (pkg)
+ "Return the last commit of a development package PKG."
+ (cl-assert (package-vc-p pkg))
+ ;; FIXME: vc should be extended to allow querying the commit of a
+ ;; directory (as is possible when dealing with git repositories).
+ ;; This should be a fallback option.
+ (cl-loop with dir = (package-desc-dir pkg)
+ for file in (directory-files dir t "\\.el\\'" t)
+ when (vc-working-revision file) return it
+ finally return "unknown"))
+
+(defun package-vc--version (pkg)
+ "Extract the commit of a development package PKG."
+ (cl-assert (package-vc-p pkg))
+ (if-let ((main-file (package-vc--main-file pkg)))
+ (with-temp-buffer
+ (insert-file-contents main-file)
+ (package-strip-rcs-id
+ (or (lm-header "package-version")
+ (lm-header "version"))))
+ "0"))
+
+(defun package-vc--main-file (pkg-desc)
+ "Return the name of the main file for PKG-DESC."
+ (cl-assert (package-vc-p pkg-desc))
+ (let ((pkg-spec (package-vc--desc->spec pkg-desc)))
+ (or (plist-get pkg-spec :main-file)
+ (expand-file-name
+ (format "%s.el" (package-desc-name pkg-desc))
+ (file-name-concat
+ (or (package-desc-dir pkg-desc)
+ (expand-file-name
+ (package-desc-name pkg-desc)
+ package-user-dir))
+ (plist-get pkg-spec :lisp-dir))))))
+
+(defun package-vc--generate-description-file (pkg-desc pkg-file)
+ "Generate a package description file for PKG-DESC and write it to PKG-FILE."
+ (let ((name (package-desc-name pkg-desc)))
+ ;; Infer the subject if missing.
+ (unless (package-desc-summary pkg-desc)
+ (setf (package-desc-summary pkg-desc)
+ (let ((main-file (package-vc--main-file pkg-desc)))
+ (or (package-desc-summary pkg-desc)
+ (and-let* ((pkg (cadr (assq name package-archive-contents))))
+ (package-desc-summary pkg))
+ (and main-file (file-exists-p main-file)
+ (lm-summary main-file))
+ package--default-summary))))
+ (let ((print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat
+ ";;; Generated package description from "
+ (replace-regexp-in-string
+ "-pkg\\.el\\'" ".el"
+ (file-name-nondirectory pkg-file))
+ " -*- no-byte-compile: t -*-\n"
+ (prin1-to-string
+ (nconc
+ (list 'define-package
+ (symbol-name name)
+ (cons 'vc (package-vc--version pkg-desc))
+ (package-desc-summary pkg-desc)
+ (let ((requires (package-desc-reqs pkg-desc)))
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ (package--alist-to-plist-args
+ (package-desc-extras pkg-desc))))
+ "\n")
+ nil pkg-file nil 'silent))))
+
+(declare-function org-export-to-file "ox" (backend file))
+
+(defun package-vc--build-documentation (pkg-desc file)
+ "Build documentation FILE for PKG-DESC.
+FILE can be an Org file, indicated by its \".org\" extension,
+otherwise it's assumed to be an Info file."
+ (let ((pkg-dir (package-desc-dir pkg-desc)))
+ (when (string-match-p "\\.org\\'" file)
+ (require 'ox)
+ (require 'ox-texinfo)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (setq file (make-temp-file "ox-texinfo-"))
+ (org-export-to-file 'texinfo file)))
+ (call-process "install-info" nil nil nil
+ file pkg-dir)))
+
+(defun package-vc--unpack-1 (pkg-desc pkg-dir)
+ "Install PKG-DESC that is already checked-out in PKG-DIR."
+ ;; In case the package was installed directly from source, the
+ ;; dependency list wasn't know beforehand, and they might have
+ ;; to be installed explicitly.
+ (let (deps)
+ (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when-let* ((require-lines (lm-header-multiline "package-requires")))
+ (thread-last
+ (mapconcat #'identity require-lines " ")
+ package-read-from-string
+ package--prepare-dependencies
+ (nconc deps)
+ (setq deps)))))
+ (dolist (dep deps)
+ (cl-callf version-to-list (cadr dep)))
+ (package-download-transaction
+ (package-compute-transaction nil (delete-dups deps))))
+
+ (let ((default-directory (file-name-as-directory pkg-dir))
+ (name (package-desc-name pkg-desc))
+ (pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
+ ;; Generate autoloads
+ (package-generate-autoloads name pkg-dir)
+
+ ;; Generate package file
+ (package-vc--generate-description-file pkg-desc pkg-file)
+
+ ;; Detect a manual
+ (when-let ((pkg-spec (package-vc--desc->spec pkg-desc))
+ ((executable-find "install-info")))
+ (dolist (doc-file (ensure-list (plist-get pkg-spec :doc)))
+ (package-vc--build-documentation pkg-desc doc-file))))
+
+ ;; Update package-alist.
+ (let ((new-desc (package-load-descriptor pkg-dir)))
+ ;; Activation has to be done before compilation, so that if we're
+ ;; upgrading and macros have changed we load the new definitions
+ ;; before compiling.
+ (when (package-activate-1 new-desc :reload :deps)
+ ;; FIXME: Compilation should be done as a separate, optional, step.
+ ;; E.g. for multi-package installs, we should first install all packages
+ ;; and then compile them.
+ (package--compile new-desc)
+ (when package-native-compile
+ (package--native-compile-async new-desc))
+ ;; After compilation, load again any files loaded by
+ ;; `activate-1', so that we use the byte-compiled definitions.
+ (package--reload-previously-loaded new-desc)))
+
+ ;; Mark package as selected
+ (package--save-selected-packages
+ (cons (package-desc-name pkg-desc)
+ package-selected-packages))
+
+ ;; Confirm that the installation was successful
+ (let ((main-file (package-vc--main-file pkg-desc)))
+ (message "Source package `%s' installed (Version %s, Revision %S)."
+ (package-desc-name pkg-desc)
+ (lm-with-file main-file
+ (package-strip-rcs-id
+ (or (lm-header "package-version")
+ (lm-header "version"))))
+ (vc-working-revision main-file)))
+ t)
+
+(defun package-vc--guess-backend (url)
+ "Guess the VC backend for URL.
+This function will internally query `package-vc-heuristic-alist'
+and return nil if it cannot reasonably guess."
+ (and url (alist-get url package-vc-heuristic-alist
+ nil nil #'string-match-p)))
+
+(defun package-vc--clone (pkg-desc pkg-spec dir rev)
+ "Clone the package PKG-DESC whose spec is PKG-SPEC into the directory DIR.
+REV specifies a specific revision to checkout. This overrides the `:branch'
+attribute in PKG-SPEC."
+ (pcase-let* ((name (package-desc-name pkg-desc))
+ ((map :url :branch) pkg-spec))
+
+ ;; Clone the repository into `repo-dir' if necessary
+ (unless (file-exists-p dir)
+ (make-directory (file-name-directory dir) t)
+ (let ((backend (or (plist-get pkg-spec :vc-backend)
+ (package-vc--query-spec pkg-desc :vc-backend)
+ (package-vc--guess-backend url)
+ (plist-get (alist-get (package-desc-archive pkg-desc)
+ package-vc--archive-data-alist
+ nil nil #'string=)
+ :vc-backend)
+ package-vc-default-backend)))
+ (unless (vc-clone url backend dir
+ (or (and (not (eq rev :last-release)) rev) branch))
+ (error "Failed to clone %s from %s" name url))))
+
+ ;; Check out the latest release if requested
+ (when (eq rev :last-release)
+ (if-let ((release-rev (package-vc--release-rev pkg-desc)))
+ (vc-retrieve-tag dir release-rev)
+ (message "No release revision was found, continuing...")))))
+
+(defun package-vc--unpack (pkg-desc pkg-spec &optional rev)
+ "Install the package described by PKG-DESC.
+PKG-SPEC is a package specification, a property list describing
+how to fetch and build the package. See `package-vc--archive-spec-alist'
+for details. The optional argument REV specifies a specific revision to
+checkout. This overrides the `:branch' attribute in PKG-SPEC."
+ (pcase-let* (((map :url :lisp-dir) pkg-spec)
+ (name (package-desc-name pkg-desc))
+ (dirname (package-desc-full-name pkg-desc))
+ (pkg-dir (expand-file-name dirname package-user-dir))
+ (real-dir (if (null lisp-dir)
+ pkg-dir
+ (unless (file-exists-p package-vc-repository-store)
+ (make-directory package-vc-repository-store t))
+ (file-name-concat
+ package-vc-repository-store
+ ;; FIXME: We aren't sure this directory
+ ;; will be unique, but we can try other
+ ;; names to avoid an unnecessary error.
+ (file-name-base url)))))
+ (setf (package-desc-dir pkg-desc) pkg-dir)
+ (when (file-exists-p pkg-dir)
+ (if (yes-or-no-p "Overwrite previous checkout?")
+ (package--delete-directory pkg-dir pkg-desc)
+ (error "There already exists a checkout for %s" name)))
+ (package-vc--clone pkg-desc pkg-spec real-dir rev)
+ (unless (eq pkg-dir real-dir)
+ ;; Link from the right position in `repo-dir' to the package
+ ;; directory in the ELPA store.
+ (make-symbolic-link (file-name-concat real-dir lisp-dir) pkg-dir))
+
+ (package-vc--unpack-1 pkg-desc pkg-dir)))
+
+(defun package-vc--sourced-packages-list ()
+ "Generate a list of packages with VC data."
+ (seq-filter
+ (lambda (pkg)
+ (or (package-vc--desc->spec (cadr pkg))
+ ;; If we have no explicit VC data, we can try a kind of
+ ;; heuristic and use the URL header, that might already be
+ ;; pointing towards a repository, and use that as a backup
+ (and-let* ((extras (package-desc-extras (cadr pkg)))
+ (url (alist-get :url extras))
+ ((package-vc--guess-backend url))))))
+ package-archive-contents))
+
+(defun package-vc-update (pkg-desc)
+ "Attempt to update the package PKG-DESC."
+ ;; HACK: To run `package-vc--unpack-1' after checking out the new
+ ;; revision, we insert a hook into `vc-post-command-functions', and
+ ;; remove it right after it ran. To avoid running the hook multiple
+ ;; times or even for the wrong repository (as `vc-pull' is often
+ ;; asynchronous), we extract the relevant arguments using a pseudo
+ ;; filter for `vc-filter-command-function', executed only for the
+ ;; side effect, and store them in the lexical scope. When the hook
+ ;; is run, we check if the arguments are the same (`eq') as the ones
+ ;; previously extracted, and only in that case will be call
+ ;; `package-vc--unpack-1'. Ugh...
+ ;;
+ ;; If there is a better way to do this, it should be done.
+ (letrec ((pkg-dir (package-desc-dir pkg-desc))
+ (empty (make-symbol empty))
+ (args (list empty empty empty))
+ (vc-filter-command-function
+ (lambda (command file-or-list flags)
+ (setf (nth 0 args) command
+ (nth 1 args) file-or-list
+ (nth 2 args) flags)
+ (list command file-or-list flags)))
+ (post-upgrade
+ (lambda (command file-or-list flags)
+ (when (and (memq (nth 0 args) (list command empty))
+ (memq (nth 1 args) (list file-or-list empty))
+ (memq (nth 2 args) (list flags empty)))
+ (with-demoted-errors "Failed to activate: %S"
+ (package-vc--unpack-1 pkg-desc pkg-dir))
+ (remove-hook 'vc-post-command-functions post-upgrade)))))
+ (add-hook 'vc-post-command-functions post-upgrade)
+ (with-demoted-errors "Failed to fetch: %S"
+ (vc-pull))))
+
+(defun package-vc--archives-initialize ()
+ "Initialize package.el and fetch package specifications."
+ (package--archives-initialize)
+ (unless package-vc--archive-data-alist
+ (package-vc--download-and-read-archives)))
+
+(defun package-vc--release-rev (pkg-desc)
+ "Return the latest revision that bumps the \"Version\" tag for PKG-DESC.
+If no such revision can be found, return nil."
+ (with-current-buffer (find-file-noselect (package-vc--main-file pkg-desc))
+ (vc-buffer-sync)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (cond
+ ((re-search-forward
+ (concat (lm-get-header-re "package-version") ".*$")
+ (lm-code-start) t))
+ ((re-search-forward
+ (concat (lm-get-header-re "version") ".*$")
+ (lm-code-start) t)))
+ (ignore-error vc-not-supported
+ (vc-call-backend (vc-backend (buffer-file-name))
+ 'last-change
+ (buffer-file-name)
+ (line-number-at-pos nil t))))))))
+
+;;;###autoload
+(defun package-vc-install (name-or-url &optional name rev backend)
+ "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."
+ (interactive
+ (progn
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (package-vc--archives-initialize)
+ (let* ((packages (package-vc--sourced-packages-list))
+ (input (completing-read
+ "Fetch package source (name or URL): " packages))
+ (name (file-name-base input)))
+ (list input (intern (string-remove-prefix "emacs-" name))
+ (and current-prefix-arg :last-release)))))
+ (package-vc--archives-initialize)
+ (cond
+ ((and-let* (((stringp name-or-url))
+ (backend (or backend (package-vc--guess-backend name-or-url))))
+ (package-vc--unpack
+ (package-desc-create
+ :name (or name (intern (file-name-base name-or-url)))
+ :kind 'vc)
+ (list :vc-backend backend :url name-or-url)
+ rev)))
+ ((and-let* ((desc (assoc name-or-url package-archive-contents #'string=)))
+ (package-vc--unpack
+ (let ((copy (copy-package-desc (cadr desc))))
+ (setf (package-desc-kind copy) 'vc)
+ copy)
+ (or (package-vc--desc->spec (cadr desc))
+ (and-let* ((extras (package-desc-extras (cadr desc)))
+ (url (alist-get :url extras))
+ (backend (package-vc--guess-backend url)))
+ (list :vc-backend backend :url url))
+ (user-error "Package has no VC data"))
+ rev)))
+ ((user-error "Unknown package to fetch: %s" name-or-url))))
+
+;;;###autoload
+(defun package-vc-checkout (pkg-desc directory &optional rev)
+ "Clone the sources for PKG-DESC into DIRECTORY and visit that directory.
+Unlike `package-vc-install', this does not yet set up the package
+for use with Emacs; use `package-vc-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."
+ (interactive
+ (progn
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (package-vc--archives-initialize)
+ (let* ((packages (package-vc--sourced-packages-list))
+ (input (completing-read
+ "Fetch package source (name or URL): " packages)))
+ (list (cadr (assoc input package-archive-contents #'string=))
+ (read-file-name "Clone into new or empty directory: " nil nil t
nil
+ (lambda (dir) (or (not (file-exists-p dir))
+ (directory-empty-p dir))))
+ (and current-prefix-arg :last-release)))))
+ (package-vc--archives-initialize)
+ (let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
+ (and-let* ((extras (package-desc-extras pkg-desc))
+ (url (alist-get :url extras))
+ (backend (package-vc--guess-backend url)))
+ (list :vc-backend backend :url url))
+ (user-error "Package has no VC data"))))
+ (package-vc--clone pkg-desc pkg-spec directory rev)
+ (find-file directory)))
+
+;;;###autoload
+(defun package-vc-install-from-checkout (dir name)
+ "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."
+ (interactive (let ((dir (read-directory-name "Directory: ")))
+ (list dir
+ (if current-prefix-arg
+ (read-string "Package name: ")
+ (file-name-base (directory-file-name dir))))))
+ (unless (vc-responsible-backend dir)
+ (user-error "Directory %S is not under version control" dir))
+ (package-vc--archives-initialize)
+ (let* ((name (or name (file-name-base (directory-file-name dir))))
+ (pkg-dir (expand-file-name name package-user-dir)))
+ (make-symbolic-link dir pkg-dir)
+ (package-vc--unpack-1 (package-desc-create
+ :name (intern name)
+ :kind 'vc)
+ pkg-dir)))
+
+;;;###autoload
+(defun package-vc-refresh (pkg-desc)
+ "Refresh the installation for package given by PKG-DESC.
+Interactively, prompt for the name of the package to refresh."
+ (interactive (package-vc--read-pkg "Refresh package: "))
+ (package-vc--unpack-1 pkg-desc (package-desc-dir pkg-desc)))
+
+(defun package-vc--read-pkg (prompt)
+ "Query for a source package description with PROMPT."
+ (cadr (assoc (completing-read
+ prompt
+ package-alist
+ (lambda (pkg) (package-vc-p (cadr pkg)))
+ t)
+ package-alist
+ #'string=)))
+
+;;;###autoload
+(defun package-vc-prepare-patch (pkg subject revisions)
+ "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'."
+ (interactive
+ (list (package-vc--read-pkg "Package to prepare a patch for: ")
+ (and (not vc-prepare-patches-separately)
+ (read-string "Subject: " "[PATCH] " nil nil t))
+ (or (log-view-get-marked)
+ (vc-read-multiple-revisions "Revisions: "))))
+ (vc-prepare-patch (package-maintainers pkg t)
+ subject revisions))
+
+(provide 'package-vc)
+;;; package-vc.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index f3077cbbdb..a7bcdd214c 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -146,6 +146,7 @@
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
(eval-when-compile (require 'epg)) ;For setf accessors.
+(eval-when-compile (require 'inline)) ;For `define-inline'
(require 'seq)
(require 'tabulated-list)
@@ -456,6 +457,11 @@ synchronously."
(defvar package--default-summary "No description available.")
+(define-inline package-vc-p (pkg-desc)
+ "Return non-nil if PKG-DESC is a source package."
+ (inline-letevals (pkg-desc)
+ (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc))))
+
(cl-defstruct (package-desc
;; Rename the default constructor from `make-package-desc'.
(:constructor package-desc-create)
@@ -468,14 +474,18 @@ synchronously."
&rest rest-plist
&aux
(name (intern name-string))
- (version (version-to-list version-string))
+ (version (if (eq (car-safe version-string) 'vc)
+ (version-to-list (cdr version-string))
+ (version-to-list version-string)))
(reqs (mapcar (lambda (elt)
(list (car elt)
(version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
requirements)))
- (kind (plist-get rest-plist :kind))
+ (kind (if (eq (car-safe version-string) 'vc)
+ 'vc
+ (plist-get rest-plist :kind)))
(archive (plist-get rest-plist :archive))
(extras (let (alist)
(while rest-plist
@@ -567,9 +577,11 @@ This is, approximately, the inverse of `version-to-list'.
(defun package-desc-full-name (pkg-desc)
"Return full name of package-desc object PKG-DESC.
This is the name of the package with its version appended."
- (format "%s-%s"
- (package-desc-name pkg-desc)
- (package-version-join (package-desc-version pkg-desc))))
+ (if (package-vc-p pkg-desc)
+ (symbol-name (package-desc-name pkg-desc))
+ (format "%s-%s"
+ (package-desc-name pkg-desc)
+ (package-version-join (package-desc-version pkg-desc)))))
(defun package-desc-suffix (pkg-desc)
"Return file-name extension of package-desc object PKG-DESC.
@@ -600,6 +612,25 @@ package."
"Return the priority of the archive of package-desc object PKG-DESC."
(package-archive-priority (package-desc-archive pkg-desc)))
+(defun package--parse-elpaignore (pkg-desc)
+ "Return the of regular expression to match files ignored by PKG-DESC."
+ (let* ((pkg-dir (file-name-as-directory (package-desc-dir pkg-desc)))
+ (ignore (expand-file-name ".elpaignore" pkg-dir))
+ files)
+ (when (file-exists-p ignore)
+ (with-temp-buffer
+ (insert-file-contents ignore)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (wildcard-to-regexp
+ (let ((line (buffer-substring
+ (line-beginning-position)
+ (line-end-position))))
+ (file-name-concat pkg-dir (string-trim-left line "/"))))
+ files)
+ (forward-line)))
+ files)))
+
(cl-defstruct (package--bi-desc
(:constructor package-make-builtin (version summary))
(:type vector))
@@ -648,6 +679,8 @@ loaded and/or activated, customize `package-load-list'.")
;; `package-load-all-descriptors', which ultimately populates the
;; `package-alist' variable.
+(declare-function package-vc-version "package-vc" (pkg))
+
(defun package-process-define-package (exp)
"Process define-package expression EXP and push it to `package-alist'.
EXP should be a form read from a foo-pkg.el file.
@@ -676,6 +709,8 @@ are sorted with the highest version first."
nil)))
new-pkg-desc)))
+(declare-function package-vc-commit "package-vc" (pkg))
+
(defun package-load-descriptor (pkg-dir)
"Load the package description file in directory PKG-DIR.
Create a new `package-desc' object, add it to `package-alist' and
@@ -706,11 +741,9 @@ description file containing a call to `define-package',
which
updates `package-alist'."
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
- (dolist (subdir (directory-files dir))
- (unless (equal subdir "..")
- (let ((pkg-dir (expand-file-name subdir dir)))
- (when (file-directory-p pkg-dir)
- (package-load-descriptor pkg-dir))))))))
+ (dolist (pkg-dir (directory-files dir t "\\`[^.]" t))
+ (when (file-directory-p pkg-dir)
+ (package-load-descriptor pkg-dir))))))
(defun package--alist ()
"Return `package-alist', after computing it if needed."
@@ -873,14 +906,22 @@ correspond to previously loaded files."
(defun package--get-activatable-pkg (pkg-name)
;; Is "activatable" a word?
- (let ((pkg-descs (cdr (assq pkg-name package-alist))))
+ (let ((pkg-descs (sort (cdr (assq pkg-name package-alist))
+ (lambda (p1 p2)
+ (let ((v1 (package-desc-version p1))
+ (v2 (package-desc-version p2)))
+ (or
+ ;; Prefer source packages.
+ (package-vc-p p1)
+ (package-vc-p p2)
+ ;; Prefer builtin packages.
+ (package-disabled-p p1 v1)
+ (not (package-disabled-p p2 v2))))))))
;; Check if PACKAGE is available in `package-alist'.
(while
(when pkg-descs
(let ((available-version (package-desc-version (car pkg-descs))))
- (or (package-disabled-p pkg-name available-version)
- ;; Prefer a builtin package.
- (package-built-in-p pkg-name available-version))))
+ (package-disabled-p pkg-name available-version)))
(setq pkg-descs (cdr pkg-descs)))
(car pkg-descs)))
@@ -958,7 +999,7 @@ untar into a directory named DIR; otherwise, signal an
error."
;; indistinguishable from a `tar' or a `single'. Let's make
;; things simple by ensuring we're one of them.
(setf (package-desc-kind pkg-desc)
- (if (> (length file-list) 1) 'tar 'single))))
+ (if (length> file-list 1) 'tar 'single))))
('tar
(make-directory package-user-dir t)
(let* ((default-directory (file-name-as-directory package-user-dir)))
@@ -1021,6 +1062,7 @@ untar into a directory named DIR; otherwise, signal an
error."
"\n")
nil pkg-file nil 'silent))))
+
;;;; Autoload
(declare-function autoload-rubric "autoload" (file &optional type feature))
@@ -1068,11 +1110,13 @@ untar into a directory named DIR; otherwise, signal an
error."
;;;; Compilation
(defvar warning-minimum-level)
+(defvar byte-compile-ignore-files)
(defun package--compile (pkg-desc)
"Byte-compile installed package PKG-DESC.
This assumes that `pkg-desc' has already been activated with
`package-activate-1'."
- (let ((warning-minimum-level :error)
+ (let ((byte-compile-ignore-files (package--parse-elpaignore pkg-desc))
+ (warning-minimum-level :error)
(load-path load-path))
(byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
@@ -1601,13 +1645,19 @@ This is the value of `package-archive-priorities' last
time
by arbitrary functions to decide whether it is necessary to call
it again.")
+(defvar package-read-archive-hook (list #'package-read-archive-contents)
+ "List of functions to call to read the archive contents.
+Each function must take an optional argument, a symbol indicating
+what archive to read in. The symbol ought to be a key in
+`package-archives'.")
+
(defun package-read-all-archive-contents ()
"Read cached archive file for all archives in `package-archives'.
If successful, set or update `package-archive-contents'."
(setq package-archive-contents nil)
(setq package--old-archive-priorities package-archive-priorities)
(dolist (archive package-archives)
- (package-read-archive-contents (car archive))))
+ (run-hook-with-args 'package-read-archive-hook (car archive))))
;;;; Package Initialize
@@ -1733,9 +1783,14 @@ Once it's empty, run
`package--post-download-archives-hook'."
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
similar to an entry in `package-alist'. Save the cached copy to
\"archives/NAME/FILE\" in `package-user-dir'."
+ ;; The downloaded archive contents will be read as part of
+ ;; `package--update-downloads-in-progress'.
+ (dolist (archive package-archives)
+ (cl-pushnew (cons archive file) package--downloads-in-progress
+ :test #'equal))
(package--with-response-buffer (cdr archive) :file file
:async async
- :error-form (package--update-downloads-in-progress archive)
+ :error-form (package--update-downloads-in-progress (cons archive file))
(let* ((location (cdr archive))
(name (car archive))
(content (buffer-string))
@@ -1748,10 +1803,10 @@ similar to an entry in `package-alist'. Save the
cached copy to
;; If we don't care about the signature, save the file and
;; we're done.
(progn
- (cl-assert (not enable-multibyte-characters))
- (let ((coding-system-for-write 'binary))
- (write-region content nil local-file nil 'silent))
- (package--update-downloads-in-progress archive))
+ (cl-assert (not enable-multibyte-characters))
+ (let ((coding-system-for-write 'binary))
+ (write-region content nil local-file nil 'silent))
+ (package--update-downloads-in-progress (cons archive file)))
;; If we care, check it (perhaps async) and *then* write the file.
(package--check-signature
location file content async
@@ -1764,7 +1819,7 @@ similar to an entry in `package-alist'. Save the cached
copy to
(when good-sigs
(write-region (mapconcat #'epg-signature-to-string good-sigs
"\n")
nil (concat local-file ".signed") nil 'silent)))
- (lambda () (package--update-downloads-in-progress archive))))))))
+ (lambda () (package--update-downloads-in-progress (cons archive
file)))))))))
(defun package--download-and-read-archives (&optional async)
"Download descriptions of all `package-archives' and read them.
@@ -1772,17 +1827,17 @@ Populate `package-archive-contents' with the result.
If optional argument ASYNC is non-nil, perform the downloads
asynchronously."
- ;; The downloaded archive contents will be read as part of
- ;; `package--update-downloads-in-progress'.
- (dolist (archive package-archives)
- (cl-pushnew archive package--downloads-in-progress
- :test #'equal))
(dolist (archive package-archives)
(condition-case-unless-debug nil
(package--download-one-archive archive "archive-contents" async)
(error (message "Failed to download `%s' archive."
(car archive))))))
+(defvar package-refresh-contents-hook (list
#'package--download-and-read-archives)
+ "List of functions to call to refresh the package archive.
+Each function may take an optional argument indicating that the
+operation ought to be executed asynchronously.")
+
;;;###autoload
(defun package-refresh-contents (&optional async)
"Download descriptions of all configured ELPA packages.
@@ -1801,7 +1856,7 @@ downloads in the background."
(condition-case-unless-debug error
(package-import-keyring default-keyring)
(error (message "Cannot import default keyring: %S" (cdr error))))))
- (package--download-and-read-archives async))
+ (run-hook-with-args 'package-refresh-contents-hook async))
;;; Dependency Management
@@ -2035,9 +2090,9 @@ if all the in-between dependencies are also in
PACKAGE-LIST."
(cdr (assoc (package-desc-archive desc) package-archives)))
(defun package-install-from-archive (pkg-desc)
- "Download and install a tar package defined by PKG-DESC."
+ "Download and install a package defined by PKG-DESC."
;; This won't happen, unless the archive is doing something wrong.
- (when (eq (package-desc-kind pkg-desc) 'dir)
+ (when (package-vc-p pkg-desc)
(error "Can't install directory package from archive"))
(let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
@@ -2175,17 +2230,22 @@ to install it but still mark it as selected."
(message "Package `%s' installed." name))
(message "`%s' is already installed" name))))
+(declare-function package-vc-update "package-vc" (pkg))
+
;;;###autoload
(defun package-update (name)
"Update package NAME if a newer version exists."
(interactive
(list (completing-read
"Update package: " (package--updateable-packages) nil t)))
- (let ((package (if (symbolp name)
- name
- (intern name))))
- (package-delete (cadr (assq package package-alist)) 'force)
- (package-install package 'dont-select)))
+ (let* ((package (if (symbolp name)
+ name
+ (intern name)))
+ (pkg-desc (cadr (assq package package-alist))))
+ (if (package-vc-p pkg-desc)
+ (package-vc-update pkg-desc)
+ (package-delete pkg-desc 'force)
+ (package-install package 'dont-select))))
(defun package--updateable-packages ()
;; Initialize the package system to get the list of package
@@ -2195,12 +2255,13 @@ to install it but still mark it as selected."
#'car
(seq-filter
(lambda (elt)
- (let ((available
- (assq (car elt) package-archive-contents)))
- (and available
- (version-list-<
- (package-desc-version (cadr elt))
- (package-desc-version (cadr available))))))
+ (or (let ((available
+ (assq (car elt) package-archive-contents)))
+ (and available
+ (version-list-<
+ (package-desc-version (cadr elt))
+ (package-desc-version (cadr available)))))
+ (package-vc-p (cadr (assq (car elt) package-alist)))))
package-alist)))
;;;###autoload
@@ -2357,15 +2418,28 @@ installed), maybe you need to
\\[package-refresh-contents]")
pkg))
(declare-function comp-el-to-eln-filename "comp.c")
-(defun package--delete-directory (dir)
- "Delete DIR recursively.
+(defvar package-vc-repository-store)
+(defun package--delete-directory (dir pkg-desc)
+ "Delete PKG-DESC directory DIR recursively.
Clean-up the corresponding .eln files if Emacs is native
compiled."
(when (featurep 'native-compile)
(cl-loop
for file in (directory-files-recursively dir "\\.el\\'")
do (comp-clean-up-stale-eln (comp-el-to-eln-filename file))))
- (delete-directory dir t))
+ (if (and (package-vc-p pkg-desc)
+ (require 'package-vc) ;load `package-vc-repository-store'
+ (file-in-directory-p dir package-vc-repository-store))
+ (progn
+ (delete-directory
+ (expand-file-name
+ (car (file-name-split
+ (file-relative-name dir package-vc-repository-store)))
+ package-vc-repository-store)
+ t)
+ (delete-file (directory-file-name dir)))
+ (delete-directory dir t)))
+
(defun package-delete (pkg-desc &optional force nosave)
"Delete package PKG-DESC.
@@ -2419,7 +2493,7 @@ If NOSAVE is non-nil, the package is not removed from
(package-desc-name pkg-used-elsewhere-by)))
(t
(add-hook 'post-command-hook #'package-menu--post-refresh)
- (package--delete-directory dir)
+ (package--delete-directory dir pkg-desc)
;; Remove NAME-VERSION.signed and NAME-readme.txt files.
;;
;; NAME-readme.txt files are no longer created, but they
@@ -2630,7 +2704,10 @@ Helper function for `describe-package'."
(incompatible-reason (package--incompatible-p desc))
(signed (if desc (package-desc-signed desc)))
(maintainer (cdr (assoc :maintainer extras)))
- (authors (cdr (assoc :authors extras))))
+ (authors (cdr (assoc :authors extras)))
+ (news (and-let* ((file (expand-file-name "news" pkg-dir))
+ ((file-readable-p file)))
+ file)))
(when (string= status "avail-obso")
(setq status "available obsolete"))
(when incompatible-reason
@@ -2829,6 +2906,14 @@ Helper function for `describe-package'."
t)
(insert (or readme-string
"This package does not provide a description.")))))
+
+ ;; Insert news if available.
+ (when news
+ (insert "\n" (make-separator-line) "\n"
+ (propertize "* News" 'face 'package-help-section-name)
+ "\n\n")
+ (insert-file-contents news))
+
;; Make library descriptions into links.
(goto-char start-of-description)
(package--describe-add-library-links)
@@ -2919,6 +3004,7 @@ either a full name or nil, and EMAIL is a valid email
address."
"r" #'revert-buffer
"~" #'package-menu-mark-obsolete-for-deletion
"w" #'package-browse-url
+ "b" #'package-report-bug
"x" #'package-menu-execute
"h" #'package-menu-quick-help
"H" #'package-menu-hide-package
@@ -3077,6 +3163,7 @@ of these dependencies, similar to the list returned by
(signed (or (not package-list-unsigned)
(package-desc-signed pkg-desc))))
(cond
+ ((package-vc-p pkg-desc) "source")
((eq dir 'builtin) "built-in")
((and lle (null held)) "disabled")
((stringp held)
@@ -3165,8 +3252,9 @@ to their archives."
(if (not installed)
filtered-by-priority
(let ((ins-version (package-desc-version installed)))
- (cl-remove-if (lambda (p) (version-list-= (package-desc-version
p)
- ins-version))
+ (cl-remove-if (lambda (p) (or (version-list-=
(package-desc-version p)
+ ins-version)
+ (package-vc-p installed)))
filtered-by-priority))))))))
(defcustom package-hidden-regexps nil
@@ -3368,6 +3456,11 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
"Face used on the status and version of installed packages."
:version "25.1")
+(defface package-status-from-source
+ '((t :inherit font-lock-negation-char-face))
+ "Face used on the status and version of installed packages."
+ :version "29.1")
+
(defface package-status-dependency
'((t :inherit package-status-installed))
"Face used on the status and version of dependency packages."
@@ -3405,6 +3498,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
("held" 'package-status-held)
("disabled" 'package-status-disabled)
("installed" 'package-status-installed)
+ ("source" 'package-status-from-source)
("dependency" 'package-status-dependency)
("unsigned" 'package-status-unsigned)
("incompat" 'package-status-incompat)
@@ -3416,9 +3510,14 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
follow-link t
package-desc ,pkg
action package-menu-describe-package)
- ,(propertize (package-version-join
- (package-desc-version pkg))
- 'font-lock-face face)
+ ,(propertize
+ (if (package-vc-p pkg)
+ (progn
+ (require 'package-vc)
+ (package-vc-commit pkg))
+ (package-version-join
+ (package-desc-version pkg)))
+ 'font-lock-face face)
,(propertize status 'font-lock-face face)
,@(if (cdr package-archives)
(list (propertize (or (package-desc-archive pkg) "")
@@ -3493,7 +3592,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status)
- '("installed" "dependency" "obsolete" "unsigned"))
+ '("installed" "source" "dependency" "obsolete" "unsigned"))
(tabulated-list-put-tag "D" t)
(forward-line)))
@@ -3849,6 +3948,8 @@ This is used for `tabulated-list-format' in
`package-menu-mode'."
((string= sB "installed") nil)
((string= sA "dependency") t)
((string= sB "dependency") nil)
+ ((string= sA "source") t)
+ ((string= sB "source") nil)
((string= sA "unsigned") t)
((string= sB "unsigned") nil)
((string= sA "held") t)
@@ -4142,6 +4243,7 @@ packages."
"held"
"incompat"
"installed"
+ "source"
"new"
"unsigned")))
package-menu-mode)
@@ -4213,22 +4315,22 @@ Unlike other filters, this leaves the marks intact."
(while (not (eobp))
(setq mark (char-after))
(unless (eq mark ?\s)
- (setq pkg-id (tabulated-list-get-id))
+ (setq pkg-id (tabulated-list-get-id))
(setq entry (package-menu--print-info-simple pkg-id))
- (push entry found-entries)
- ;; remember the mark
- (push (cons pkg-id mark) marks))
+ (push entry found-entries)
+ ;; remember the mark
+ (push (cons pkg-id mark) marks))
(forward-line))
(if found-entries
(progn
(setq tabulated-list-entries found-entries)
(package-menu--display t nil)
- ;; redo the marks, but we must remember the marks!!
- (goto-char (point-min))
- (while (not (eobp))
- (setq mark (cdr (assq (tabulated-list-get-id) marks)))
- (tabulated-list-put-tag (char-to-string mark) t)))
- (user-error "No packages found")))))
+ ;; redo the marks, but we must remember the marks!!
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq mark (cdr (assq (tabulated-list-get-id) marks)))
+ (tabulated-list-put-tag (char-to-string mark) t)))
+ (user-error "No packages found")))))
(defun package-menu-filter-upgradable ()
"Filter \"*Packages*\" buffer to show only upgradable packages."
@@ -4410,11 +4512,22 @@ beginning of the line."
(package-version-join (package-desc-version package-desc))
(package-desc-summary package-desc))))
+(defun package--query-desc (&optional alist)
+ "Query the user for a package or return the package at point.
+The optional argument ALIST must consist of elements with the
+form (PKG-NAME PKG-DESC). If not specified, it will default to
+`package-alist'."
+ (or (tabulated-list-get-id)
+ (let ((alist (or alist package-alist)))
+ (cadr (assoc (completing-read "Package: " alist nil t)
+ alist #'string=)))))
+
(defun package-browse-url (desc &optional secondary)
"Open the website of the package under point in a browser.
-`browse-url' is used to determine the browser to be used.
-If SECONDARY (interactively, the prefix), use the secondary browser."
- (interactive (list (tabulated-list-get-id)
+`browse-url' is used to determine the browser to be used. If
+SECONDARY (interactively, the prefix), use the secondary browser.
+DESC must be a `package-desc' object."
+ (interactive (list (package--query-desc)
current-prefix-arg)
package-menu-mode)
(unless desc
@@ -4423,9 +4536,47 @@ If SECONDARY (interactively, the prefix), use the
secondary browser."
(unless url
(user-error "No website for %s" (package-desc-name desc)))
(if secondary
- (funcall browse-url-secondary-browser-function url)
+ (funcall browse-url-secondary-browser-function url)
(browse-url url))))
+(defun package-maintainers (pkg-desc &optional no-error)
+ "Return an email address for the maintainers of PKG-DESC.
+The email address may contain commas, if there are multiple
+maintainers. If no maintainers are found, an error will be
+signalled. If the optional argument NO-ERROR is non-nil no error
+will be signalled in that case."
+ (unless pkg-desc
+ (error "Invalid package description"))
+ (let* ((extras (package-desc-extras pkg-desc))
+ (maint (alist-get :maintainer extras)))
+ (cond
+ ((and (null maint) (null no-error))
+ (user-error "Package has no explicit maintainer"))
+ ((not (null maint))
+ (with-temp-buffer
+ (package--print-email-button maint)
+ (string-trim (substring-no-properties (buffer-string))))))))
+
+(defun package-report-bug (desc)
+ "Prepare a message to send to the maintainers of a package.
+DESC must be a `package-desc' object."
+ (interactive (list (package--query-desc package-alist))
+ package-menu-mode)
+ (let ((maint (package-maintainers desc))
+ (name (symbol-name (package-desc-name desc)))
+ vars)
+ (dolist-with-progress-reporter (group custom-current-group-alist)
+ "Scanning for modified user options..."
+ (dolist (ent (get (cdr group) 'custom-group))
+ (when (and (custom-variable-p (car ent))
+ (boundp (car ent))
+ (not (eq (custom--standard-value (car ent))
+ (default-toplevel-value (car ent))))
+ (file-in-directory-p (car group) (package-desc-dir desc)))
+ (push (car ent) vars))))
+ (dlet ((reporter-prompt-for-summary-p t))
+ (reporter-submit-bug-report maint name vars))))
+
;;;; Introspection
(defun package-get-descriptor (pkg-name)
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 61d52026b3..b86070deef 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -56,7 +56,7 @@
;; which includes a kind of tutorial to get started with SMIE:
;;
;; SMIE: Weakness is Power! Auto-indentation with incomplete information
-;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1.
+;; Stefan Monnier, <Programming> Journal 2020, volume 5, issue 1.
;; doi: 10.22152/programming-journal.org/2021/5/1
;; A good background to understand the development (especially the parts
diff --git a/lisp/emacs-lisp/text-property-search.el
b/lisp/emacs-lisp/text-property-search.el
index d11980f4f4..d41222bdbf 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -208,8 +208,14 @@ and if a matching region is found, place point at the
start of the region."
(goto-char end)
(setq ended t)))))
;; End this at the first place the property changes value.
- (setq end (previous-single-property-change
- (point) property nil (point-min)))
+ (setq end
+ (if (and (> (point) (point-min))
+ (text-property--match-p
+ value (get-text-property (1- (point)) property)
+ predicate))
+ (previous-single-property-change (point)
+ property nil (point-min))
+ (point)))
(goto-char end))
(make-prop-match :beginning end
:end (1+ start)
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
index 8fc9785430..89c24758cb 100644
--- a/lisp/erc/ChangeLog.1
+++ b/lisp/erc/ChangeLog.1
@@ -9372,8 +9372,8 @@
2002-08-14 Mario Lang <mlang@delysid.org>
- * erc-button.el:
- Try to be compatible to XEmacs regexp-opt. (Im going to quit this job
if I find more of those damn differencies
+ * erc-button.el: Try to be compatible to XEmacs regexp-opt. (I'm
+ going to quit this job if I find more of those damn differences.)
* debian/README.Debian, debian/scripts/install:
* Added info to README.Debian
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index df9efe4b0c..026b34849a 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -99,24 +99,117 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
-;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
-;; reverse is true:
-(require 'erc)
+(require 'erc-common)
+
+(defvar erc--target)
+(defvar erc-auto-query)
+(defvar erc-channel-list)
+(defvar erc-channel-users)
+(defvar erc-default-nicks)
+(defvar erc-default-recipients)
+(defvar erc-format-nick-function)
+(defvar erc-format-query-as-channel-p)
+(defvar erc-hide-prompt)
+(defvar erc-input-marker)
+(defvar erc-insert-marker)
+(defvar erc-invitation)
+(defvar erc-join-buffer)
+(defvar erc-kill-buffer-on-part)
+(defvar erc-kill-server-buffer-on-quit)
+(defvar erc-log-p)
+(defvar erc-minibuffer-ignored)
+(defvar erc-networks--id)
+(defvar erc-nick)
+(defvar erc-nick-change-attempt-count)
+(defvar erc-prompt-for-channel-key)
+(defvar erc-prompt-hidden)
+(defvar erc-reuse-buffers)
+(defvar erc-verbose-server-ping)
+(defvar erc-whowas-on-nosuchnick)
+
+(declare-function erc--open-target "erc" (target))
+(declare-function erc--target-from-string "erc" (string))
+(declare-function erc-active-buffer "erc" nil)
+(declare-function erc-add-default-channel "erc" (channel))
+(declare-function erc-banlist-update "erc" (proc parsed))
+(declare-function erc-buffer-filter "erc" (predicate &optional proc))
+(declare-function erc-buffer-list-with-nick "erc" (nick proc))
+(declare-function erc-channel-begin-receiving-names "erc" nil)
+(declare-function erc-channel-end-receiving-names "erc" nil)
+(declare-function erc-channel-p "erc" (channel))
+(declare-function erc-channel-receive-names "erc" (names-string))
+(declare-function erc-cmd-JOIN "erc" (channel &optional key))
+(declare-function erc-connection-established "erc" (proc parsed))
+(declare-function erc-current-nick "erc" nil)
+(declare-function erc-current-nick-p "erc" (nick))
+(declare-function erc-current-time "erc" (&optional specified-time))
+(declare-function erc-default-target "erc" nil)
+(declare-function erc-delete-default-channel "erc" (channel &optional buffer))
+(declare-function erc-display-error-notice "erc" (parsed string))
+(declare-function erc-display-server-message "erc" (_proc parsed))
+(declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time))
+(declare-function erc-format-message "erc" (msg &rest args))
+(declare-function erc-format-privmessage "erc" (nick msg privp msgp))
+(declare-function erc-get-buffer "erc" (target &optional proc))
+(declare-function erc-handle-login "erc" nil)
+(declare-function erc-handle-user-status-change "erc" (type nlh &optional l))
+(declare-function erc-ignored-reply-p "erc" (msg tgt proc))
+(declare-function erc-ignored-user-p "erc" (spec))
+(declare-function erc-is-message-ctcp-and-not-action-p "erc" (message))
+(declare-function erc-is-message-ctcp-p "erc" (message))
+(declare-function erc-log-irc-protocol "erc" (string &optional outbound))
+(declare-function erc-login "erc" nil)
+(declare-function erc-make-notice "erc" (message))
+(declare-function erc-network "erc-networks" nil)
+(declare-function erc-networks--id-given "erc-networks" (arg &rest args))
+(declare-function erc-networks--id-reload "erc-networks" (arg &rest args))
+(declare-function erc-nickname-in-use "erc" (nick reason))
+(declare-function erc-parse-user "erc" (string))
+(declare-function erc-process-away "erc" (proc away-p))
+(declare-function erc-process-ctcp-query "erc" (proc parsed nick login host))
+(declare-function erc-query-buffer-p "erc" (&optional buffer))
+(declare-function erc-remove-channel-member "erc" (channel nick))
+(declare-function erc-remove-channel-users "erc" nil)
+(declare-function erc-remove-user "erc" (nick))
+(declare-function erc-sec-to-time "erc" (ns))
+(declare-function erc-server-buffer "erc" nil)
+(declare-function erc-set-active-buffer "erc" (buffer))
+(declare-function erc-set-current-nick "erc" (nick))
+(declare-function erc-set-modes "erc" (tgt mode-string))
+(declare-function erc-time-diff "erc" (t1 t2))
+(declare-function erc-trim-string "erc" (s))
+(declare-function erc-update-mode-line "erc" (&optional buffer))
+(declare-function erc-update-mode-line-buffer "erc" (buffer))
+(declare-function erc-wash-quit-reason "erc" (reason nick login host))
+
+(declare-function erc-display-message "erc"
+ (parsed type buffer msg &rest args))
+(declare-function erc-get-buffer-create "erc"
+ (server port target &optional tgt-info id))
+(declare-function erc-process-ctcp-reply "erc"
+ (proc parsed nick login host msg))
+(declare-function erc-update-channel-topic "erc"
+ (channel topic &optional modify))
+(declare-function erc-update-modes "erc"
+ (tgt mode-string &optional _nick _host _login))
+(declare-function erc-update-user-nick "erc"
+ (nick &optional new-nick host login full-name info))
+(declare-function erc-open "erc"
+ (&optional server port nick full-name connect passwd tgt-list
+ channel process client-certificate user id))
+(declare-function erc-update-channel-member "erc"
+ (channel nick new-nick
+ &optional add voice halfop op admin owner host
+ login full-name info update-message-time))
;;;; Variables and options
+(defvar-local erc-session-password nil
+ "The password used for the current session.")
+
(defvar erc-server-responses (make-hash-table :test #'equal)
"Hash table mapping server responses to their handler hooks.")
-(cl-defstruct (erc-response (:conc-name erc-response.))
- (unparsed "" :type string)
- (sender "" :type string)
- (command "" :type string)
- (command-args '() :type list)
- (contents "" :type string)
- (tags '() :type list))
-
;;; User data
(defvar-local erc-server-current-nick nil
@@ -1662,16 +1755,6 @@ Then display the welcome message."
(split-string value ",")
(list value)))))
-(defmacro erc--with-memoization (table &rest forms)
- "Adapter to be migrated to erc-compat."
- (declare (indent defun))
- `(cond
- ((fboundp 'with-memoization)
- (with-memoization ,table ,@forms)) ; 29.1
- ((fboundp 'cl--generic-with-memoization)
- (cl--generic-with-memoization ,table ,@forms))
- (t ,@forms)))
-
(defun erc--get-isupport-entry (key &optional single)
"Return an item for \"ISUPPORT\" token KEY, a symbol.
When a lookup fails return nil. Otherwise return a list whose
@@ -1681,7 +1764,7 @@ ambiguous and only useful for tokens supporting a single
primitive value."
(if-let* ((table (or erc--isupport-params
(erc-with-server-buffer erc--isupport-params)))
- (value (erc--with-memoization (gethash key table)
+ (value (erc-compat--with-memoization (gethash key table)
(when-let ((v (assoc (symbol-name key)
erc-server-parameters)))
(if (cdr v)
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
new file mode 100644
index 0000000000..d8aac36eab
--- /dev/null
+++ b/lisp/erc/erc-common.el
@@ -0,0 +1,271 @@
+;;; erc-common.el --- Macros and types for ERC -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
+;; Keywords: comm, IRC, chat, client, internet
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+
+(eval-when-compile (require 'cl-lib) (require 'subr-x))
+(require 'erc-compat)
+
+(defvar erc--casemapping-rfc1459)
+(defvar erc--casemapping-rfc1459-strict)
+(defvar erc-channel-users)
+(defvar erc-dbuf)
+(defvar erc-log-p)
+(defvar erc-server-users)
+(defvar erc-session-server)
+
+(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
+(declare-function erc-get-buffer "erc" (target &optional proc))
+(declare-function erc-server-buffer "erc" nil)
+
+(cl-defstruct erc-input
+ string insertp sendp)
+
+(cl-defstruct (erc--input-split (:include erc-input))
+ lines cmdp)
+
+(cl-defstruct (erc-server-user (:type vector) :named)
+ ;; User data
+ nickname host login full-name info
+ ;; Buffers
+ ;;
+ ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where
+ ;; CHANNEL-DATA is either nil or an erc-channel-user struct.
+ (buffers nil))
+
+(cl-defstruct (erc-channel-user (:type vector) :named)
+ voice halfop op admin owner
+ ;; Last message time (in the form of the return value of
+ ;; (current-time)
+ ;;
+ ;; This is useful for ordered name completion.
+ (last-message-time nil))
+
+(cl-defstruct erc--target
+ (string "" :type string :documentation "Received name of target.")
+ (symbol nil :type symbol :documentation "Case-mapped name as symbol."))
+
+;; At some point, it may make sense to add a query type with an
+;; account field, which may help support reassociation across
+;; reconnects and nick changes (likely requires v3 extensions).
+;;
+;; These channel variants should probably take on a `joined' field to
+;; track "joinedness", which `erc-server-JOIN', `erc-server-PART',
+;; etc. should toggle. Functions like `erc--current-buffer-joined-p'
+;; may find it useful.
+
+(cl-defstruct (erc--target-channel (:include erc--target)))
+(cl-defstruct (erc--target-channel-local (:include erc--target-channel)))
+
+(cl-defstruct (erc-response (:conc-name erc-response.))
+ (unparsed "" :type string)
+ (sender "" :type string)
+ (command "" :type string)
+ (command-args '() :type list)
+ (contents "" :type string)
+ (tags '() :type list))
+
+(defmacro define-erc-module (name alias doc enable-body disable-body
+ &optional local-p)
+ "Define a new minor mode using ERC conventions.
+Symbol NAME is the name of the module.
+Symbol ALIAS is the alias to use, or nil.
+DOC is the documentation string to use for the minor mode.
+ENABLE-BODY is a list of expressions used to enable the mode.
+DISABLE-BODY is a list of expressions used to disable the mode.
+If LOCAL-P is non-nil, the mode will be created as a buffer-local
+mode, rather than a global one.
+
+This will define a minor mode called erc-NAME-mode, possibly
+an alias erc-ALIAS-mode, as well as the helper functions
+erc-NAME-enable, and erc-NAME-disable.
+
+Example:
+
+ ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\")
+ (define-erc-module replace nil
+ \"This mode replaces incoming text according to `erc-replace-alist'.\"
+ ((add-hook \\='erc-insert-modify-hook
+ #\\='erc-replace-insert))
+ ((remove-hook \\='erc-insert-modify-hook
+ #\\='erc-replace-insert)))"
+ (declare (doc-string 3) (indent defun))
+ (let* ((sn (symbol-name name))
+ (mode (intern (format "erc-%s-mode" (downcase sn))))
+ (group (intern (format "erc-%s" (downcase sn))))
+ (enable (intern (format "erc-%s-enable" (downcase sn))))
+ (disable (intern (format "erc-%s-disable" (downcase sn)))))
+ `(progn
+ (define-minor-mode
+ ,mode
+ ,(format "Toggle ERC %S mode.
+With a prefix argument ARG, enable %s if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+%s" name name doc)
+ ;; FIXME: We don't know if this group exists, so this `:group' may
+ ;; actually just silence a valid warning about the fact that the var
+ ;; is not associated with any group.
+ :global ,(not local-p) :group (quote ,group)
+ (if ,mode
+ (,enable)
+ (,disable)))
+ (defun ,enable ()
+ ,(format "Enable ERC %S mode."
+ name)
+ (interactive)
+ (add-to-list 'erc-modules (quote ,name))
+ (setq ,mode t)
+ ,@enable-body)
+ (defun ,disable ()
+ ,(format "Disable ERC %S mode."
+ name)
+ (interactive)
+ (setq erc-modules (delq (quote ,name) erc-modules))
+ (setq ,mode nil)
+ ,@disable-body)
+ ,(when (and alias (not (eq name alias)))
+ `(defalias
+ ',(intern
+ (format "erc-%s-mode"
+ (downcase (symbol-name alias))))
+ #',mode))
+ ;; For find-function and find-variable.
+ (put ',mode 'definition-name ',name)
+ (put ',enable 'definition-name ',name)
+ (put ',disable 'definition-name ',name))))
+
+(defmacro erc-with-buffer (spec &rest body)
+ "Execute BODY in the buffer associated with SPEC.
+
+SPEC should have the form
+
+ (TARGET [PROCESS])
+
+If TARGET is a buffer, use it. Otherwise, use the buffer
+matching TARGET in the process specified by PROCESS.
+
+If PROCESS is nil, use the current `erc-server-process'.
+See `erc-get-buffer' for details.
+
+See also `with-current-buffer'.
+
+\(fn (TARGET [PROCESS]) BODY...)"
+ (declare (indent 1) (debug ((form &optional form) body)))
+ (let ((buf (make-symbol "buf"))
+ (proc (make-symbol "proc"))
+ (target (make-symbol "target"))
+ (process (make-symbol "process")))
+ `(let* ((,target ,(car spec))
+ (,process ,(cadr spec))
+ (,buf (if (bufferp ,target)
+ ,target
+ (let ((,proc (or ,process
+ (and (processp erc-server-process)
+ erc-server-process))))
+ (if (and ,target ,proc)
+ (erc-get-buffer ,target ,proc))))))
+ (when (buffer-live-p ,buf)
+ (with-current-buffer ,buf
+ ,@body)))))
+
+(defmacro erc-with-server-buffer (&rest body)
+ "Execute BODY in the current ERC server buffer.
+If no server buffer exists, return nil."
+ (declare (indent 0) (debug (body)))
+ (let ((buffer (make-symbol "buffer")))
+ `(let ((,buffer (erc-server-buffer)))
+ (when (buffer-live-p ,buffer)
+ (with-current-buffer ,buffer
+ ,@body)))))
+
+(defmacro erc-with-all-buffers-of-server (process pred &rest forms)
+ "Execute FORMS in all buffers which have same process as this server.
+FORMS will be evaluated in all buffers having the process PROCESS and
+where PRED matches or in all buffers of the server process if PRED is
+nil."
+ (declare (indent 2) (debug (form form body)))
+ (macroexp-let2 nil pred pred
+ `(erc-buffer-filter (lambda ()
+ (when (or (not ,pred) (funcall ,pred))
+ ,@forms))
+ ,process)))
+
+(defun erc-log-aux (string)
+ "Do the debug logging of STRING."
+ (let ((cb (current-buffer))
+ (point 1)
+ (was-eob nil)
+ (session-buffer (erc-server-buffer)))
+ (if session-buffer
+ (progn
+ (set-buffer session-buffer)
+ (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
+ (progn
+ (setq erc-dbuf (get-buffer-create
+ (concat "*ERC-DEBUG: "
+ erc-session-server "*")))))
+ (set-buffer erc-dbuf)
+ (setq point (point))
+ (setq was-eob (eobp))
+ (goto-char (point-max))
+ (insert (concat "** " string "\n"))
+ (if was-eob (goto-char (point-max))
+ (goto-char point))
+ (set-buffer cb))
+ (message "ERC: ** %s" string))))
+
+(define-inline erc-log (string)
+ "Logs STRING if logging is on (see `erc-log-p')."
+ (inline-quote
+ (when erc-log-p
+ (erc-log-aux ,string))))
+
+(defun erc-downcase (string)
+ "Return a downcased copy of STRING with properties.
+Use the CASEMAPPING ISUPPORT parameter to determine the style."
+ (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single))
+ (inhibit-read-only t))
+ (if (equal mapping "ascii")
+ (downcase string)
+ (with-temp-buffer
+ (insert string)
+ (translate-region (point-min) (point-max)
+ (if (equal mapping "rfc1459-strict")
+ erc--casemapping-rfc1459-strict
+ erc--casemapping-rfc1459))
+ (buffer-string)))))
+
+(define-inline erc-get-channel-user (nick)
+ "Find NICK in the current buffer's `erc-channel-users' hash table."
+ (inline-quote (gethash (erc-downcase ,nick) erc-channel-users)))
+
+(define-inline erc-get-server-user (nick)
+ "Find NICK in the current server's `erc-server-users' hash table."
+ (inline-letevals (nick)
+ (inline-quote (erc-with-server-buffer
+ (gethash (erc-downcase ,nick) erc-server-users)))))
+
+(provide 'erc-common)
+
+;;; erc-common.el ends here
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 8a00e711ac..03bd8f1352 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -156,6 +156,18 @@ If START or END is negative, it counts from the end."
(setq i (1+ i) start (1+ start)))
res))))))
+
+;;;; Misc 29.1
+
+(defmacro erc-compat--with-memoization (table &rest forms)
+ (declare (indent defun))
+ (cond
+ ((fboundp 'with-memoization)
+ `(with-memoization ,table ,@forms)) ; 29.1
+ ((fboundp 'cl--generic-with-memoization)
+ `(cl--generic-with-memoization ,table ,@forms))
+ (t `(progn ,@forms))))
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 90a10766c4..ebeab921fb 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -411,8 +411,11 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
"Provide completion for the /DCC command."
(pcomplete-here (append '("chat" "close" "get" "list")
(when (fboundp 'make-network-process) '("send"))))
+ (when (equal "get" (downcase (pcomplete-arg 1)))
+ (pcomplete-opt "ts")
+ (pcomplete-opt (if (equal "-s" (pcomplete-arg 'first 2)) "t" "s")))
(pcomplete-here
- (pcase (intern (downcase (pcomplete-arg 1)))
+ (pcase (intern (downcase (pcomplete-arg 'first 1)))
('chat (mapcar (lambda (elt) (plist-get elt :nick))
(cl-remove-if-not
(lambda (elt)
@@ -428,7 +431,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
erc-dcc-list)))
('send (pcomplete-erc-all-nicks))))
(pcomplete-here
- (pcase (intern (downcase (pcomplete-arg 2)))
+ (pcase (intern (downcase (pcomplete-arg 'first 1)))
('get (mapcar (lambda (elt) (plist-get elt :file))
(cl-remove-if-not
(lambda (elt)
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 8fef23945d..59b5f01f23 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -29,10 +29,23 @@
;;; Code:
-(require 'erc)
-
;;; Imenu support
+(require 'erc-common)
+
+(defvar erc-controls-highlight-regexp)
+(defvar erc-controls-remove-regexp)
+(defvar erc-input-marker)
+(defvar erc-insert-marker)
+(defvar erc-server-process)
+(defvar erc-modules)
+(defvar erc-log-p)
+
+(declare-function erc-buffer-list "erc" (&optional predicate proc))
+(declare-function erc-error "erc" (&rest args))
+(declare-function erc-extract-command-from-line "erc" (line))
+(declare-function erc-beg-of-input-line "erc" nil)
+
(defun erc-imenu-setup ()
"Setup Imenu support in an ERC buffer."
(setq-local imenu-create-index-function #'erc-create-imenu-index))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index d8fb879819..dba6ead073 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -39,8 +39,32 @@
;;; Code:
-(require 'erc)
(eval-when-compile (require 'cl-lib))
+(require 'erc-common)
+
+(defvar erc--target)
+(defvar erc-insert-marker)
+(defvar erc-kill-buffer-hook)
+(defvar erc-kill-server-hook)
+(defvar erc-modules)
+(defvar erc-rename-buffers)
+(defvar erc-reuse-buffers)
+(defvar erc-server-announced-name)
+(defvar erc-server-connected)
+(defvar erc-server-parameters)
+(defvar erc-server-process)
+(defvar erc-session-server)
+
+(declare-function erc--default-target "erc" nil)
+(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
+(declare-function erc-buffer-filter "erc" (predicate &optional proc))
+(declare-function erc-current-nick "erc" nil)
+(declare-function erc-display-error-notice "erc" (parsed string))
+(declare-function erc-error "erc" (&rest args))
+(declare-function erc-get-buffer "erc" (target &optional proc))
+(declare-function erc-server-buffer "erc" nil)
+(declare-function erc-server-process-alive "erc-backend" (&optional buffer))
+(declare-function erc-set-active-buffer "erc" (buffer))
;; Variables
@@ -813,7 +837,7 @@ This may have originated from an `:id' arg to entry-point
commands
(erc-networks--id-symbol nid))
(cl-generic-define-context-rewriter erc-obsolete-var (var spec)
- `((with-suppressed-warnings ((obsolete ,var)) ,var) ,spec))
+ `((with-suppressed-warnings ((obsolete ,var) (free-vars ,var)) ,var) ,spec))
;; As a catch-all, derive the symbol from the unquoted printed repr.
(cl-defgeneric erc-networks--id-create (id)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index db39e341b2..6b14cf87e2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -60,6 +60,9 @@
(load "erc-loaddefs" 'noerror 'nomessage)
+(require 'erc-networks)
+(require 'erc-goodies)
+(require 'erc-backend)
(require 'cl-lib)
(require 'format-spec)
(require 'pp)
@@ -69,8 +72,6 @@
(require 'iso8601)
(eval-when-compile (require 'subr-x))
-(require 'erc-compat)
-
(defconst erc-version "5.4.1"
"This version of ERC.")
@@ -132,29 +133,12 @@
"Running scripts at startup and with /LOAD."
:group 'erc)
-;; Defined in erc-backend
-(defvar erc--server-last-reconnect-count)
-(defvar erc--server-reconnecting)
-(defvar erc-channel-members-changed-hook)
-(defvar erc-network)
-(defvar erc-networks--id)
-(defvar erc-server-367-functions)
-(defvar erc-server-announced-name)
-(defvar erc-server-connect-function)
-(defvar erc-server-connected)
-(defvar erc-server-current-nick)
-(defvar erc-server-lag)
-(defvar erc-server-last-sent-time)
-(defvar erc-server-process)
-(defvar erc-server-quitting)
-(defvar erc-server-reconnect-count)
-(defvar erc-server-reconnecting)
-(defvar erc-session-client-certificate)
-(defvar erc-session-connector)
-(defvar erc-session-port)
-(defvar erc-session-server)
-(defvar erc-session-user-full-name)
-(defvar erc-session-username)
+;; Forward declarations
+(defvar erc-message-parsed)
+
+(defvar tabbar--local-hlf)
+(defvar motif-version-string)
+(defvar gtk-version-string)
;; tunable connection and authentication parameters
@@ -349,9 +333,6 @@ A typical value would be \((\"#emacs\" \"QUIT\" \"JOIN\")
:group 'erc-ignore
:type 'erc-message-type)
-(defvar-local erc-session-password nil
- "The password used for the current session.")
-
(defcustom erc-disconnected-hook nil
"Run this hook with arguments (NICK IP REASON) when disconnected.
This happens before automatic reconnection. Note, that
@@ -436,69 +417,14 @@ It associates nicknames with `erc-server-user' struct
instances.")
'((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|))
(mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
-(defun erc-downcase (string)
- "Return a downcased copy of STRING with properties.
-Use the CASEMAPPING ISUPPORT parameter to determine the style."
- (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single))
- (inhibit-read-only t))
- (if (equal mapping "ascii")
- (downcase string)
- (with-temp-buffer
- (insert string)
- (translate-region (point-min) (point-max)
- (if (equal mapping "rfc1459-strict")
- erc--casemapping-rfc1459-strict
- erc--casemapping-rfc1459))
- (buffer-string)))))
-
-(defmacro erc-with-server-buffer (&rest body)
- "Execute BODY in the current ERC server buffer.
-If no server buffer exists, return nil."
- (declare (indent 0) (debug (body)))
- (let ((buffer (make-symbol "buffer")))
- `(let ((,buffer (erc-server-buffer)))
- (when (buffer-live-p ,buffer)
- (with-current-buffer ,buffer
- ,@body)))))
-
-(cl-defstruct (erc-server-user (:type vector) :named)
- ;; User data
- nickname host login full-name info
- ;; Buffers
- ;;
- ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where
- ;; CHANNEL-DATA is either nil or an erc-channel-user struct.
- (buffers nil)
- )
-
-(cl-defstruct (erc-channel-user (:type vector) :named)
- voice halfop op admin owner
- ;; Last message time (in the form of the return value of
- ;; (current-time)
- ;;
- ;; This is useful for ordered name completion.
- (last-message-time nil))
-
-(define-inline erc-get-channel-user (nick)
- "Find NICK in the current buffer's `erc-channel-users' hash table."
- (inline-quote (gethash (erc-downcase ,nick) erc-channel-users)))
-
-(define-inline erc-get-server-user (nick)
- "Find NICK in the current server's `erc-server-users' hash table."
- (inline-letevals (nick)
- (inline-quote (erc-with-server-buffer
- (gethash (erc-downcase ,nick) erc-server-users)))))
-
-(define-inline erc-add-server-user (nick user)
+(defun erc-add-server-user (nick user)
"This function is for internal use only.
Adds USER with nickname NICK to the `erc-server-users' hash table."
- (inline-letevals (nick user)
- (inline-quote
- (erc-with-server-buffer
- (puthash (erc-downcase ,nick) ,user erc-server-users)))))
+ (erc-with-server-buffer
+ (puthash (erc-downcase nick) user erc-server-users)))
-(define-inline erc-remove-server-user (nick)
+(defun erc-remove-server-user (nick)
"This function is for internal use only.
Removes the user with nickname NICK from the `erc-server-users'
@@ -506,10 +432,8 @@ hash table. This user is not removed from the
`erc-channel-users' lists of other buffers.
See also: `erc-remove-user'."
- (inline-letevals (nick)
- (inline-quote
- (erc-with-server-buffer
- (remhash (erc-downcase ,nick) erc-server-users)))))
+ (erc-with-server-buffer
+ (remhash (erc-downcase nick) erc-server-users)))
(defun erc-change-user-nickname (user new-nick)
"This function is for internal use only.
@@ -580,55 +504,45 @@ Removes all users in the current channel. This is called
by
erc-channel-users)
(clrhash erc-channel-users)))
-(define-inline erc-channel-user-owner-p (nick)
+(defun erc-channel-user-owner-p (nick)
"Return non-nil if NICK is an owner of the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
- (hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
- (and cdata (cdr cdata)
- (erc-channel-user-owner (cdr cdata))))))))
-
-(define-inline erc-channel-user-admin-p (nick)
+ (and nick
+ (hash-table-p erc-channel-users)
+ (let ((cdata (erc-get-channel-user nick)))
+ (and cdata (cdr cdata)
+ (erc-channel-user-owner (cdr cdata))))))
+
+(defun erc-channel-user-admin-p (nick)
"Return non-nil if NICK is an admin in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-admin (cdr cdata))))))))
+ (erc-channel-user-admin (cdr cdata))))))
-(define-inline erc-channel-user-op-p (nick)
+(defun erc-channel-user-op-p (nick)
"Return non-nil if NICK is an operator in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-op (cdr cdata))))))))
+ (erc-channel-user-op (cdr cdata))))))
-(define-inline erc-channel-user-halfop-p (nick)
+(defun erc-channel-user-halfop-p (nick)
"Return non-nil if NICK is a half-operator in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-halfop (cdr cdata))))))))
+ (erc-channel-user-halfop (cdr cdata))))))
-(define-inline erc-channel-user-voice-p (nick)
+(defun erc-channel-user-voice-p (nick)
"Return non-nil if NICK has voice in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-voice (cdr cdata))))))))
+ (erc-channel-user-voice (cdr cdata))))))
(defun erc-get-channel-user-list ()
"Return a list of users in the current channel.
@@ -1377,96 +1291,6 @@ See also `erc-show-my-nick'."
(defvar-local erc-dbuf nil)
-(defmacro define-erc-module (name alias doc enable-body disable-body
- &optional local-p)
- "Define a new minor mode using ERC conventions.
-Symbol NAME is the name of the module.
-Symbol ALIAS is the alias to use, or nil.
-DOC is the documentation string to use for the minor mode.
-ENABLE-BODY is a list of expressions used to enable the mode.
-DISABLE-BODY is a list of expressions used to disable the mode.
-If LOCAL-P is non-nil, the mode will be created as a buffer-local
-mode, rather than a global one.
-
-This will define a minor mode called erc-NAME-mode, possibly
-an alias erc-ALIAS-mode, as well as the helper functions
-erc-NAME-enable, and erc-NAME-disable.
-
-Example:
-
- ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\")
- (define-erc-module replace nil
- \"This mode replaces incoming text according to `erc-replace-alist'.\"
- ((add-hook \\='erc-insert-modify-hook
- #\\='erc-replace-insert))
- ((remove-hook \\='erc-insert-modify-hook
- #\\='erc-replace-insert)))"
- (declare (doc-string 3) (indent defun))
- (let* ((sn (symbol-name name))
- (mode (intern (format "erc-%s-mode" (downcase sn))))
- (group (intern (format "erc-%s" (downcase sn))))
- (enable (intern (format "erc-%s-enable" (downcase sn))))
- (disable (intern (format "erc-%s-disable" (downcase sn)))))
- `(progn
- (define-minor-mode
- ,mode
- ,(format "Toggle ERC %S mode.
-With a prefix argument ARG, enable %s if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
-%s" name name doc)
- ;; FIXME: We don't know if this group exists, so this `:group' may
- ;; actually just silence a valid warning about the fact that the var
- ;; is not associated with any group.
- :global ,(not local-p) :group (quote ,group)
- (if ,mode
- (,enable)
- (,disable)))
- (defun ,enable ()
- ,(format "Enable ERC %S mode."
- name)
- (interactive)
- (add-to-list 'erc-modules (quote ,name))
- (setq ,mode t)
- ,@enable-body)
- (defun ,disable ()
- ,(format "Disable ERC %S mode."
- name)
- (interactive)
- (setq erc-modules (delq (quote ,name) erc-modules))
- (setq ,mode nil)
- ,@disable-body)
- ,(when (and alias (not (eq name alias)))
- `(defalias
- ',(intern
- (format "erc-%s-mode"
- (downcase (symbol-name alias))))
- #',mode))
- ;; For find-function and find-variable.
- (put ',mode 'definition-name ',name)
- (put ',enable 'definition-name ',name)
- (put ',disable 'definition-name ',name))))
-
-;; The rationale for favoring inheritance here (nicer dispatch) is
-;; kinda flimsy since there aren't yet any actual methods.
-
-(cl-defstruct erc--target
- (string "" :type string :documentation "Received name of target.")
- (symbol nil :type symbol :documentation "Case-mapped name as symbol."))
-
-;; These should probably take on a `joined' field to track joinedness,
-;; which should be toggled by `erc-server-JOIN', `erc-server-PART',
-;; etc. Functions like `erc--current-buffer-joined-p' (bug#48598) may
-;; find it useful.
-
-(cl-defstruct (erc--target-channel (:include erc--target)))
-
-(cl-defstruct (erc--target-channel-local (:include erc--target-channel)))
-
-;; At some point, it may make sense to add a query type with an
-;; account field, which may help support reassociation across
-;; reconnects and nick changes (likely requires v3 extensions).
-
(defun erc--target-from-string (string)
"Construct an `erc--target' variant from STRING."
(funcall (if (erc-channel-p string)
@@ -1516,12 +1340,6 @@ capabilities."
(add-hook hook fun nil t)
fun))
-(define-inline erc-log (string)
- "Logs STRING if logging is on (see `erc-log-p')."
- (inline-quote
- (when erc-log-p
- (erc-log-aux ,string))))
-
(defun erc-server-buffer ()
"Return the server buffer for the current buffer's process.
The buffer-local variable `erc-server-process' is used to find
@@ -1577,29 +1395,7 @@ If BUFFER is nil, the current buffer is used."
(if erc-online-p "" "not "))
erc-online-p))))
-(defun erc-log-aux (string)
- "Do the debug logging of STRING."
- (let ((cb (current-buffer))
- (point 1)
- (was-eob nil)
- (session-buffer (erc-server-buffer)))
- (if session-buffer
- (progn
- (set-buffer session-buffer)
- (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
- (progn
- (setq erc-dbuf (get-buffer-create
- (concat "*ERC-DEBUG: "
- erc-session-server "*")))))
- (set-buffer erc-dbuf)
- (setq point (point))
- (setq was-eob (eobp))
- (goto-char (point-max))
- (insert (concat "** " string "\n"))
- (if was-eob (goto-char (point-max))
- (goto-char point))
- (set-buffer cb))
- (message "ERC: ** %s" string))))
+
;; Last active buffer, to print server messages in the right place
@@ -1841,40 +1637,6 @@ All strings are compared according to IRC protocol case
rules, see
(throw 'result list)
(setq list (cdr list))))))
-(defmacro erc-with-buffer (spec &rest body)
- "Execute BODY in the buffer associated with SPEC.
-
-SPEC should have the form
-
- (TARGET [PROCESS])
-
-If TARGET is a buffer, use it. Otherwise, use the buffer
-matching TARGET in the process specified by PROCESS.
-
-If PROCESS is nil, use the current `erc-server-process'.
-See `erc-get-buffer' for details.
-
-See also `with-current-buffer'.
-
-\(fn (TARGET [PROCESS]) BODY...)"
- (declare (indent 1) (debug ((form &optional form) body)))
- (let ((buf (make-symbol "buf"))
- (proc (make-symbol "proc"))
- (target (make-symbol "target"))
- (process (make-symbol "process")))
- `(let* ((,target ,(car spec))
- (,process ,(cadr spec))
- (,buf (if (bufferp ,target)
- ,target
- (let ((,proc (or ,process
- (and (processp erc-server-process)
- erc-server-process))))
- (if (and ,target ,proc)
- (erc-get-buffer ,target ,proc))))))
- (when (buffer-live-p ,buf)
- (with-current-buffer ,buf
- ,@body)))))
-
(defun erc-get-buffer (target &optional proc)
"Return the buffer matching TARGET in the process PROC.
If PROC is not supplied, all processes are searched."
@@ -1921,18 +1683,6 @@ needs to match PROC."
(setq predicate (lambda () t)))
(erc-buffer-filter predicate proc))
-(defmacro erc-with-all-buffers-of-server (process pred &rest forms)
- "Execute FORMS in all buffers which have same process as this server.
-FORMS will be evaluated in all buffers having the process PROCESS and
-where PRED matches or in all buffers of the server process if PRED is
-nil."
- (declare (indent 1) (debug (form form body)))
- (macroexp-let2 nil pred pred
- `(erc-buffer-filter (lambda ()
- (when (or (not ,pred) (funcall ,pred))
- ,@forms))
- ,process)))
-
(define-obsolete-function-alias 'erc-iswitchb #'erc-switch-to-buffer "25.1")
(defun erc--switch-to-buffer (&optional arg)
(read-buffer "Switch to ERC buffer: "
@@ -2877,8 +2627,6 @@ every `erc-lurker-cleanup-interval' updates to
consumption of lurker state during long Emacs sessions and/or ERC
sessions with large numbers of incoming PRIVMSGs.")
-(defvar erc-message-parsed)
-
(defun erc-lurker-update-status (_message)
"Update `erc-lurker-state' if necessary.
@@ -4071,7 +3819,7 @@ the message given by REASON."
(delete-process process))
(erc-server-reconnect)
(with-suppressed-warnings ((obsolete erc-server-reconnecting)
- ((obsolete erc-reuse-buffers)))
+ (obsolete erc-reuse-buffers))
(if erc-reuse-buffers
(progn (cl-assert (not erc--server-reconnecting))
(cl-assert (not erc-server-reconnecting)))
@@ -4090,9 +3838,6 @@ the message given by REASON."
t)
(put 'erc-cmd-SERVER 'process-not-needed t)
-(defvar motif-version-string)
-(defvar gtk-version-string)
-
(defun erc-cmd-SV ()
"Say the current ERC and Emacs version into channel."
(erc-send-message (format "I'm using ERC %s with GNU Emacs %s (%s%s)%s."
@@ -5349,6 +5094,12 @@ Example: (operator) o => @, (voiced) v => +."
(setq i (1+ i)))
alist))))
+(defcustom erc-channel-members-changed-hook nil
+ "This hook is called every time the variable `channel-members' changes.
+The buffer where the change happened is current while this hook is called."
+ :group 'erc-hooks
+ :type 'hook)
+
(defun erc-channel-receive-names (names-string)
"This function is for internal use only.
@@ -5392,13 +5143,6 @@ channel."
name name t voice halfop op admin owner)))))
(run-hooks 'erc-channel-members-changed-hook)))
-
-(defcustom erc-channel-members-changed-hook nil
- "This hook is called every time the variable `channel-members' changes.
-The buffer where the change happened is current while this hook is called."
- :group 'erc-hooks
- :type 'hook)
-
(defun erc-update-user-nick (nick &optional new-nick
host login full-name info)
"Update the stored user information for the user with nickname NICK.
@@ -6008,12 +5752,6 @@ When the returned value is a string, pass it to
`erc-error'.")
(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$"
"Regular expression used for matching commands in ERC.")
-(cl-defstruct erc-input
- string insertp sendp)
-
-(cl-defstruct (erc--input-split (:include erc-input))
- lines cmdp)
-
(defun erc--discard-trailing-multiline-nulls (state)
"Ensure last line of STATE's string is non-null.
But only when `erc-send-whitespace-lines' is non-nil. STATE is
@@ -6957,9 +6695,6 @@ shortened server name instead."
(t ""))))
;; erc-goodies is required at end of this file.
-(declare-function erc-controls-strip "erc-goodies" (str))
-
-(defvar tabbar--local-hlf)
;; FIXME when 29.1 is cut and `format-spec' is added to ELPA Compat,
;; remove the function invocations from the spec form below.
@@ -7448,12 +7183,4 @@ Otherwise, connect to HOST:PORT as USER and /join
CHANNEL."
(provide 'erc)
-(require 'erc-backend)
-
-;; Deprecated. We might eventually stop requiring the goodies automatically.
-;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to
-;; avoid a recursive require error when byte-compiling the entire package.
-(require 'erc-goodies)
-(require 'erc-networks)
-
;;; erc.el ends here
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index aebbc36e71..499deaa7fc 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -1,4 +1,4 @@
-;;; em-tramp.el --- Eshell features that require TRAMP -*- lexical-binding:t
-*-
+;;; em-tramp.el --- Eshell features that require Tramp -*- lexical-binding:t
-*-
;; Copyright (C) 1999-2022 Free Software Foundation, Inc.
@@ -21,7 +21,7 @@
;;; Commentary:
-;; Eshell features that require TRAMP.
+;; Eshell features that require Tramp.
;;; Code:
@@ -38,29 +38,30 @@
;;;###autoload
(progn
(defgroup eshell-tramp nil
- "This module defines commands that use TRAMP in a way that is
+ "This module defines commands that use Tramp in a way that is
not transparent to the user. So far, this includes only the
- built-in su and sudo commands, which are not compatible with
- the full, external su and sudo commands, and require the user
- to understand how to use the TRAMP sudo method."
- :tag "TRAMP Eshell features"
+ built-in su, sudo and doas commands, which are not compatible
+ with the full, external su, sudo, and doas commands, and
+ require the user to understand how to use the Tramp sudo
+ method."
+ :tag "Tramp Eshell features"
:group 'eshell-module))
(defun eshell-tramp-initialize () ;Called from `eshell-mode' via intern-soft!
- "Initialize the TRAMP-using commands code."
+ "Initialize the Tramp-using commands code."
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-host-reference nil t))
(setq-local eshell-complex-commands
- (append '("su" "sudo")
+ (append '("su" "sudo" "doas")
eshell-complex-commands)))
(autoload 'eshell-parse-command "esh-cmd")
(defun eshell/su (&rest args)
- "Alias \"su\" to call TRAMP.
+ "Alias \"su\" to call Tramp.
-Uses the system su through TRAMP's su method."
+Uses the system su through Tramp's su method."
(eshell-eval-using-options
"su" args
'((?h "help" nil nil "show this usage screen")
@@ -91,42 +92,67 @@ Become another USER during a login session.")
(put 'eshell/su 'eshell-no-numeric-conversions t)
+(defun eshell--method-wrap-directory (directory method &optional user)
+ "Return DIRECTORY as accessed by a Tramp METHOD for USER."
+ (let ((user (or user "root"))
+ (dir (file-local-name (expand-file-name directory)))
+ (prefix (file-remote-p directory))
+ (host (or (file-remote-p directory 'host)
+ tramp-default-host))
+ (rmethod (file-remote-p directory 'method))
+ (ruser (file-remote-p directory 'user)))
+ (if (and prefix (or (not (string-equal rmethod method))
+ (not (string-equal ruser user))))
+ (format "%s|%s:%s@%s:%s"
+ (substring prefix 0 -1) method user host dir)
+ (format "/%s:%s@%s:%s" method user host dir))))
+
(defun eshell/sudo (&rest args)
"Alias \"sudo\" to call Tramp.
-Uses the system sudo through TRAMP's sudo method."
+Uses the system sudo through Tramp's sudo method."
(eshell-eval-using-options
"sudo" args
'((?h "help" nil nil "show this usage screen")
(?u "user" t user "execute a command as another USER")
+ (?s "shell" nil shell "start a shell instead of executing COMMAND")
:show-usage
:parse-leading-options-only
- :usage "[(-u | --user) USER] COMMAND
+ :usage "[(-u | --user) USER] (-s | --shell) | COMMAND
Execute a COMMAND as the superuser or another USER.")
- (throw 'eshell-external
- (let* ((user (or user "root"))
- (host (or (file-remote-p default-directory 'host)
- tramp-default-host))
- (dir (file-local-name (expand-file-name default-directory)))
- (prefix (file-remote-p default-directory))
- (default-directory
- (if (and prefix
- (or
- (not
- (string-equal
- "sudo"
- (file-remote-p default-directory 'method)))
- (not
- (string-equal
- user
- (file-remote-p default-directory 'user)))))
- (format "%s|sudo:%s@%s:%s"
- (substring prefix 0 -1) user host dir)
- (format "/sudo:%s@%s:%s" user host dir))))
- (eshell-named-command (car args) (cdr args))))))
+ (let ((dir (eshell--method-wrap-directory default-directory "sudo" user)))
+ (if shell
+ (throw 'eshell-replace-command
+ (eshell-parse-command "cd" (list dir)))
+ (throw 'eshell-external
+ (let ((default-directory dir))
+ (eshell-named-command (car args) (cdr args))))))))
(put 'eshell/sudo 'eshell-no-numeric-conversions t)
+(defun eshell/doas (&rest args)
+ "Call Tramp's doas method with ARGS.
+
+Uses the system doas through Tramp's doas method."
+ (eshell-eval-using-options
+ "doas" args
+ '((?h "help" nil nil "show this usage screen")
+ (?u "user" t user "execute a command as another USER")
+ (?s "shell" nil shell "start a shell instead of executing COMMAND")
+ :show-usage
+ :parse-leading-options-only
+ :usage "[(-u | --user) USER] (-s | --shell) | COMMAND
+Execute a COMMAND as the superuser or another USER.")
+ (let ((dir (eshell--method-wrap-directory default-directory "doas" user)))
+ (if shell
+ (throw 'eshell-replace-command
+ (eshell-parse-command "cd" (list dir)))
+ (throw 'eshell-external
+ (let ((default-directory dir))
+ (eshell-named-command (car args) (cdr args))))))))
+
+(put 'eshell/doas 'eshell-no-numeric-conversions t)
+
(provide 'em-tramp)
;; Local Variables:
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index f47373c115..0ec11e8a0b 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -296,7 +296,7 @@ directories separated by `path-separator'."
(if (listp path)
path
;; Don't use `parse-colon-path' here, since we don't want
- ;; the additonal translations it does on each element.
+ ;; the additional translations it does on each element.
(split-string path (path-separator))))))
(defun eshell-parse-colon-path (path-env)
@@ -350,16 +350,13 @@ Prepend remote identification of `default-directory', if
any."
"Convert OBJECT into a string value."
(cond
((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
((numberp object)
(number-to-string object))
+ ((and (eq object t)
+ (not eshell-stringify-t))
+ nil)
(t
- (unless (and (eq object t)
- (not eshell-stringify-t))
- (pp-to-string object)))))
+ (string-trim-right (pp-to-string object)))))
(defsubst eshell-stringify-list (args)
"Convert each element of ARGS into a string value."
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 432385587b..f1530285fb 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -367,7 +367,7 @@ See `text-scale-increase' for more details."
;;;###autoload
(defun text-scale-adjust (inc)
"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:
@@ -377,13 +377,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
@@ -467,19 +468,22 @@ the `cdr' has the maximum font size, in units of 1/10 pt."
;;;###autoload (define-key ctl-x-map [(control meta ?0)]
'global-text-scale-adjust)
;;;###autoload
(defun global-text-scale-adjust (increment)
- "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.
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index 1949f62609..002b7bcfff 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -910,7 +910,7 @@
1998-07-11 Mike McEwan <mike@lotusland.demon.co.uk>
* gnus-agent.el (gnus-agent-fetch-headers): Note last fetched
- headers per sesion to aid expiry in `headers only' groups.
+ headers per session to aid expiry in `headers only' groups.
* gnus-agent.el (gnus-agent-expire): Update group info to add
expired articles to list of read articles and prevent
diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3
index c33c76f68d..8087021a7c 100644
--- a/lisp/gnus/ChangeLog.3
+++ b/lisp/gnus/ChangeLog.3
@@ -4902,7 +4902,7 @@
2011-07-31 Marcus Harnisch <marcus.harnisch@gmx.net> (tiny change)
* gnus-art.el (gnus-article-stop-animations): Use `elt' instead of
- `aref' for XEmacs compatibiltiy.
+ `aref' for XEmacs compatibility.
2011-07-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -23276,7 +23276,7 @@
Signal a specific `search-failed' rather than a generic `error'.
* gnus-salt.el (gnus-pick-mouse-pick-region): Switch 1 => point-min.
- (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1.
+ (gnus-generate-vertical-tree): Use `bobp' rather than compare to 1.
(gnus-highlight-selected-tree): Use point-min rather than 1 and 2.
2004-09-10 Simon Josefsson <jas@extundo.com>
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 3bea1a4c1d..814d21823d 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -26,7 +26,6 @@
(eval-when-compile (require 'cl-lib))
(defvar tool-bar-map)
-(defvar w3m-minor-mode-map)
(require 'gnus)
(require 'gnus-sum)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 24cba97718..3bbd68bdcd 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -7034,6 +7034,7 @@ is a function used to switch to and display the mail
buffer."
;; Firefox sends us In-Reply-To headers that are Message-IDs
;; without <> around them. Fix that.
(when (and (eq (car h) 'In-Reply-To)
+ (stringp (cdr h))
;; Looks like a Message-ID.
(string-match-p "\\`[^ @]+@[^ @]+\\'" (cdr h))
(not (string-match-p "\\`<.*>\\'" (cdr h))))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 73cd183a02..8392eb601f 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -238,7 +238,7 @@ during splitting, which may be slow."
(with-current-buffer (nnimap-buffer)
(erase-buffer)
;; If we have a lot of ranges, split them up to avoid
- ;; generating too-long lines. (The limit is 8192 octects,
+ ;; generating too-long lines. (The limit is 8192 octets,
;; and this should guarantee that it's (much) shorter than
;; that.) We don't stream the requests, since the server
;; may respond to the requests out-of-order:
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 0a63e0a1dd..ef710d582d 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -228,7 +228,7 @@ the default otherwise."
;; Apropos `icomplete-scroll', we implement "scrolling icomplete"
;; within classic icomplete, which is "rotating", by contrast.
;;
-;; The two variables supporing this are
+;; The two variables supporting this are
;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'.
;; They come into play when:
;;
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el
index 4f4d4f4832..3d065b778e 100644
--- a/lisp/international/emoji.el
+++ b/lisp/international/emoji.el
@@ -552,8 +552,7 @@ the name is not known."
(apply (or class 'transient-prefix) :command name
(cons :variable-pitch (cons t slots))))
(put name 'transient--layout
- (cl-mapcan (lambda (s) (transient--parse-child name s))
- suffixes)))
+ (transient-parse-suffixes name suffixes)))
name))
(defun emoji--recent-transient (end-function)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 48e5c9aa1f..61a26b504c 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1208,6 +1208,16 @@ Arguments are the same as `set-language-info'."
(list 'const lang))
(sort (mapcar 'car language-info-alist) 'string<))))))
+(defun set-language-info-setup-keymap (lang-env alist describe-map setup-map)
+ "Setup menu items for LANG-ENV.
+See `set-language-info-alist' for details of other arguments."
+ (let ((doc (assq 'documentation alist)))
+ (when doc
+ (define-key-after describe-map (vector (intern lang-env))
+ (cons lang-env 'describe-specified-language-support))))
+ (define-key-after setup-map (vector (intern lang-env))
+ (cons lang-env 'setup-specified-language-environment)))
+
(defun set-language-info-alist (lang-env alist &optional parents)
"Store ALIST as the definition of language environment LANG-ENV.
ALIST is an alist of KEY and INFO values. See the documentation of
@@ -1222,51 +1232,44 @@ in the European submenu in each of those two menus."
(setq lang-env (symbol-name lang-env)))
((stringp lang-env)
(setq lang-env (purecopy lang-env))))
- (let ((describe-map describe-language-environment-map)
- (setup-map setup-language-environment-map))
- (if parents
- (let ((l parents)
- map parent-symbol parent prompt)
- (while l
- (if (symbolp (setq parent-symbol (car l)))
- (setq parent (symbol-name parent))
- (setq parent parent-symbol parent-symbol (intern parent)))
- (setq map (lookup-key describe-map (vector parent-symbol)))
- ;; This prompt string is for define-prefix-command, so
- ;; that the map it creates will be suitable for a menu.
- (or map (setq prompt (format "%s Environment" parent)))
- (if (not map)
- (progn
- (setq map (intern (format "describe-%s-environment-map"
- (downcase parent))))
- (define-prefix-command map nil prompt)
- (define-key-after describe-map (vector parent-symbol)
- (cons parent map))))
- (setq describe-map (symbol-value map))
- (setq map (lookup-key setup-map (vector parent-symbol)))
- (if (not map)
- (progn
- (setq map (intern (format "setup-%s-environment-map"
- (downcase parent))))
- (define-prefix-command map nil prompt)
- (define-key-after setup-map (vector parent-symbol)
- (cons parent map))))
- (setq setup-map (symbol-value map))
- (setq l (cdr l)))))
-
- ;; Set up menu items for this language env.
- (let ((doc (assq 'documentation alist)))
- (when doc
- (define-key-after describe-map (vector (intern lang-env))
- (cons lang-env 'describe-specified-language-support))))
- (define-key-after setup-map (vector (intern lang-env))
- (cons lang-env 'setup-specified-language-environment))
-
- (dolist (elt alist)
- (set-language-info-internal lang-env (car elt) (cdr elt)))
-
- (if (equal lang-env current-language-environment)
- (set-language-environment lang-env))))
+ (if parents
+ (while parents
+ (let (describe-map setup-map parent-symbol parent prompt)
+ (if (symbolp (setq parent-symbol (car parents)))
+ (setq parent (symbol-name parent))
+ (setq parent parent-symbol parent-symbol (intern parent)))
+ (setq describe-map (lookup-key describe-language-environment-map
+ (vector parent-symbol)))
+ ;; This prompt string is for define-prefix-command, so
+ ;; that the map it creates will be suitable for a menu.
+ (or describe-map (setq prompt (format "%s Environment" parent)))
+ (unless describe-map
+ (setq describe-map (intern (format "describe-%s-environment-map"
+ (downcase parent))))
+ (define-prefix-command describe-map nil prompt)
+ (define-key-after
+ describe-language-environment-map
+ (vector parent-symbol) (cons parent describe-map)))
+ (setq setup-map (lookup-key setup-language-environment-map
+ (vector parent-symbol)))
+ (unless setup-map
+ (setq setup-map (intern (format "setup-%s-environment-map"
+ (downcase parent))))
+ (define-prefix-command setup-map nil prompt)
+ (define-key-after
+ setup-language-environment-map
+ (vector parent-symbol) (cons parent setup-map)))
+ (setq parents (cdr parents))
+ (set-language-info-setup-keymap
+ lang-env alist
+ (symbol-value describe-map) (symbol-value setup-map))))
+ (set-language-info-setup-keymap
+ lang-env alist
+ describe-language-environment-map setup-language-environment-map))
+ (dolist (elt alist)
+ (set-language-info-internal lang-env (car elt) (cdr elt)))
+ (if (equal lang-env current-language-environment)
+ (set-language-environment lang-env)))
(defun read-language-name (key prompt &optional default)
"Read a language environment name which has information for KEY.
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 8db78ebcda..420d83ab1f 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -598,7 +598,7 @@ There should be no more than seven characters after the
final `/'."
;; Support for loading compressed files.
-(defun jka-compr-load (file &optional noerror nomessage _nosuffix)
+(defun jka-compr-load (file &optional noerror nomessage _nosuffix _must-suffix)
"Documented as original."
(let* ((local-copy (jka-compr-file-local-copy file))
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 27facaa858..e2a21820f4 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -31,7 +31,7 @@
;;; Transliteration
-;; The followings provide the various transliteration schemes (such as
+;; The following provides the various transliteration schemes (such as
;; ITRANS, kyoto-harvard, and Aiba) of Indian scripts. They are also
;; used in quail/indian.el for typing Indian script in Emacs.
@@ -638,7 +638,7 @@
;;; IS 13194 utilities
-;; The followings provide conversion between IS 13194 (ISCII) and UCS.
+;; The following provides conversion between IS 13194 (ISCII) and UCS.
(dlet
;;Unicode vs IS13194 ;; only Devanagari is supported now.
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index c34017d9b3..230db3b100 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -253,7 +253,7 @@ in this language environment."))
(documentation . "\
Language environment for Gāndhārī, Sanskrit, and other languages
using the Kharoṣṭhī script."))
- '("Misc"))
+ '("Indian"))
(let ((consonant "[\U00010A00\U00010A10-\U00010A35]")
(vowel "[\U00010A01-\U00010A06]")
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index b992846b0b..c754e72354 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -3925,18 +3925,6 @@ See the documentation of `define-ccl-program' for the
detail of CCL program.
(register-definition-prefixes "ccl" '("ccl-"))
-;;; Generated autoloads from emacs-lisp/cconv.el
-
-(autoload 'cconv-closure-convert "cconv" "\
-Main entry point for closure conversion.
-FORM is a piece of Elisp code after macroexpansion.
-
-Returns a form where all lambdas don't have any free variables.
-
-(fn FORM)")
-(register-definition-prefixes "cconv" '("cconv-"))
-
-
;;; Generated autoloads from cdl.el
(register-definition-prefixes "cdl" '("cdl-"))
@@ -4959,6 +4947,8 @@ evaluate `compilation-shell-minor-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
+\\{compilation-shell-minor-mode-map}
+
(fn &optional ARG)" t)
(autoload 'compilation-minor-mode "compile" "\
Toggle Compilation minor mode.
@@ -4982,6 +4972,8 @@ evaluate `compilation-minor-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
+\\{compilation-minor-mode-map}
+
(fn &optional ARG)" t)
(autoload 'compilation-next-error-function "compile" "\
Advance to the next error message and visit the file where the error was.
@@ -8366,7 +8358,7 @@ A second call of this function without changing point
inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
completion.
-(fn PREFIX)" '("P"))
+(fn PREFIX)" t)
(autoload 'ebrowse-tags-loop-continue "ebrowse" "\
Repeat last operation on files in tree.
FIRST-TIME non-nil means this is not a repetition, but the first time.
@@ -8976,6 +8968,55 @@ Turn on EDT Emulation." t)
(register-definition-prefixes "edt-vt100" '("edt-set-term-width-"))
+;;; Generated autoloads from progmodes/eglot.el
+
+(push (purecopy '(eglot 1 9)) package--builtin-versions)
+(autoload 'eglot "eglot" "\
+Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE.
+
+This starts a Language Server Protocol (LSP) server suitable for the
+buffers of PROJECT whose `major-mode' is MANAGED-MAJOR-MODE.
+CLASS is the class of the LSP server to start and CONTACT specifies
+how to connect to the server.
+
+Interactively, the command attempts to guess MANAGED-MAJOR-MODE
+from the current buffer's `major-mode', CLASS and CONTACT from
+`eglot-server-programs' looked up by the major mode, and PROJECT from
+`project-find-functions'. The search for active projects in this
+context binds `eglot-lsp-context' (which see).
+
+If it can't guess, it prompts the user for the mode and the server.
+With a single \\[universal-argument] prefix arg, it always prompts for COMMAND.
+With two \\[universal-argument], it also always prompts for MANAGED-MAJOR-MODE.
+
+The LSP server of CLASS is started (or contacted) via CONTACT.
+If this operation is successful, current *and future* file
+buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
+by the LSP server, meaning the information about their contents is
+exchanged periodically with the server to provide enhanced
+code-analysis via `xref-find-definitions', `flymake-mode',
+`eldoc-mode', and `completion-at-point', among others.
+
+PROJECT is a project object as returned by `project-current'.
+
+CLASS is a subclass of `eglot-lsp-server'.
+
+CONTACT specifies how to contact the server. It is a
+keyword-value plist used to initialize CLASS or a plain list as
+described in `eglot-server-programs', which see.
+
+LANGUAGE-ID is the language ID string to send to the server for
+MANAGED-MAJOR-MODE, which matters to a minority of servers.
+
+INTERACTIVE is t if called interactively.
+
+(fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional
INTERACTIVE)" t)
+(autoload 'eglot-ensure "eglot" "\
+Start Eglot session for current buffer if there isn't one.")
+(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
+(register-definition-prefixes "eglot" '("eglot-"))
+
+
;;; Generated autoloads from ehelp.el
(autoload 'with-electric-help "ehelp" "\
@@ -9915,7 +9956,7 @@ When present, ID should be an opaque object used to
identify the
connection unequivocally. This is rarely needed and not available
interactively.
-(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) ID)" '((erc-select-read-args)))
+(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) ID)" t)
(defalias 'erc-select #'erc)
(autoload 'erc-tls "erc" "\
ERC is a powerful, modular, and extensible IRC client.
@@ -9962,7 +10003,7 @@ symbol composed of letters from the Latin alphabet.)
This option is
generally unneeded, however. See info node `(erc) Connecting' for use
cases. Not available interactively.
-(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) CLIENT-CERTIFICATE ID)" '((let ((erc-default-port
erc-default-port-tls)) (erc-select-read-args))))
+(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) CLIENT-CERTIFICATE ID)" t)
(autoload 'erc-handle-irc-url "erc" "\
Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
@@ -10178,7 +10219,9 @@ it has to be wrapped in `(eval (quote ...))'.
If NAME is already defined as a test and Emacs is running
in batch mode, an error is signalled.
-(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
BODY...)" nil 'macro)
+(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
BODY...)" nil t)
+(function-put 'ert-deftest 'doc-string-elt 3)
+(function-put 'ert-deftest 'lisp-indent-function 2)
(autoload 'ert-run-tests-batch "ert" "\
Run the tests specified by SELECTOR, printing results to the terminal.
@@ -12292,6 +12335,8 @@ evaluate `flymake-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
+\\{flymake-mode-map}
+
(fn &optional ARG)" t)
(autoload 'flymake-mode-on "flymake" "\
Turn Flymake mode on.")
@@ -14396,7 +14441,12 @@ Run gdb passing it COMMAND-LINE as arguments.
If COMMAND-LINE names a program FILE to debug, gdb will run in
a buffer named *gud-FILE*, and the directory containing FILE
becomes the initial working directory and source-file directory
-for your debugger.
+for your debugger. If you don't want `default-directory' to
+change to the directory of FILE, specify FILE without leading
+directories, in which case FILE should reside either in the
+directory of the buffer from which this command is invoked, or
+it can be found by searching PATH.
+
If COMMAND-LINE requests that gdb attaches to a process PID, gdb
will run in *gud-PID*, otherwise it will run in *gud*; in these
cases the initial working directory is the `default-directory' of
@@ -15917,7 +15967,8 @@ inlined into the compiled format versions. This means
that if you
change its definition, you should explicitly call
`ibuffer-recompile-formats'.
-(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil 'macro)
+(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t)
+(function-put 'define-ibuffer-column 'lisp-indent-function 'defun)
(autoload 'define-ibuffer-sorter "ibuf-macs" "\
Define a method of sorting named NAME.
DOCUMENTATION is the documentation of the function, which will be called
@@ -15928,7 +15979,9 @@ For sorting, the forms in BODY will be evaluated with
`a' bound to one
buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
-(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil 'macro)
+(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t)
+(function-put 'define-ibuffer-sorter 'lisp-indent-function 1)
+(function-put 'define-ibuffer-sorter 'doc-string-elt 2)
(autoload 'define-ibuffer-op "ibuf-macs" "\
Generate a function which operates on a buffer.
OP becomes the name of the function; if it doesn't begin with
@@ -15967,7 +16020,9 @@ BODY define the operation; they are forms to evaluate
per each
marked buffer. BODY is evaluated with `buf' bound to the
buffer object.
-(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING
ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil 'macro)
+(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING
ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil t)
+(function-put 'define-ibuffer-op 'lisp-indent-function 2)
+(function-put 'define-ibuffer-op 'doc-string-elt 3)
(autoload 'define-ibuffer-filter "ibuf-macs" "\
Define a filter named NAME.
DOCUMENTATION is the documentation of the function.
@@ -15982,7 +16037,9 @@ not a particular buffer should be displayed or not.
The forms in BODY
will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
-(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil 'macro)
+(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t)
+(function-put 'define-ibuffer-filter 'lisp-indent-function 2)
+(function-put 'define-ibuffer-filter 'doc-string-elt 2)
(register-definition-prefixes "ibuf-macs" '("ibuffer-"))
@@ -17401,7 +17458,7 @@ Convert old Emacs Devanagari characters to UCS.
;;; Generated autoloads from leim/quail/indian.el
-(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u"
"inscript-" "quail-" "tamil-"))
+(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u"
"inscript-" "quail-" "tamil"))
;;; Generated autoloads from progmodes/inf-lisp.el
@@ -19555,7 +19612,7 @@ Populate MENU with commands that open a man page at
point.
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 3 2 1)) package--builtin-versions)
+(push (purecopy '(map 3 3 1)) package--builtin-versions)
(register-definition-prefixes "map" '("map-"))
@@ -25621,6 +25678,8 @@ evaluate `rectangle-mark-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
+\\{rectangle-mark-mode-map}
+
(fn &optional ARG)" t)
(register-definition-prefixes "rect" '("apply-on-rectangle"
"clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope"
"rectangle-" "spaces-string" "string-rectangle-"))
@@ -26500,7 +26559,7 @@ Emacs will list the message in the summary.
(fn REGEXP)" t)
(autoload 'rmail-summary-by-topic "rmailsum" "\
Display a summary of all messages with the given SUBJECT.
-Normally checks just the Subject field of headers; but with prefix
+Normally checks just the Subject field of headers; but when prefix
argument WHOLE-MESSAGE is non-nil, looks in the whole message.
SUBJECT is a regular expression.
@@ -33026,7 +33085,7 @@ Like `message', but do nothing if `url-show-status' is
nil.
(fn X Y)")
-(defalias 'url-basepath 'url-file-directory)
+(defalias 'url-basepath #'url-file-directory)
(autoload 'url-file-directory "url-util" "\
Return the directory part of FILE, for a URL.
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 31a34bc1de..deef00b4c2 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -371,7 +371,7 @@ Full key sequences are listed below:")
;;; Tamil phonetic input method
;;;
-;; Define the input method straightaway.
+;; Define the input method straight away.
(quail-define-package "tamil-phonetic" "Tamil" "ழ" t
"Customisable Tamil phonetic input method.
To change the translation rules of the input method, customize
diff --git a/lisp/leim/quail/misc-lang.el b/lisp/leim/quail/misc-lang.el
index 73287ee784..e9e11ac679 100644
--- a/lisp/leim/quail/misc-lang.el
+++ b/lisp/leim/quail/misc-lang.el
@@ -1526,7 +1526,7 @@
(quail-define-package
"gothic" "Gothic" "𐌰" nil
- "Input methid for the ancient Gothic script."
+ "Input method for the ancient Gothic script."
nil t t t t nil nil nil nil nil t)
(quail-define-rules
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 2ae916e3ac..eb6a071bf4 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -131,17 +131,13 @@
;; feedmail-send-it. Hers's the best way to use the stuff in this
;; file:
;;
-;; Save this file as feedmail.el somewhere on your elisp loadpath;
-;; byte-compile it. Put the following lines in your init file:
+;; Put the following lines in your init file:
;;
;; (setq send-mail-function 'feedmail-send-it)
-;; (autoload 'feedmail-send-it "feedmail")
;;
;; If you plan to use the queue stuff, also use this:
;;
;; (setq feedmail-enable-queue t)
-;; (autoload 'feedmail-run-the-queue "feedmail")
-;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail")
;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist))
;;
;; though VM users might find it more comfortable to use this instead of
@@ -174,11 +170,6 @@
;; like to add the suffix ".fqm" to the list of non-saved things via the
variable
;; desktop-files-not-to-save.
;;
-;; If you are planning to call feedmail-queue-reminder from your .emacs or
-;; something similar, you might need this:
-;;
-;; (autoload 'feedmail-queue-reminder "feedmail")
-;;
;; If you ever use rmail-resend and queue messages, you should do this:
;;
;; (setq feedmail-queue-alternative-mail-header-separator "")
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index a13f9de174..9fb7b36e98 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,6 +1,6 @@
;;; mail-hist.el --- headers and message body history for outgoing mail -*-
lexical-binding: t; -*-
-;; Copyright (C) 1994, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Created: March, 1994
@@ -24,21 +24,15 @@
;;; Commentary:
-;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of
-;; time.
-;;
-;; To use this package, put it in a directory in your load-path, and
-;; put this in your init file:
+;; To use this package, add this to your init file:
;;
-;; (load "mail-hist" nil t)
+;; (require 'mail-hist)
;;
-;; Or you could do it with autoloads and hooks in your .emacs:
+;; Or you could do it with hooks in your .emacs:
;;
-;; (add-hook 'mail-mode-hook 'mail-hist-define-keys)
-;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
-;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc
-;; (autoload 'mail-hist-define-keys "mail-hist")
-;; (autoload 'mail-hist-put-headers-into-history "mail-hist")
+;; (add-hook 'mail-mode-hook 'mail-hist-define-keys)
+;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
+;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc
;;
;; Once it's installed, use M-p and M-n from mail headers to recover
;; previous/next contents in the history for that header, or, in the
@@ -51,6 +45,9 @@
;; point, so that you can mix the histories of different messages
;; easily. This might be confusing at times, but there should be no
;; problems that undo can't handle.
+;;
+;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of
+;; time.
;;; Code:
(require 'ring)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index f095d5e9c0..e3372a6ff4 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1751,6 +1751,7 @@ not be a new one). It returns non-nil if it got any new
messages."
(spam-filter-p (and (featurep 'rmail-spam-filter)
rmail-use-spam-filter))
(blurb "")
+ (mod-p (buffer-modified-p))
result success suffix)
(narrow-to-region (point) (point))
;; Read in the contents of the inbox files, renaming them as
@@ -1766,10 +1767,11 @@ not be a new one). It returns non-nil if it got any
new messages."
(rmail-insert-inbox-text files nil)
(setq delete-files (rmail-insert-inbox-text files t))))
;; If there was no new mail, or we aborted before actually
- ;; trying to get any, mark buffer unmodified. Otherwise the
- ;; buffer is correctly marked modified and the file locked
- ;; until we save out the new mail.
- (if (= (point-min) (point-max))
+ ;; trying to get any, mark buffer unmodified, unless it was
+ ;; modified originally. Otherwise the buffer is correctly
+ ;; marked modified and the file locked until we save out the
+ ;; new mail.
+ (if (and (null mod-p) (= (point-min) (point-max)))
(set-buffer-modified-p nil)))
;; Scan the new text and convert each message to
;; Rmail/mbox format.
diff --git a/lisp/man.el b/lisp/man.el
index 7ba7bee417..6c50f017e3 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -451,50 +451,45 @@ Otherwise, the value is whatever the function
table)
"Syntax table used in Man mode buffers.")
-(defvar Man-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (set-keymap-parent map
- (make-composed-keymap button-buffer-map special-mode-map))
-
- (define-key map "n" 'Man-next-section)
- (define-key map "p" 'Man-previous-section)
- (define-key map "\en" 'Man-next-manpage)
- (define-key map "\ep" 'Man-previous-manpage)
- (define-key map "." 'beginning-of-buffer)
- (define-key map "r" 'Man-follow-manual-reference)
- (define-key map "g" 'Man-goto-section)
- (define-key map "s" 'Man-goto-see-also-section)
- (define-key map "k" 'Man-kill)
- (define-key map "u" 'Man-update-manpage)
- (define-key map "m" 'man)
- ;; Not all the man references get buttons currently. The text in the
- ;; manual page can contain references to other man pages
- (define-key map "\r" 'man-follow)
-
- (easy-menu-define nil map
- "`Man-mode' menu."
- '("Man"
- ["Next Section" Man-next-section t]
- ["Previous Section" Man-previous-section t]
- ["Go To Section..." Man-goto-section t]
- ["Go To \"SEE ALSO\" Section" Man-goto-see-also-section
- :active (cl-member Man-see-also-regexp Man--sections
- :test #'string-match-p)]
- ["Follow Reference..." Man-follow-manual-reference
- :active Man--refpages
- :help "Go to a manpage referred to in the \"SEE ALSO\" section"]
- "--"
- ["Next Manpage" Man-next-manpage
- :active (> (length Man-page-list) 1)]
- ["Previous Manpage" Man-previous-manpage
- :active (> (length Man-page-list) 1)]
- "--"
- ["Man..." man t]
- ["Kill Buffer" Man-kill t]
- ["Quit" quit-window t]))
- map)
- "Keymap for Man mode.")
+(defvar-keymap Man-mode-map
+ :doc "Keymap for Man mode."
+ :suppress t
+ :parent (make-composed-keymap button-buffer-map special-mode-map)
+ "n" #'Man-next-section
+ "p" #'Man-previous-section
+ "M-n" #'Man-next-manpage
+ "M-p" #'Man-previous-manpage
+ "." #'beginning-of-buffer
+ "r" #'Man-follow-manual-reference
+ "g" #'Man-goto-section
+ "s" #'Man-goto-see-also-section
+ "k" #'Man-kill
+ "u" #'Man-update-manpage
+ "m" #'man
+ ;; Not all the man references get buttons currently. The text in the
+ ;; manual page can contain references to other man pages
+ "RET" #'man-follow
+
+ :menu
+ '("Man"
+ ["Next Section" Man-next-section t]
+ ["Previous Section" Man-previous-section t]
+ ["Go To Section..." Man-goto-section t]
+ ["Go To \"SEE ALSO\" Section" Man-goto-see-also-section
+ :active (cl-member Man-see-also-regexp Man--sections
+ :test #'string-match-p)]
+ ["Follow Reference..." Man-follow-manual-reference
+ :active Man--refpages
+ :help "Go to a manpage referred to in the \"SEE ALSO\" section"]
+ "--"
+ ["Next Manpage" Man-next-manpage
+ :active (> (length Man-page-list) 1)]
+ ["Previous Manpage" Man-previous-manpage
+ :active (> (length Man-page-list) 1)]
+ "--"
+ ["Man..." man t]
+ ["Kill Buffer" Man-kill t]
+ ["Quit" quit-window t]))
;; buttons
(define-button-type 'Man-abstract-xref-man-page
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index 00e52df2bb..c7f5586140 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -8064,7 +8064,7 @@
* mh-e.el (mh-last-msg): Add call to mh-recenter.
-2002-10-26 Peter S Galbraith <psg@debia.org>
+2002-10-26 Peter S Galbraith <psg@debian.org>
* mh-comp.el (mh-search-addr-regexp, mh-re-search-to-cc): Remove
`mh-re-search-to-cc' in favor of more generalized new function
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 396d431ed5..40b9862d01 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -852,7 +852,88 @@ via `set-message-function'."
;; was handled specially by this function.
t))))
-(setq set-message-function 'set-minibuffer-message)
+(setq set-message-function 'set-message-functions)
+
+(defcustom set-message-functions '(set-minibuffer-message)
+ "List of functions to handle display of echo-area messages.
+Each function is called with one argument that is the text of a message.
+If a function returns nil, a previous message string is given to the
+next function in the list, and if the last function returns nil, the
+last message string is displayed in the echo area.
+If a function returns a string, the returned string is given to the
+next function in the list, and if the last function returns a string,
+it's displayed in the echo area.
+If a function returns any other non-nil value, no more functions are
+called from the list, and no message will be displayed in the echo area."
+ :type '(choice (const :tag "No special message handling" nil)
+ (repeat
+ (choice (function-item :tag "Inhibit some messages"
+ inhibit-message)
+ (function-item :tag "Accumulate messages"
+ set-multi-message)
+ (function-item :tag "Handle minibuffer"
+ set-minibuffer-message)
+ (function :tag "Custom function"))))
+ :version "29.1")
+
+(defun set-message-functions (message)
+ (run-hook-wrapped 'set-message-functions
+ (lambda (fun)
+ (when (stringp message)
+ (let ((ret (funcall fun message)))
+ (when ret (setq message ret))))
+ nil))
+ message)
+
+(defcustom inhibit-message-regexps nil
+ "List of regexps that inhibit messages by the function `inhibit-message'."
+ :type '(repeat regexp)
+ :version "29.1")
+
+(defun inhibit-message (message)
+ "Don't display MESSAGE when it matches the regexp `inhibit-message-regexps'.
+This function is intended to be added to `set-message-functions'."
+ (or (and (consp inhibit-message-regexps)
+ (string-match-p (mapconcat #'identity inhibit-message-regexps "\\|")
+ message))
+ message))
+
+(defcustom multi-message-timeout 2
+ "Number of seconds between messages before clearing the accumulated list."
+ :type 'number
+ :version "29.1")
+
+(defcustom multi-message-max 8
+ "Max size of the list of accumulated messages."
+ :type 'number
+ :version "29.1")
+
+(defvar multi-message-separator "\n")
+
+(defvar multi-message-list nil)
+
+(defun set-multi-message (message)
+ "Return recent messages as one string to display in the echo area.
+Note that this feature works best only when `resize-mini-windows'
+is at its default value `grow-only'."
+ (let ((last-message (car multi-message-list)))
+ (unless (and last-message (equal message (aref last-message 1)))
+ (when last-message
+ (cond
+ ((> (float-time) (+ (aref last-message 0) multi-message-timeout))
+ (setq multi-message-list nil))
+ ((or
+ ;; `message-log-max' was nil, potential clutter.
+ (aref last-message 2)
+ ;; Remove old message that is substring of the new message
+ (string-prefix-p (aref last-message 1) message))
+ (setq multi-message-list (cdr multi-message-list)))))
+ (push (vector (float-time) message (not message-log-max))
multi-message-list)
+ (when (> (length multi-message-list) multi-message-max)
+ (setf (nthcdr multi-message-max multi-message-list) nil)))
+ (mapconcat (lambda (m) (aref m 1))
+ (reverse multi-message-list)
+ multi-message-separator)))
(defun clear-minibuffer-message ()
"Clear minibuffer message.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 6ffa65a2dd..d6d0fb9a25 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4242,7 +4242,7 @@ directory, so that Emacs will know its current contents."
((eq identification 'localname) localname)
(t (ange-ftp-replace-name-component file ""))))))
-(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
+(defun ange-ftp-load (file &optional noerror nomessage nosuffix must-suffix)
(if (ange-ftp-ftp-name file)
(let ((tryfiles (if nosuffix
(list file)
@@ -4264,7 +4264,7 @@ directory, so that Emacs will know its current contents."
(or noerror
(signal 'file-error (list "Cannot open load file" file)))
nil))
- (ange-ftp-real-load file noerror nomessage nosuffix)))
+ (ange-ftp-real-load file noerror nomessage nosuffix must-suffix)))
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
(defun ange-ftp-unhandled-file-name-directory (_filename)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 6c978c5a5f..9f0ad7b83c 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -37,6 +37,7 @@
(declare-function dbus-message-internal "dbusbind.c")
(declare-function dbus--init-bus "dbusbind.c")
(declare-function libxml-parse-xml-region "xml.c")
+(defvar dbus-debug)
(defvar dbus-message-type-invalid)
(defvar dbus-message-type-method-call)
(defvar dbus-message-type-method-return)
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index b8f5018005..315f7e5f52 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -341,7 +341,8 @@ is utf-8"
"p" #'backward-button
"SPC" #'scroll-up-command
"S-SPC" #'scroll-down-command
- "M-SPC" #'scroll-down-command)
+ "M-SPC" #'scroll-down-command
+ "DEL" #'scroll-down-command)
(defvar dictionary-connection
nil
@@ -1150,9 +1151,7 @@ It presents the selection or word at point as default
input and
allows editing it."
(interactive
(list (let ((default (dictionary-search-default)))
- (read-string (if default
- (format "Search word (%s): " default)
- "Search word: ")
+ (read-string (format-prompt "Search word" default)
nil 'dictionary-word-history default))
(if current-prefix-arg
(read-string (if dictionary-default-dictionary
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index dea17f3424..b44989d906 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -38,6 +38,9 @@
(defcustom eudc-server nil
"The name or IP address of the directory server.
+This variable is deprecated as of Emacs 29.1. Please add an
+entry to `eudc-server-hotlist' instead of setting `eudc-server'.
+
A port number may be specified by appending a colon and a
number to the name of the server. Use `localhost' if the directory
server resides on your computer (BBDB backend).
@@ -48,9 +51,10 @@ instead."
;; Known protocols (used in completion)
;; Not to be mistaken with `eudc-supported-protocols'
-(defvar eudc-known-protocols '(bbdb ldap))
+(defvar eudc-known-protocols '(bbdb ldap ecomplete mailabbrev))
-(defcustom eudc-server-hotlist nil
+(defcustom eudc-server-hotlist '(("localhost" . ecomplete)
+ ("localhost" . mailabbrev))
"Directory servers to query.
This is an alist of the form (SERVER . PROTOCOL). SERVER is the
host name or URI of the server, PROTOCOL is a symbol representing
@@ -343,9 +347,15 @@ arguments that should be passed to the program."
:inline t
(string :tag "Argument")))))
+(defcustom eudc-ignore-options-file nil
+ "Ignore configuration in `eudc-options-file', if non-nil."
+ :type 'boolean
+ :version "29.1")
+
(defcustom eudc-options-file
(locate-user-emacs-file "eudc-options" ".eudc-options")
- "A file where the `servers' hotlist is stored."
+ "A file where the `servers' hotlist is stored.
+See `eudc-ignore-options-file'."
:type '(file :Tag "File Name:")
:version "25.1")
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 5f9e78fc7f..8319c048e2 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -726,7 +726,8 @@ server for future sessions."
(if (called-interactively-p 'interactive)
(message "Current directory server is now %s (%s)" eudc-server
eudc-protocol))
(if (null no-save)
- (eudc-save-options)))
+ (when (not eudc-ignore-options-file)
+ (eudc-save-options))))
;;;###autoload
(defun eudc-get-email (name &optional error)
@@ -1107,7 +1108,11 @@ queries the server for the existing fields and displays
a corresponding form."
(error "%s:%s is already in the hotlist" protocol server)
(setq eudc-server-hotlist (cons (cons server protocol)
eudc-server-hotlist))
(eudc-install-menu)
- (eudc-save-options)))
+ (if eudc-ignore-options-file
+ (warn "Not saving bookmark due to `eudc-ignore-options-file'\
+ customization. Instead, customize `eudc-server-hotlist' to include %s:%s"
+ protocol server)
+ (eudc-save-options))))
(defun eudc-bookmark-current-server ()
"Add current server to the EUDC `servers' hotlist."
@@ -1117,6 +1122,9 @@ queries the server for the existing fields and displays a
corresponding form."
(defun eudc-save-options ()
"Save options to `eudc-options-file'."
(interactive)
+ (when eudc-ignore-options-file
+ (error "EUDC is configured to ignore the deprecated options file;\
+ see `eudc-ignore-options-file'"))
(with-current-buffer (find-file-noselect eudc-options-file t)
(goto-char (point-min))
;; delete the previous setq
@@ -1278,11 +1286,13 @@ queries the server for the existing fields and displays
a corresponding form."
;;{{{ Load time initializations
;; Load the options file
-(if (and (not noninteractive)
- (and (locate-library eudc-options-file)
- (progn (message "") t)) ; Remove mode line message
- (not (featurep 'eudc-options-file)))
- (load eudc-options-file))
+(let ((library-file-path (locate-library eudc-options-file)))
+ (if (and (not noninteractive)
+ (and library-file-path
+ (progn (message "") t)) ; Remove mode line message
+ (not (featurep 'eudc-options-file))
+ (not eudc-ignore-options-file))
+ (load eudc-options-file)))
;; Install the full menu
(unless (featurep 'infodock)
diff --git a/lisp/net/eudcb-ecomplete.el b/lisp/net/eudcb-ecomplete.el
new file mode 100644
index 0000000000..55011d29f6
--- /dev/null
+++ b/lisp/net/eudcb-ecomplete.el
@@ -0,0 +1,108 @@
+;;; eudcb-ecomplete.el --- EUDC - ecomplete backend -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Author: Alexander Adolf
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This library provides an interface to the ecomplete package as
+;; an EUDC data source.
+
+;;; Usage:
+;; No setup is required, since there is an entry for this backend
+;; in `eudc-server-hotlist' by default.
+;;
+;; For example, if your `ecomplete-database-file' (typically
+;; ~/.emacs.d/ecompleterc) contains:
+;;
+;; ((mail ("larsi@gnus.org" 38154 1516109510 "Lars <larsi@ecomplete.org>")))
+;;
+;; Then:
+;;
+;; C-x m lars C-u M-x eudc-expand-try-all RET
+;;
+;; should expand the email address into the To: field of the new
+;; message.
+
+;;; Code:
+
+(require 'eudc)
+(require 'ecomplete)
+(require 'mail-parse)
+
+(defvar eudc-ecomplete-attributes-translation-alist
+ '((email . mail))
+ "See `eudc-protocol-attributes-translation-alist'.
+The back-end-specific attribute names are used as the \"type\" of
+entry when searching, and they must hence match the types you use
+in your ecompleterc database file.")
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-ecomplete-query-internal
+ 'ecomplete)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'ecomplete)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+ 'eudc-ecomplete-attributes-translation-alist
+ 'ecomplete)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'ecomplete)
+
+;;;###autoload
+(defun eudc-ecomplete-query-internal (query &optional _return-attrs)
+ "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." ; FIXME: why is this being ignored?
+ (ecomplete-setup)
+ (let ((email-attr (car (eudc-translate-attribute-list '(email))))
+ result)
+ (dolist (term query)
+ (let* ((attr (car term))
+ (value (cdr term))
+ (matches (ecomplete-get-matches attr value)))
+ (when matches
+ (dolist (match (split-string (string-trim (substring-no-properties
+ matches))
+ "[\n\r]"))
+ ;; Try to decompose the email address.
+ (let* ((decoded (mail-header-parse-address match t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if (and decoded (eq attr email-attr))
+ ;; The email could be decomposed, push individual
+ ;; fields.
+ (push `((,attr . ,email)
+ ,@(when name (list (cons 'name name))))
+ result)
+ ;; Otherwise just forward the value as-is.
+ (push (list (cons attr match)) result)))))))
+ result))
+
+(eudc-register-protocol 'ecomplete)
+
+(provide 'eudcb-ecomplete)
+;;; eudcb-ecomplete.el ends here
diff --git a/lisp/net/eudcb-mailabbrev.el b/lisp/net/eudcb-mailabbrev.el
new file mode 100644
index 0000000000..64b50af09b
--- /dev/null
+++ b/lisp/net/eudcb-mailabbrev.el
@@ -0,0 +1,127 @@
+;;; eudcb-mailabbrev.el --- EUDC - mailabbrev backend -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Author: Alexander Adolf
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This library provides an interface to the mailabbrev package as
+;; an EUDC data source.
+
+;;; Usage:
+;; No setup is required, since there is an entry for this backend
+;; in `eudc-server-hotlist' by default.
+;;
+;; For example, if your `mail-personal-alias-file' (typically
+;; ~/.mailrc) contains:
+;;
+;; alias lars "Lars <larsi@mail-abbrev.com>"
+;;
+;; Then:
+;;
+;; C-x m lars C-u M-x eudc-expand-try-all RET
+;;
+;; will expand the correct email address into the To: field of the
+;; new message.
+
+;;; Code:
+
+(require 'eudc)
+(require 'mailabbrev)
+(require 'mail-parse)
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-mailabbrev-query-internal
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+ nil
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'mailabbrev)
+;;;###autoload
+(defun eudc-mailabbrev-query-internal (query &optional _return-attrs)
+ "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'."
+ (mail-abbrevs-setup)
+ (let (result)
+ (dolist (term query)
+ (let* ((attr (car term))
+ (value (cdr term))
+ (raw-matches (symbol-value (intern-soft value mail-abbrevs))))
+ (when (and raw-matches
+ (memq attr '(email firstname name)))
+ (let* ((matches (split-string raw-matches ", "))
+ (num-matches (length matches)))
+ (if (> num-matches 1)
+ ;; multiple matches: distribution list
+ (let ((distr-str (string)))
+ (dolist (recipient matches)
+ ;; try to decompose email construct
+ (let* ((decoded (mail-header-parse-address recipient t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if decoded
+ ;; decoding worked, push rfc5322 rendered address
+ (setq distr-str
+ (copy-sequence
+ (concat distr-str ", "
+ (eudc-rfc5322-make-address email
+ nil
+ name))))
+ ;; else, just forward the value as-is
+ (setq distr-str
+ (copy-sequence
+ (concat distr-str ", " recipient))))))
+ ;; push result, removing the leading ", "
+ (push (list (cons 'email (substring distr-str 2 -1)))
+ result))
+ ;; simple case: single match
+ (let* ((match (car matches))
+ (decoded (mail-header-parse-address match t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if decoded
+ ;; decoding worked, push individual fields
+ (push `((email . ,email)
+ ,@(when name (list (cons 'name name))))
+ result)
+ ;; else, just forward the value as-is
+ (push (list (cons 'email match)) result))))))))
+ result))
+
+(eudc-register-protocol 'mailabbrev)
+
+(provide 'eudcb-mailabbrev)
+
+;;; eudcb-mailabbrev.el ends here
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 414de931c4..3799ef96e8 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1596,7 +1596,8 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(list :eww-form eww-form
:value value
:type "textarea"
- :name (dom-attr dom 'name)))))
+ :name (dom-attr dom 'name)))
+ (put-text-property start (1+ start) 'shr-tab-stop t)))
(defun eww-tag-input (dom)
(let ((type (downcase (or (dom-attr dom 'type) "text")))
@@ -1660,7 +1661,8 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(add-face-text-property start (point) 'eww-form-select)
(put-text-property start (point) 'keymap eww-select-map)
(unless (= start (point))
- (put-text-property start (1+ start) 'help-echo "select field"))
+ (put-text-property start (1+ start) 'help-echo "select field")
+ (put-text-property start (1+ start) 'shr-tab-stop t))
(shr-ensure-paragraph))))
(defun eww-select-display (select)
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 38a5e14c94..2b7e539392 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -173,6 +173,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\".
@@ -195,6 +198,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(make-network-process :name name :buffer buffer
:host (puny-encode-domain host) :service service
:nowait (plist-get parameters :nowait)
+ :noquery (plist-get parameters :noquery)
:tls-parameters
(plist-get parameters :tls-parameters)
:coding (plist-get parameters :coding))
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index f65ef522f2..af196ccecf 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -40,7 +40,6 @@
;; Silence warnings
(defvar newsticker-groups)
-(defvar w3m-minor-mode-map)
(defvar newsticker--retrieval-timer-list nil
"List of timers for news retrieval.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index b7eeab1735..370f388b3e 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2066,7 +2066,8 @@ connection."
(set-marker-insertion-type rcirc-prompt-end-marker t)
;; run markup functions
- (cl-assert (bolp))
+ (unless (bolp)
+ (newline))
(save-excursion
(save-restriction
(narrow-to-region (point) (point))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 63f313dc50..b08bc63e8a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3997,6 +3997,17 @@ Let-bind it when necessary.")
(cond
((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
+ ;; Tramp reads and writes timestamps on second level. So we round
+ ;; the timestamps to seconds w/o fractions.
+ ;; `time-convert' has been introduced with Emacs 27.1.
+ ((fboundp 'time-convert)
+ (time-less-p
+ (tramp-compat-funcall
+ 'time-convert
+ (file-attribute-modification-time (file-attributes file2)) 'integer)
+ (tramp-compat-funcall
+ 'time-convert
+ (file-attribute-modification-time (file-attributes file1)) 'integer)))
(t (time-less-p
(file-attribute-modification-time (file-attributes file2))
(file-attribute-modification-time (file-attributes file1))))))
@@ -4573,14 +4584,9 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(setq file (concat file ".elc")))
((file-exists-p (concat file ".el"))
(setq file (concat file ".el")))))
- (when must-suffix
- ;; The first condition is always true for absolute file names.
- ;; Included for safety's sake.
- (unless (or (file-name-directory file)
- (string-match-p (rx ".el" (? "c") eos) file))
- (tramp-error
- v 'file-error
- "File `%s' does not include a `.el' or `.elc' suffix" file)))
+ (when (and must-suffix (not (string-match-p (rx ".el" (? "c") eos) file)))
+ (tramp-error
+ v 'file-error "File `%s' does not include a `.el' or `.elc' suffix"
file))
(unless (or noerror (file-exists-p file))
(tramp-error v 'file-missing file))
(if (not (file-exists-p file))
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 453c2b736d..85db33b9a9 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -1,6 +1,6 @@
;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas -*-
lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2022 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
@@ -82,19 +82,17 @@ Return a pattern."
(concat "\\`\\(" (regexp-opt rng-c-keywords) "\\)\\'")
"Regular expression to match a keyword in the compact syntax.")
-(defvar rng-c-syntax-table nil
+(defvar rng-c-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?# "<" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?- "w" st)
+ (modify-syntax-entry ?. "w" st)
+ (modify-syntax-entry ?_ "w" st)
+ (modify-syntax-entry ?: "_" st)
+ st)
"Syntax table for parsing the compact syntax.")
-(if rng-c-syntax-table
- ()
- (setq rng-c-syntax-table (make-syntax-table))
- (modify-syntax-entry ?# "<" rng-c-syntax-table)
- (modify-syntax-entry ?\n ">" rng-c-syntax-table)
- (modify-syntax-entry ?- "w" rng-c-syntax-table)
- (modify-syntax-entry ?. "w" rng-c-syntax-table)
- (modify-syntax-entry ?_ "w" rng-c-syntax-table)
- (modify-syntax-entry ?: "_" rng-c-syntax-table))
-
(defconst rng-c-literal-1-re
"'\\(''\\([^']\\|'[^']\\|''[^']\\)*''\\|[^'\n]*\\)'"
"Regular expression to match a single-quoted literal.")
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index 836e1430df..4e1c44d2bc 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -881,7 +881,7 @@
(org-table-find-dataline, org-table-move-row)
(org-table-insert-hline, org-table-kill-row):
Use `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so
- that abbreviated rows don't interfer with setting the cursor back
+ that abbreviated rows don't interfere with setting the cursor back
at the correct position.
* org.el (org-agenda-prepare-buffers): Use `save-excursion'
@@ -4724,7 +4724,7 @@
2013-11-12 Michael Brand <michael.ch.brand@gmail.com>
* org-table.el (org-table-eval-formula): Align the arrow pointing
- to the error in a Calc formula to the other fomula debugger logs.
+ to the error in a Calc formula to the other formula debugger logs.
* org.el (org-link-escape-chars-browser): Add char double quote.
(org-open-at-point): Use the constant
@@ -30650,7 +30650,7 @@
and scheduling search.
* org-exp.el (org-html-handle-time-stamps): No longer check for
- the `org-export-with-timestamps' option, because the preprocesser
+ the `org-export-with-timestamps' option, because the preprocessor
has taken care of this already.
* org.el (org-entry-properties): Catch the case when this is
@@ -32411,7 +32411,7 @@
* org-exp.el (org-print-icalendar-entries): Move the call to
`org-diary-to-ical-string' out of the loop, and kill the buffer
- afterwords.
+ afterwards.
* org-remember.el (org-remember-visit-immediately):
Position cursor after moving to the note.
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 67db49e9a6..b1ee32ab33 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -45,8 +45,6 @@
;; Installation
;; ============
;;
-;; Install org mode
-;; Ensure org-ctags.el is somewhere in your emacs load path.
;; Download and install Exuberant ctags -- "https://ctags.sourceforge.net/"
;; Edit your .emacs file (see next section) and load emacs.
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 7a91a33b74..137a11f3d9 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -42,7 +42,6 @@
;;
;; 1.) Add this to your init file (.emacs probably):
;;
-;; (add-to-list 'load-path "/path/to/org-protocol/")
;; (require 'org-protocol)
;;
;; 3.) Ensure emacs-server is up and running.
diff --git a/lisp/outline.el b/lisp/outline.el
index ef5249a146..a646f71db8 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -507,7 +507,9 @@ See the command `outline-mode' for more information on this
mode."
(when (eq (current-bidi-paragraph-direction) 'right-to-left)
(setq-local outline--use-rtl t))
(setq-local outline--button-icons (outline--create-button-icons))
- (when (eq outline-minor-mode-use-buttons 'in-margins)
+ (when (and (eq outline-minor-mode-use-buttons 'in-margins)
+ (> 1 (if outline--use-rtl right-margin-width
+ left-margin-width)))
(if outline--use-rtl
(setq-local right-margin-width (1+ right-margin-width))
(setq-local left-margin-width (1+ left-margin-width)))
@@ -542,7 +544,9 @@ See the command `outline-mode' for more information on this
mode."
(remove-overlays nil nil 'outline-highlight t))
(when outline-minor-mode-use-buttons
(remove-overlays nil nil 'outline-button t)
- (when (eq outline-minor-mode-use-buttons 'in-margins)
+ (when (and (eq outline-minor-mode-use-buttons 'in-margins)
+ (< 0 (if outline--use-rtl right-margin-width
+ left-margin-width)))
(if outline--use-rtl
(setq-local right-margin-width (1- right-margin-width))
(setq-local left-margin-width (1- left-margin-width)))
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 8670e5786a..e66b1ff42a 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -534,72 +534,71 @@ RET: expand or collapse"))
;;; Report mode
-(defvar profiler-report-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" 'profiler-report-next-entry)
- (define-key map "p" 'profiler-report-previous-entry)
- ;; I find it annoying more than helpful to not be able to navigate
- ;; normally with the cursor keys. --Stef
- ;; (define-key map [down] 'profiler-report-next-entry)
- ;; (define-key map [up] 'profiler-report-previous-entry)
- (define-key map "\r" 'profiler-report-toggle-entry)
- (define-key map "\t" 'profiler-report-toggle-entry)
- (define-key map "i" 'profiler-report-toggle-entry)
- (define-key map "f" 'profiler-report-find-entry)
- (define-key map "j" 'profiler-report-find-entry)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'profiler-report-find-entry)
- (define-key map "d" 'profiler-report-describe-entry)
- (define-key map "C" 'profiler-report-render-calltree)
- (define-key map "B" 'profiler-report-render-reversed-calltree)
- (define-key map "A" 'profiler-report-ascending-sort)
- (define-key map "D" 'profiler-report-descending-sort)
- (define-key map "=" 'profiler-report-compare-profile)
- (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
- (easy-menu-define profiler-report-menu map "Menu for Profiler Report
mode."
- '("Profiler"
- ["Next Entry" profiler-report-next-entry :active t
- :help "Move to next entry"]
- ["Previous Entry" profiler-report-previous-entry :active t
- :help "Move to previous entry"]
- "--"
- ["Toggle Entry" profiler-report-toggle-entry
- :active (profiler-report-calltree-at-point)
- :help "Expand or collapse the current entry"]
- ["Find Entry" profiler-report-find-entry
- ;; FIXME should deactivate if not on a known function.
- :active (profiler-report-calltree-at-point)
- :help "Find the definition of the current entry"]
- ["Describe Entry" profiler-report-describe-entry
- :active (profiler-report-calltree-at-point)
- :help "Show the documentation of the current entry"]
- "--"
- ["Show Calltree" profiler-report-render-calltree
- :active profiler-report-reversed
- :help "Show calltree view"]
- ["Show Reversed Calltree" profiler-report-render-reversed-calltree
- :active (not profiler-report-reversed)
- :help "Show reversed calltree view"]
- ["Sort Ascending" profiler-report-ascending-sort
- :active (not (eq profiler-report-order 'ascending))
- :help "Sort calltree view in ascending order"]
- ["Sort Descending" profiler-report-descending-sort
- :active (not (eq profiler-report-order 'descending))
- :help "Sort calltree view in descending order"]
- "--"
- ["Compare Profile..." profiler-report-compare-profile :active t
- :help "Compare current profile with another"]
- ["Write Profile..." profiler-report-write-profile :active t
- :help "Write current profile to a file"]
- "--"
- ["Start Profiler" profiler-start :active (not (profiler-running-p))
- :help "Start profiling"]
- ["Stop Profiler" profiler-stop :active (profiler-running-p)
- :help "Stop profiling"]
- ["New Report" profiler-report :active (profiler-running-p)
- :help "Make a new report"]))
- map)
- "Keymap for `profiler-report-mode'.")
+(defvar-keymap profiler-report-mode-map
+ :doc "Keymap for `profiler-report-mode'."
+ "n" #'profiler-report-next-entry
+ "p" #'profiler-report-previous-entry
+ ;; I find it annoying more than helpful to not be able to navigate
+ ;; normally with the cursor keys. --Stef
+ ;; "<down>" #'profiler-report-next-entry
+ ;; "<up>" #'profiler-report-previous-entry
+ "RET" #'profiler-report-toggle-entry
+ "TAB" #'profiler-report-toggle-entry
+ "i" #'profiler-report-toggle-entry
+ "f" #'profiler-report-find-entry
+ "j" #'profiler-report-find-entry
+ "d" #'profiler-report-describe-entry
+ "C" #'profiler-report-render-calltree
+ "B" #'profiler-report-render-reversed-calltree
+ "A" #'profiler-report-ascending-sort
+ "D" #'profiler-report-descending-sort
+ "=" #'profiler-report-compare-profile
+ "C-x C-w" #'profiler-report-write-profile
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'profiler-report-find-entry
+
+ :menu
+ '("Profiler"
+ ["Next Entry" profiler-report-next-entry :active t
+ :help "Move to next entry"]
+ ["Previous Entry" profiler-report-previous-entry :active t
+ :help "Move to previous entry"]
+ "--"
+ ["Toggle Entry" profiler-report-toggle-entry
+ :active (profiler-report-calltree-at-point)
+ :help "Expand or collapse the current entry"]
+ ["Find Entry" profiler-report-find-entry
+ ;; FIXME should deactivate if not on a known function.
+ :active (profiler-report-calltree-at-point)
+ :help "Find the definition of the current entry"]
+ ["Describe Entry" profiler-report-describe-entry
+ :active (profiler-report-calltree-at-point)
+ :help "Show the documentation of the current entry"]
+ "--"
+ ["Show Calltree" profiler-report-render-calltree
+ :active profiler-report-reversed
+ :help "Show calltree view"]
+ ["Show Reversed Calltree" profiler-report-render-reversed-calltree
+ :active (not profiler-report-reversed)
+ :help "Show reversed calltree view"]
+ ["Sort Ascending" profiler-report-ascending-sort
+ :active (not (eq profiler-report-order 'ascending))
+ :help "Sort calltree view in ascending order"]
+ ["Sort Descending" profiler-report-descending-sort
+ :active (not (eq profiler-report-order 'descending))
+ :help "Sort calltree view in descending order"]
+ "--"
+ ["Compare Profile..." profiler-report-compare-profile :active t
+ :help "Compare current profile with another"]
+ ["Write Profile..." profiler-report-write-profile :active t
+ :help "Write current profile to a file"]
+ "--"
+ ["Start Profiler" profiler-start :active (not (profiler-running-p))
+ :help "Start profiling"]
+ ["Stop Profiler" profiler-stop :active (profiler-running-p)
+ :help "Stop profiling"]
+ ["New Report" profiler-report :active (profiler-running-p)
+ :help "Make a new report"]))
(defun profiler-report-make-buffer-name (profile)
(format "*%s-Profiler-Report %s*"
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 4b8154dafe..735d829769 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -287,7 +287,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten
somewhere"))
(cons cc-file cc-bytecomp-loaded-files))
(cc-bytecomp-debug-msg
"cc-bytecomp-load: Loading %S" cc-file)
- ;; native-comp may async compile also intalled el.gz
+ ;; native-comp may async compile also installed el.gz
;; files therefore we may have to load here other el.gz.
(load cc-part nil t)
(cc-bytecomp-debug-msg
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 81aac2ec27..b13f6a5914 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -86,7 +86,7 @@
;;; Variables also used at compile time.
-(defconst c-version "5.35.1"
+(defconst c-version "5.35.2"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index d730fddeb0..5d3d240886 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -6052,7 +6052,7 @@ comment at the start of cc-engine.el for more info."
;; the like.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The approximate interval at which we cache the value of the brace stack.
-(defconst c-bs-interval 5000)
+(defconst c-bs-interval 2000)
;; The list of cached values of the brace stack. Each value in the list is a
;; cons of the position it is valid for and the value of the stack as
;; described above.
@@ -6158,9 +6158,10 @@ comment at the start of cc-engine.el for more info."
(setq s (cdr s))))
((c-keyword-member kwd-sym 'c-flat-decl-block-kwds)
(push 0 s))))
- ;; The failing `c-syntactic-re-search-forward' may have left us in the
- ;; middle of a token, which might be a significant token. Fix this!
- (c-beginning-of-current-token)
+ (when (> prev-match-pos 1) ; Has the search matched at least once?
+ ;; The failing `c-syntactic-re-search-forward' may have left us in the
+ ;; middle of a token, which might be a significant token. Fix this!
+ (c-beginning-of-current-token))
(cons (point)
(cons bound-<> s)))))
@@ -7355,7 +7356,7 @@ multi-line strings (but not C++, for example)."
(defun c-ml-string-opener-intersects-region (&optional start finish)
;; If any part of the region [START FINISH] is inside an ml-string opener,
;; return a dotted list of the start, end and double-quote position of that
- ;; opener. That list wlll not include any "context characters" before or
+ ;; opener. That list will not include any "context characters" before or
;; after the opener. If an opener is found, the match-data will indicate
;; it, with (match-string 1) being the entire delimiter, and (match-string
;; 2) the "main" double-quote. Otherwise, the match-data is undefined.
@@ -10207,7 +10208,11 @@ This function might do hidden buffer changes."
(save-rec-ref-ids c-record-ref-identifiers)
;; Set when we parse a declaration which might also be an expression,
;; such as "a *b". See CASE 16 and CASE 17.
- maybe-expression)
+ maybe-expression
+ ;; Set for the type when `c-forward-type' returned `maybe', and we
+ ;; want to fontify it as a type, but aren't confident enough to enter
+ ;; it into `c-found-types'.
+ unsafe-maybe)
(save-excursion
(goto-char preceding-token-end)
@@ -10768,7 +10773,15 @@ This function might do hidden buffer changes."
((eq at-decl-or-cast t)
(throw 'at-decl-or-cast t))
((and c-has-bitfields
- (eq at-decl-or-cast 'ids)) ; bitfield.
+ ;; Check for a bitfield.
+ (eq at-decl-or-cast 'ids)
+ (save-excursion
+ (forward-char) ; Over the :
+ (c-forward-syntactic-ws)
+ (and (looking-at "[[:alnum:]]")
+ (progn (c-forward-token-2)
+ (c-forward-syntactic-ws)
+ (memq (char-after) '(?\; ?,))))))
(setq backup-if-not-cast t)
(throw 'at-decl-or-cast t)))
@@ -10903,7 +10916,7 @@ This function might do hidden buffer changes."
;; a statement beginning with an identifier.
(when (and (eq at-type 'maybe)
(not (eq context 'top)))
- (setq c-record-type-identifiers nil))
+ (setq unsafe-maybe t))
(throw 'at-decl-or-cast t))
;; CASE 11
@@ -11206,7 +11219,8 @@ This function might do hidden buffer changes."
;; fontification just because it's "a known type that can't
;; be a name or other expression". 2013-09-18.
)
- (let ((c-promote-possible-types t))
+ (let ((c-promote-possible-types
+ (if unsafe-maybe 'just-one t)))
(save-excursion
(goto-char type-start)
(c-forward-type))))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 2aa6b90dea..fb5ef69413 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -2390,6 +2390,8 @@ with // and /*, not more generic line and block comments."
;; Go to a less nested declaration each time round this loop.
(and
(setq old-pos (point))
+ ;; The following form tries to move to the end of the previous
+ ;; declaration without moving outside of an enclosing {.
(let (pseudo)
(while
(and
@@ -2404,7 +2406,9 @@ with // and /*, not more generic line and block comments."
(setq pseudo (c-cheap-inside-bracelist-p
(c-parse-state)))))))
(goto-char pseudo))
t)
- (>= (point) bod-lim)
+ (or (> (point) bod-lim)
+ (eq bod-lim (point-min)))
+ ;; Move forward to the start of the next declaration.
(progn (c-forward-syntactic-ws)
;; Have we got stuck in a comment at EOB?
(not (and (eobp)
@@ -2501,7 +2505,7 @@ with // and /*, not more generic line and block comments."
(not (eobp)))
(progn
(c-forward-over-token)
- ;; Cope with having POS withing a syntactically invalid
+ ;; Cope with having POS within a syntactically invalid
;; (...), by moving backward out of the parens and trying
;; again.
(when (and (eq (char-before) ?\))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 539b277149..b36896ae7c 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1429,10 +1429,40 @@ the last)."
(rx (sequence line-start (0+ blank) (eval cperl--imenu-entries-rx)))
"The regular expression used for `outline-minor-mode'.")
-(defvar cperl-mode-syntax-table nil
+(defvar cperl-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\\ "\\" st)
+ (modify-syntax-entry ?/ "." st)
+ (modify-syntax-entry ?* "." st)
+ (modify-syntax-entry ?+ "." st)
+ (modify-syntax-entry ?- "." st)
+ (modify-syntax-entry ?= "." st)
+ (modify-syntax-entry ?% "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+ (modify-syntax-entry ?& "." st)
+ (modify-syntax-entry ?$ "\\" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?# "<" st)
+ (modify-syntax-entry ?' "\"" st)
+ (modify-syntax-entry ?` "\"" st)
+ (if cperl-under-as-char
+ (modify-syntax-entry ?_ "w" st))
+ (modify-syntax-entry ?: "_" st)
+ (modify-syntax-entry ?| "." st)
+ st)
"Syntax table in use in CPerl mode buffers.")
-(defvar cperl-string-syntax-table nil
+(defvar cperl-string-syntax-table
+ (let ((st (copy-syntax-table cperl-mode-syntax-table)))
+ (modify-syntax-entry ?$ "." st)
+ (modify-syntax-entry ?\{ "." st)
+ (modify-syntax-entry ?\} "." st)
+ (modify-syntax-entry ?\" "." st)
+ (modify-syntax-entry ?' "." st)
+ (modify-syntax-entry ?` "." st)
+ (modify-syntax-entry ?# "." st) ; (?# comment )
+ st)
"Syntax table in use in CPerl mode string-like chunks.")
(defsubst cperl-1- (p)
@@ -1441,38 +1471,6 @@ the last)."
(defsubst cperl-1+ (p)
(min (point-max) (1+ p)))
-(if cperl-mode-syntax-table
- ()
- (setq cperl-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table)
- (modify-syntax-entry ?/ "." cperl-mode-syntax-table)
- (modify-syntax-entry ?* "." cperl-mode-syntax-table)
- (modify-syntax-entry ?+ "." cperl-mode-syntax-table)
- (modify-syntax-entry ?- "." cperl-mode-syntax-table)
- (modify-syntax-entry ?= "." cperl-mode-syntax-table)
- (modify-syntax-entry ?% "." cperl-mode-syntax-table)
- (modify-syntax-entry ?< "." cperl-mode-syntax-table)
- (modify-syntax-entry ?> "." cperl-mode-syntax-table)
- (modify-syntax-entry ?& "." cperl-mode-syntax-table)
- (modify-syntax-entry ?$ "\\" cperl-mode-syntax-table)
- (modify-syntax-entry ?\n ">" cperl-mode-syntax-table)
- (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
- (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
- (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
- (if cperl-under-as-char
- (modify-syntax-entry ?_ "w" cperl-mode-syntax-table))
- (modify-syntax-entry ?: "_" cperl-mode-syntax-table)
- (modify-syntax-entry ?| "." cperl-mode-syntax-table)
- (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))
- (modify-syntax-entry ?$ "." cperl-string-syntax-table)
- (modify-syntax-entry ?\{ "." cperl-string-syntax-table)
- (modify-syntax-entry ?\} "." cperl-string-syntax-table)
- (modify-syntax-entry ?\" "." cperl-string-syntax-table)
- (modify-syntax-entry ?' "." cperl-string-syntax-table)
- (modify-syntax-entry ?` "." cperl-string-syntax-table)
- (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment )
-
-
(defvar cperl-faces-init nil)
;; Fix for msb.el
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index f4584b6311..43e430d40c 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -1,6 +1,6 @@
;;; cpp.el --- highlight or hide text according to cpp conditionals -*-
lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: c, faces, tools
@@ -98,8 +98,8 @@ Each entry is a list with the following elements:
(const :tag "Both branches writable" both)))))
(defcustom cpp-message-min-time-interval 1.0
- "Minimum time interval in seconds for `cpp-progress-message' messages.
-If nil, `cpp-progress-message' prints no progress messages."
+ "Minimum time interval in seconds for `cpp-highlight-buffer' progress
messages.
+If nil, `cpp-highlight-buffer' prints no progress messages."
:type '(choice (const :tag "Disable progress messages" nil)
float)
:version "26.1")
@@ -218,14 +218,15 @@ A prefix arg suppresses display of that buffer."
(cpp-parse-reset)
(if (null cpp-edit-list)
(cpp-edit-load))
- (let (cpp-state-stack)
+ (let ((reporter
+ (and cpp-message-min-time-interval
+ (make-progress-reporter "Parsing..." (point-min) (point-max)
+ nil nil cpp-message-min-time-interval)))
+ cpp-state-stack)
(save-excursion
(goto-char (point-min))
- (cpp-progress-message "Parsing...")
(while (re-search-forward cpp-parse-regexp nil t)
- (cpp-progress-message "Parsing...%d%%"
- (floor (* 100.0 (- (point) (point-min)))
- (buffer-size)))
+ (when reporter (progress-reporter-update reporter (point)))
(let ((match (buffer-substring (match-beginning 0) (match-end 0))))
(cond ((or (string-equal match "'")
(string-equal match "\""))
@@ -268,7 +269,7 @@ A prefix arg suppresses display of that buffer."
(cpp-parse-close from to))
(t
(cpp-parse-error "Parser error"))))))))
- (cpp-progress-message "Parsing...done"))
+ (when reporter (progress-reporter-done reporter)))
(if cpp-state-stack
(save-excursion
(goto-char (nth 3 (car cpp-state-stack)))
@@ -410,47 +411,45 @@ A prefix arg suppresses display of that buffer."
;;; Edit Buffer:
-(defvar cpp-edit-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
- (define-key map [ down-mouse-2 ] 'cpp-push-button)
- (define-key map [ mouse-2 ] 'ignore)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\C-?" 'scroll-down-command)
- (define-key map [ delete ] 'scroll-down)
- (define-key map "\C-c\C-c" 'cpp-edit-apply)
- (define-key map "a" 'cpp-edit-apply)
- (define-key map "A" 'cpp-edit-apply)
- (define-key map "r" 'cpp-edit-reset)
- (define-key map "R" 'cpp-edit-reset)
- (define-key map "s" 'cpp-edit-save)
- (define-key map "S" 'cpp-edit-save)
- (define-key map "l" 'cpp-edit-load)
- (define-key map "L" 'cpp-edit-load)
- (define-key map "h" 'cpp-edit-home)
- (define-key map "H" 'cpp-edit-home)
- (define-key map "b" 'cpp-edit-background)
- (define-key map "B" 'cpp-edit-background)
- (define-key map "k" 'cpp-edit-known)
- (define-key map "K" 'cpp-edit-known)
- (define-key map "u" 'cpp-edit-unknown)
- (define-key map "u" 'cpp-edit-unknown)
- (define-key map "t" 'cpp-edit-true)
- (define-key map "T" 'cpp-edit-true)
- (define-key map "f" 'cpp-edit-false)
- (define-key map "F" 'cpp-edit-false)
- (define-key map "w" 'cpp-edit-write)
- (define-key map "W" 'cpp-edit-write)
- (define-key map "X" 'cpp-edit-toggle-known)
- (define-key map "x" 'cpp-edit-toggle-known)
- (define-key map "Y" 'cpp-edit-toggle-unknown)
- (define-key map "y" 'cpp-edit-toggle-unknown)
- (define-key map "q" 'bury-buffer)
- (define-key map "Q" 'bury-buffer)
- map)
- "Keymap for `cpp-edit-mode'.")
-
+(defvar-keymap cpp-edit-mode-map
+ :doc "Keymap for `cpp-edit-mode'."
+ :full t
+ :suppress t
+ "<down-mouse-2>" #'cpp-push-button
+ "<mouse-2>" #'ignore
+ "SPC" #'scroll-up-command
+ "S-SPC" #'scroll-down-command
+ "DEL" #'scroll-down-command
+ "<delete>" #'scroll-down
+ "C-c C-c" #'cpp-edit-apply
+ "a" #'cpp-edit-apply
+ "A" #'cpp-edit-apply
+ "r" #'cpp-edit-reset
+ "R" #'cpp-edit-reset
+ "s" #'cpp-edit-save
+ "S" #'cpp-edit-save
+ "l" #'cpp-edit-load
+ "L" #'cpp-edit-load
+ "h" #'cpp-edit-home
+ "H" #'cpp-edit-home
+ "b" #'cpp-edit-background
+ "B" #'cpp-edit-background
+ "k" #'cpp-edit-known
+ "K" #'cpp-edit-known
+ "u" #'cpp-edit-unknown
+ "U" #'cpp-edit-unknown
+ "t" #'cpp-edit-true
+ "T" #'cpp-edit-true
+ "f" #'cpp-edit-false
+ "F" #'cpp-edit-false
+ "w" #'cpp-edit-write
+ "W" #'cpp-edit-write
+ "X" #'cpp-edit-toggle-known
+ "x" #'cpp-edit-toggle-known
+ "Y" #'cpp-edit-toggle-unknown
+ "y" #'cpp-edit-toggle-unknown
+ "q" #'bury-buffer
+ "Q" #'bury-buffer)
(defvar-local cpp-edit-symbols nil
@@ -816,6 +815,7 @@ Type must be one of the types defined in
`cpp-face-type-list'."
;;; Utilities:
+(make-obsolete-variable 'cpp-progress-time nil "29.1")
(defvar cpp-progress-time 0
"Last time `cpp-progress-message' issued a progress message.")
@@ -825,6 +825,7 @@ Type must be one of the types defined in
`cpp-face-type-list'."
Print messages at most once every `cpp-message-min-time-interval' seconds.
If that option is nil, don't prints messages.
ARGS are the same as for `message'."
+ (declare (obsolete make-progress-reporter "29.1"))
(when cpp-message-min-time-interval
(let ((time (current-time)))
(unless (time-less-p cpp-message-min-time-interval
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index 8f79cdaaab..f1d7f236b9 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -1,6 +1,6 @@
;;; dcl-mode.el --- major mode for editing DCL command files -*-
lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Odd Gripenstam <gripenstamol@decus.se>
;; Maintainer: emacs-devel@gnu.org
@@ -258,38 +258,34 @@ See `imenu-generic-expression' for details."
;;; *** Global variables ****************************************************
-(defvar dcl-mode-syntax-table nil
+(defvar dcl-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?! "<" st) ; comment start
+ (modify-syntax-entry ?\n ">" st) ; comment end
+ (modify-syntax-entry ?< "(>" st) ; < and ...
+ (modify-syntax-entry ?> ")<" st) ; > is a matching pair
+ (modify-syntax-entry ?\\ "_" st) ; not an escape
+ st)
"Syntax table used in DCL-buffers.")
-(unless dcl-mode-syntax-table
- (setq dcl-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?! "<" dcl-mode-syntax-table) ; comment start
- (modify-syntax-entry ?\n ">" dcl-mode-syntax-table) ; comment end
- (modify-syntax-entry ?< "(>" dcl-mode-syntax-table) ; < and ...
- (modify-syntax-entry ?> ")<" dcl-mode-syntax-table) ; > is a matching pair
- (modify-syntax-entry ?\\ "_" dcl-mode-syntax-table) ; not an escape
-)
-
-
-(defvar dcl-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\e\n" #'dcl-split-line)
- (define-key map "\e\t" #'tempo-complete-tag)
- (define-key map "\e^" #'dcl-delete-indentation)
- (define-key map "\em" #'dcl-back-to-indentation)
- (define-key map "\ee" #'dcl-forward-command)
- (define-key map "\ea" #'dcl-backward-command)
- (define-key map "\e\C-q" #'dcl-indent-command)
- (define-key map "\t" #'dcl-tab)
- (define-key map ":" #'dcl-electric-character)
- (define-key map "F" #'dcl-electric-character)
- (define-key map "f" #'dcl-electric-character)
- (define-key map "E" #'dcl-electric-character)
- (define-key map "e" #'dcl-electric-character)
- (define-key map "\C-c\C-o" #'dcl-set-option)
- (define-key map "\C-c\C-f" #'tempo-forward-mark)
- (define-key map "\C-c\C-b" #'tempo-backward-mark)
- map)
- "Keymap used in DCL-mode buffers.")
+
+(defvar-keymap dcl-mode-map
+ :doc "Keymap used in DCL-mode buffers."
+ "M-RET" #'dcl-split-line
+ "M-TAB" #'tempo-complete-tag
+ "M-^" #'dcl-delete-indentation
+ "M-m" #'dcl-back-to-indentation
+ "M-e" #'dcl-forward-command
+ "M-a" #'dcl-backward-command
+ "C-M-q" #'dcl-indent-command
+ "TAB" #'dcl-tab
+ ":" #'dcl-electric-character
+ "F" #'dcl-electric-character
+ "f" #'dcl-electric-character
+ "E" #'dcl-electric-character
+ "e" #'dcl-electric-character
+ "C-c C-o" #'dcl-set-option
+ "C-c C-f" #'tempo-forward-mark
+ "C-c C-b" #'tempo-backward-mark)
(easy-menu-define dcl-mode-menu dcl-mode-map
"Menu for DCL-mode buffers."
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 6e42da2d54..1894826fe4 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -166,8 +166,6 @@
;;
;; Where setup-ebnf2ps.el should be a file containing:
;;
-;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment
-;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path))
;; (require 'ebnf2ps)
;; ;; insert here your ebnf2ps settings
;; (setq ebnf-terminal-shape 'bevel)
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index c587061837..12808e80c4 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -56,7 +56,7 @@
;; available as GNU ELPA :core packages. Historically, a number of
;; :core packages were added or reworked in Emacs to make this
;; possible. This principle should be upheld when adding new LSP
-;; features or tweaking exising ones. Design any new facilities in
+;; features or tweaking existing ones. Design any new facilities in
;; a way that they could work in the absence of LSP or using some
;; different protocol, then make sure Eglot can link up LSP
;; information to it.
@@ -206,7 +206,7 @@ language-server/bin/php-language-server.php"))
(elm-mode . ("elm-language-server"))
(mint-mode . ("mint" "ls"))
(kotlin-mode . ("kotlin-language-server"))
- (go-mode . ("gopls"))
+ ((go-mode go-dot-mod-mode go-dot-work-mode) .
("gopls"))
((R-mode ess-r-mode) . ("R" "--slave" "-e"
"languageserver::run()"))
(java-mode . ("jdtls"))
@@ -217,7 +217,7 @@ language-server/bin/php-language-server.php"))
(scala-mode . ("metals-emacs"))
(racket-mode . ("racket" "-l"
"racket-langserver"))
((tex-mode context-mode texinfo-mode
bibtex-mode)
- . ("digestif"))
+ . ,(eglot-alternatives '("digestif"
"texlab")))
(erlang-mode . ("erlang_ls" "--transport"
"stdio"))
(yaml-mode . ("yaml-language-server"
"--stdio"))
(nix-mode . ,(eglot-alternatives '("nil"
"rnix-lsp")))
@@ -234,7 +234,7 @@ language-server/bin/php-language-server.php"))
. ("clojure-lsp"))
(csharp-mode . ("omnisharp" "-lsp"))
(purescript-mode .
("purescript-language-server" "--stdio"))
- (perl-mode . ("perl" "-MPerl::LanguageServer"
"-e" "Perl::LanguageServer::run"))
+ ((perl-mode cperl-mode) . ("perl"
"-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
(markdown-mode . ("marksman" "server")))
"How the command `eglot' guesses the server to start.
An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
@@ -298,7 +298,10 @@ CONTACT can be:
the call is interactive, the function can ask the user for
hints on finding the required programs, etc. Otherwise, it
should not ask the user for any input, and return nil or signal
- an error if it can't produce a valid CONTACT.")
+ an error if it can't produce a valid CONTACT. The helper
+ function `eglot-alternatives' (which see) can be used to
+ produce a function that offers more than one server for a given
+ MAJOR-MODE.")
(defface eglot-highlight-symbol-face
'((t (:inherit bold)))
@@ -583,7 +586,7 @@ on unknown notifications and errors on unknown requests."))
(cl-defmacro eglot--dbind (vars object &body body)
"Destructure OBJECT, binding VARS in BODY.
VARS is ([(INTERFACE)] SYMS...)
-Honour `eglot-strict-mode'."
+Honor `eglot-strict-mode'."
(declare (indent 2) (debug (sexp sexp &rest form)))
(let ((interface-name (if (consp (car vars))
(car (pop vars))))
@@ -610,7 +613,7 @@ Honour `eglot-strict-mode'."
(cl-defmacro eglot--lambda (cl-lambda-list &body body)
"Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
-Honour `eglot-strict-mode'."
+Honor `eglot-strict-mode'."
(declare (indent 1) (debug (sexp &rest form)))
(let ((e (cl-gensym "jsonrpc-lambda-elem")))
`(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
@@ -877,7 +880,8 @@ SERVER."
PRESERVE-BUFFERS as in `eglot-shutdown', which see."
(interactive (list current-prefix-arg))
(cl-loop for ss being the hash-values of eglot--servers-by-project
- do (cl-loop for s in ss do (eglot-shutdown s nil
preserve-buffers))))
+ do (with-demoted-errors "[eglot] shutdown all: %s"
+ (cl-loop for s in ss do (eglot-shutdown s nil nil
preserve-buffers)))))
(defun eglot--on-shutdown (server)
"Called by jsonrpc.el when SERVER is already dead."
@@ -1200,7 +1204,8 @@ This docstring appeases checkdoc, that's all."
(pcase-let ((`(,connection . ,inferior)
(eglot--inferior-bootstrap
readable-name
- contact)))
+ contact
+ '(:noquery t))))
(setq autostart-inferior-process inferior)
connection))))
((stringp (car contact))
@@ -1244,7 +1249,7 @@ This docstring appeases checkdoc, that's all."
(setf (eglot--language-id server) language-id)
(setf (eglot--inferior-process server) autostart-inferior-process)
(run-hook-with-args 'eglot-server-initialized-hook server)
- ;; Now start the handshake. To honour `eglot-sync-connect'
+ ;; Now start the handshake. To honor `eglot-sync-connect'
;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
;; and mimic most of `jsonrpc-request'.
(unwind-protect
@@ -1425,7 +1430,8 @@ LBP defaults to `line-beginning-position'."
(defun eglot--pos-to-lsp-position (&optional pos)
"Convert point POS to LSP position."
(eglot--widening
- (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
+ ;; LSP line is zero-origin; emacs is one-origin.
+ (list :line (1- (line-number-at-pos pos t))
:character (progn (when pos (goto-char pos))
(funcall eglot-current-column-function)))))
@@ -1495,29 +1501,41 @@ If optional MARKER, return a marker instead"
(defun eglot--path-to-uri (path)
"URIfy PATH."
(let ((truepath (file-truename path)))
- (concat "file://"
- ;; Add a leading "/" for local MS Windows-style paths.
- (if (and (eq system-type 'windows-nt)
- (not (file-remote-p truepath)))
- "/")
- (url-hexify-string
- ;; Again watch out for trampy paths.
- (directory-file-name (file-local-name truepath))
- eglot--uri-path-allowed-chars))))
+ (if (url-type (url-generic-parse-url truepath))
+ ;; Path is already a URI, so forward it to the LSP server
+ ;; untouched. The server should be able to handle it, since
+ ;; it provided this URI to clients in the first place.
+ truepath
+ (concat "file://"
+ ;; Add a leading "/" for local MS Windows-style paths.
+ (if (and (eq system-type 'windows-nt)
+ (not (file-remote-p truepath)))
+ "/")
+ (url-hexify-string
+ ;; Again watch out for trampy paths.
+ (directory-file-name (file-local-name truepath))
+ eglot--uri-path-allowed-chars)))))
(defun eglot--uri-to-path (uri)
"Convert URI to file path, helped by `eglot--current-server'."
(when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
(let* ((server (eglot-current-server))
(remote-prefix (and server (eglot--trampish-p server)))
- (retval (url-unhex-string (url-filename (url-generic-parse-url uri))))
- ;; Remove the leading "/" for local MS Windows-style paths.
- (normalized (if (and (not remote-prefix)
- (eq system-type 'windows-nt)
- (cl-plusp (length retval)))
- (substring retval 1)
- retval)))
- (concat remote-prefix normalized)))
+ (url (url-generic-parse-url uri)))
+ ;; Only parse file:// URIs, leave other URI untouched as
+ ;; `file-name-handler-alist' should know how to handle them
+ ;; (bug#58790).
+ (if (string= "file" (url-type url))
+ (let* ((retval (url-unhex-string (url-filename url)))
+ ;; Remove the leading "/" for local MS Windows-style paths.
+ (normalized (if (and (not remote-prefix)
+ (eq system-type 'windows-nt)
+ (cl-plusp (length retval)))
+ (substring retval 1)
+ retval)))
+ (concat remote-prefix normalized))
+
+ uri)))
(defun eglot--snippet-expansion-fn ()
"Compute a function to expand snippets.
@@ -1658,7 +1676,7 @@ against a variable's name. Examples include the string
Before Eglot starts \"managing\" a particular buffer, it
opinionatedly sets some peripheral Emacs facilities, such as
Flymake, Xref and Company. These overriding settings help ensure
-consistent Eglot behaviour and only stay in place until
+consistent Eglot behavior and only stay in place until
\"managing\" stops (usually via `eglot-shutdown'), whereupon the
previous settings are restored.
@@ -1823,13 +1841,13 @@ If it is activated, also signal textDocument/didOpen."
(call-interactively what)
(force-mode-line-update t))))))
-(defun eglot-manual () "Open on-line documentation."
- (interactive) (browse-url "https://github.com/joaotavora/eglot#readme"))
+(defun eglot-manual () "Open documentation."
+ (declare (obsolete info "29.1"))
+ (interactive) (info "(eglot)"))
(easy-menu-define eglot-menu nil "Eglot"
`("Eglot"
;; Commands for getting information and customization.
- ["Read manual" eglot-manual]
["Customize Eglot" (lambda () (interactive) (customize-group "eglot"))]
"--"
;; xref like commands.
@@ -2350,10 +2368,11 @@ When called interactively, use the currently active
server"
(with-temp-buffer
(let* ((uri-path (eglot--uri-to-path scopeUri))
(default-directory
- (if (and (not (string-empty-p uri-path))
- (file-directory-p uri-path))
- (file-name-as-directory uri-path)
- (project-root (eglot--project server)))))
+ (if (and uri-path
+ (not (string-empty-p uri-path))
+ (file-directory-p uri-path))
+ (file-name-as-directory uri-path)
+ (project-root (eglot--project server)))))
(setq-local major-mode (car (eglot--major-modes server)))
(hack-dir-local-variables-non-file-buffer)
(cl-loop for (wsection o)
@@ -2916,7 +2935,7 @@ for which LSP on-type-formatting should be requested."
(let ((active-param (or activeParameter sig-help-active-param))
params-start params-end)
;; Ad-hoc attempt to parse label as <name>(<params>)
- (when (looking-at "\\([^(]+\\)(\\([^)]+\\))")
+ (when (looking-at "\\([^(]*\\)(\\([^)]+\\))")
(setq params-start (match-beginning 2) params-end (match-end 2))
(add-face-text-property (match-beginning 1) (match-end 1)
'font-lock-function-name-face))
@@ -3093,25 +3112,7 @@ Returns a list as described in docstring of
`imenu--index-alist'."
(save-excursion
(save-restriction
(narrow-to-region beg end)
-
- ;; On emacs versions < 26.2,
- ;; `replace-buffer-contents' is buggy - it calls
- ;; change functions with invalid arguments - so we
- ;; manually call the change functions here.
- ;;
- ;; See emacs bugs #32237, #32278:
- ;;
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237
- ;;
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278
- (let ((inhibit-modification-hooks t)
- (length (- end beg))
- (beg (marker-position beg))
- (end (marker-position end)))
- (run-hook-with-args 'before-change-functions
- beg end)
- (replace-buffer-contents temp)
- (run-hook-with-args 'after-change-functions
- beg (+ beg (length newText))
- length))))
+ (replace-buffer-contents temp)))
(progress-reporter-update reporter (cl-incf done)))))))
(mapcar (eglot--lambda ((TextEdit) range newText)
(cons newText (eglot--range-region range 'markers)))
@@ -3140,7 +3141,7 @@ Returns a list as described in docstring of
`imenu--index-alist'."
(unless (y-or-n-p
(format "[eglot] Server wants to edit:\n %s\n Proceed? "
(mapconcat #'identity (mapcar #'car prepared) "\n
")))
- (jsonrpc-error "User cancelled server edit")))
+ (jsonrpc-error "User canceled server edit")))
(cl-loop for edit in prepared
for (path edits version) = edit
do (with-current-buffer (find-file-noselect path)
@@ -3265,8 +3266,12 @@ at point. With prefix argument, prompt for ACTION-KIND."
(eglot-unregister-capability server method id)
(let* (success
(globs (mapcar
- (eglot--lambda ((FileSystemWatcher) globPattern)
- (eglot--glob-compile globPattern t t))
+ (eglot--lambda ((FileSystemWatcher) globPattern kind)
+ (cons (eglot--glob-compile globPattern t t)
+ ;; the default "7" means bitwise OR of
+ ;; WatchKind.Create (1), WatchKind.Change
+ ;; (2), WatchKind.Delete (4)
+ (or kind 7)))
watchers))
(dirs-to-watch
(delete-dups (mapcar #'file-name-directory
@@ -3275,17 +3280,20 @@ at point. With prefix argument, prompt for
ACTION-KIND."
(cl-labels
((handle-event
(event)
- (pcase-let ((`(,desc ,action ,file ,file1) event))
+ (pcase-let* ((`(,desc ,action ,file ,file1) event)
+ (action-type (cl-case action
+ (created 1) (changed 2) (deleted 3)))
+ (action-bit (when action-type
+ (ash 1 (1- action-type)))))
(cond
((and (memq action '(created changed deleted))
- (cl-find file globs :test (lambda (f g) (funcall g f))))
+ (cl-loop for (glob . kind-bitmask) in globs
+ thereis (and (> (logand kind-bitmask action-bit) 0)
+ (funcall glob file))))
(jsonrpc-notify
server :workspace/didChangeWatchedFiles
`(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
- :type ,(cl-case action
- (created 1)
- (changed 2)
- (deleted 3)))))))
+ :type ,action-type)))))
((eq action 'renamed)
(handle-event `(,desc 'deleted ,file))
(handle-event `(,desc 'created ,file1)))))))
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 85c5992998..cbdb0994cb 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,7 +1,6 @@
;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2022 Free
-;; Software Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -2006,16 +2005,15 @@ see the doc of that variable if you want to add names
to the list."
(set-buffer-modified-p nil)
(select-tags-table-mode))
-(defvar select-tags-table-mode-map ; Doc string?
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map button-buffer-map)
- (define-key map "t" 'push-button)
- (define-key map " " 'next-line)
- (define-key map "\^?" 'previous-line)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "q" 'select-tags-table-quit)
- map))
+(defvar-keymap select-tags-table-mode-map
+ :doc "Keymap for `select-tags-table-mode'."
+ :parent button-buffer-map
+ "t" #'push-button
+ "SPC" #'next-line
+ "DEL" #'previous-line
+ "n" #'next-line
+ "p" #'previous-line
+ "q" #'select-tags-table-quit)
(define-derived-mode select-tags-table-mode special-mode "Select Tags Table"
"Major mode for choosing a current tags table among those already loaded."
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 6de079f05a..00507a3c1a 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -31,14 +31,14 @@
;; are available, implementing block hiding and showing. They (and their
;; keybindings) are:
;;
-;; hs-hide-block C-c @ C-h
-;; hs-show-block C-c @ C-s
-;; hs-hide-all C-c @ C-M-h
-;; hs-show-all C-c @ C-M-s
-;; hs-hide-level C-c @ C-l
-;; hs-toggle-hiding C-c @ C-c
-;; hs-toggle-hiding [(shift mouse-2)]
-;; hs-hide-initial-comment-block
+;; `hs-hide-block' C-c @ C-h
+;; `hs-show-block' C-c @ C-s
+;; `hs-hide-all' C-c @ C-M-h
+;; `hs-show-all' C-c @ C-M-s
+;; `hs-hide-level' C-c @ C-l
+;; `hs-toggle-hiding' C-c @ C-c
+;; `hs-toggle-hiding' S-<mouse-2>
+;; `hs-hide-initial-comment-block'
;;
;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they
;; are simply text between curly braces, while in Lisp-ish modes parens
@@ -50,16 +50,14 @@
;; * Suggested usage
;;
-;; First make sure hideshow.el is in a directory in your `load-path'.
-;; You can optionally byte-compile it using `M-x byte-compile-file'.
-;; Then, add the following to your init file:
+;; Add the following to your init file:
;;
-;; (load-library "hideshow")
-;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly
+;; (require 'hideshow)
+;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly
;;
;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle
;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is
-;; activated or deactivated, `hs-minor-mode-hook' is run w/ `run-hooks'.
+;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'.
;;
;; Additionally, Joseph Eydelnant writes:
;; I enjoy your package hideshow.el Version 5.24 2001/02/13
@@ -67,14 +65,14 @@
;; toggle hide/show all with a single key.
;; Here are a few lines of code that lets me do just that.
;;
-;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.")
-;; ;;;###autoload
-;; (defun my-toggle-hideshow-all () "Toggle hideshow all."
-;; (interactive)
-;; (setq my-hs-hide (not my-hs-hide))
-;; (if my-hs-hide
-;; (hs-hide-all)
-;; (hs-show-all)))
+;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.")
+;; ;;;###autoload
+;; (defun my-toggle-hideshow-all () "Toggle hideshow all."
+;; (interactive)
+;; (setq my-hs-hide (not my-hs-hide))
+;; (if my-hs-hide
+;; (hs-hide-all)
+;; (hs-show-all)))
;;
;; [Your hideshow hacks here!]
@@ -82,12 +80,12 @@
;;
;; You can use `M-x customize-variable' on the following variables:
;;
-;; - hs-hide-comments-when-hiding-all -- self-explanatory!
-;; - hs-hide-all-non-comment-function -- if non-nil, when doing a
-;; `hs-hide-all', this function
-;; is called w/ no arguments
-;; - hs-isearch-open -- what kind of hidden blocks to
-;; open when doing isearch
+;; - `hs-hide-comments-when-hiding-all' -- self-explanatory!
+;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a
+;; `hs-hide-all', this function
+;; is called with no arguments
+;; - `hs-isearch-open' -- what kind of hidden blocks to
+;; open when doing isearch
;;
;; Some languages (e.g., Java) are deeply nested, so the normal behavior
;; of `hs-hide-all' (hiding all but top-level blocks) results in very
@@ -96,21 +94,21 @@
;; what is more useful. For example, the following code shows the next
;; nested level in addition to the top-level:
;;
-;; (defun ttn-hs-hide-level-1 ()
-;; (when (hs-looking-at-block-start-p)
-;; (hs-hide-level 1))
-;; (forward-sexp 1))
-;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
+;; (defun ttn-hs-hide-level-1 ()
+;; (when (hs-looking-at-block-start-p)
+;; (hs-hide-level 1))
+;; (forward-sexp 1))
+;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
;;
-;; Hideshow works w/ incremental search (isearch) by setting the variable
+;; Hideshow works with incremental search (isearch) by setting the variable
;; `hs-headline', which is the line of text at the beginning of a hidden
;; block that contains a match for the search. You can have this show up
;; in the mode line by modifying the variable `mode-line-format'. For
;; example, the following code prepends this info to the mode line:
;;
-;; (unless (memq 'hs-headline mode-line-format)
-;; (setq mode-line-format
-;; (append '("-" hs-headline) mode-line-format)))
+;; (unless (memq 'hs-headline mode-line-format)
+;; (setq mode-line-format
+;; (append '("-" hs-headline) mode-line-format)))
;;
;; See documentation for `mode-line-format' for more info.
;;
@@ -121,8 +119,8 @@
;;
;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling
;; commands when the result of the toggle is to hide or show blocks,
-;; respectively. All hooks are run w/ `run-hooks'. See docs for each
-;; variable or hook for more info.
+;; respectively. All hooks are run with `run-hooks'. See the
+;; documentation for each variable or hook for more information.
;;
;; Normally, hideshow tries to determine appropriate values for block
;; and comment definitions by examining the buffer's major mode. If
@@ -348,22 +346,20 @@ info node `(elisp)Overlays'."
"Non-nil if using hideshow mode as a minor mode of some other mode.
Use the command `hs-minor-mode' to toggle or set this variable.")
-(defvar hs-minor-mode-map
- (let ((map (make-sparse-keymap)))
- ;; These bindings roughly imitate those used by Outline mode.
- (define-key map "\C-c@\C-h" #'hs-hide-block)
- (define-key map "\C-c@\C-s" #'hs-show-block)
- (define-key map "\C-c@\C-\M-h" #'hs-hide-all)
- (define-key map "\C-c@\C-\M-s" #'hs-show-all)
- (define-key map "\C-c@\C-l" #'hs-hide-level)
- (define-key map "\C-c@\C-c" #'hs-toggle-hiding)
- (define-key map "\C-c@\C-a" #'hs-show-all)
- (define-key map "\C-c@\C-t" #'hs-hide-all)
- (define-key map "\C-c@\C-d" #'hs-hide-block)
- (define-key map "\C-c@\C-e" #'hs-toggle-hiding)
- (define-key map [(shift mouse-2)] #'hs-toggle-hiding)
- map)
- "Keymap for hideshow minor mode.")
+(defvar-keymap hs-minor-mode-map
+ :doc "Keymap for hideshow minor mode."
+ ;; These bindings roughly imitate those used by Outline mode.
+ "C-c @ C-h" #'hs-hide-block
+ "C-c @ C-s" #'hs-show-block
+ "C-c @ C-M-h" #'hs-hide-all
+ "C-c @ C-M-s" #'hs-show-all
+ "C-c @ C-l" #'hs-hide-level
+ "C-c @ C-c" #'hs-toggle-hiding
+ "C-c @ C-a" #'hs-show-all
+ "C-c @ C-t" #'hs-hide-all
+ "C-c @ C-d" #'hs-hide-block
+ "C-c @ C-e" #'hs-toggle-hiding
+ "S-<mouse-2>" #'hs-toggle-hiding)
(easy-menu-define hs-minor-mode-menu hs-minor-mode-map
"Menu used when hideshow minor mode is active."
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index 9d1ceaa55a..358b347f6e 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -33,9 +33,6 @@
;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and
;; `https://ftp.gnu.org/pub/gnu/mdk'.
;;
-;; To use this mode, place the following in your init file:
-;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'.
-;;
;; When you load a file with the extension .mixal the mode will be started
;; automatically. If you want to start the mode manually, use `M-x
mixal-mode'.
;; Font locking will work, the behavior of tabs is the same as Emacs's
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 18b9899169..bce5bc3ba7 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1,6 +1,6 @@
;;; octave.el --- editing octave source files under emacs -*-
lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
;; John Eaton <jwe@octave.org>
@@ -65,43 +65,39 @@ The string `function' and its name are given by the first
and third
parenthetical grouping.")
-(defvar octave-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\M-." 'octave-find-definition)
- (define-key map "\M-\C-j" 'octave-indent-new-comment-line)
- (define-key map "\C-c\C-p" 'octave-previous-code-line)
- (define-key map "\C-c\C-n" 'octave-next-code-line)
- (define-key map "\C-c\C-a" 'octave-beginning-of-line)
- (define-key map "\C-c\C-e" 'octave-end-of-line)
- (define-key map [remap down-list] 'smie-down-list)
- (define-key map "\C-c\M-\C-h" 'octave-mark-block)
- (define-key map "\C-c]" 'smie-close-block)
- (define-key map "\C-c/" 'smie-close-block)
- (define-key map "\C-c;" 'octave-update-function-file-comment)
- (define-key map "\C-hd" 'octave-help)
- (define-key map "\C-ha" 'octave-lookfor)
- (define-key map "\C-c\C-l" 'octave-source-file)
- (define-key map "\C-c\C-f" 'octave-insert-defun)
- (define-key map "\C-c\C-il" 'octave-send-line)
- (define-key map "\C-c\C-ib" 'octave-send-block)
- (define-key map "\C-c\C-if" 'octave-send-defun)
- (define-key map "\C-c\C-ir" 'octave-send-region)
- (define-key map "\C-c\C-ia" 'octave-send-buffer)
- (define-key map "\C-c\C-is" 'octave-show-process-buffer)
- (define-key map "\C-c\C-iq" 'octave-hide-process-buffer)
- (define-key map "\C-c\C-ik" 'octave-kill-process)
- (define-key map "\C-c\C-i\C-l" 'octave-send-line)
- (define-key map "\C-c\C-i\C-b" 'octave-send-block)
- (define-key map "\C-c\C-i\C-f" 'octave-send-defun)
- (define-key map "\C-c\C-i\C-r" 'octave-send-region)
- (define-key map "\C-c\C-i\C-a" 'octave-send-buffer)
- (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer)
- (define-key map "\C-c\C-i\C-q" 'octave-hide-process-buffer)
- (define-key map "\C-c\C-i\C-k" 'octave-kill-process)
- map)
- "Keymap used in Octave mode.")
-
-
+(defvar-keymap octave-mode-map
+ :doc "Keymap used in Octave mode."
+ "M-." #'octave-find-definition
+ "C-M-j" #'octave-indent-new-comment-line
+ "C-c C-p" #'octave-previous-code-line
+ "C-c C-n" #'octave-next-code-line
+ "C-c C-a" #'octave-beginning-of-line
+ "C-c C-e" #'octave-end-of-line
+ "<remap> <down-list>" #'smie-down-list
+ "C-c C-M-h" #'octave-mark-block
+ "C-c ]" #'smie-close-block
+ "C-c /" #'smie-close-block
+ "C-c ;" #'octave-update-function-file-comment
+ "C-h d" #'octave-help
+ "C-h a" #'octave-lookfor
+ "C-c C-l" #'octave-source-file
+ "C-c C-f" #'octave-insert-defun
+ "C-c C-i l" #'octave-send-line
+ "C-c C-i b" #'octave-send-block
+ "C-c C-i f" #'octave-send-defun
+ "C-c C-i r" #'octave-send-region
+ "C-c C-i a" #'octave-send-buffer
+ "C-c C-i s" #'octave-show-process-buffer
+ "C-c C-i q" #'octave-hide-process-buffer
+ "C-c C-i k" #'octave-kill-process
+ "C-c C-i C-l" #'octave-send-line
+ "C-c C-i C-b" #'octave-send-block
+ "C-c C-i C-f" #'octave-send-defun
+ "C-c C-i C-r" #'octave-send-region
+ "C-c C-i C-a" #'octave-send-buffer
+ "C-c C-i C-s" #'octave-show-process-buffer
+ "C-c C-i C-q" #'octave-hide-process-buffer
+ "C-c C-i C-k" #'octave-kill-process)
(easy-menu-define octave-mode-menu octave-mode-map
"Menu for Octave mode."
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index db9df67279..4dd0fd67a6 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -27,8 +27,8 @@
;;; Commentary:
-;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
-;; to your init file and change the first line of your perl script to:
+;; To enter `perl-mode' automatically, change the first line of your
+;; perl script to:
;; #!/usr/bin/perl -- # -*-Perl-*-
;; With arguments to perl:
;; #!/usr/bin/perl -P- # -*-Perl-*-
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ac278edd40..ed26872ae7 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
-;; Version: 0.8.2
+;; Version: 0.8.3
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -296,7 +296,6 @@ to find the list of ignores for each directory."
(defun project--files-in-directory (dir ignores &optional files)
(require 'find-dired)
(require 'xref)
- (defvar find-name-arg)
(let* ((default-directory dir)
;; Make sure ~/ etc. in local directory name is
;; expanded and not left for the shell command
@@ -308,11 +307,11 @@ to find the list of ignores for each directory."
(xref--find-ignores-arguments ignores "./")
(if files
(concat (shell-quote-argument "(")
- " " find-name-arg " "
+ " -name "
(mapconcat
#'shell-quote-argument
(split-string files)
- (concat " -o " find-name-arg " "))
+ (concat " -o -name "))
" "
(shell-quote-argument ")"))
"")))
@@ -353,7 +352,10 @@ Also quote LOCAL-FILES if `default-directory' is quoted."
local-files))))
(cl-defgeneric project-buffers (project)
- "Return the list of all live buffers that belong to PROJECT."
+ "Return the list of all live buffers that belong to PROJECT.
+
+The default implementation matches each buffer to PROJECT root using
+the buffer's value of `default-directory'."
(let ((root (expand-file-name (file-name-as-directory (project-root
project))))
bufs)
(dolist (buf (buffer-list))
@@ -1222,11 +1224,14 @@ displayed."
(defcustom project-kill-buffer-conditions
'(buffer-file-name ; All file-visiting buffers are included.
- ;; Most of the temp buffers in the background:
- (major-mode . fundamental-mode)
+ ;; Most of temp and logging buffers (aside from hidden ones):
+ (and
+ (major-mode . fundamental-mode)
+ "\\`[^ ]")
;; non-text buffer such as xref, occur, vc, log, ...
(and (derived-mode . special-mode)
- (not (major-mode . help-mode)))
+ (not (major-mode . help-mode))
+ (not (derived-mode . gnus-mode)))
(derived-mode . compilation-mode)
(derived-mode . dired-mode)
(derived-mode . diff-mode)
@@ -1277,21 +1282,6 @@ Used by `project-kill-buffers'."
:package-version '(project . "0.8.2")
:safe #'booleanp)
-(defun project--buffer-list (pr)
- "Return the list of all buffers in project PR."
- (let ((conn (file-remote-p (project-root pr)))
- bufs)
- (dolist (buf (buffer-list))
- ;; For now we go with the assumption that a project must reside
- ;; entirely on one host. We might relax that in the future.
- (when (and (equal conn
- (file-remote-p (buffer-local-value 'default-directory
buf)))
- (equal pr
- (with-current-buffer buf
- (project-current))))
- (push buf bufs)))
- (nreverse bufs)))
-
(defun project--buffer-check (buf conditions)
"Check if buffer BUF matches any element of the list CONDITIONS.
See `project-kill-buffer-conditions' or
@@ -1667,9 +1657,10 @@ to directory DIR."
(let ((command (if (symbolp project-switch-commands)
project-switch-commands
(project--switch-project-command))))
- (let ((default-directory dir)
- (project-current-inhibit-prompt t))
- (call-interactively command))))
+ (with-temp-buffer
+ (let ((default-directory dir)
+ (project-current-inhibit-prompt t))
+ (call-interactively command)))))
(provide 'project)
;;; project.el ends here
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 89482d86ce..6355b17e4a 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -278,24 +278,22 @@ If nil, use `temporary-file-directory'."
;; Variables.
-(defvar ps-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-v" #'ps-run-boundingbox)
- (define-key map "\C-c\C-u" #'ps-mode-uncomment-region)
- (define-key map "\C-c\C-t" #'ps-mode-epsf-rich)
- (define-key map "\C-c\C-s" #'ps-run-start)
- (define-key map "\C-c\C-r" #'ps-run-region)
- (define-key map "\C-c\C-q" #'ps-run-quit)
- (define-key map "\C-c\C-p" #'ps-mode-print-buffer)
- (define-key map "\C-c\C-o" #'ps-mode-comment-out-region)
- (define-key map "\C-c\C-k" #'ps-run-kill)
- (define-key map "\C-c\C-j" #'ps-mode-other-newline)
- (define-key map "\C-c\C-l" #'ps-run-clear)
- (define-key map "\C-c\C-b" #'ps-run-buffer)
- ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
- (define-key map "\177" #'ps-mode-backward-delete-char)
- map)
- "Local keymap to use in PostScript mode.")
+(defvar-keymap ps-mode-map
+ :doc "Local keymap to use in PostScript mode."
+ "C-c C-v" #'ps-run-boundingbox
+ "C-c C-u" #'ps-mode-uncomment-region
+ "C-c C-t" #'ps-mode-epsf-rich
+ "C-c C-s" #'ps-run-start
+ "C-c C-r" #'ps-run-region
+ "C-c C-q" #'ps-run-quit
+ "C-c C-p" #'ps-mode-print-buffer
+ "C-c C-o" #'ps-mode-comment-out-region
+ "C-c C-k" #'ps-run-kill
+ "C-c C-j" #'ps-mode-other-newline
+ "C-c C-l" #'ps-run-clear
+ "C-c C-b" #'ps-run-buffer
+ ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
+ "DEL" #'ps-mode-backward-delete-char)
(defvar ps-mode-syntax-table
(let ((st (make-syntax-table)))
@@ -332,15 +330,13 @@ If nil, use `temporary-file-directory'."
st)
"Syntax table used while in PostScript mode.")
-(defvar ps-run-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map comint-mode-map)
- (define-key map "\C-c\C-q" #'ps-run-quit)
- (define-key map "\C-c\C-k" #'ps-run-kill)
- (define-key map "\C-c\C-e" #'ps-run-goto-error)
- (define-key map [mouse-2] #'ps-run-mouse-goto-error)
- map)
- "Local keymap to use in PostScript run mode.")
+(defvar-keymap ps-run-mode-map
+ :doc "Local keymap to use in PostScript run mode."
+ :parent comint-mode-map
+ "C-c C-q" #'ps-run-quit
+ "C-c C-k" #'ps-run-kill
+ "C-c C-e" #'ps-run-goto-error
+ "<mouse-2>" #'ps-run-mouse-goto-error)
(defvar ps-mode-tmp-file nil
"Name of temporary file, set by `ps-run'.")
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index cec0d54a44..a734e06149 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -5377,6 +5377,7 @@ likely an invalid python file."
;; block and the current line, otherwise it
;; is not an opening block.
(save-excursion
+ (python-nav-end-of-statement)
(forward-line)
(let ((no-back-indent t))
(save-match-data
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index 7e9aeab8fe..9aa8a994ed 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -1,7 +1,6 @@
;;; simula.el --- SIMULA 87 code editing commands for Emacs -*-
lexical-binding: t; -*-
-;; Copyright (C) 1992, 1994, 1996, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
;; Maintainer: emacs-devel@gnu.org
@@ -246,31 +245,19 @@ for SIMULA mode to function correctly."
(defvar simula-font-lock-keywords simula-font-lock-keywords-1
"Default expressions to highlight in Simula mode.")
-; The following function is taken from cc-mode.el,
-; it determines the flavor of the Emacs running
-
-(defvar simula-mode-menu
- '(["Indent Line" simula-indent-line t]
- ["Backward Statement" simula-previous-statement t]
- ["Forward Statement" simula-next-statement t]
- ["Backward Up Level" simula-backward-up-level t]
- ["Forward Down Statement" simula-forward-down-level t])
- "Emacs menu for SIMULA mode.")
-
-(defvar simula-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-u" #'simula-backward-up-level)
- (define-key map "\C-c\C-p" #'simula-previous-statement)
- (define-key map "\C-c\C-d" #'simula-forward-down-level)
- (define-key map "\C-c\C-n" #'simula-next-statement)
- ;; (define-key map "\C-c\C-g" #'simula-goto-definition)
- ;; (define-key map "\C-c\C-h" #'simula-standard-help)
- (define-key map "\177" #'backward-delete-char-untabify)
- (define-key map ":" #'simula-electric-label)
- (define-key map "\e\C-q" #'simula-indent-exp)
- ;; (define-key map "\t" #'simula-indent-command)
- map)
- "Keymap used in `simula-mode'.")
+(defvar-keymap simula-mode-map
+ :doc "Keymap used in `simula-mode'."
+ "C-c C-u" #'simula-backward-up-level
+ "C-c C-p" #'simula-previous-statement
+ "C-c C-d" #'simula-forward-down-level
+ "C-c C-n" #'simula-next-statement
+ ;; "C-c C-g" #'simula-goto-definition
+ ;; "C-c C-h" #'simula-standard-help
+ "DEL" #'backward-delete-char-untabify
+ ":" #'simula-electric-label
+ "C-M-q" #'simula-indent-exp
+ ;; "TAB" #'simula-indent-command
+ )
(easy-menu-define simula-mode-menu simula-mode-map
"Menu for `simula-mode'."
@@ -1560,7 +1547,6 @@ If not nil and not t, move to limit of search and return
nil."
(let (abbrevs-changed)
(simula-install-standard-abbrevs))
-;; Hilit mode support.
;; obsolete
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index b950f93f2a..a1c0aa76de 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1358,37 +1358,33 @@ specified, it's `sql-product' or `sql-connection' must
match."
;; Keymap for sql-interactive-mode.
-(defvar sql-interactive-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map comint-mode-map)
- (define-key map (kbd "C-j") 'sql-accumulate-and-indent)
- (define-key map (kbd "C-c C-w") 'sql-copy-column)
- (define-key map (kbd "O") 'sql-magic-go)
- (define-key map (kbd "o") 'sql-magic-go)
- (define-key map (kbd ";") 'sql-magic-semicolon)
- (define-key map (kbd "C-c C-l a") 'sql-list-all)
- (define-key map (kbd "C-c C-l t") 'sql-list-table)
- map)
- "Mode map used for `sql-interactive-mode'.
-Based on `comint-mode-map'.")
+(defvar-keymap sql-interactive-mode-map
+ :doc "Mode map used for `sql-interactive-mode'.
+Based on `comint-mode-map'."
+ :parent comint-mode-map
+ "C-j" #'sql-accumulate-and-indent
+ "C-c C-w" #'sql-copy-column
+ "O" #'sql-magic-go
+ "o" #'sql-magic-go
+ ";" #'sql-magic-semicolon
+ "C-c C-l a" #'sql-list-all
+ "C-c C-l t" #'sql-list-table)
;; Keymap for sql-mode.
-(defvar sql-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") 'sql-send-paragraph)
- (define-key map (kbd "C-c C-r") 'sql-send-region)
- (define-key map (kbd "C-c C-s") 'sql-send-string)
- (define-key map (kbd "C-c C-b") 'sql-send-buffer)
- (define-key map (kbd "C-c C-n") 'sql-send-line-and-next)
- (define-key map (kbd "C-c C-i") 'sql-product-interactive)
- (define-key map (kbd "C-c C-z") 'sql-show-sqli-buffer)
- (define-key map (kbd "C-c C-l a") 'sql-list-all)
- (define-key map (kbd "C-c C-l t") 'sql-list-table)
- (define-key map [remap beginning-of-defun] 'sql-beginning-of-statement)
- (define-key map [remap end-of-defun] 'sql-end-of-statement)
- map)
- "Mode map used for `sql-mode'.")
+(defvar-keymap sql-mode-map
+ :doc "Mode map used for `sql-mode'."
+ "C-c C-c" #'sql-send-paragraph
+ "C-c C-r" #'sql-send-region
+ "C-c C-s" #'sql-send-string
+ "C-c C-b" #'sql-send-buffer
+ "C-c C-n" #'sql-send-line-and-next
+ "C-c C-i" #'sql-product-interactive
+ "C-c C-z" #'sql-show-sqli-buffer
+ "C-c C-l a" #'sql-list-all
+ "C-c C-l t" #'sql-list-table
+ "<remap> <beginning-of-defun>" #'sql-beginning-of-statement
+ "<remap> <end-of-defun>" #'sql-end-of-statement)
;; easy menu for sql-mode.
@@ -3030,9 +3026,10 @@ displayed."
;; Our start must be between them
(goto-char last)
- ;; Find a beginning-of-stmt that's not in a comment
+ ;; Find a beginning-of-stmt that's not in a string or comment
(while (and (re-search-forward regexp next t 1)
- (nth 7 (syntax-ppss)))
+ (or (nth 3 (syntax-ppss))
+ (nth 7 (syntax-ppss))))
(goto-char (match-end 0)))
(goto-char
(if (match-data)
@@ -3062,8 +3059,9 @@ displayed."
;; If we found another end-of-stmt
(if (not (apply re-search term nil t n nil))
(setq arg 0)
- ;; count it if we're not in a comment
- (unless (nth 7 (syntax-ppss))
+ ;; count it if we're not in a string or comment
+ (unless (or (nth 3 (syntax-ppss))
+ (nth 7 (syntax-ppss)))
(setq arg (- arg (cl-signum arg))))))
(goto-char (if (match-data)
(match-end 0)
diff --git a/lisp/replace.el b/lisp/replace.el
index 8f81ec33a6..c7ae77d128 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2818,7 +2818,7 @@ see the documentation of `replace-match' to find out how
to simulate
`case-replace'.
This function returns nil if there were no matches to make, or
-the user cancelled the call.
+the user canceled the call.
REPLACEMENTS is either a string, a list of strings, or a cons cell
containing a function and its first argument. The function is
diff --git a/lisp/rot13.el b/lisp/rot13.el
index c063725de8..5d1c46e483 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -85,9 +85,16 @@ and END, and return the encrypted string."
;;;###autoload
(defun rot13-region (start end)
- "ROT13 encrypt the region between START and END in current buffer."
+ "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."
(interactive "r")
- (translate-region start end rot13-translate-table))
+ (condition-case nil
+ (translate-region start end rot13-translate-table)
+ (buffer-read-only
+ (when (called-interactively-p 'interactive)
+ (let ((dec (rot13-string (buffer-substring start end))))
+ (message "Buffer is read-only:\n%s" (string-trim dec)))))))
;;;###autoload
(defun rot13-other-window ()
diff --git a/lisp/savehist.el b/lisp/savehist.el
index 8924c8dde2..f1d3e50d94 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -1,6 +1,6 @@
;;; savehist.el --- Save minibuffer history -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2005-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com>
;; Maintainer: emacs-devel@gnu.org
@@ -41,10 +41,6 @@
;; You can also explicitly save history with `M-x savehist-save' and
;; load it by loading the `savehist-file' with `M-x load-file'.
-;; If you are using a version of Emacs that does not ship with this
-;; package, be sure to have `savehist.el' in a directory that is in
-;; your load-path, and to byte-compile it.
-
;;; Code:
;; User variables
diff --git a/lisp/simple.el b/lisp/simple.el
index e804f717b0..a53b7b1d0d 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2491,9 +2491,14 @@ Also see `suggest-key-bindings'."
(defvar execute-extended-command--binding-timer nil)
+(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)))))
+
(defun execute-extended-command (prefixarg &optional command-name typed)
- ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
- ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
"Read a command name, then read the arguments and call the command.
To pass a prefix argument to the command you are
invoking, give a prefix argument to `execute-extended-command'."
@@ -2516,7 +2521,7 @@ invoking, give a prefix argument to
`execute-extended-command'."
(not executing-kbd-macro)
(where-is-internal function overriding-local-map t)))
(delay-before-suggest 0)
- (find-shorter nil))
+ find-shorter shorter)
(unless (commandp function)
(error "`%s' is not a valid command name" command-name))
;; If we're executing a command that's remapped, we can't actually
@@ -2540,11 +2545,11 @@ invoking, give a prefix argument to
`execute-extended-command'."
;; flight.
(when execute-extended-command--binding-timer
(cancel-timer execute-extended-command--binding-timer))
- ;; If this command displayed something in the echo area, then
- ;; postpone the display of our suggestion message a bit.
(when (and suggest-key-bindings
(or binding
(and extended-command-suggest-shorter typed)))
+ ;; If this command displayed something in the echo area, then
+ ;; postpone the display of our suggestion message a bit.
(setq delay-before-suggest
(cond
((zerop (length (current-message))) 0)
@@ -2556,7 +2561,7 @@ invoking, give a prefix argument to
`execute-extended-command'."
(symbolp function)
(> (length (symbol-name function)) 2))
;; There's no binding for CMD. Let's try and find the shortest
- ;; string to use in M-x.
+ ;; string to use in M-x. But don't actually do anything yet.
(setq find-shorter t))
(when (or binding find-shorter)
(setq execute-extended-command--binding-timer
@@ -2570,15 +2575,12 @@ invoking, give a prefix argument to
`execute-extended-command'."
(when find-shorter
(while-no-input
;; FIXME: Can be slow. Cache it maybe?
- (setq binding (execute-extended-command--shorter
+ (setq shorter (execute-extended-command--shorter
(symbol-name function) typed))))
- (when binding
+ (when (or binding shorter)
(with-temp-message
- (format-message "You can run the command `%s' with %s"
- function
- (if (stringp binding)
- (concat "M-x " binding " RET")
- (key-description binding)))
+ (execute-extended-command--describe-binding-msg
+ function binding shorter)
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))))))
@@ -2647,10 +2649,7 @@ function as needed."
((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
`(autoload ,_file . ,body))
(let ((doc (car body)))
- (when (and (funcall docstring-p doc)
- ;; Handle a doc reference--but these never come last
- ;; in the function body, so reject them if they are last.
- (or (cdr body) (eq 'autoload (car-safe function))))
+ (when (funcall docstring-p doc)
doc)))
(_ (signal 'invalid-function (list function))))))
diff --git a/lisp/subr.el b/lisp/subr.el
index 83e2e75c41..6b83196d05 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -161,16 +161,18 @@ of previous VARs.
`(progn . ,(nreverse exps))))
(defmacro setq-local (&rest pairs)
- "Make variables in PAIRS buffer-local and assign them the corresponding
values.
+ "Make each VARIABLE buffer-local and assign to it the corresponding VALUE.
-PAIRS is a list of variable/value pairs. For each variable, make
-it buffer-local and assign it the corresponding value. The
-variables are literal symbols and should not be quoted.
+The arguments are variable/value pairs For each VARIABLE in a pair,
+make VARIABLE buffer-local and assign to it the corresponding VALUE
+of the pair. The VARIABLEs are literal symbols and should not be quoted.
-The second VALUE is not computed until after the first VARIABLE
-is set, and so on; each VALUE can use the new value of variables
-set earlier in the `setq-local'. The return value of the
-`setq-local' form is the value of the last VALUE.
+The VALUE of the Nth pair is not computed until after the VARIABLE
+of the (N-1)th pair is set; thus, each VALUE can use the new VALUEs
+of VARIABLEs set by earlier pairs.
+
+The return value of the `setq-local' form is the VALUE of the last
+pair.
\(fn [VARIABLE VALUE]...)"
(declare (debug setq))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 9c746b8978..eb4cec4861 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -933,7 +933,9 @@ when the tab is current. Return the result as a keymap."
(let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format)))
(rest (tab-bar-format-list rest))
(rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
- (hpos (string-pixel-width (propertize rest 'face 'tab-bar)))
+ (hpos (progn
+ (add-face-text-property 0 (length rest) 'tab-bar t rest)
+ (string-pixel-width rest)))
(str (propertize " " 'display `(space :align-to (- right (,hpos))))))
`((align-right menu-item ,str ignore))))
@@ -963,7 +965,146 @@ on the tab bar instead."
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
- (append tab-bar-map (tab-bar-format-list tab-bar-format)))
+ (let ((items (tab-bar-format-list tab-bar-format)))
+ (when tab-bar-auto-width
+ (setq items (tab-bar-auto-width items)))
+ (append tab-bar-map items)))
+
+
+(defcustom tab-bar-auto-width t
+ "Automatically resize width of tabs on tab bar to fill available tab-bar
space.
+When non-nil, the widths of the tabs on the tab bar are
+automatically resized so that their width is evenly distributed
+across the tab bar. This keeps the widths of the tabs
+independent of the length of the buffer names shown on each tab;
+the tab widths change only when tabs are added or deleted, or
+when the frame's dimensions change. This also avoids as much as
+possible wrapping a long tab bar to a second tab-bar line.
+
+The automatic resizing of tabs takes place as long as tabs are no
+wider than allowed by the value of `tab-bar-auto-width-max', and
+at least as wide as specified by the value of
+`tab-bar-auto-width-min'.
+
+When this variable is nil, the width of each tab is determined by the
+length of the tab's name."
+ :type 'boolean
+ :group 'tab-bar
+ :version "29.1")
+
+(defcustom tab-bar-auto-width-max '(220 20)
+ "Maximum width for automatic resizing of width of tab-bar tabs.
+This determines the maximum width of tabs before their names will be
+truncated on display.
+The value should be a list of two numbers: the first is the maximum
+width of tabs in pixels for GUI frames, the second is the maximum
+width of tabs in characters on TTY frames.
+If the value of this variable is nil, there is no limit on maximum
+width.
+This variable has effect only when `tab-bar-auto-width' is non-nil."
+ :type '(choice
+ (const :tag "No limit" nil)
+ (list (integer :tag "Max width (pixels)" :value 220)
+ (integer :tag "Max width (chars)" :value 20)))
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (setq tab-bar--fixed-width-hash nil))
+ :group 'tab-bar
+ :version "29.1")
+
+(defvar tab-bar-auto-width-min '(20 2)
+ "Minimum width of tabs for automatic resizing under `tab-bar-auto-width'.
+The value should be a list of two numbers, giving the minimum width
+as the number of pixels for GUI frames and the number of characters
+for text-mode frames. Tabs whose width is smaller than this will not
+be narrowed.
+It's not recommended to change this value since with larger values, the
+tab bar might wrap to the second line when it shouldn't.")
+
+(defvar tab-bar-auto-width-faces
+ '( tab-bar-tab tab-bar-tab-inactive
+ tab-bar-tab-ungrouped
+ tab-bar-tab-group-inactive)
+ "Resize tabs only with these faces.")
+
+(defvar tab-bar--fixed-width-hash nil
+ "Memoization table for `tab-bar-auto-width'.")
+
+(defun tab-bar-auto-width (items)
+ "Return tab-bar items with resized tab names."
+ (unless tab-bar--fixed-width-hash
+ (define-hash-table-test 'tab-bar--fixed-width-hash-test
+ #'equal-including-properties
+ #'sxhash-equal-including-properties)
+ (setq tab-bar--fixed-width-hash
+ (make-hash-table :test 'tab-bar--fixed-width-hash-test)))
+ (let ((tabs nil) ;; list of resizable tabs
+ (non-tabs "") ;; concatenated names of non-resizable tabs
+ (width 0)) ;; resize tab names to this width
+ (dolist (item items)
+ (when (and (eq (nth 1 item) 'menu-item) (stringp (nth 2 item)))
+ (if (memq (get-text-property 0 'face (nth 2 item))
+ tab-bar-auto-width-faces)
+ (push item tabs)
+ (unless (eq (nth 0 item) 'align-right)
+ (setq non-tabs (concat non-tabs (nth 2 item)))))))
+ (when tabs
+ (add-face-text-property 0 (length non-tabs) 'tab-bar t non-tabs)
+ (setq width (/ (- (frame-inner-width)
+ (string-pixel-width non-tabs))
+ (length tabs)))
+ (when tab-bar-auto-width-min
+ (setq width (max width (if window-system
+ (nth 0 tab-bar-auto-width-min)
+ (nth 1 tab-bar-auto-width-min)))))
+ (when tab-bar-auto-width-max
+ (setq width (min width (if window-system
+ (nth 0 tab-bar-auto-width-max)
+ (nth 1 tab-bar-auto-width-max)))))
+ (dolist (item tabs)
+ (setf (nth 2 item)
+ (with-memoization (gethash (list (selected-frame)
+ width (nth 2 item))
+ tab-bar--fixed-width-hash)
+ (let* ((name (nth 2 item))
+ (len (length name))
+ (close-p (get-text-property (1- len) 'close-tab name))
+ (continue t)
+ (prev-width (string-pixel-width name))
+ curr-width)
+ (cond
+ ((< prev-width width)
+ (let* ((space (apply 'propertize " "
+ (text-properties-at 0 name)))
+ (ins-pos (- len (if close-p 1 0)))
+ (prev-name name))
+ (while continue
+ (setf (substring name ins-pos ins-pos) space)
+ (setq curr-width (string-pixel-width name))
+ (if (and (< curr-width width)
+ (not (eq curr-width prev-width)))
+ (setq prev-width curr-width
+ prev-name name)
+ ;; Set back a shorter name
+ (setq name prev-name
+ continue nil)))))
+ ((> prev-width width)
+ (let ((del-pos1 (if close-p -2 -1))
+ (del-pos2 (if close-p -1 nil)))
+ (while continue
+ (setf (substring name del-pos1 del-pos2) "")
+ (setq curr-width (string-pixel-width name))
+ (if (and (> curr-width width)
+ (not (eq curr-width prev-width)))
+ (setq prev-width curr-width)
+ (setq continue nil)))
+ (let* ((len (length name))
+ (pos (- len (if close-p 1 0))))
+ (add-face-text-property
+ (max 0 (- pos 2)) (max 0 pos) 'shadow nil name)))))
+ name)))))
+ items))
;; Some window-configuration parameters don't need to be persistent.
@@ -1110,7 +1251,8 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(to-number (cond ((< tab-number 0) (+ (length tabs) (1+ tab-number)))
((zerop tab-number) (1+ from-index))
(t tab-number)))
- (to-index (1- (max 1 (min to-number (length tabs))))))
+ (to-index (1- (max 1 (min to-number (length tabs)))))
+ (minibuffer-was-active (minibuffer-window-active-p
(selected-window))))
(unless (eq from-index to-index)
(let* ((from-tab (tab-bar--tab))
@@ -1136,7 +1278,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(wc-history-back (alist-get 'wc-history-back to-tab))
(wc-history-forward (alist-get 'wc-history-forward to-tab)))
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
;; set-window-configuration does not restore the value of
;; point in the current buffer, so restore it separately.
@@ -1164,8 +1306,22 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
tab-bar-history-forward))))
(ws
+ ;; `window-state-put' fails when called in the minibuffer
+ (when (minibuffer-selected-window)
+ (select-window (minibuffer-selected-window)))
(window-state-put ws nil 'safe)))
+ ;; Select the minibuffer when it was active before switching tabs
+ (when (and minibuffer-was-active (active-minibuffer-window))
+ (select-window (active-minibuffer-window)))
+
+ ;; When the minibuffer was activated in one tab, but exited in
+ ;; another tab, then after going back to the first tab, it has
+ ;; such inconsistent state that the current buffer is the minibuffer,
+ ;; but its window is not active. So try to undo this mess.
+ (when (and (minibufferp) (not (active-minibuffer-window)))
+ (other-window 1))
+
(when tab-bar-history-mode
(setq tab-bar-history-omit t))
@@ -1900,7 +2056,7 @@ This navigates back in the history of window
configurations."
(cons tab-bar-history-old
(gethash (selected-frame) tab-bar-history-forward))
tab-bar-history-forward)
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
(when (and (markerp wc-point) (marker-buffer wc-point))
(goto-char wc-point)))
(message "No more tab back history"))))
@@ -1919,7 +2075,7 @@ This navigates forward in the history of window
configurations."
(cons tab-bar-history-old
(gethash (selected-frame) tab-bar-history-back))
tab-bar-history-back)
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
(when (and (markerp wc-point) (marker-buffer wc-point))
(goto-char wc-point)))
(message "No more tab forward history"))))
@@ -2192,7 +2348,7 @@ with those specified by the selected window
configuration."
((framep all-frames) (list all-frames))
(t (list (selected-frame)))))
-(defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames
ignore-current-tab)
+(defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames
ignore-current-tab all-tabs)
"Return the tab that owns the window whose buffer is BUFFER-OR-NAME.
BUFFER-OR-NAME may be a buffer or a buffer name, and defaults to
the current buffer.
@@ -2210,14 +2366,20 @@ selected frame and no others.
When the optional argument IGNORE-CURRENT-TAB is non-nil,
don't take into account the buffers in the currently selected tab.
-Otherwise, prefer buffers of the current tab."
+Otherwise, prefer buffers of the current tab.
+
+When the optional argument ALL-TABS is non-nil, return a list of all tabs
+that contain the buffer BUFFER-OR-NAME."
(let ((buffer (if buffer-or-name
(get-buffer buffer-or-name)
- (current-buffer))))
+ (current-buffer)))
+ buffer-tabs)
(when (bufferp buffer)
- (seq-some
+ (funcall
+ (if all-tabs #'seq-each #'seq-some)
(lambda (frame)
- (seq-some
+ (funcall
+ (if all-tabs #'seq-each #'seq-some)
(lambda (tab)
(when (if (eq (car tab) 'current-tab)
(get-buffer-window buffer frame)
@@ -2229,8 +2391,9 @@ Otherwise, prefer buffers of the current tab."
(memq buffer buffers)
;; writable window-state
(member (buffer-name buffer) buffers))))
- (append tab `((index . ,(tab-bar--tab-index tab nil frame))
- (frame . ,frame)))))
+ (push (append tab `((index . ,(tab-bar--tab-index tab nil frame))
+ (frame . ,frame)))
+ buffer-tabs)))
(let* ((tabs (funcall tab-bar-tabs-function frame))
(current-tab (tab-bar--current-tab-find tabs)))
(setq tabs (remq current-tab tabs))
@@ -2239,7 +2402,8 @@ Otherwise, prefer buffers of the current tab."
tabs
;; Make sure current-tab is at the beginning of tabs.
(cons current-tab tabs)))))
- (tab-bar--reusable-frames all-frames)))))
+ (tab-bar--reusable-frames all-frames))
+ (if all-tabs (nreverse buffer-tabs) (car (last buffer-tabs))))))
(defun display-buffer-in-tab (buffer alist)
"Display BUFFER in a tab using display actions in ALIST.
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index a4e95bbc75..99a785ee3e 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -483,7 +483,7 @@ which the tab will represent."
(dolist (fn tab-line-tab-face-functions)
(setf face (funcall fn tab tabs face buffer-p selected-p)))
(apply 'propertize
- (concat (propertize name
+ (concat (propertize (string-replace "%" "%%" name) ;; (bug#57848)
'keymap tab-line-tab-map
'help-echo (if selected-p "Current tab"
"Click to select tab")
@@ -572,19 +572,31 @@ For use in `tab-line-tab-face-functions'."
(defvar tab-line-auto-hscroll)
+(defun tab-line-cache-key-default (_tabs)
+ "Return default list of cache keys."
+ (list
+ ;; for setting face 'tab-line-tab-current'
+ (mode-line-window-selected-p)
+ ;; for `tab-line-tab-face-modified'
+ (and (memq 'tab-line-tab-face-modified
+ tab-line-tab-face-functions)
+ (buffer-file-name)
+ (buffer-modified-p))))
+
+(defvar tab-line-cache-key-function #'tab-line-cache-key-default
+ "Function that adds more cache keys.
+It is called with one argument, a list of tabs, and should return a list
+of cache keys. You can use `add-function' to add more cache keys.")
+
(defun tab-line-format ()
"Format for displaying the tab line of the selected window."
(let* ((tabs (funcall tab-line-tabs-function))
- (cache-key (list tabs
- ;; handle buffer renames
- (buffer-name (window-buffer))
- ;; handle tab-line scrolling
- (window-parameter nil 'tab-line-hscroll)
- ;; for setting face 'tab-line-tab-current'
- (mode-line-window-selected-p)
- (and (memq 'tab-line-tab-face-modified
- tab-line-tab-face-functions)
- (buffer-file-name) (buffer-modified-p))))
+ (cache-key (append (list tabs
+ ;; handle buffer renames
+ (buffer-name (window-buffer))
+ ;; handle tab-line scrolling
+ (window-parameter nil 'tab-line-hscroll))
+ (funcall tab-line-cache-key-function tabs)))
(cache (window-parameter nil 'tab-line-cache)))
;; Enable auto-hscroll again after it was disabled on manual scrolling.
;; The moment to enable it is when the window-buffer was updated.
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index d2a35bd550..55dced96b7 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -875,26 +875,24 @@ cannot be completed sensibly: `custom-ident',
(modify-syntax-entry ?? "." st)
st))
-(defvar css-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap info-lookup-symbol] 'css-lookup-symbol)
- ;; `info-complete-symbol' is not used.
- (define-key map [remap complete-symbol] 'completion-at-point)
- (define-key map "\C-c\C-f" 'css-cycle-color-format)
- (easy-menu-define css-menu map "CSS mode menu"
- '("CSS"
- :help "CSS-specific features"
- ["Reformat block" fill-paragraph
- :help "Reformat declaration block or fill comment at point"]
- ["Cycle color format" css-cycle-color-format
- :help "Cycle color at point between different formats"]
- "-"
- ["Describe symbol" css-lookup-symbol
- :help "Display documentation for a CSS symbol"]
- ["Complete symbol" completion-at-point
- :help "Complete symbol before point"]))
- map)
- "Keymap used in `css-mode'.")
+(defvar-keymap css-mode-map
+ :doc "Keymap used in `css-mode'."
+ "<remap> <info-lookup-symbol>" #'css-lookup-symbol
+ ;; `info-complete-symbol' is not used.
+ "<remap> <complete-symbol>" #'completion-at-point
+ "C-c C-f" #'css-cycle-color-format
+ :menu
+ '("CSS"
+ :help "CSS-specific features"
+ ["Reformat block" fill-paragraph
+ :help "Reformat declaration block or fill comment at point"]
+ ["Cycle color format" css-cycle-color-format
+ :help "Cycle color at point between different formats"]
+ "-"
+ ["Describe symbol" css-lookup-symbol
+ :help "Display documentation for a CSS symbol"]
+ ["Complete symbol" completion-at-point
+ :help "Complete symbol before point"]))
(eval-and-compile
(defconst css--uri-re
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index a66b72cfd0..11039f2963 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -2131,7 +2131,9 @@ But don't look beyond what's visible on the screen."
;; only reset if a new overlay exists
(setq flyspell-auto-correct-previous-pos nil)
- (let ((overlay-list (overlays-in (point-min) position))
+ (let ((overlay-list (seq-sort-by
+ #'overlay-start #'>
+ (overlays-in (point-min) position)))
(new-overlay 'dummy-value))
;; search for previous (new) flyspell overlay
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index f81cedc39b..2f34a58b5b 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -125,9 +125,7 @@
;; are tired of guessing how it works come back to this document
;; again.
;;
-;; To use the package regularly place this file in the site library
-;; directory and add the next expression in your init file. Make
-;; sure that directory is included in the `load-path'.
+;; To use the package regularly, add this to your init file:
;;
;; (require 'table)
;;
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 462f87d3c1..9dda3e1fcb 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -441,7 +441,7 @@ the bounds of a possible ill-formed URI (one lacking a
scheme)."
;; Otherwise, find the bounds within which a URI may exist. The
;; method is similar to `ffap-string-at-point'. Note that URIs
;; may contain parentheses but may not contain spaces (RFC3986).
- (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'")
+ (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'[]")
(skip-before "^[0-9a-zA-Z]")
(skip-after ":;.,!?'")
(pt (point))
diff --git a/lisp/thread.el b/lisp/thread.el
index 1e6e9e75a7..c0cc5feb97 100644
--- a/lisp/thread.el
+++ b/lisp/thread.el
@@ -58,20 +58,18 @@ An EVENT has the format
:type 'number
:version "27.1")
-(defvar thread-list-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map tabulated-list-mode-map)
- (define-key map "b" #'thread-list-pop-to-backtrace)
- (define-key map "s" nil)
- (define-key map "sq" #'thread-list-send-quit-signal)
- (define-key map "se" #'thread-list-send-error-signal)
- (easy-menu-define nil map ""
- '("Threads"
- ["Show backtrace" thread-list-pop-to-backtrace t]
- ["Send Quit Signal" thread-list-send-quit-signal t]
- ["Send Error Signal" thread-list-send-error-signal t]))
- map)
- "Local keymap for `thread-list-mode' buffers.")
+(defvar-keymap thread-list-mode-map
+ :doc "Local keymap for `thread-list-mode' buffers."
+ :parent tabulated-list-mode-map
+ "b" #'thread-list-pop-to-backtrace
+ "s" nil
+ "s q" #'thread-list-send-quit-signal
+ "s e" #'thread-list-send-error-signal
+ :menu
+ '("Threads"
+ ["Show backtrace" thread-list-pop-to-backtrace t]
+ ["Send Quit Signal" thread-list-send-quit-signal t]
+ ["Send Error Signal" thread-list-send-error-signal t]))
(define-derived-mode thread-list-mode tabulated-list-mode "Thread-List"
"Major mode for monitoring Lisp threads."
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 147a643c9f..95c0fe14f3 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -63,9 +63,9 @@ If a list, it is a list of the types of messages to be
logged."
(and (listp url-debug) (memq tag url-debug)))
(with-current-buffer (get-buffer-create "*URL-DEBUG*")
(goto-char (point-max))
- (insert (symbol-name tag) " -> " (apply 'format args) "\n")
+ (insert (symbol-name tag) " -> " (apply #'format args) "\n")
(if (numberp url-debug)
- (apply 'message args)))))
+ (apply #'message args)))))
;;;###autoload
(defun url-parse-args (str &optional nodowncase)
@@ -125,23 +125,13 @@ conversion. Replaces these characters as follows:
< ==> <
> ==> >
\" ==> ""
- (if (string-match "[&<>\"]" string)
- (with-current-buffer (get-buffer-create " *entity*")
- (erase-buffer)
- (buffer-disable-undo (current-buffer))
- (insert string)
- (goto-char (point-min))
- (while (progn
- (skip-chars-forward "^&<>\"")
- (not (eobp)))
- (insert (cdr (assq (char-after (point))
- '((?\" . """)
- (?& . "&")
- (?< . "<")
- (?> . ">")))))
- (delete-char 1))
- (buffer-string))
- string))
+ (replace-regexp-in-string "[&<>\"]"
+ (lambda (c) (cdr (assq (aref c 0)
+ '((?\" . """)
+ (?& . "&")
+ (?< . "<")
+ (?> . ">")))))
+ string))
;;;###autoload
(defun url-normalize-url (url)
@@ -169,7 +159,7 @@ Will not do anything if `url-show-status' is nil."
(= url-lazy-message-time
(setq url-lazy-message-time (time-convert nil 'integer))))
nil
- (apply 'message args)))
+ (apply #'message args)))
;;;###autoload
(defun url-get-normalized-date (&optional specified-time)
@@ -186,7 +176,7 @@ Will not do anything if `url-show-status' is nil."
#'string-trim-left "29.1")
(define-obsolete-function-alias 'url-pretty-length
- 'file-size-human-readable "24.4")
+ #'file-size-human-readable "24.4")
;;;###autoload
(defun url-display-message (fmt &rest args)
@@ -206,7 +196,7 @@ Will not do anything if `url-show-status' is nil."
(round (* 100 (/ x (float y)))))
;;;###autoload
-(defalias 'url-basepath 'url-file-directory)
+(defalias 'url-basepath #'url-file-directory)
;;;###autoload
(defun url-file-directory (file)
@@ -395,8 +385,7 @@ if character N is allowed."
(aref url-encoding-table byte)))
(if (multibyte-string-p string)
(encode-coding-string string 'utf-8)
- string)
- ""))
+ string)))
(defconst url-host-allowed-chars
;; Allow % to avoid re-encoding %-encoded sequences.
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 003b26eca4..e13894d6b5 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -23,11 +23,10 @@
;;; Commentary:
;; Provides a lightweight alternative to emerge/ediff.
-;; To use it, simply add to your .emacs the following lines:
;;
-;; (autoload 'smerge-mode "smerge-mode" nil t)
+;; To use it, simply type `M-x smerge-mode'.
;;
-;; you can even have it turned on automatically with the following
+;; You can even have it turned on automatically with the following
;; piece of code in your .emacs:
;;
;; (defun sm-try-smerge ()
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 6f77f99555..8f00441e81 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -532,6 +532,12 @@ in the branch repository (or whose status not be
determined)."
(add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t)
(vc-message-unresolved-conflicts buffer-file-name)))
+(defun vc-bzr-clone (remote directory rev)
+ (if rev
+ (vc-bzr-command nil 0 '() "branch" "-r" rev remote directory)
+ (vc-bzr-command nil 0 '() "branch" remote directory))
+ directory)
+
(defun vc-bzr-version-dirstate (dir)
"Try to return as a string the bzr revision ID of directory DIR.
This uses the dirstate file's parent revision entry.
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 3c6afec037..a1ff03144b 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -373,9 +373,8 @@ in the order given by `git status'."
(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
- (let* ((process-file-side-effects nil)
- (commit (vc-git--rev-parse "HEAD" t)))
- (or (vc-git-symbolic-commit commit) commit)))
+ (let (process-file-side-effects)
+ (vc-git--rev-parse "HEAD")))
(defun vc-git--symbolic-ref (file)
(or
@@ -1268,6 +1267,12 @@ This prompts for a branch to merge from."
(add-hook 'after-save-hook #'vc-git-resolve-when-done nil 'local))
(vc-message-unresolved-conflicts buffer-file-name)))
+(defun vc-git-clone (remote directory rev)
+ (if rev
+ (vc-git--out-ok "clone" "--branch" rev remote directory)
+ (vc-git--out-ok "clone" remote directory))
+ directory)
+
;;; HISTORY FUNCTIONS
(autoload 'vc-setup-buffer "vc-dispatcher")
@@ -1626,6 +1631,19 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(expand-file-name fname (vc-git-root default-directory))))
revision)))))
+(defun vc-git-last-change (file line)
+ (vc-buffer-sync)
+ (let ((file (file-relative-name file (vc-git-root (buffer-file-name)))))
+ (with-temp-buffer
+ (when (vc-git--out-ok
+ "blame" "--porcelain"
+ (format "-L%d,+1" line)
+ file)
+ (goto-char (point-min))
+ (save-match-data
+ (when (looking-at "\\`\\([[:alnum:]]+\\)[[:space:]]+")
+ (match-string 1)))))))
+
;;; TAG/BRANCH SYSTEM
(declare-function vc-read-revision "vc"
@@ -1675,15 +1693,11 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
;; does not (and cannot) quote.
(vc-git--rev-parse (concat rev "~1"))))
-(defun vc-git--rev-parse (rev &optional short)
+(defun vc-git--rev-parse (rev)
(with-temp-buffer
(and
- (if short
- (vc-git--out-ok "rev-parse" "--short" rev)
- (vc-git--out-ok "rev-parse" rev))
- (string-trim-right
- (buffer-substring-no-properties (point-min) (min (+ (point-min) 40)
- (point-max)))))))
+ (vc-git--out-ok "rev-parse" rev)
+ (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))
(defun vc-git-next-revision (file rev)
"Git-specific version of `vc-next-revision'."
@@ -1869,7 +1883,8 @@ This command shares argument histories with \\[rgrep] and
\\[grep]."
"Show the contents of stash NAME."
(interactive (list (vc-git-stash-read "Show stash: ")))
(vc-setup-buffer "*vc-git-stash*")
- (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
+ (vc-git-command "*vc-git-stash*" 'async nil
+ "stash" "show" "--color=never" "-p" name)
(set-buffer "*vc-git-stash*")
(setq buffer-read-only t)
(diff-mode)
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 1b1c1683dd..90903255e0 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1266,6 +1266,12 @@ REV is the revision to check out into WORKFILE."
(add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t)
(vc-message-unresolved-conflicts buffer-file-name)))
+(defun vc-hg-clone (remote directory rev)
+ (if rev
+ (vc-hg-command nil 0 '() "clone" "--rev" rev remote directory)
+ (vc-hg-command nil 0 '() "clone" remote directory))
+
+ directory)
;; Modeled after the similar function in vc-bzr.el
(defun vc-hg-revert (file &optional contents-done)
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 9c2bdf6674..1b43ca5787 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -364,7 +364,7 @@ DIRECTORY or absolute."
(with-temp-buffer
(when (zerop (vc-svn-command
t t nil "propget" "svn:ignore" (expand-file-name directory)))
- (split-string (buffer-string) "\n"))))
+ (split-string (buffer-string) "\n" t))))
(defun vc-svn-find-admin-dir (file)
"Return the administrative directory of FILE."
@@ -817,6 +817,13 @@ Set file properties accordingly. If FILENAME is non-nil,
return its status."
"info" "--show-item" "repos-root-url")
(buffer-substring-no-properties (point-min) (1- (point-max))))))
+(defun vc-svn-clone (remote directory rev)
+ (if rev
+ (vc-svn-command nil 0 '() "checkout" "--revision" rev remote directory)
+ (vc-svn-command nil 0 '() "checkout" remote directory))
+
+ (file-name-concat directory "trunk"))
+
(provide 'vc-svn)
;;; vc-svn.el ends here
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index df51f52bc7..513fbb23fe 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -448,6 +448,11 @@
;; - mergebase (rev1 &optional rev2)
;;
;; Return the common ancestor between REV1 and REV2 revisions.
+;;
+;; - last-change (file line)
+;;
+;; Return the most recent revision of FILE that made a change
+;; on LINE.
;; TAG/BRANCH SYSTEM
;;
@@ -584,6 +589,15 @@
;; buffer should be inserted into an inline patch. If the two last
;; properties are omitted, `point-min' and `point-max' will
;; respectively be used instead.
+;;
+;; - clone (remote directory rev)
+;;
+;; Attempt to clone a REMOTE repository, into a local DIRECTORY.
+;; Returns a string with the directory with the contents of the
+;; repository if successful, otherwise nil. With a non-nil value
+;; for REV the backend will attempt to check out a specific
+;; revision, if possible without first checking out the default
+;; branch.
;;; Changes from the pre-25.1 API:
;;
@@ -1715,9 +1729,6 @@ Runs the normal hooks `vc-before-checkin-hook' and
`vc-checkin-hook'."
"--no-backup-if-mismatch"
"-i" "-"))
(user-error "Patch failed: %s" (buffer-string))))
- (dolist (f files)
- (with-current-buffer (get-file-buffer f)
- (revert-buffer t t t)))
(vc-call-backend backend 'checkin files comment))
(dolist (f files)
(copy-file (expand-file-name f tmpdir)
@@ -3554,6 +3565,43 @@ to provide the `find-revision' operation instead."
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
+(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
+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."
+ (unless directory
+ (setq directory default-directory))
+ (if backend
+ (progn
+ (unless (memq backend vc-handled-backends)
+ (error "Unknown VC backend %s" backend))
+ (vc-call-backend backend 'clone remote directory rev))
+ (catch 'ok
+ (dolist (backend vc-handled-backends)
+ (ignore-error vc-not-supported
+ (when-let ((res (vc-call-backend
+ backend 'clone
+ remote directory rev)))
+ (throw 'ok res)))))))
+
+(declare-function log-view-current-tag "log-view" (&optional pos))
+(defun vc-default-last-change (_backend file line)
+ "Default `last-change' implementation.
+It returns the last revision that changed LINE number in FILE."
+ (unless (file-exists-p file)
+ (signal 'file-error "File doesn't exist"))
+ (with-temp-buffer
+ (vc-call-backend (vc-backend file) 'annotate-command
+ file (current-buffer))
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (let ((rev (vc-call-backend
+ (vc-backend file)
+ 'annotate-extract-revision-at-line)))
+ (if (consp rev) (car rev) rev))))
+
;; These things should probably be generally available
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index e7dd1ba715..896df91983 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1,7 +1,6 @@
;;; vcursor.el --- manipulate an alternative ("virtual") cursor -*-
lexical-binding: t; -*-
-;; Copyright (C) 1994, 1996, 1998, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Peter Stephenson <pws@ibmth.df.unipi.it>
;; Maintainer: emacs-devel@gnu.org
@@ -39,7 +38,7 @@
;; off after any operation not involving the vcursor, but the
;; vcursor itself will be left alone.
;; - works on dumb terminals
-;; - new keymap vcursor-map for binding to a prefix key
+;; - new keymap `vcursor-map' for binding to a prefix key
;; - `vcursor-compare-windows' substantially improved
;; - `vcursor-execute-{key,command}' much better about using the
;; right keymaps and arranging for the correct windows to be used
@@ -339,8 +338,6 @@ disable the vcursor."
(cons 'meta key)
key))))
-;; (defvar vcursor)
-
(defun vcursor-bind-keys (var value)
"Alter the value of the variable VAR to VALUE, binding keys as required.
VAR is usually `vcursor-key-bindings'. Normally this function is called
@@ -468,38 +465,36 @@ scrolling set this. It is used by the
`vcursor-auto-disable' code.")
(defvar vcursor-temp-goal-column nil
"Keeps track of temporary goal columns for the virtual cursor.")
-(defvar vcursor-map
- (let ((map (make-sparse-keymap)))
- (define-key map "t" #'vcursor-use-vcursor-map)
-
- (define-key map "\C-p" #'vcursor-previous-line)
- (define-key map "\C-n" #'vcursor-next-line)
- (define-key map "\C-b" #'vcursor-backward-char)
- (define-key map "\C-f" #'vcursor-forward-char)
-
- (define-key map "\r" #'vcursor-disable)
- (define-key map " " #'vcursor-copy)
- (define-key map "\C-y" #'vcursor-copy-word)
- (define-key map "\C-i" #'vcursor-toggle-copy)
- (define-key map "<" #'vcursor-beginning-of-buffer)
- (define-key map ">" #'vcursor-end-of-buffer)
- (define-key map "\M-v" #'vcursor-scroll-down)
- (define-key map "\C-v" #'vcursor-scroll-up)
- (define-key map "o" #'vcursor-other-window)
- (define-key map "g" #'vcursor-goto)
- (define-key map "x" #'vcursor-swap-point)
- (define-key map "\C-s" #'vcursor-isearch-forward)
- (define-key map "\C-r" #'vcursor-isearch-backward)
- (define-key map "\C-a" #'vcursor-beginning-of-line)
- (define-key map "\C-e" #'vcursor-end-of-line)
- (define-key map "\M-w" #'vcursor-forward-word)
- (define-key map "\M-b" #'vcursor-backward-word)
- (define-key map "\M-l" #'vcursor-copy-line)
- (define-key map "c" #'vcursor-compare-windows)
- (define-key map "k" #'vcursor-execute-key)
- (define-key map "\M-x" #'vcursor-execute-command)
- map)
- "Keymap for vcursor command.")
+(defvar-keymap vcursor-map
+ :doc "Keymap for vcursor command."
+ "t" #'vcursor-use-vcursor-map
+
+ "C-p" #'vcursor-previous-line
+ "C-n" #'vcursor-next-line
+ "C-b" #'vcursor-backward-char
+ "C-f" #'vcursor-forward-char
+
+ "RET" #'vcursor-disable
+ "SPC" #'vcursor-copy
+ "C-y" #'vcursor-copy-word
+ "C-i" #'vcursor-toggle-copy
+ "<" #'vcursor-beginning-of-buffer
+ ">" #'vcursor-end-of-buffer
+ "M-v" #'vcursor-scroll-down
+ "C-v" #'vcursor-scroll-up
+ "o" #'vcursor-other-window
+ "g" #'vcursor-goto
+ "x" #'vcursor-swap-point
+ "C-s" #'vcursor-isearch-forward
+ "C-r" #'vcursor-isearch-backward
+ "C-a" #'vcursor-beginning-of-line
+ "C-e" #'vcursor-end-of-line
+ "M-w" #'vcursor-forward-word
+ "M-b" #'vcursor-backward-word
+ "M-l" #'vcursor-copy-line
+ "c" #'vcursor-compare-windows
+ "k" #'vcursor-execute-key
+ "M-x" #'vcursor-execute-command)
;; This seems unused, but it was done as part of define-prefix-command,
;; so let's keep it for now.
(fset 'vcursor-map vcursor-map)
@@ -515,7 +510,6 @@ scrolling set this. It is used by the
`vcursor-auto-disable' code.")
If that's disabled, don't go anywhere but don't complain."
;; This is where we go off-mass-shell. Assume there is a
;; save-excursion to get us back to the pole, er, point.
-
(and (overlayp vcursor-overlay)
(overlay-buffer vcursor-overlay)
(set-buffer (overlay-buffer vcursor-overlay))
@@ -538,7 +532,6 @@ always considered, and the value of `pop-up-frames' is
always respected).
Returns nil if the virtual cursor is not visible anywhere suitable.
Set `vcursor-window' to the returned value as a side effect."
-
;; The order of priorities (respecting NOT-THIS) is (1)
;; vcursor-window if the virtual cursor is visible there (2) any
;; window displaying the virtual cursor (3) vcursor-window provided
@@ -547,7 +540,6 @@ Set `vcursor-window' to the returned value as a side
effect."
;; buffer (5) with NEW-WIN, a window selected by display-buffer (so
;; the variables pop-up-windows and pop-up-frames are significant)
;; (6) nil.
-
(let ((thiswin (selected-window)) winok winbuf)
(save-excursion
(vcursor-locate)
@@ -652,7 +644,6 @@ This is called by most of the virtual-cursor motion
commands."
If the virtual cursor is (or was recently) visible in another window,
switch to that first. Without a prefix ARG, disable the virtual
cursor as well."
-
(interactive "P")
(and (vcursor-find-window) (select-window vcursor-window))
(let ((buf (and vcursor-overlay (overlay-buffer vcursor-overlay))))
@@ -667,7 +658,6 @@ cursor as well."
The virtual cursor window becomes the selected window and the old
window becomes the virtual cursor window. If the virtual cursor would
not be visible otherwise, display it in another window."
-
(interactive)
(let ((buf (current-buffer)) (here (point)) (win (selected-window)))
(vcursor-goto) ; will disable the vcursor
@@ -679,14 +669,12 @@ not be visible otherwise, display it in another window."
(defun vcursor-scroll-up (&optional n)
"Scroll up the vcursor window ARG lines or near full screen if none.
The vcursor will always appear in an unselected window."
-
(interactive "P")
(vcursor-window-funcall #'scroll-up n))
(defun vcursor-scroll-down (&optional n)
"Scroll down the vcursor window ARG lines or near full screen if none.
The vcursor will always appear in an unselected window."
-
(interactive "P")
(vcursor-window-funcall #'scroll-down n))
@@ -694,7 +682,6 @@ The vcursor will always appear in an unselected window."
"Perform forward incremental search in the virtual cursor window.
The virtual cursor is moved to the resulting point; the ordinary
cursor stays where it was."
-
(interactive "P")
(vcursor-window-funcall #'isearch-forward rep norecurs)
)
@@ -703,7 +690,6 @@ cursor stays where it was."
"Perform backward incremental search in the virtual cursor window.
The virtual cursor is moved to the resulting point; the ordinary
cursor stays where it was."
-
(interactive "P")
(vcursor-window-funcall #'isearch-backward rep norecurs)
)
@@ -719,7 +705,6 @@ ARGS. In this case, a new window will not be created if
the vcursor
is visible in the current one."
;; that's to avoid messing up compatibility with old versions
;; by introducing a new argument, which would have to come before ARGS.
-
(vcursor-find-window (not (and (listp func) (vcursor-check t))) t)
(save-excursion
(let ((sw (selected-window)) text)
@@ -751,7 +736,6 @@ is called.
This is called by most of the virtual-cursor copying commands to find
out how much to copy."
-
(vcursor-check)
(with-current-buffer (overlay-buffer vcursor-overlay)
(save-excursion
@@ -792,7 +776,6 @@ active at the same point as the real cursor.
Copying mode is always turned off: the next use of the vcursor will
not copy text until you turn it on again."
-
(interactive "P")
(if (overlayp vcursor-overlay)
(progn
@@ -1078,7 +1061,6 @@ With no argument, copy to the end of the current line.
Behavior with regard to newlines is similar (but not identical) to
`kill-line'; the main difference is that whitespace at the end of the
line is treated like ordinary characters."
-
(interactive "P")
(let* ((num (prefix-numeric-value arg))
(count (vcursor-get-char-count #'end-of-line num)))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 4238461b7e..791a0a0b4e 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -546,7 +546,7 @@ Used when `whitespace-style' includes the value
`trailing'.")
(t :background "red1" :foreground "yellow"))
"Face used to visualize trailing blanks.
-See '`whitespace-trailing-regexp'."
+See `whitespace-trailing-regexp'."
:group 'whitespace)
diff --git a/lisp/winner.el b/lisp/winner.el
index 174b698e7b..c8354b18be 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -328,6 +328,14 @@ You may want to include buffer names such as *Help*,
*Apropos*,
map)
"Keymap for Winner mode.")
+(defvar-keymap winner-repeat-map
+ :doc "Keymap to repeat winner key sequences. Used in `repeat-mode'."
+ "<left>" #'winner-undo
+ "<right>" #'winner-redo)
+
+(put #'winner-undo 'repeat-map 'winner-repeat-map)
+(put #'winner-redo 'repeat-map 'winner-repeat-map)
+
;;;###autoload
(define-minor-mode winner-mode
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 109748baec..7195ba9d89 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -20,15 +20,17 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
-;; See xwidget.c for more api functions.
+
+;; See the node "(emacs)Embedded WebKit Widgets" in the Emacs manual for
+;; help on user-facing features, and "(elisp)Embedded Native Widgets" in
+;; the Emacs Lisp reference manual for help on more API functions.
+
+;;; Code:
;; This breaks compilation when we don't have xwidgets.
;; And is pointless when we do, since it's in C and so preloaded.
;;(require 'xwidget-internal)
-;;; Code:
-
(require 'cl-lib)
(require 'bookmark)
(require 'format-spec)
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index 2dd9a9a476..98e31df70c 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -27,7 +27,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <mingw_time.h>
/* MinGW-w64 gcc does not automotically define a macro for
- differentiating it fom MinGW gcc. We need to test the presence of
+ differentiating it from MinGW gcc. We need to test the presence of
__MINGW64_VERSION_MAJOR in _mingw.h: */
#ifdef __MINGW32__
# include <_mingw.h>
diff --git a/src/ChangeLog.13 b/src/ChangeLog.13
index 268a59219c..6eb54dfb2c 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -10183,7 +10183,7 @@
(w32_wnd_proc): Handle bottom divider width.
For WM_WINDOWPOSCHANGING return zero if we resize pixelwise.
(Fx_create_frame): Default divider width parameters.
- Caclulate sizes pixelwise. Add vertical drag cursor support.
+ Calculate sizes pixelwise. Add vertical drag cursor support.
(x_create_tip_frame): Default divider widths to zero.
Pixelize call to change_frame_size.
(Fx_show_tip): Add handling of divider widths. Pixelize window
diff --git a/src/ChangeLog.7 b/src/ChangeLog.7
index e893a2a6d8..9c6fd810d3 100644
--- a/src/ChangeLog.7
+++ b/src/ChangeLog.7
@@ -1215,19 +1215,19 @@
* ccl.c: Change term translation to code conversion, then change
terms unify/unification to translate/translation respectively
- throughtout the file.
+ throughout the file.
* charset.c: Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
(ONE_BYTE_CHAR_WIDTH): Delete unnecessary continuation line at the
tail.
* charset.h: Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
(GET_TRANSLATION_TABLE): Name changed from UNIFICATION_ID_TABLE.
* coding.c: Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
(encode_coding_iso2022): Fix bug in encoding a text ending by a
composite character.
(check_composing_code): If we are decoding the last block of data,
diff --git a/src/alloc.c b/src/alloc.c
index 39e69280b6..03199f69d3 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6304,7 +6304,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type
pvectype)
static void
mark_overlay (struct Lisp_Overlay *ov)
{
- /* We don't mark the `interval_node` object, because it is managed manually
+ /* We don't mark the `itree_node` object, because it is managed manually
rather than by the GC. */
eassert (BASE_EQ (ov->interval->data, make_lisp_ptr (ov, Lisp_Vectorlike)));
set_vectorlike_marked (&ov->header);
diff --git a/src/buffer.c b/src/buffer.c
index b67b989326..9be2c4a970 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -982,7 +982,7 @@ set_overlays_multibyte (bool multibyte)
struct itree_tree *tree = current_buffer->overlays;
const intmax_t size = itree_size (tree);
- /* We can't use `interval_node_set_region` at the same time
+ /* We can't use `itree_node_set_region` at the same time
as we iterate over the itree, so we need an auxiliary storage
to keep the list of nodes. */
USE_SAFE_ALLOCA;
@@ -3454,21 +3454,66 @@ overlay_strings (ptrdiff_t pos, struct window *w,
unsigned char **pstr)
void
-adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
+adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length, bool
before_markers)
{
- /* After an insertion, the lists are still sorted properly,
- but we may need to update the value of the overlay center. */
- if (! current_buffer->overlays)
- return;
- itree_insert_gap (current_buffer->overlays, pos, length);
+ if (!current_buffer->indirections)
+ itree_insert_gap (current_buffer->overlays, pos, length, before_markers);
+ else
+ {
+ struct buffer *base = current_buffer->base_buffer
+ ? current_buffer->base_buffer
+ : current_buffer;
+ Lisp_Object tail, other;
+ itree_insert_gap (base->overlays, pos, length, before_markers);
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == base)
+ itree_insert_gap (XBUFFER (other)->overlays, pos, length,
+ before_markers);
+ }
+}
+
+static void
+adjust_overlays_for_delete_in_buffer (struct buffer * buf,
+ ptrdiff_t pos, ptrdiff_t length)
+{
+ Lisp_Object hit_list = Qnil;
+ struct itree_node *node;
+
+ /* Ideally, the evaporate check would be done directly within
+ `itree_delete_gap`, but that code isn't supposed to know about overlays,
+ only about `itree_node`s, so it would break an abstraction boundary. */
+ itree_delete_gap (buf->overlays, pos, length);
+
+ /* Delete any zero-sized overlays at position POS, if the `evaporate'
+ property is set. */
+
+ ITREE_FOREACH (node, buf->overlays, pos, pos, ASCENDING)
+ {
+ if (node->end == pos && node->begin == pos
+ && ! NILP (Foverlay_get (node->data, Qevaporate)))
+ hit_list = Fcons (node->data, hit_list);
+ }
+
+ for (; CONSP (hit_list); hit_list = XCDR (hit_list))
+ Fdelete_overlay (XCAR (hit_list));
}
void
adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
{
- if (! current_buffer->overlays)
- return;
- itree_delete_gap (current_buffer->overlays, pos, length);
+ if (!current_buffer->indirections)
+ adjust_overlays_for_delete_in_buffer (current_buffer, pos, length);
+ else
+ {
+ struct buffer *base = current_buffer->base_buffer
+ ? current_buffer->base_buffer
+ : current_buffer;
+ Lisp_Object tail, other;
+ adjust_overlays_for_delete_in_buffer (base, pos, length);
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == base)
+ adjust_overlays_for_delete_in_buffer (XBUFFER (other), pos, length);
+ }
}
@@ -3601,7 +3646,7 @@ buffer. */)
o_end = OVERLAY_END (overlay);
}
- if (! EQ (buffer, obuffer))
+ if (! BASE_EQ (buffer, obuffer))
{
if (! NILP (obuffer))
remove_buffer_overlay (XBUFFER (obuffer), XOVERLAY (overlay));
@@ -3790,7 +3835,9 @@ and also contained within the specified region.
Empty overlays are included in the result if they are located at BEG,
between BEG and END, or at END provided END denotes the position at the
-end of the accessible part of the buffer. */)
+end of the accessible part of the buffer.
+
+The resulting list of overlays is in an arbitrary unpredictable order. */)
(Lisp_Object beg, Lisp_Object end)
{
ptrdiff_t len, noverlays;
@@ -4080,25 +4127,6 @@ call_overlay_mod_hooks (Lisp_Object list, Lisp_Object
overlay, bool after,
}
}
-/* Delete any zero-sized overlays at position POS, if the `evaporate'
- property is set. */
-void
-evaporate_overlays (ptrdiff_t pos)
-{
- Lisp_Object hit_list = Qnil;
- struct itree_node *node;
-
- ITREE_FOREACH (node, current_buffer->overlays, pos, pos, ASCENDING)
- {
- if (node->end == pos
- && ! NILP (Foverlay_get (node->data, Qevaporate)))
- hit_list = Fcons (node->data, hit_list);
- }
-
- for (; CONSP (hit_list); hit_list = XCDR (hit_list))
- Fdelete_overlay (XCAR (hit_list));
-}
-
/***********************************************************************
Allocation with mmap
***********************************************************************/
diff --git a/src/buffer.h b/src/buffer.h
index 3ea4125645..2e80c8a7b0 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1170,7 +1170,6 @@ extern EMACS_INT fix_position (Lisp_Object);
extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
extern void compact_buffer (struct buffer *);
-extern void evaporate_overlays (ptrdiff_t);
extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *,
ptrdiff_t *);
extern ptrdiff_t overlays_in (ptrdiff_t, ptrdiff_t, bool, Lisp_Object **,
ptrdiff_t *, bool, bool, ptrdiff_t *);
diff --git a/src/callproc.c b/src/callproc.c
index 4d4b86629c..f9f840e544 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -648,6 +648,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
#ifndef MSDOS
+ child_signal_init ();
block_input ();
block_child_signal (&oldset);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index fcdf103c19..35d6e9e0d7 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -561,7 +561,7 @@ static struct Lisp_Module_Function *
allocate_module_function (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
- interactive_form, PVEC_MODULE_FUNCTION);
+ command_modes, PVEC_MODULE_FUNCTION);
}
#define XSET_MODULE_FUNCTION(var, ptr) \
diff --git a/src/emacs.c b/src/emacs.c
index 9fd151e64d..eba4cf78ad 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -82,6 +82,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#endif /* HAVE_WINDOW_SYSTEM */
#include "bignum.h"
+#include "itree.h"
#include "intervals.h"
#include "character.h"
#include "buffer.h"
@@ -431,9 +432,9 @@ terminate_due_to_signal (int sig, int backtrace_limit)
if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
{
/* Avoid abort in shut_down_emacs if we were interrupted
- by SIGINT in noninteractive usage, as in that case we
- don't care about the message stack. */
- if (sig == SIGINT && noninteractive)
+ in noninteractive usage, as in that case we don't
+ care about the message stack. */
+ if (noninteractive)
clear_message_stack ();
Fkill_emacs (make_fixnum (sig), Qnil);
}
@@ -1935,6 +1936,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
running_asynch_code = 0;
init_random ();
init_xfaces ();
+ init_itree ();
#if defined HAVE_JSON && !defined WINDOWSNT
init_json ();
@@ -3111,6 +3113,8 @@ You must run Emacs in batch mode in order to dump it. */)
gflags.will_dump_with_unexec_ = false;
gflags.dumped_with_unexec_ = true;
+ forget_itree ();
+
alloc_unexec_pre ();
unexec (SSDATA (filename), !NILP (symfile) ? SSDATA (symfile) : 0);
diff --git a/src/eval.c b/src/eval.c
index e1399d6a05..ea23829948 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2435,7 +2435,9 @@ eval_sub (Lisp_Object form)
else if (XSUBR (fun)->max_args == UNEVALLED)
val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
- else if (XSUBR (fun)->max_args == MANY)
+ else if (XSUBR (fun)->max_args == MANY
+ || XSUBR (fun)->max_args > 8)
+
{
/* Pass a vector of evaluated arguments. */
Lisp_Object *vals;
@@ -2998,7 +3000,8 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs,
Lisp_Object *args)
if (numargs >= subr->min_args)
{
/* Conforming call to finite-arity subr. */
- if (numargs <= subr->max_args)
+ if (numargs <= subr->max_args
+ && subr->max_args <= 8)
{
Lisp_Object argbuf[8];
Lisp_Object *a;
@@ -3034,15 +3037,13 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t
numargs, Lisp_Object *args)
return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5],
a[6], a[7]);
default:
- /* If a subr takes more than 8 arguments without using MANY
- or UNEVALLED, we need to extend this function to support it.
- Until this is done, there is no way to call the function. */
- emacs_abort ();
+ emacs_abort (); /* Can't happen. */
}
}
/* Call to n-adic subr. */
- if (subr->max_args == MANY)
+ if (subr->max_args == MANY
+ || subr->max_args > 8)
return subr->function.aMANY (numargs, args);
}
diff --git a/src/gnutls.c b/src/gnutls.c
index a0de0238c4..7f0aaf85a4 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -2790,6 +2790,10 @@ Any GnuTLS extension with ID up to 100
capabilities = Fcons (intern("gnutls"), capabilities);
+# ifdef HAVE_GNUTLS_EXT__DUMBFW
+ capabilities = Fcons (intern("ClientHello Padding"), capabilities);
+# endif
+
# ifdef HAVE_GNUTLS3
capabilities = Fcons (intern("gnutls3"), capabilities);
capabilities = Fcons (intern("digests"), capabilities);
@@ -2807,16 +2811,14 @@ Any GnuTLS extension with ID up to 100
const char* name = gnutls_ext_get_name(ext);
if (name != NULL)
{
- capabilities = Fcons (intern(name), capabilities);
+ Lisp_Object cap = intern (name);
+ if (NILP (Fmemq (cap, capabilities)))
+ capabilities = Fcons (cap, capabilities);
}
}
# endif
# endif /* HAVE_GNUTLS3 */
-# ifdef HAVE_GNUTLS_EXT__DUMBFW
- capabilities = Fcons (intern("ClientHello Padding"), capabilities);
-# endif
-
# ifdef WINDOWSNT
Vlibrary_cache = Fcons (Fcons (Qgnutls, capabilities), Vlibrary_cache);
# endif /* WINDOWSNT */
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index 0f8e26d0db..3a98285677 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -653,6 +653,24 @@ public:
Quit ();
else if (msg->what == B_CLIPBOARD_CHANGED)
haiku_write (CLIPBOARD_CHANGED_EVENT, &rq);
+ else if (msg->what == B_KEY_MAP_LOADED)
+ {
+ /* Install the new keymap. Or rather, clear key_map -- Emacs
+ will fetch it again from the main thread the next time it
+ is needed. */
+ if (key_map_lock.Lock ())
+ {
+ if (key_map)
+ free (key_map);
+
+ if (key_chars)
+ free (key_chars);
+
+ key_map = NULL;
+ key_chars = NULL;
+ key_map_lock.Unlock ();
+ }
+ }
else
BApplication::MessageReceived (msg);
}
diff --git a/src/image.c b/src/image.c
index 04f31cdfa1..30f565f88d 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1845,7 +1845,9 @@ image_clear_image (struct frame *f, struct image *img)
{
block_input ();
image_clear_image_1 (f, img,
- CLEAR_IMAGE_PIXMAP | CLEAR_IMAGE_MASK | CLEAR_IMAGE_COLORS);
+ (CLEAR_IMAGE_PIXMAP
+ | CLEAR_IMAGE_MASK
+ | CLEAR_IMAGE_COLORS));
unblock_input ();
}
@@ -2982,7 +2984,8 @@ lookup_image (struct frame *f, Lisp_Object spec, int
face_id)
unblock_input ();
}
- /* We're using IMG, so set its timestamp to `now'. */
+ /* IMG is now being used, so set its timestamp to the current
+ time. */
img->timestamp = current_timespec ();
/* Value is the image id. */
@@ -3240,12 +3243,13 @@ x_create_x_image_and_pixmap (struct frame *f, int
width, int height, int depth,
static void
x_destroy_x_image (XImage *ximg)
{
- eassert (input_blocked_p ());
if (ximg)
{
xfree (ximg->data);
ximg->data = NULL;
}
+
+ XDestroyImage (ximg);
}
# if !defined USE_CAIRO && defined HAVE_XRENDER
@@ -6226,26 +6230,28 @@ static void
image_from_emacs_colors (struct frame *f, struct image *img, Emacs_Color
*colors)
{
int x, y;
- Emacs_Pix_Container oimg = NULL;
+ Emacs_Pix_Container ximage;
Emacs_Color *p;
+ ximage = NULL;
+
init_color_table ();
image_clear_image_1 (f, img, CLEAR_IMAGE_PIXMAP | CLEAR_IMAGE_COLORS);
image_create_x_image_and_pixmap (f, img, img->width, img->height, 0,
- &oimg, 0);
+ &ximage, 0);
p = colors;
for (y = 0; y < img->height; ++y)
for (x = 0; x < img->width; ++x, ++p)
{
unsigned long pixel;
pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
- PUT_PIXEL (oimg, x, y, pixel);
+ PUT_PIXEL (ximage, x, y, pixel);
}
xfree (colors);
- image_put_x_image (f, img, oimg, 0);
+ image_put_x_image (f, img, ximage, false);
#ifdef COLOR_TABLE_SUPPORT
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
@@ -12209,7 +12215,15 @@ non-numeric, there is no explicit limit on the size of
images. */);
# endif
DEFSYM (Qgobject, "gobject");
#endif /* HAVE_NTGUI */
-#endif /* HAVE_RSVG */
+#elif defined HAVE_NATIVE_IMAGE_API \
+ && ((defined HAVE_NS && defined NS_IMPL_COCOA) \
+ || defined HAVE_HAIKU)
+ DEFSYM (Qsvg, "svg");
+
+ /* On Haiku, the SVG translator may not be installed. */
+ if (image_can_use_native_api (Qsvg))
+ add_image_type (Qsvg);
+#endif
#ifdef HAVE_NS
DEFSYM (Qheic, "heic");
diff --git a/src/insdel.c b/src/insdel.c
index 6d56a76c77..03ce59b340 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -268,6 +268,7 @@ adjust_markers_for_delete (ptrdiff_t from, ptrdiff_t
from_byte,
m->bytepos = from_byte;
}
}
+ adjust_overlays_for_delete (from, to - from);
}
@@ -307,6 +308,7 @@ adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t
from_byte,
m->charpos += nchars;
}
}
+ adjust_overlays_for_insert (from, to - from, before_markers);
}
/* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
@@ -343,6 +345,11 @@ adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t
from_byte,
ptrdiff_t diff_bytes = new_bytes - old_bytes;
adjust_suspend_auto_hscroll (from, from + old_chars);
+
+ /* FIXME: When OLD_CHARS is 0, this "replacement" is really just an
+ insertion, but the behavior we provide here in that case is that of
+ `insert-before-markers` rather than that of `insert`.
+ Maybe not a bug, but not a feature either. */
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
if (m->bytepos >= prev_to_byte)
@@ -358,6 +365,10 @@ adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t
from_byte,
}
check_markers ();
+
+ adjust_overlays_for_insert (from + old_chars, new_chars, true);
+ if (old_chars)
+ adjust_overlays_for_delete (from, old_chars);
}
/* Starting at POS (BYTEPOS), find the byte position corresponding to
@@ -917,7 +928,6 @@ insert_1_both (const char *string,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE,
PT + nchars, PT_BYTE + nbytes,
before_markers);
@@ -1043,7 +1053,6 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
PT_BYTE + outgoing_nbytes,
before_markers);
@@ -1115,9 +1124,8 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool
text_at_gap_tail)
insert_from_gap_1 (nchars, nbytes, text_at_gap_tail);
- adjust_overlays_for_insert (ins_charpos, nchars);
adjust_markers_for_insert (ins_charpos, ins_bytepos,
- ins_charpos + nchars, ins_bytepos + nbytes, 0);
+ ins_charpos + nchars, ins_bytepos + nbytes, false);
if (buffer_intervals (current_buffer))
{
@@ -1257,10 +1265,9 @@ insert_from_buffer_1 (struct buffer *buf,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
PT_BYTE + outgoing_nbytes,
- 0);
+ false);
offset_intervals (current_buffer, PT, nchars);
@@ -1316,17 +1323,12 @@ adjust_after_replace (ptrdiff_t from, ptrdiff_t
from_byte,
len, len_byte);
else
adjust_markers_for_insert (from, from_byte,
- from + len, from_byte + len_byte, 0);
+ from + len, from_byte + len_byte, false);
if (nchars_del > 0)
record_delete (from, prev_text, false);
record_insert (from, len);
- if (len > nchars_del)
- adjust_overlays_for_insert (from, len - nchars_del);
- else if (len < nchars_del)
- adjust_overlays_for_delete (from, nchars_del - len);
-
offset_intervals (current_buffer, from, len - nchars_del);
if (from < PT)
@@ -1338,8 +1340,6 @@ adjust_after_replace (ptrdiff_t from, ptrdiff_t from_byte,
check_markers ();
- if (len == 0)
- evaporate_overlays (from);
modiff_incr (&MODIFF, nchars_del + len);
CHARS_MODIFF = MODIFF;
}
@@ -1507,14 +1507,9 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object
new,
which make the original byte positions of the markers
invalid. */
adjust_markers_bytepos (from, from_byte, from + inschars,
- from_byte + outgoing_insbytes, 1);
+ from_byte + outgoing_insbytes, true);
}
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- adjust_overlays_for_delete (from, nchars_del);
- adjust_overlays_for_insert (from, inschars);
-
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Get the intervals for the part of the string we are inserting--
@@ -1530,9 +1525,6 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object
new,
(from_byte + outgoing_insbytes
- (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
- if (outgoing_insbytes == 0)
- evaporate_overlays (from);
-
check_markers ();
modiff_incr (&MODIFF, nchars_del + inschars);
@@ -1640,18 +1632,10 @@ replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
sequences which make the original byte positions of the
markers invalid. */
adjust_markers_bytepos (from, from_byte, from + inschars,
- from_byte + insbytes, 1);
+ from_byte + insbytes, true);
}
}
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- if (nchars_del != inschars)
- {
- adjust_overlays_for_insert (from, inschars);
- adjust_overlays_for_delete (from + inschars, nchars_del);
- }
-
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Relocate point as if it were a marker. */
@@ -1664,9 +1648,6 @@ replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
adjust_point (inschars - nchars_del, insbytes - nbytes_del);
}
- if (insbytes == 0)
- evaporate_overlays (from);
-
check_markers ();
modiff_incr (&MODIFF, nchars_del + inschars);
@@ -1854,10 +1835,6 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
offset_intervals (current_buffer, from, - nchars_del);
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- adjust_overlays_for_delete (from, nchars_del);
-
GAP_SIZE += nbytes_del;
ZV_BYTE -= nbytes_del;
Z_BYTE -= nbytes_del;
@@ -1879,8 +1856,6 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
check_markers ();
- evaporate_overlays (from);
-
return deletion;
}
diff --git a/src/itree.c b/src/itree.c
index 3b10802ff0..ae69c97d6d 100644
--- a/src/itree.c
+++ b/src/itree.c
@@ -70,7 +70,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
but not the END. The previous/next overlay change operations need
to find the nearest point where there is *either* an interval BEG
or END point, but there is no efficient way to narrow the search
- space over END postions.
+ space over END positions.
Consider the case where next-overlay-change is called at POS, all
interval BEG positions are less than pos POS and all interval END
@@ -191,7 +191,7 @@ interval_stack_clear (struct interval_stack *stack)
}
static inline void
-interval_stack_ensure_space (struct interval_stack *stack, intmax_t nelements)
+interval_stack_ensure_space (struct interval_stack *stack, uintmax_t nelements)
{
if (nelements > stack->size)
{
@@ -207,7 +207,7 @@ static inline void
interval_stack_push_flagged (struct interval_stack *stack,
struct itree_node *node, bool flag)
{
- eassert (node && node != NULL);
+ 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
@@ -258,7 +258,7 @@ struct itree_iterator
are limited by the fact we don't allow modifying the tree at the same
time, making the use of nested iterations quite rare anyway.
So we just use a single global iterator instead for now. */
-static struct itree_iterator *iter;
+static struct itree_iterator *iter = NULL;
static int
interval_tree_max_height (const struct itree_tree *tree)
@@ -287,12 +287,21 @@ itree_iterator_create (struct itree_tree *tree)
return g;
}
-static void
-itree_init (void)
+void
+init_itree (void)
{
+ eassert (!iter);
iter = itree_iterator_create (NULL);
}
+#ifdef HAVE_UNEXEC
+void
+forget_itree (void)
+{
+ iter = NULL;
+}
+#endif
+
struct check_subtree_result
{
/* Node count of the tree. */
@@ -555,16 +564,11 @@ itree_node_end (struct itree_tree *tree,
return node->end;
}
-/* Allocate an interval_tree. Free with interval_tree_destroy. */
+/* Allocate an itree_tree. Free with itree_destroy. */
struct itree_tree *
itree_create (void)
{
- /* FIXME? Maybe avoid the initialization of itree_null in the same
- way that is used to call mem_init in alloc.c? It's not really
- important though. */
- itree_init ();
-
struct itree_tree *tree = xmalloc (sizeof (*tree));
itree_clear (tree);
return tree;
@@ -584,10 +588,9 @@ itree_clear (struct itree_tree *tree)
/* Initialize a pre-allocated tree (presumably on the stack). */
static void
-interval_tree_init (struct interval_tree *tree)
+interval_tree_init (struct itree_tree *tree)
{
- interval_tree_clear (tree);
- /* tree->iter = itree_iterator_create (tree); */
+ itree_clear (tree);
}
#endif
@@ -596,8 +599,6 @@ void
itree_destroy (struct itree_tree *tree)
{
eassert (tree->root == NULL);
- /* if (tree->iter)
- * itree_iterator_destroy (tree->iter); */
xfree (tree);
}
@@ -770,12 +771,12 @@ interval_tree_insert_fix (struct itree_tree *tree,
}
/* Insert a NODE into the TREE.
- Note, that inserting a node twice results in undefined behaviour. */
+ Note, that inserting a node twice results in undefined behavior. */
static void
interval_tree_insert (struct itree_tree *tree, struct itree_node *node)
{
- eassert (node->begin <= node->end && node != NULL);
+ eassert (node && node->begin <= node->end);
/* FIXME: The assertion below fails because `delete_all_overlays`
doesn't set left/right/parent to NULL. */
/* eassert (node->left == NULL && node->right == NULL
@@ -785,7 +786,7 @@ interval_tree_insert (struct itree_tree *tree, struct
itree_node *node)
struct itree_node *parent = NULL;
struct itree_node *child = tree->root;
uintmax_t otick = tree->otick;
- /* It's the responsability of the caller to set `otick` on the node,
+ /* It's the responsibility of the caller to set `otick` on the node,
to "confirm" that the begin/end fields are up to date. */
eassert (node->otick == otick);
@@ -868,7 +869,7 @@ itree_node_set_region (struct itree_tree *tree,
static bool
interval_tree_contains (struct itree_tree *tree, struct itree_node *node)
{
- eassert (node);
+ eassert (iter && node);
struct itree_node *other;
ITREE_FOREACH (other, tree, node->begin, PTRDIFF_MAX, ASCENDING)
if (other == node)
@@ -912,7 +913,7 @@ interval_tree_remove_fix (struct itree_tree *tree,
if (parent == NULL)
eassert (node == tree->root);
else
- eassert (node == NULL || node->parent == parent);
+ eassert (node == NULL || node->parent == parent);
while (parent != NULL && null_safe_is_black (node))
{
@@ -1151,7 +1152,7 @@ itree_iterator_start (struct itree_tree *tree, ptrdiff_t
begin,
ptrdiff_t end, enum itree_order order,
const char *file, int line)
{
- /* struct itree_iterator *iter = tree->iter; */
+ eassert (iter);
if (iter->running)
{
fprintf (stderr,
@@ -1179,7 +1180,7 @@ itree_iterator_start (struct itree_tree *tree, ptrdiff_t
begin,
void
itree_iterator_finish (struct itree_iterator *iter)
{
- eassert (iter->running);
+ eassert (iter && iter->running);
iter->running = false;
}
@@ -1190,33 +1191,44 @@ itree_iterator_finish (struct itree_iterator *iter)
/* Insert a gap at POS of length LENGTH expanding all intervals
intersecting it, while respecting their rear_advance and
- front_advance setting. */
+ front_advance setting.
+
+ If BEFORE_MARKERS is non-zero, all overlays beginning/ending at POS
+ are treated as if their front_advance/rear_advance was true. */
void
itree_insert_gap (struct itree_tree *tree,
- ptrdiff_t pos, ptrdiff_t length)
+ ptrdiff_t pos, ptrdiff_t length, bool before_markers)
{
- if (length <= 0 || tree->root == NULL)
+ if (!tree || length <= 0 || tree->root == NULL)
return;
uintmax_t ootick = tree->otick;
/* FIXME: Don't allocate iterator/stack anew every time. */
/* Nodes with front_advance starting at pos may mess up the tree
- order, so we need to remove them first. */
+ 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_node *node = NULL;
- ITREE_FOREACH (node, tree, pos, pos + 1, PRE_ORDER)
+ if (!before_markers)
{
- if (node->begin == pos && node->front_advance
- && (node->begin != node->end || node->rear_advance))
- interval_stack_push (saved, node);
+ ITREE_FOREACH (node, tree, pos, pos + 1, PRE_ORDER)
+ {
+ if (node->begin == pos && node->front_advance
+ /* If we have front_advance and !rear_advance and
+ 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);
+ }
}
- for (int i = 0; i < saved->length; ++i)
+ for (size_t i = 0; i < saved->length; ++i)
itree_remove (tree, nav_nodeptr (saved->nodes[i]));
/* We can't use an iterator here, because we can't effectively
- narrow AND shift some subtree at the same time. */
+ narrow AND shift some subtree at the same time. */
if (tree->root != NULL)
{
const int size = interval_tree_max_height (tree) + 1;
@@ -1228,25 +1240,28 @@ itree_insert_gap (struct itree_tree *tree,
{
/* Process in pre-order. */
interval_tree_inherit_offset (tree->otick, node);
+ if (pos > node->limit)
+ continue;
if (node->right != NULL)
{
if (node->begin > pos)
{
- /* All nodes in this subtree are shifted by length. */
+ /* All nodes in this subtree are shifted by length. */
node->right->offset += length;
++tree->otick;
}
else
interval_stack_push (stack, node->right);
}
- if (node->left != NULL
- && pos <= node->left->limit + node->left->offset)
+ if (node->left != NULL)
interval_stack_push (stack, node->left);
- /* node->begin == pos implies no front-advance. */
- if (node->begin > pos)
+ if (before_markers
+ ? node->begin >= pos
+ : node->begin > pos) /* node->begin == pos => !front-advance */
node->begin += length;
- if (node->end > pos || (node->end == pos && node->rear_advance))
+ if (node->end > pos
+ || (node->end == pos && (before_markers || node->rear_advance)))
{
node->end += length;
eassert (node != NULL);
@@ -1256,16 +1271,17 @@ itree_insert_gap (struct itree_tree *tree,
interval_stack_destroy (stack);
}
- /* Reinsert nodes starting at POS having front-advance. */
+ /* Reinsert nodes starting at POS having front-advance. */
uintmax_t notick = tree->otick;
nodeptr_and_flag nav;
while ((nav = interval_stack_pop (saved),
node = nav_nodeptr (nav)))
{
eassert (node->otick == ootick);
+ eassert (node->begin == pos);
+ eassert (node->end > pos || node->rear_advance);
node->begin += length;
- if (node->end != pos || node->rear_advance)
- node->end += length;
+ node->end += length;
node->otick = notick;
interval_tree_insert (tree, node);
}
@@ -1274,19 +1290,19 @@ itree_insert_gap (struct itree_tree *tree,
}
/* Delete a gap at POS of length LENGTH, contracting all intervals
- intersecting it. */
+ intersecting it. */
void
itree_delete_gap (struct itree_tree *tree,
ptrdiff_t pos, ptrdiff_t length)
{
- if (length <= 0 || tree->root == NULL)
+ if (!tree || length <= 0 || tree->root == NULL)
return;
- /* FIXME: Don't allocate stack anew every time. */
+ /* FIXME: Don't allocate stack anew every time. */
/* Can't use the iterator here, because by decrementing begin, we
- might unintentionally bring shifted nodes back into our search space. */
+ 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);
struct itree_node *node;
@@ -1297,6 +1313,8 @@ itree_delete_gap (struct itree_tree *tree,
{
node = nav_nodeptr (nav);
interval_tree_inherit_offset (tree->otick, node);
+ if (pos > node->limit)
+ continue;
if (node->right != NULL)
{
if (node->begin > pos + length)
@@ -1308,8 +1326,7 @@ itree_delete_gap (struct itree_tree *tree,
else
interval_stack_push (stack, node->right);
}
- if (node->left != NULL
- && pos <= node->left->limit + node->left->offset)
+ if (node->left != NULL)
interval_stack_push (stack, node->left);
if (pos < node->begin)
@@ -1352,7 +1369,7 @@ interval_node_intersects (const struct itree_node *node,
struct itree_node *
itree_iterator_next (struct itree_iterator *g)
{
- eassert (g->running);
+ eassert (g && g->running);
struct itree_node *const null = NULL;
struct itree_node *node;
@@ -1424,9 +1441,9 @@ void
itree_iterator_narrow (struct itree_iterator *g,
ptrdiff_t begin, ptrdiff_t end)
{
- eassert (g->running);
+ eassert (g && g->running);
eassert (begin >= g->begin);
eassert (end <= g->end);
- g->begin = max (begin, g->begin);
- g->end = min (end, g->end);
+ g->begin = max (begin, g->begin);
+ g->end = min (end, g->end);
}
diff --git a/src/itree.h b/src/itree.h
index c6b68d3667..10ee0897c3 100644
--- a/src/itree.h
+++ b/src/itree.h
@@ -106,6 +106,10 @@ enum itree_order
ITREE_PRE_ORDER,
};
+extern void init_itree (void);
+#ifdef HAVE_UNEXEC
+extern void forget_itree (void);
+#endif
extern void itree_node_init (struct itree_node *, bool, bool, Lisp_Object);
extern ptrdiff_t itree_node_begin (struct itree_tree *, struct itree_node *);
extern ptrdiff_t itree_node_end (struct itree_tree *, struct itree_node *);
@@ -119,7 +123,7 @@ extern void itree_insert (struct itree_tree *, struct
itree_node *,
ptrdiff_t, ptrdiff_t);
extern struct itree_node *itree_remove (struct itree_tree *,
struct itree_node *);
-extern void itree_insert_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
+extern void itree_insert_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t, bool);
extern void itree_delete_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
/* Iteration functions. Almost all code should use ITREE_FOREACH
@@ -147,7 +151,7 @@ extern struct itree_node *itree_iterator_next (struct
itree_iterator *);
BEWARE:
- The expression T may be evaluated more than once, so make sure
- it is cheap a pure.
+ it is cheap and pure.
- Only a single iteration can happen at a time, so make sure none of the
code within the loop can start another tree iteration, i.e. it shouldn't
be able to run ELisp code, nor GC since GC can run ELisp by way
diff --git a/src/keyboard.c b/src/keyboard.c
index a978d6f02b..069cf0627b 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -503,9 +503,11 @@ echo_add_key (Lisp_Object c)
if ((NILP (echo_string) || SCHARS (echo_string) == 0)
&& help_char_p (c))
{
- AUTO_STRING (str, " (Type ? for further options)");
+ AUTO_STRING (str, " (Type ? for further options, q for quick help)");
AUTO_LIST2 (props, Qface, Qhelp_key_binding);
Fadd_text_properties (make_fixnum (7), make_fixnum (8), props, str);
+ Fadd_text_properties (make_fixnum (30), make_fixnum (31), props,
+str);
new_string = concat2 (new_string, str);
}
diff --git a/src/lisp.h b/src/lisp.h
index ff91cb58db..29bda0b3df 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3286,10 +3286,11 @@ CHECK_SUBR (Lisp_Object x)
`minargs' should be a number, the minimum number of arguments allowed.
`maxargs' should be a number, the maximum number of arguments allowed,
or else MANY or UNEVALLED.
- MANY means pass a vector of evaluated arguments,
- in the form of an integer number-of-arguments
- followed by the address of a vector of Lisp_Objects
- which contains the argument values.
+ MANY means there are &rest arguments. Here we pass a vector
+ of evaluated arguments in the form of an integer
+ number-of-arguments followed by the address of a vector of
+ Lisp_Objects which contains the argument values. (We also use
+ this convention when calling a subr with more than 8 parameters.)
UNEVALLED means pass the list of unevaluated arguments
`intspec' says how interactive arguments are to be fetched.
If the string starts with a `(', `intspec' is evaluated and the resulting
@@ -4791,7 +4792,7 @@ extern void syms_of_editfns (void);
extern bool mouse_face_overlay_overlaps (Lisp_Object);
extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
extern AVOID nsberror (Lisp_Object);
-extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
+extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool);
extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
@@ -5016,6 +5017,7 @@ extern bool running_asynch_code;
/* Defined in process.c. */
struct Lisp_Process;
+extern void child_signal_init (void);
extern void kill_buffer_processes (Lisp_Object);
extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object,
struct Lisp_Process *, int);
diff --git a/src/lread.c b/src/lread.c
index c14d48d363..e1f4424dae 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1233,7 +1233,8 @@ Return t if the file exists and loads successfully. */)
/* If file name is magic, call the handler. */
handler = Ffind_file_name_handler (file, Qload);
if (!NILP (handler))
- return call5 (handler, Qload, file, noerror, nomessage, nosuffix);
+ return
+ call6 (handler, Qload, file, noerror, nomessage, nosuffix, must_suffix);
/* The presence of this call is the result of a historical accident:
it used to be in every file-operation and when it got removed
@@ -5417,7 +5418,8 @@ from the file, and matches them against this regular
expression.
When the regular expression matches, the file is considered to be safe
to load. */);
Vbytecomp_version_regexp
- = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version
FSF\\)");
+ = build_pure_c_string
+ ("^;;;.\\(?:in Emacs version\\|bytecomp version FSF\\)");
DEFSYM (Qlexical_binding, "lexical-binding");
DEFVAR_LISP ("lexical-binding", Vlexical_binding,
diff --git a/src/nsimage.m b/src/nsimage.m
index 9cb5090dd0..dd8768664a 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -74,8 +74,10 @@ ns_can_use_native_image_api (Lisp_Object type)
imageType = @"com.compuserve.gif";
else if (EQ (type, Qtiff))
imageType = @"public.tiff";
+#ifndef HAVE_RSVG
else if (EQ (type, Qsvg))
imageType = @"public.svg-image";
+#endif
else if (EQ (type, Qheic))
imageType = @"public.heic";
diff --git a/src/nsterm.m b/src/nsterm.m
index 17f40dc7e3..507f2a9e7d 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -7056,6 +7056,36 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
processingCompose = NO;
}
+static Lisp_Object
+ns_in_echo_area_1 (void *ptr)
+{
+ Lisp_Object in_echo_area;
+ specpdl_ref count;
+
+ count = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
+ in_echo_area = safe_call (1, Qns_in_echo_area);
+
+ return unbind_to (count, in_echo_area);
+}
+
+static Lisp_Object
+ns_in_echo_area_2 (enum nonlocal_exit exit, Lisp_Object error)
+{
+ return Qnil;
+}
+
+static bool
+ns_in_echo_area (void)
+{
+ Lisp_Object in_echo_area;
+
+ in_echo_area
+ = internal_catch_all (ns_in_echo_area_1, NULL,
+ ns_in_echo_area_2);
+
+ return !NILP (in_echo_area);
+}
/* Used to position char selection windows, etc. */
- (NSRect)firstRectForCharacterRange: (NSRange)theRange
@@ -7069,7 +7099,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
if (NS_KEYLOG)
NSLog (@"firstRectForCharRange request");
- if (WINDOWP (echo_area_window) && ! NILP (call0 (intern
("ns-in-echo-area"))))
+ if (WINDOWP (echo_area_window) && ns_in_echo_area ())
win = XWINDOW (echo_area_window);
else
win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe));
@@ -11012,6 +11042,7 @@ respectively. */);
DEFSYM (Qcondensed, "condensed");
DEFSYM (Qreverse_italic, "reverse-italic");
DEFSYM (Qexpanded, "expanded");
+ DEFSYM (Qns_in_echo_area, "ns-in-echo-area");
#ifdef NS_IMPL_COCOA
Fprovide (Qcocoa, Qnil);
diff --git a/src/pdumper.c b/src/pdumper.c
index 1dfdcb43f1..24b026d0aa 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2137,8 +2137,8 @@ static dump_off
dump_interval_node (struct dump_context *ctx, struct itree_node *node,
dump_off parent_offset)
{
-#if CHECK_STRUCTS && !defined (HASH_interval_node_5765524F7E)
-# error "interval_node changed. See CHECK_STRUCTS comment in config.h."
+#if CHECK_STRUCTS && !defined (HASH_itree_node_50DE304F13)
+# error "itree_node changed. See CHECK_STRUCTS comment in config.h."
#endif
struct itree_node out;
dump_object_start (ctx, &out, sizeof (out));
@@ -2179,7 +2179,7 @@ dump_interval_node (struct dump_context *ctx, struct
itree_node *node,
static dump_off
dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_1CD4249AEC)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_EB4C05D8D2)
# error "Lisp_Overlay changed. See CHECK_STRUCTS comment in config.h."
#endif
START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out);
@@ -2746,7 +2746,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_F0F08347A5
+#if CHECK_STRUCTS && !defined HASH_buffer_193CAA5E45
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index 491ba33882..4f3e3697ba 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -714,40 +714,42 @@ pgtk_set_window_size (struct frame *f, bool
change_gravity,
void
pgtk_iconify_frame (struct frame *f)
-/* --------------------------------------------------------------------------
- External: Iconify window
- --------------------------------------------------------------------------
*/
{
+ GtkWindow *window;
+
/* Don't keep the highlight on an invisible frame. */
+
if (FRAME_DISPLAY_INFO (f)->highlight_frame == f)
- FRAME_DISPLAY_INFO (f)->highlight_frame = 0;
+ FRAME_DISPLAY_INFO (f)->highlight_frame = NULL;
+
+ /* If the frame is already iconified, return. */
if (FRAME_ICONIFIED_P (f))
return;
- block_input ();
+ /* Child frames on PGTK have no outer widgets. In that case, simply
+ refuse to iconify the frame. */
if (FRAME_GTK_OUTER_WIDGET (f))
{
if (!FRAME_VISIBLE_P (f))
gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f));
- gtk_window_iconify (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
- SET_FRAME_VISIBLE (f, 0);
- SET_FRAME_ICONIFIED (f, true);
- unblock_input ();
- return;
- }
+ window = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f));
- /* Make sure the X server knows where the window should be positioned,
- in case the user deiconifies with the window manager. */
- if (!FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f))
- pgtk_set_offset (f, f->left_pos, f->top_pos, 0);
+ gtk_window_iconify (window);
- SET_FRAME_ICONIFIED (f, true);
- SET_FRAME_VISIBLE (f, 0);
+ /* Don't make the frame iconified here. Doing so will cause it
+ to be skipped by redisplay, until GDK says it is deiconified
+ (see window_state_event for more details). However, if the
+ window server rejects the iconification request, GDK will
+ never tell Emacs about the iconification not happening,
+ leading to the frame not being redisplayed until the next
+ window state change. */
- unblock_input ();
+ /* SET_FRAME_VISIBLE (f, 0);
+ SET_FRAME_ICONIFIED (f, true); */
+ }
}
static gboolean
@@ -5420,9 +5422,7 @@ map_event (GtkWidget *widget,
/* Check if fullscreen was specified before we where mapped the
first time, i.e. from the command line. */
if (!FRAME_X_OUTPUT (f)->has_been_visible)
- {
- set_fullscreen_state (f);
- }
+ set_fullscreen_state (f);
if (!iconified)
{
@@ -5465,24 +5465,6 @@ window_state_event (GtkWidget *widget,
inev.ie.kind = NO_EVENT;
inev.ie.arg = Qnil;
- if (f)
- {
- if (new_state & GDK_WINDOW_STATE_FOCUSED)
- {
- if (FRAME_ICONIFIED_P (f))
- {
- /* Gnome shell does not iconify us when C-z is pressed.
- It hides the frame. So if our state says we aren't
- hidden anymore, treat it as deiconified. */
- SET_FRAME_VISIBLE (f, 1);
- SET_FRAME_ICONIFIED (f, false);
- FRAME_X_OUTPUT (f)->has_been_visible = true;
- inev.ie.kind = DEICONIFY_EVENT;
- XSETFRAME (inev.ie.frame_or_window, f);
- }
- }
- }
-
if (new_state & GDK_WINDOW_STATE_FULLSCREEN)
store_frame_param (f, Qfullscreen, Qfullboth);
else if (new_state & GDK_WINDOW_STATE_MAXIMIZED)
@@ -5500,14 +5482,37 @@ window_state_event (GtkWidget *widget,
else
store_frame_param (f, Qfullscreen, Qnil);
+ /* The Wayland protocol provides no way for the client to know
+ whether or not one of its toplevels has actually been
+ deiconified. It only provides a request for clients to iconify a
+ toplevel, without even the ability to determine whether or not
+ the iconification request was rejected by the display server.
+
+ GDK computes the iconified state by sending a window state event
+ containing only GDK_WINDOW_STATE_ICONIFIED immediately after
+ gtk_window_iconify is called. That is error-prone if the request
+ to iconify the frame was rejected by the display server, but is
+ not the main problem here, as Wayland compositors only rarely
+ reject such requests. GDK also assumes that it can clear the
+ iconified state upon receiving the next toplevel configure event
+ from the display server. Unfortunately, such events can be sent
+ by Wayland compositors while the frame is iconified, and may also
+ not be sent upon deiconification. So, no matter what Emacs does,
+ the iconification state of a frame is likely to be wrong under
+ one situation or another. */
+
if (new_state & GDK_WINDOW_STATE_ICONIFIED)
- SET_FRAME_ICONIFIED (f, true);
+ {
+ SET_FRAME_ICONIFIED (f, true);
+ SET_FRAME_VISIBLE (f, false);
+ }
else
{
FRAME_X_OUTPUT (f)->has_been_visible = true;
inev.ie.kind = DEICONIFY_EVENT;
XSETFRAME (inev.ie.frame_or_window, f);
SET_FRAME_ICONIFIED (f, false);
+ SET_FRAME_VISIBLE (f, true);
}
if (new_state & GDK_WINDOW_STATE_STICKY)
@@ -6594,6 +6599,44 @@ pgtk_selection_event (GtkWidget *widget, GdkEvent *event,
return FALSE;
}
+/* Display a warning message if the PGTK port is being used under X;
+ that is not supported. */
+
+static void
+pgtk_display_x_warning (GdkDisplay *display)
+{
+ GtkWidget *dialog_widget, *label, *content_area;
+ GtkDialog *dialog;
+ GtkWindow *window;
+ GdkScreen *screen;
+
+ /* Do this instead of GDK_IS_X11_DISPLAY because the GDK X header
+ pulls in Xlib, which conflicts with definitions in pgtkgui.h. */
+ if (strcmp (G_OBJECT_TYPE_NAME (display),
+ "GdkX11Display"))
+ return;
+
+ dialog_widget = gtk_dialog_new ();
+ dialog = GTK_DIALOG (dialog_widget);
+ window = GTK_WINDOW (dialog_widget);
+ screen = gdk_display_get_default_screen (display);
+ content_area = gtk_dialog_get_content_area (dialog);
+
+ gtk_window_set_title (window, "Warning");
+ gtk_window_set_screen (window, screen);
+
+ label = gtk_label_new ("You are trying to run Emacs configured with"
+ " the \"pure-GTK\" interface under the X Window"
+ " System. That configuration is unsupported and"
+ " will lead to sporadic crashes during transfer of"
+ " large selection data. It will also lead to"
+ " various problems with keyboard input.");
+ gtk_label_set_line_wrap (GTK_LABEL (label), TRUE);
+ gtk_container_add (GTK_CONTAINER (content_area), label);
+ gtk_widget_show (label);
+ gtk_widget_show (dialog_widget);
+}
+
/* Open a connection to X display DISPLAY_NAME, and return
the structure that describes the open display.
If we cannot contact the display, return null. */
@@ -6697,6 +6740,9 @@ pgtk_term_init (Lisp_Object display_name, char
*resource_name)
return 0;
}
+ /* If the PGTK port is being used under X, complain very loudly, as
+ that isn't supported. */
+ pgtk_display_x_warning (dpy);
dpyinfo = xzalloc (sizeof *dpyinfo);
pgtk_initialize_display_info (dpyinfo);
diff --git a/src/print.c b/src/print.c
index 34552803c0..4c3bf6c4ee 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2028,8 +2028,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
i = sprintf (buf, " stmt=%p", XSQLITE (obj)->stmt);
strout (buf, i, i, printcharfun);
}
- i = sprintf (buf, " name=%s", XSQLITE (obj)->name);
- strout (buf, i, i, printcharfun);
+ print_c_string (" name=", printcharfun);
+ print_c_string (XSQLITE (obj)->name, printcharfun);
printchar ('>', printcharfun);
}
break;
diff --git a/src/process.c b/src/process.c
index 04b466d508..6cbdfed1f5 100644
--- a/src/process.c
+++ b/src/process.c
@@ -292,7 +292,6 @@ static int child_signal_read_fd = -1;
descriptor to notify `wait_reading_process_output' of process
status changes. */
static int child_signal_write_fd = -1;
-static void child_signal_init (void);
#ifndef WINDOWSNT
static void child_signal_read (int, void *);
#endif
@@ -7323,7 +7322,7 @@ process has been transmitted to the serial port. */)
/* Set up `child_signal_read_fd' and `child_signal_write_fd'. */
-static void
+void
child_signal_init (void)
{
/* Either both are initialized, or both are uninitialized. */
diff --git a/src/search.c b/src/search.c
index b5d6a442c0..1c5831b6de 100644
--- a/src/search.c
+++ b/src/search.c
@@ -1558,7 +1558,6 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (1)
{
/* Try matching at position POS. */
- ptrdiff_t this_pos = pos;
ptrdiff_t this_pos_byte = pos_byte;
ptrdiff_t this_len = len;
unsigned char *p = pat;
@@ -1580,7 +1579,6 @@ simple_search (EMACS_INT n, unsigned char *pat,
p += charlen;
this_pos_byte += buf_charlen;
- this_pos++;
}
if (this_len == 0)
@@ -2824,11 +2822,21 @@ Return value is undefined if the last search failed.
*/)
}
DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0,
- doc: /* Return a list describing what the last search matched.
-Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
-All the elements are markers or nil (nil if the Nth pair didn't match)
-if the last match was on a buffer; integers or nil if a string was matched.
-Use `set-match-data' to reinstate the data in this list.
+ doc: /* Return a list of positions that record text matched by the last
search.
+Element 2N of the returned list is the position of the beginning of the
+match of the Nth subexpression; it corresponds to `(match-beginning N)';
+element 2N + 1 is the position of the end of the match of the Nth
+subexpression; it corresponds to `(match-end N)'. See `match-beginning'
+and `match-end'.
+If the last search was on a buffer, all the elements are by default
+markers or nil (nil when the Nth pair didn't match); they are integers
+or nil if the search was on a string. But if the optional argument
+INTEGERS is non-nil, the elements that represent buffer positions are
+always integers, not markers, and (if the search was on a buffer) the
+buffer itself is appended to the list as one additional element.
+
+Use `set-match-data' to reinstate the match data from the elements of
+this list.
Note that non-matching optional groups at the end of the regexp are
elided instead of being represented with two `nil's each. For instance:
@@ -2838,16 +2846,13 @@ elided instead of being represented with two `nil's
each. For instance:
(match-data))
=> (0 1 nil nil 0 1)
-If INTEGERS (the optional first argument) is non-nil, always use
-integers (rather than markers) to represent buffer positions. In
-this case, and if the last match was in a buffer, the buffer will get
-stored as one additional element at the end of the list.
-
-If REUSE is a list, reuse it as part of the value. If REUSE is long
-enough to hold all the values, and if INTEGERS is non-nil, no consing
-is done.
+If REUSE is a list, store the value in REUSE by destructively modifying it.
+If REUSE is long enough to hold all the values, its length remains the
+same, and any unused elements are set to nil. If REUSE is not long
+enough, it is extended. Note that if REUSE is long enough and INTEGERS
+is non-nil, no consing is done to make the return value; this minimizes GC.
-If optional third arg RESEAT is non-nil, any previous markers on the
+If optional third argument RESEAT is non-nil, any previous markers on the
REUSE list will be modified to point to nowhere.
Return value is undefined if the last search failed. */)
diff --git a/src/sqlite.c b/src/sqlite.c
index d6cb38a29a..ac860f55bc 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -52,7 +52,9 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null,
(sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int));
DEF_DLL_FN (SQLITE_API int, sqlite3_extended_errcode, (sqlite3*));
DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
+#if SQLITE_VERSION_NUMBER >= 3007015
DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int));
+#endif
DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*));
DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*));
@@ -91,7 +93,9 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# undef sqlite3_bind_int
# undef sqlite3_extended_errcode
# undef sqlite3_errmsg
-# undef sqlite3_errstr
+# if SQLITE_VERSION_NUMBER >= 3007015
+# undef sqlite3_errstr
+# endif
# undef sqlite3_step
# undef sqlite3_changes
# undef sqlite3_column_count
@@ -117,7 +121,9 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# define sqlite3_bind_int fn_sqlite3_bind_int
# define sqlite3_extended_errcode fn_sqlite3_extended_errcode
# define sqlite3_errmsg fn_sqlite3_errmsg
-# define sqlite3_errstr fn_sqlite3_errstr
+# if SQLITE_VERSION_NUMBER >= 3007015
+# define sqlite3_errstr fn_sqlite3_errstr
+# endif
# define sqlite3_step fn_sqlite3_step
# define sqlite3_changes fn_sqlite3_changes
# define sqlite3_column_count fn_sqlite3_column_count
@@ -146,7 +152,9 @@ load_dll_functions (HMODULE library)
LOAD_DLL_FN (library, sqlite3_bind_int);
LOAD_DLL_FN (library, sqlite3_extended_errcode);
LOAD_DLL_FN (library, sqlite3_errmsg);
+#if SQLITE_VERSION_NUMBER >= 3007015
LOAD_DLL_FN (library, sqlite3_errstr);
+#endif
LOAD_DLL_FN (library, sqlite3_step);
LOAD_DLL_FN (library, sqlite3_changes);
LOAD_DLL_FN (library, sqlite3_column_count);
@@ -428,13 +436,27 @@ row_to_value (sqlite3_stmt *stmt)
static Lisp_Object
sqlite_prepare_errdata (int code, sqlite3 *sdb)
{
- Lisp_Object errstr = build_string (sqlite3_errstr (code));
Lisp_Object errcode = make_fixnum (code);
- /* More details about what went wrong. */
- Lisp_Object ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
const char *errmsg = sqlite3_errmsg (sdb);
- return list4 (errstr, errmsg ? build_string (errmsg) : Qnil,
- errcode, ext_errcode);
+ Lisp_Object lerrmsg = errmsg ? build_string (errmsg) : Qnil;
+ Lisp_Object errstr, ext_errcode;
+
+#if SQLITE_VERSION_NUMBER >= 3007015
+ errstr = build_string (sqlite3_errstr (code));
+#else
+ /* The internet says this is identical to sqlite3_errstr (code). */
+ errstr = lerrmsg;
+#endif
+
+ /* More details about what went wrong. */
+#if SQLITE_VERSION_NUMBER >= 3006005
+ ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
+#else
+ /* What value to use here? */
+ ext_errcode = make_fixnum (0);
+#endif
+
+ return list4 (errstr, lerrmsg, errcode, ext_errcode);
}
DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
@@ -528,14 +550,15 @@ DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select,
2, 4, 0,
If VALUES is non-nil, it should be a list or a vector specifying the
values that will be interpolated into a parameterized statement.
-By default, the return value is a list where the first element is a
-list of column names, and the rest of the elements are the matching data.
+By default, the return value is a list, whose contents depend on
+the value of the optional argument RETURN-TYPE.
-RETURN-TYPE can be either nil (which means that the matching data
-should be returned as a list of rows), or `full' (the same, but the
-first element in the return list will be the column names), or `set',
-which means that we return a set object that can be queried with
-`sqlite-next' and other functions to get the data. */)
+If RETURN-TYPE is nil or omitted, the function returns a list of rows
+matching QUERY. If RETURN-TYPE is `full', the function returns a
+list whose first element is the list of column names, and the rest
+of the elements are the rows matching QUERY. If RETURN-TYPE is `set',
+the function returns a set object that can be queried with functions
+like `sqlite-next' etc., in order to get the data. */)
(Lisp_Object db, Lisp_Object query, Lisp_Object values,
Lisp_Object return_type)
{
diff --git a/src/w32fns.c b/src/w32fns.c
index 5f652ae9e4..c7eddcba6d 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -2734,8 +2734,7 @@ setup_w32_kbdhook (void)
int i;
CoCreateGuid (&guid);
- StringFromGUID2 (&guid, newTitle, 64);
- if (newTitle != NULL)
+ if (oldTitle != NULL && StringFromGUID2 (&guid, newTitle, 64))
{
GetConsoleTitleW (oldTitle, 1024);
SetConsoleTitleW (newTitle);
@@ -8418,7 +8417,7 @@ a ShowWindow flag:
current_dir = ENCODE_FILE (current_dir);
/* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
- be a URL that is not limited to MAX_PATH chararcters. */
+ be a URL that is not limited to MAX_PATH characters. */
doclen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (document), -1, NULL, 0);
doc_w = xmalloc (doclen * sizeof (wchar_t));
diff --git a/src/xdisp.c b/src/xdisp.c
index dd243eca98..f6a279636a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -23153,10 +23153,18 @@ extend_face_to_end_of_line (struct it *it)
this is called when redisplaying a non-selected window, with
point temporarily moved to window-point. */
specbind (Qinhibit_quit, Qt);
- const int extend_face_id = (it->face_id == DEFAULT_FACE_ID
- || it->s != NULL)
- ? DEFAULT_FACE_ID
- : face_at_pos (it, LFACE_EXTEND_INDEX);
+ /* The default face, possibly remapped. */
+ struct face *default_face =
+ FACE_FROM_ID_OR_NULL (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
+ if (!default_face)
+ return;
+
+ const int extend_face_id =
+ (it->face_id == default_face->id || it->s != NULL)
+ ? it->face_id
+ : (it->glyph_row->ends_at_zv_p
+ ? default_face->id
+ : face_at_pos (it, LFACE_EXTEND_INDEX));
unbind_to (count, Qnil);
/* Face extension extends the background and box of IT->extend_face_id
@@ -23193,14 +23201,8 @@ extend_face_to_end_of_line (struct it *it)
if (!ASCII_CHAR_P (it->c))
it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil);
- /* The default face, possibly remapped. */
- struct face *default_face =
- FACE_FROM_ID (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
#ifdef HAVE_WINDOW_SYSTEM
- if (default_face == NULL)
- error ("extend_face_to_end_of_line: default_face is not set!");
-
if (FRAME_WINDOW_P (f))
{
/* If the row is empty, add a space with the current face of IT,
@@ -33562,8 +33564,14 @@ coords_in_mouse_face_p (struct window *w, int hpos,
int vpos)
bool
cursor_in_mouse_face_p (struct window *w)
{
- int hpos = w->phys_cursor.hpos;
int vpos = w->phys_cursor.vpos;
+
+ /* If the cursor is outside the matrix glyph rows, it cannot be
+ within the mouse face. */
+ if (!(0 <= vpos && vpos < w->current_matrix->nrows))
+ return false;
+
+ int hpos = w->phys_cursor.hpos;
struct glyph_row *row = MATRIX_ROW (w->current_matrix, vpos);
/* When the window is hscrolled, cursor hpos can legitimately be out
diff --git a/src/xselect.c b/src/xselect.c
index db5c7853e7..9480ac18c1 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -918,6 +918,13 @@ x_handle_selection_request (struct selection_input_event
*event)
}
/* Save conversion results */
lisp_data_to_selection_data (dpyinfo, multprop, &cs);
+
+ /* If cs.type is ATOM, change it to ATOM_PAIR. This is because
+ the parameters to a MULTIPLE are ATOM_PAIRs. */
+
+ if (cs.type == XA_ATOM)
+ cs.type = dpyinfo->Xatom_ATOM_PAIR;
+
XChangeProperty (dpyinfo->display, requestor, property,
cs.type, cs.format, PropModeReplace,
cs.data, cs.size);
diff --git a/src/xterm.c b/src/xterm.c
index f1bccddb6c..7a1fd6086c 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -912,11 +912,6 @@ struct x_selection_request_event
struct x_selection_request_event *pending_selection_requests;
-/* Compare two request serials A and B with OP, handling
- wraparound. */
-#define X_COMPARE_SERIALS(a, op ,b) \
- (((long) (a) - (long) (b)) op 0)
-
struct x_atom_ref
{
/* Atom name. */
@@ -5245,7 +5240,9 @@ xi_convert_button_state (XIButtonState *in, unsigned int
*out)
}
}
-/* Return the modifier state in XEV as a standard X modifier mask. */
+/* Return the modifier state in XEV as a standard X modifier mask.
+ This should be used for non-keyboard events, where the group does
+ not matter. */
#ifdef USE_GTK
static
@@ -5263,6 +5260,17 @@ xi_convert_event_state (XIDeviceEvent *xev)
return mods | buttons;
}
+/* Like the above. However, buttons are not converted, while the
+ group is. This should be used for key events being passed to the
+ likes of input methods and Xt. */
+
+static unsigned int
+xi_convert_event_keyboard_state (XIDeviceEvent *xev)
+{
+ return ((xev->mods.effective & ~(1 << 13 | 1 << 14))
+ | (xev->group.effective << 13));
+}
+
/* Free all XI2 devices on DPYINFO. */
static void
x_free_xi_devices (struct x_display_info *dpyinfo)
@@ -5301,6 +5309,7 @@ x_free_xi_devices (struct x_display_info *dpyinfo)
}
#ifdef HAVE_XINPUT2_1
+
struct xi_known_valuator
{
/* The current value of this valuator. */
@@ -5312,20 +5321,21 @@ struct xi_known_valuator
/* The next valuator whose value we already know. */
struct xi_known_valuator *next;
};
+
#endif
static void
-xi_populate_device_from_info (struct xi_device_t *xi_device,
+xi_populate_device_from_info (struct x_display_info *dpyinfo,
+ struct xi_device_t *xi_device,
XIDeviceInfo *device)
{
#ifdef HAVE_XINPUT2_1
struct xi_scroll_valuator_t *valuator;
struct xi_known_valuator *values, *tem;
- int actual_valuator_count;
+ int actual_valuator_count, c;
XIScrollClassInfo *info;
- XIValuatorClassInfo *val_info;
+ XIValuatorClassInfo *valuator_info;
#endif
- int c;
#ifdef HAVE_XINPUT2_2
XITouchClassInfo *touch_info;
#endif
@@ -5334,30 +5344,90 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
USE_SAFE_ALLOCA;
#endif
+ /* Initialize generic information about the device: its ID, which
+ buttons are currently pressed and thus presumably actively
+ grabbing the device, what kind of device it is (master pointer,
+ master keyboard, slave pointer, slave keyboard, or floating
+ slave), and its attachment.
+
+ Here is a brief description of what device uses and attachments
+ are. Under XInput 2, user input from individual input devices is
+ multiplexed into specific seats before being delivered, with each
+ seat corresponding to a single on-screen mouse pointer and having
+ its own keyboard focus. Each seat consists of two virtual
+ devices: the master keyboard and the master pointer, the first of
+ which is used to report all keyboard input, with the other used
+ to report all other input.
+
+ Input from each physical device (mouse, trackpad or keyboard) is
+ then associated with that slave device's paired master device.
+ For example, moving the device "Logitech USB Optical Mouse",
+ enslaved by the master pointer device "Virtual core pointer",
+ will result in movement of the mouse pointer associated with that
+ master device's seat. If the pointer moves over an Emacs frame,
+ then the frame will receive XI_Enter and XI_Motion events from
+ that master pointer.
+
+ Likewise, keyboard input from the device "AT Translated Set 2
+ keyboard", enslaved by the master keyboard device "Virtual core
+ keyboard", will be reported to its seat's input focus window.
+
+ The device use describes what the device is. The meanings of
+ MasterPointer, MasterKeyboard, SlavePointer and SlaveKeyboard
+ should be obvious. FloatingSlave means the device is a slave
+ device that is not associated with any seat, and thus generates
+ no input.
+
+ The device attachment is a device ID whose meaning varies
+ depending on the device use. If the device is a master device,
+ then the attachment is the device ID of the other device in its
+ seat (the master keyboard for master pointer devices, and vice
+ versa). Otherwise, it is the ID of the master device the slave
+ device is attached to. For slave devices not attached to any
+ seat, its value is undefined. */
+
xi_device->device_id = device->deviceid;
xi_device->grab = 0;
-
-#ifdef HAVE_XINPUT2_1
- actual_valuator_count = 0;
- xi_device->valuators = xmalloc (sizeof *xi_device->valuators
- * device->num_classes);
- values = NULL;
-#endif
-
xi_device->use = device->use;
xi_device->name = build_string (device->name);
xi_device->attachment = device->attachment;
+ /* Clear the list of active touch points on the device, which are
+ individual touches tracked by a touchscreen. */
+
#ifdef HAVE_XINPUT2_2
xi_device->touchpoints = NULL;
xi_device->direct_p = false;
#endif
+#ifdef HAVE_XINPUT2_1
+ if (!dpyinfo->xi2_version)
+ {
+ /* Skip everything below as there are no classes of interest on
+ XI 2.0 servers. */
+ xi_device->valuators = NULL;
+ xi_device->scroll_valuator_count = 0;
+
+ SAFE_FREE ();
+ return;
+ }
+
+ actual_valuator_count = 0;
+ xi_device->valuators = xnmalloc (device->num_classes,
+ sizeof *xi_device->valuators);
+ values = NULL;
+
+ /* Initialize device info based on a list of "device classes".
+ Device classes are little pieces of information associated with a
+ device. Emacs is interested in scroll valuator information and
+ touch handling information, which respectively describe the axes
+ (if any) along which the device's scroll wheel rotates, and how
+ the device reports touch input. */
+
for (c = 0; c < device->num_classes; ++c)
{
switch (device->classes[c]->type)
{
-#ifdef HAVE_XINPUT2_1
case XIScrollClass:
{
info = (XIScrollClassInfo *) device->classes[c];
@@ -5375,17 +5445,27 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
case XIValuatorClass:
{
- val_info = (XIValuatorClassInfo *) device->classes[c];
+ valuator_info = (XIValuatorClassInfo *) device->classes[c];
tem = SAFE_ALLOCA (sizeof *tem);
+ /* Avoid restoring bogus values if some driver
+ accidentally specifies relative values in scroll
+ valuator classes how the input extension spec says they
+ should be, but allow restoring values when a value is
+ set, which is how the input extension actually
+ behaves. */
+
+ if (valuator_info->value == 0.0
+ && valuator_info->mode != XIModeAbsolute)
+ continue;
+
tem->next = values;
- tem->number = val_info->number;
- tem->current_value = val_info->value;
+ tem->number = valuator_info->number;
+ tem->current_value = valuator_info->value;
values = tem;
break;
}
-#endif
#ifdef HAVE_XINPUT2_2
case XITouchClass:
@@ -5399,7 +5479,6 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
}
}
-#ifdef HAVE_XINPUT2_1
xi_device->scroll_valuator_count = actual_valuator_count;
/* Now look through all the valuators whose values are already known
@@ -5413,7 +5492,9 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
if (xi_device->valuators[c].number == tem->number)
{
xi_device->valuators[c].invalid_p = false;
- xi_device->valuators[c].current_value = tem->current_value;
+ xi_device->valuators[c].current_value
+ = tem->current_value;
+ xi_device->valuators[c].emacs_value = 0.0;
}
}
}
@@ -5475,7 +5556,8 @@ x_cache_xi_devices (struct x_display_info *dpyinfo)
for (i = 0; i < ndevices; ++i)
{
if (infos[i].enabled)
- xi_populate_device_from_info (&dpyinfo->devices[actual_devices++],
+ xi_populate_device_from_info (dpyinfo,
+ &dpyinfo->devices[actual_devices++],
&infos[i]);
}
@@ -5610,8 +5692,11 @@ static void
xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo,
int id)
{
- struct xi_device_t *device = xi_device_from_id (dpyinfo, id);
+ struct xi_device_t *device;
struct xi_scroll_valuator_t *valuator;
+ int i;
+
+ device = xi_device_from_id (dpyinfo, id);
if (!device)
return;
@@ -5619,7 +5704,7 @@ xi_reset_scroll_valuators_for_device_id (struct
x_display_info *dpyinfo,
if (!device->scroll_valuator_count)
return;
- for (int i = 0; i < device->scroll_valuator_count; ++i)
+ for (i = 0; i < device->scroll_valuator_count; ++i)
{
valuator = &device->valuators[i];
valuator->invalid_p = true;
@@ -11414,15 +11499,18 @@ x_new_focus_frame (struct x_display_info *dpyinfo,
struct frame *frame)
x_frame_rehighlight (dpyinfo);
}
+#ifdef HAVE_XFIXES
+
/* True if the display in DPYINFO supports a version of Xfixes
sufficient for pointer blanking. */
-#ifdef HAVE_XFIXES
+
static bool
-x_probe_xfixes_extension (struct x_display_info *dpyinfo)
+x_fixes_pointer_blanking_supported (struct x_display_info *dpyinfo)
{
return (dpyinfo->xfixes_supported_p
&& dpyinfo->xfixes_major >= 4);
}
+
#endif /* HAVE_XFIXES */
/* Toggle mouse pointer visibility on frame F using the XFixes
@@ -11493,7 +11581,7 @@ x_toggle_visible_pointer (struct frame *f, bool
invisible)
/* But if Xfixes is available, try using it instead. */
if (dpyinfo->invisible_cursor == None)
{
- if (x_probe_xfixes_extension (dpyinfo))
+ if (x_fixes_pointer_blanking_supported (dpyinfo))
{
dpyinfo->fixes_pointer_blanking = true;
xfixes_toggle_visible_pointer (f, invisible);
@@ -11521,7 +11609,7 @@ XTtoggle_invisible_pointer (struct frame *f, bool
invisible)
block_input ();
#ifdef HAVE_XFIXES
if (FRAME_DISPLAY_INFO (f)->fixes_pointer_blanking
- && x_probe_xfixes_extension (FRAME_DISPLAY_INFO (f)))
+ && x_fixes_pointer_blanking_supported (FRAME_DISPLAY_INFO (f)))
xfixes_toggle_visible_pointer (f, invisible);
else
#endif
@@ -11529,13 +11617,16 @@ XTtoggle_invisible_pointer (struct frame *f, bool
invisible)
unblock_input ();
}
-/* Handle FocusIn and FocusOut state changes for FRAME.
- If FRAME has focus and there exists more than one frame, puts
- a FOCUS_IN_EVENT into *BUFP. */
+/* Handle FocusIn and FocusOut state changes for FRAME. If FRAME has
+ focus and there exists more than one frame, puts a FOCUS_IN_EVENT
+ into *BUFP. Note that this code is not used to handle focus
+ changes on builds that can use the X Input extension for handling
+ input focus when it is available (currently the no toolkit and GTK
+ 3 toolkits). */
static void
-x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct
frame *frame,
- struct input_event *bufp)
+x_focus_changed (int type, int state, struct x_display_info *dpyinfo,
+ struct frame *frame, struct input_event *bufp)
{
if (type == FocusIn)
{
@@ -13017,121 +13108,185 @@ xi_get_scroll_valuator (struct xi_device_t *device,
int number)
return NULL;
}
-#endif
+/* Check if EVENT, a DeviceChanged event, contains any scroll
+ valuators. */
-/* Handle EVENT, a DeviceChanged event. Look up the device that
- changed, and update its information with the data in EVENT. */
+static bool
+xi_has_scroll_valuators (XIDeviceChangedEvent *event)
+{
+ int i;
+
+ for (i = 0; i < event->num_classes; ++i)
+ {
+ if (event->classes[i]->type == XIScrollClass)
+ return true;
+ }
+
+ return false;
+}
+
+/* Repopulate the information (touchpoint tracking information, scroll
+ valuators, etc) in DEVICE with the device classes provided in
+ CLASSES. This is called upon receiving a DeviceChanged event.
+
+ This function is not present on XI 2.0 as there are no worthwhile
+ classes there. */
static void
-xi_handle_device_changed (struct x_display_info *dpyinfo,
- struct xi_device_t *device,
- XIDeviceChangedEvent *event)
+xi_handle_new_classes (struct x_display_info *dpyinfo, struct xi_device_t
*device,
+ XIAnyClassInfo **classes, int num_classes)
{
-#ifdef HAVE_XINPUT2_1
- XIDeviceInfo *info;
XIScrollClassInfo *scroll;
- int i, ndevices;
struct xi_scroll_valuator_t *valuator;
XIValuatorClassInfo *valuator_info;
-#endif
+ int i;
#ifdef HAVE_XINPUT2_2
- struct xi_touch_point_t *tem, *last;
XITouchClassInfo *touch;
#endif
-#ifdef HAVE_XINPUT2_1
- /* When a DeviceChange event is received for a master device, we
- don't get any scroll valuators along with it. This is possibly
- an X server bug but I really don't want to dig any further, so
- fetch the scroll valuators manually. (bug#57020) */
-
- x_catch_errors (dpyinfo->display);
- info = XIQueryDevice (dpyinfo->display, event->deviceid,
- /* ndevices is always 1 if a deviceid is
- specified. If the request fails, NULL will
- be returned. */
- &ndevices);
- x_uncatch_errors ();
+ if (dpyinfo->xi2_version < 1)
+ /* Emacs is connected to an XI 2.0 server, which reports no
+ classes of interest. */
+ return;
- if (info)
- {
- device->valuators = xrealloc (device->valuators,
- (info->num_classes
- * sizeof *device->valuators));
- device->scroll_valuator_count = 0;
+ device->valuators = xnmalloc (num_classes,
+ sizeof *device->valuators);
+ device->scroll_valuator_count = 0;
#ifdef HAVE_XINPUT2_2
- device->direct_p = false;
+ device->direct_p = false;
#endif
- for (i = 0; i < info->num_classes; ++i)
+ for (i = 0; i < num_classes; ++i)
+ {
+ switch (classes[i]->type)
{
- switch (info->classes[i]->type)
- {
- case XIScrollClass:
- scroll = (XIScrollClassInfo *) info->classes[i];
-
- valuator = &device->valuators[device->scroll_valuator_count++];
- valuator->horizontal = (scroll->scroll_type
- == XIScrollTypeHorizontal);
- valuator->invalid_p = true;
- valuator->emacs_value = DBL_MIN;
- valuator->increment = scroll->increment;
- valuator->number = scroll->number;
- break;
+ case XIScrollClass:
+ scroll = (XIScrollClassInfo *) classes[i];
+
+ valuator = &device->valuators[device->scroll_valuator_count++];
+ valuator->horizontal = (scroll->scroll_type
+ == XIScrollTypeHorizontal);
+ valuator->invalid_p = true;
+ valuator->emacs_value = 0;
+ valuator->increment = scroll->increment;
+ valuator->number = scroll->number;
+ break;
#ifdef HAVE_XINPUT2_2
- case XITouchClass:
- touch = (XITouchClassInfo *) info->classes[i];
+ case XITouchClass:
+ touch = (XITouchClassInfo *) classes[i];
- if (touch->mode == XIDirectTouch)
- device->direct_p = true;
- break;
+ if (touch->mode == XIDirectTouch)
+ device->direct_p = true;
+ break;
#endif
- }
}
+ }
- /* Restore the values of any scroll valuators that we already
- know about. */
+ /* Restore the values of any scroll valuators that we already
+ know about. */
- for (i = 0; i < info->num_classes; ++i)
- {
- switch (info->classes[i]->type)
- {
- case XIValuatorClass:
- valuator_info = (XIValuatorClassInfo *) info->classes[i];
+ for (i = 0; i < num_classes; ++i)
+ {
+ if (classes[i]->type != XIValuatorClass)
+ continue;
- valuator = xi_get_scroll_valuator (device,
- valuator_info->number);
- if (valuator)
- {
- valuator->invalid_p = false;
- valuator->current_value = valuator_info->value;
- }
+ valuator_info = (XIValuatorClassInfo *) classes[i];
- break;
- }
- }
+ /* Avoid restoring bogus values if some driver accidentally
+ specifies relative values in scroll valuator classes how the
+ input extension spec says they should be, but allow restoring
+ values when a value is set, which is how the input extension
+ actually behaves. */
+
+ if (valuator_info->value == 0.0
+ && valuator_info->mode != XIModeAbsolute)
+ continue;
+
+ valuator = xi_get_scroll_valuator (device,
+ valuator_info->number);
+
+ if (!valuator)
+ continue;
+
+ valuator->invalid_p = false;
+ valuator->current_value = valuator_info->value;
+ valuator->emacs_value = 0;
+ break;
+ }
+}
+
+#endif
+
+/* Handle EVENT, a DeviceChanged event. Look up the device that
+ changed, and update its information with the data in EVENT. */
+
+static void
+xi_handle_device_changed (struct x_display_info *dpyinfo,
+ struct xi_device_t *device,
+ XIDeviceChangedEvent *event)
+{
+#ifdef HAVE_XINPUT2_1
+ int ndevices;
+ XIDeviceInfo *info;
+#endif
#ifdef HAVE_XINPUT2_2
- /* The device is no longer a DirectTouch device, so
- remove any touchpoints that we might have
- recorded. */
- if (!device->direct_p)
- {
- tem = device->touchpoints;
+ struct xi_touch_point_t *tem, *last;
+#endif
- while (tem)
- {
- last = tem;
- tem = tem->next;
- xfree (last);
- }
+#ifdef HAVE_XINPUT2_1
+ if (xi_has_scroll_valuators (event))
+ /* Scroll valuators are provided by this event. Use the values
+ provided in this event to populate the device's new scroll
+ valuator list: if this event is a SlaveSwitch event caused by
+ wheel movement, then querying for the device info will probably
+ return the value after the wheel movement, leading to a delta
+ of 0 being computed upon handling the subsequent XI_Motion
+ event. (bug#58980) */
+ xi_handle_new_classes (dpyinfo, device, event->classes,
+ event->num_classes);
+ else
+ {
+ /* When a DeviceChange event is received for a master device,
+ the X server sometimes does not send any scroll valuators
+ along with it. This is possibly an X server bug but I really
+ don't want to dig any further, so fetch the scroll valuators
+ manually. (bug#57020) */
- device->touchpoints = NULL;
- }
+ x_catch_errors (dpyinfo->display);
+ info = XIQueryDevice (dpyinfo->display, event->deviceid,
+ /* ndevices is always 1 if a deviceid is
+ specified. If the request fails, NULL will
+ be returned. */
+ &ndevices);
+ x_uncatch_errors ();
+
+ if (!info)
+ return;
+
+ /* info contains the classes currently associated with the
+ event. Apply them. */
+ xi_handle_new_classes (dpyinfo, device, info->classes,
+ info->num_classes);
+ }
#endif
- XIFreeDeviceInfo (info);
+#ifdef HAVE_XINPUT2_2
+ /* The device is no longer a DirectTouch device, so remove any
+ touchpoints that we might have recorded. */
+ if (!device->direct_p)
+ {
+ tem = device->touchpoints;
+
+ while (tem)
+ {
+ last = tem;
+ tem = tem->next;
+ xfree (last);
+ }
+
+ device->touchpoints = NULL;
}
#endif
}
@@ -13383,7 +13538,7 @@ x_find_modifier_meanings (struct x_display_info
*dpyinfo)
#ifdef HAVE_XKB
int i;
int found_meta_p = false;
- uint vmodmask;
+ unsigned int vmodmask;
#endif
dpyinfo->meta_mod_mask = 0;
@@ -18620,7 +18775,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* If drag-and-drop or another modal dialog/menu is in
progress, handle SelectionRequest events immediately, by
- pushing it onto the selecction queue. */
+ pushing it onto the selection queue. */
if (x_use_pending_selection_requests)
{
@@ -20980,8 +21135,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf)))
{
+ x_ignore_errors_for_next_request (dpyinfo);
XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
RevertToParent, event->xbutton.time);
+ x_stop_ignoring_errors (dpyinfo);
+
if (FRAME_PARENT_FRAME (f))
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
}
@@ -21393,6 +21551,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
related to those grabs arrive. The only way to
remedy this is to never reset scroll valuators on a
grab-related crossing event. (bug#57476) */
+
if (enter->mode != XINotifyUngrab
&& enter->mode != XINotifyGrab
&& enter->mode != XINotifyPassiveGrab
@@ -21522,17 +21681,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
was very complicated and kept running into server
bugs. */
#ifdef HAVE_XINPUT2_1
- if (any
- /* xfwm4 selects for button events on the frame
- window, resulting in passive grabs being
- generated along with the delivery of emulated
- button events; this then interferes with
- scrolling, since device valuators will constantly
- be reset as the crossing events related to those
- grabs arrive. The only way to remedy this is to
- never reset scroll valuators on a grab-related
- crossing event. (bug#57476) */
- && leave->mode != XINotifyUngrab
+ /* xfwm4 selects for button events on the frame window,
+ resulting in passive grabs being generated along with
+ the delivery of emulated button events; this then
+ interferes with scrolling, since device valuators
+ will constantly be reset as the crossing events
+ related to those grabs arrive. The only way to
+ remedy this is to never reset scroll valuators on a
+ grab-related crossing event. (bug#57476) */
+
+ if (leave->mode != XINotifyUngrab
&& leave->mode != XINotifyGrab
&& leave->mode != XINotifyPassiveUngrab
&& leave->mode != XINotifyPassiveGrab)
@@ -21569,19 +21727,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
masks are set on the frame widget's window. */
f = x_window_to_frame (dpyinfo, leave->event);
- /* Also do this again here, since the test for `any'
- above may not have found a frame, as that usually
- just looks up a top window on Xt builds. */
-
-#ifdef HAVE_XINPUT2_1
- if (f && leave->mode != XINotifyUngrab
- && leave->mode != XINotifyGrab
- && leave->mode != XINotifyPassiveUngrab
- && leave->mode != XINotifyPassiveGrab)
- xi_reset_scroll_valuators_for_device_id (dpyinfo,
- leave->deviceid);
-#endif
-
if (!f)
f = x_top_window_to_frame (dpyinfo, leave->event);
#endif
@@ -22696,9 +22841,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#else
/* Non-no toolkit builds without GTK 3 use core
- events to handle focus. */
+ events to handle focus. Errors are still
+ caught here in case the window is not
+ viewable. */
+ x_ignore_errors_for_next_request (dpyinfo);
XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW
(f),
RevertToParent, xev->time);
+ x_stop_ignoring_errors (dpyinfo);
#endif
if (FRAME_PARENT_FRAME (f))
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW
(f));
@@ -22953,7 +23102,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
char *copy_bufptr = copy_buffer;
int copy_bufsiz = sizeof (copy_buffer);
ptrdiff_t i;
- uint old_state;
+ unsigned int old_state;
struct xi_device_t *device, *source;
coding = Qlatin_1;
@@ -22979,8 +23128,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
copy.xkey.root = xev->root;
copy.xkey.subwindow = xev->child;
copy.xkey.time = xev->time;
- copy.xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 <<
14))
- | (xev->group.effective << 13));
+ copy.xkey.state = xi_convert_event_keyboard_state (xev);
xi_convert_button_state (&xev->buttons, ©.xkey.state);
copy.xkey.x = lrint (xev->event_x);
@@ -23036,8 +23184,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xkey.root = xev->root;
xkey.subwindow = xev->child;
xkey.time = xev->time;
- xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14))
- | (xev->group.effective << 13));
+ xkey.state = xi_convert_event_keyboard_state (xev);
xkey.x = lrint (xev->event_x);
xkey.y = lrint (xev->event_y);
@@ -23101,8 +23248,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#ifdef HAVE_XKB
if (dpyinfo->xkb_desc)
{
- uint xkb_state = state;
- xkb_state &= ~(1 << 13 | 1 << 14);
+ unsigned int xkb_state;
+
+ xkb_state = state & ~(1 << 13 | 1 << 14);
xkb_state |= xev->group.effective << 13;
if (!XkbTranslateKeyCode (dpyinfo->xkb_desc, keycode,
@@ -23455,8 +23603,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xkey.root = xev->root;
xkey.subwindow = xev->child;
xkey.time = xev->time;
- xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14))
- | (xev->group.effective << 13));
+ xkey.state = xi_convert_event_keyboard_state (xev);
xkey.x = lrint (xev->event_x);
xkey.y = lrint (xev->event_y);
xkey.x_root = lrint (xev->root_x);
@@ -23558,7 +23705,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
memset (dpyinfo->devices + dpyinfo->num_devices -
1,
0, sizeof *dpyinfo->devices);
device = &dpyinfo->devices[dpyinfo->num_devices -
1];
- xi_populate_device_from_info (device, info);
+ xi_populate_device_from_info (dpyinfo, device,
info);
}
if (info)
@@ -24939,6 +25086,48 @@ static struct x_error_message_stack *x_error_message;
/* The amount of items (depth) in that stack. */
int x_error_message_count;
+/* Compare various request serials while handling wraparound. Treat a
+ difference of more than X_ULONG_MAX / 2 as wraparound.
+
+ Note that these functions truncate serials to 32 bits before
+ comparison. */
+
+static bool
+x_is_serial_more_than (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ return true;
+
+ return (b - a > X_ULONG_MAX / 2);
+}
+
+static bool
+x_is_serial_more_than_or_equal_to (unsigned int a, unsigned int b)
+{
+ if (a >= b)
+ return true;
+
+ return (b - a > X_ULONG_MAX / 2);
+}
+
+static bool
+x_is_serial_less_than (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ return true;
+
+ return (a - b > X_ULONG_MAX / 2);
+}
+
+static bool
+x_is_serial_less_than_or_equal_to (unsigned int a, unsigned int b)
+{
+ if (a <= b)
+ return true;
+
+ return (a - b > X_ULONG_MAX / 2);
+}
+
static struct x_error_message_stack *
x_find_error_handler (Display *dpy, XErrorEvent *event)
{
@@ -24948,8 +25137,8 @@ x_find_error_handler (Display *dpy, XErrorEvent *event)
while (stack)
{
- if (X_COMPARE_SERIALS (event->serial, >=,
- stack->first_request)
+ if (x_is_serial_more_than_or_equal_to (event->serial,
+ stack->first_request)
&& dpy == stack->dpy)
return stack;
@@ -25052,11 +25241,11 @@ x_request_can_fail (struct x_display_info *dpyinfo,
failable_requests < dpyinfo->next_failable_request;
failable_requests++)
{
- if (X_COMPARE_SERIALS (request, >=,
- failable_requests->start)
+ if (x_is_serial_more_than_or_equal_to (request,
+ failable_requests->start)
&& (!failable_requests->end
- || X_COMPARE_SERIALS (request, <=,
- failable_requests->end)))
+ || x_is_serial_less_than_or_equal_to (request,
+ failable_requests->end)))
return failable_requests;
}
@@ -25074,11 +25263,11 @@ x_clean_failable_requests (struct x_display_info
*dpyinfo)
for (first = dpyinfo->failable_requests; first < last; first++)
{
- if (X_COMPARE_SERIALS (first->start, >,
- LastKnownRequestProcessed (dpyinfo->display))
+ if (x_is_serial_more_than (first->start,
+ LastKnownRequestProcessed (dpyinfo->display))
|| !first->end
- || X_COMPARE_SERIALS (first->end, >,
- LastKnownRequestProcessed (dpyinfo->display)))
+ || x_is_serial_more_than (first->end,
+ LastKnownRequestProcessed
(dpyinfo->display)))
break;
}
@@ -25157,8 +25346,7 @@ x_stop_ignoring_errors (struct x_display_info *dpyinfo)
/* Abort if no request was made since
`x_ignore_errors_for_next_request'. */
- if (X_COMPARE_SERIALS (range->end, <,
- range->start))
+ if (x_is_serial_less_than (range->end, range->start))
emacs_abort ();
#ifdef HAVE_GTK3
@@ -27377,6 +27565,25 @@ x_get_focus_frame (struct frame *f)
return lisp_focus;
}
+/* Return the toplevel parent of F, if it is a child frame.
+ Otherwise, return NULL. */
+
+static struct frame *
+x_get_toplevel_parent (struct frame *f)
+{
+ struct frame *parent;
+
+ if (!FRAME_PARENT_FRAME (f))
+ return NULL;
+
+ parent = FRAME_PARENT_FRAME (f);
+
+ while (FRAME_PARENT_FRAME (parent))
+ parent = FRAME_PARENT_FRAME (parent);
+
+ return parent;
+}
+
/* 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.
@@ -27402,6 +27609,18 @@ x_focus_frame (struct frame *f, bool noactivate)
else
{
if (!noactivate
+ /* If F is override-redirect, use SetInputFocus instead.
+ Override-redirect frames are not subject to window
+ management. */
+ && !FRAME_OVERRIDE_REDIRECT (f)
+ /* If F is a child frame, use SetInputFocus instead. This
+ may not work if its parent is not activated. */
+ && !FRAME_PARENT_FRAME (f)
+ /* If the focus is being transferred from a child frame to
+ its toplevel parent, also use SetInputFocus. */
+ && (!dpyinfo->x_focus_frame
+ || (x_get_toplevel_parent (dpyinfo->x_focus_frame)
+ != f))
&& x_wm_supports (f, dpyinfo->Xatom_net_active_window))
{
/* When window manager activation is possible, use it
@@ -28912,10 +29131,9 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif
int i;
+#if defined HAVE_XFIXES && defined USE_XCB
USE_SAFE_ALLOCA;
-
- /* Avoid warnings when SAFE_ALLOCA is not actually used. */
- ((void) SAFE_ALLOCA (0));
+#endif
block_input ();
@@ -29069,7 +29287,9 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
unblock_input ();
+#if defined HAVE_XFIXES && defined USE_XCB
SAFE_FREE ();
+#endif
return 0;
}
@@ -29089,7 +29309,9 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
unblock_input ();
+#if defined HAVE_XFIXES && defined USE_XCB
SAFE_FREE ();
+#endif
return 0;
}
#endif
@@ -29559,11 +29781,10 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
xi_select_hierarchy_events (dpyinfo);
#endif
+ dpyinfo->xi2_version = minor;
x_cache_xi_devices (dpyinfo);
}
}
-
- dpyinfo->xi2_version = minor;
skip_xi_setup:
;
#endif
@@ -29778,21 +29999,30 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
{
XrmValue d, fr, to;
Font font;
+ XFontStruct *query_result;
dpy = dpyinfo->display;
- d.addr = (XPointer)&dpy;
+ d.addr = (XPointer) &dpy;
d.size = sizeof (Display *);
fr.addr = (char *) XtDefaultFont;
fr.size = sizeof (XtDefaultFont);
to.size = sizeof (Font *);
- to.addr = (XPointer)&font;
+ to.addr = (XPointer) &font;
x_catch_errors (dpy);
if (!XtCallConverter (dpy, XtCvtStringToFont, &d, 1, &fr, &to, NULL))
emacs_abort ();
- if (x_had_errors_p (dpy) || !XQueryFont (dpy, font))
+ query_result = XQueryFont (dpy, font);
+
+ /* Set the dialog font to some fallback (here, 9x15) if the font
+ specified is invalid. */
+ if (x_had_errors_p (dpy) || !font)
XrmPutLineResource (&xrdb, "Emacs.dialog.*.font: 9x15");
- /* Do not free XFontStruct returned by the above call to XQueryFont.
- This leads to X protocol errors at XtCloseDisplay (Bug#18403). */
+
+ /* Do not destroy the font struct returned above with XFreeFont;
+ that also destroys the font, leading to to X protocol errors at
+ XtCloseDisplay. Just free the font info structure.
+ (Bug#18403) */
+ XFreeFontInfo (NULL, query_result, 1);
x_uncatch_errors ();
}
#endif
@@ -29966,7 +30196,9 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
unblock_input ();
+#if defined HAVE_XFIXES && defined USE_XCB
SAFE_FREE ();
+#endif
return dpyinfo;
}
@@ -30277,11 +30509,6 @@ x_delete_terminal (struct terminal *terminal)
closing all the displays. */
XrmDestroyDatabase (dpyinfo->rdb);
#endif
-
-#ifdef HAVE_XKB
- if (dpyinfo->xkb_desc)
- XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True);
-#endif
#ifdef USE_GTK
xg_display_close (dpyinfo->display);
#else
@@ -30291,9 +30518,6 @@ x_delete_terminal (struct terminal *terminal)
XCloseDisplay (dpyinfo->display);
#endif
#endif /* ! USE_GTK */
-
- if (dpyinfo->modmap)
- XFreeModifiermap (dpyinfo->modmap);
/* Do not close the connection here because it's already closed
by X(t)CloseDisplay (Bug#18403). */
dpyinfo->display = NULL;
@@ -30306,6 +30530,18 @@ x_delete_terminal (struct terminal *terminal)
else if (dpyinfo->connection >= 0)
emacs_close (dpyinfo->connection);
+ /* Free the keyboard and modifier maps here; that is safe to do
+ without a display, and not doing so leads to a lot of data being
+ leaked upon IO error. */
+
+#ifdef HAVE_XKB
+ if (dpyinfo->xkb_desc)
+ XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True);
+#endif
+
+ if (dpyinfo->modmap)
+ XFreeModifiermap (dpyinfo->modmap);
+
/* No more input on this descriptor. */
delete_keyboard_wait_descriptor (dpyinfo->connection);
/* Mark as dead. */
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 09becc7fe7..18b0257e01 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -354,6 +354,17 @@
(should (equal "subdir" (dired-get-filename 'local t)))))))
+(ert-deftest dired-test-bug59047 ()
+ "Test for https://debbugs.gnu.org/59047 ."
+ (dired (list (expand-file-name "src" source-directory)
+ "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c"))
+ (dired-hide-all)
+ (dired-hide-all)
+ (dired-next-line 1)
+ (should (equal 'dired-hide-details-detail
+ (get-text-property
+ (1+ (line-beginning-position)) 'invisible))))
+
(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body)
"Helper macro for Bug#27940 test."
(declare (indent 1) (debug body))
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
index 6f351170f1..429ef26657 100644
--- a/test/lisp/elide-head-tests.el
+++ b/test/lisp/elide-head-tests.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
-;; Keywords:
;; This file is part of GNU Emacs.
@@ -20,10 +19,6 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;; Commentary:
-
-;;
-
;;; Code:
(require 'elide-head)
@@ -169,6 +164,22 @@
***************************************************************************/
" "This program is distributed in the hope that")
+;; from mentor.el [no "/" in the gnu.org URL]
+(elide-head--add-test gpl3-5 "\
+;; Mentor 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, or (at your option)
+;; any later version.
+;;
+;; Mentor 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 Mentor. If not, see <https://www.gnu.org/licenses>.
+" "Mentor is distributed in the hope that")
+
;;; GPLv2
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index a1dfbab9dc..8645d7f104 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -20,8 +20,9 @@
;;; Commentary:
;;; Code:
-(require 'ert)
+(require 'ert-x)
(require 'erc-dcc)
+(require 'erc-pcomplete)
(ert-deftest erc-dcc-ctcp-query-send-regexp ()
(let ((s "DCC SEND \"file name\" 2130706433 9899 1405135128"))
@@ -164,4 +165,120 @@
(should (eq t (plist-get (car erc-dcc-list) :turbo)))
(should (equal (pop calls) (list elt "foo.bin" proc))))))))
+(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"))
+ (elt (list :nick "tester!~tester@fake.irc"
+ :type 'GET
+ :peer nil
+ :parent proc
+ :ip "127.0.0.1"
+ :port "9899"
+ :file "foo.bin"
+ :size 1405135128))
+ ;;
+ erc-accidental-paste-threshold-seconds
+ erc-insert-modify-hook erc-send-completed-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (erc-mode)
+ (pcomplete-erc-setup)
+ (add-hook 'erc-complete-functions #'erc-pcompletions-at-point 0 t)
+ (setq erc-server-process proc
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker)
+ erc-server-current-nick "dummy")
+ (setq-local erc-dcc-list (list elt)) ; for interactive noodling
+ (set-process-query-on-exit-flag proc nil)
+ (goto-char (point-max))
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+ (goto-char erc-input-marker)
+ (funcall test-fn))
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-basic ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (insert "/dcc get ")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester foo.bin" nil t))))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-1flag ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (goto-char erc-input-marker)
+ (delete-region (point) (point-max))
+ (insert "/dcc get -")
+ (call-interactively #'completion-at-point)
+ (with-current-buffer (get-buffer "*Completions*")
+ (goto-char (point-min))
+ (search-forward "-s")
+ (search-forward "-t"))
+ (insert "s ")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s tester foo.bin" nil t))))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-2flags ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (goto-char erc-input-marker)
+ (delete-region (point) (point-max))
+ (insert "/dcc get -")
+ (call-interactively #'completion-at-point)
+ (with-current-buffer (get-buffer "*Completions*")
+ (goto-char (point-min))
+ (search-forward "-s")
+ (search-forward "-t"))
+ (insert "s -")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s -t " nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s -t tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s -t tester foo.bin" nil t))))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-2flags-reverse ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (goto-char erc-input-marker)
+ (delete-region (point) (point-max))
+ (insert "/dcc get -")
+ (call-interactively #'completion-at-point)
+ (with-current-buffer (get-buffer "*Completions*")
+ (goto-char (point-min))
+ (search-forward "-s")
+ (search-forward "-t"))
+ (insert "t -")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -t -s " nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -t -s tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -t -s tester foo.bin" nil t))))))
+
;;; erc-dcc-tests.el ends here
diff --git a/test/lisp/erc/erc-networks-tests.el
b/test/lisp/erc/erc-networks-tests.el
index 66a334b709..32bdfa11ff 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -20,7 +20,7 @@
;;; Code:
(require 'ert-x) ; cl-lib
-(require 'erc-networks)
+(require 'erc)
(defun erc-networks-tests--create-dead-proc (&optional buf)
(let ((p (start-process "true" (or buf (current-buffer)) "true")))
diff --git a/test/lisp/erc/erc-services-tests.el
b/test/lisp/erc/erc-services-tests.el
index 8e2b8d2927..c22d4cf75e 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -469,12 +469,9 @@
(list (assoc 'secret (cdr found)))))
(defvar erc-join-tests--auth-source-pass-entries
- '(("irc.gnu.org:irc/#chan"
- ("port" . "irc") ("user" . "#chan") (secret . "bar"))
- ("my.gnu.org:irc/#chan"
- ("port" . "irc") ("user" . "#chan") (secret . "baz"))
- ("GNU.chat:irc/#chan"
- ("port" . "irc") ("user" . "#chan") (secret . "foo"))))
+ '(("irc.gnu.org:irc/#chan" (secret . "bar"))
+ ("my.gnu.org:irc/#chan" (secret . "baz"))
+ ("GNU.chat:irc/#chan" (secret . "foo"))))
(ert-deftest erc--auth-source-search--pass-standard ()
(ert-skip "Pass backend not yet supported")
@@ -506,16 +503,11 @@
(ert-skip "Pass backend not yet supported")
(let ((store
`(,@erc-join-tests--auth-source-pass-entries
- ("GNU.chat:6697/#chan"
- ("port" . "6697") ("user" . "#chan") (secret . "spam"))
- ("my.gnu.org:irc/#fsf"
- ("port" . "irc") ("user" . "#fsf") (secret . "42"))
- ("irc.gnu.org:6667"
- ("port" . "6667") (secret . "sesame"))
- ("MyHost:irc"
- ("port" . "irc") (secret . "456"))
- ("MyHost:6667"
- ("port" . "6667") (secret . "123"))))
+ ("GNU.chat:6697/#chan" (secret . "spam"))
+ ("my.gnu.org:irc/#fsf" (secret . "42"))
+ ("irc.gnu.org:6667" (secret . "sesame"))
+ ("MyHost:irc" (secret . "456"))
+ ("MyHost:6667" (secret . "123"))))
(auth-sources '(password-store))
(auth-source-do-cache nil))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b2ed29e80e..c88dd9888d 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -24,7 +24,6 @@
(require 'ert-x)
(require 'erc)
(require 'erc-ring)
-(require 'erc-networks)
(ert-deftest erc--read-time-period ()
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
@@ -48,27 +47,6 @@
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
(should (equal (erc--read-time-period "foo: ") 86400))))
-(ert-deftest erc--meta--backend-dependencies ()
- (with-temp-buffer
- (insert-file-contents-literally
- (concat (file-name-sans-extension (symbol-file 'erc)) ".el"))
- (let ((beg (search-forward ";; Defined in erc-backend"))
- (end (search-forward "\n\n"))
- vars)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (with-syntax-table lisp-data-mode-syntax-table
- (condition-case _
- (while (push (cadr (read (current-buffer))) vars))
- (end-of-file)))))
- (should (= (point) end))
- (dolist (var vars)
- (setq var (concat "\\_<" (symbol-name var) "\\_>"))
- (ert-info (var)
- (should (save-excursion (search-forward-regexp var nil t))))))))
-
(ert-deftest erc-with-all-buffers-of-server ()
(let (proc-exnet
proc-onet
diff --git a/test/lisp/eshell/em-tramp-tests.el
b/test/lisp/eshell/em-tramp-tests.el
index 8969c1e229..6cc35ecdb1 100644
--- a/test/lisp/eshell/em-tramp-tests.el
+++ b/test/lisp/eshell/em-tramp-tests.el
@@ -85,4 +85,79 @@
`(,(format "/sudo:USER@%s:%s" tramp-default-host
default-directory)
("echo" ("-u" "hi")))))))
+(ert-deftest em-tramp-test/sudo-shell ()
+ "Test Eshell `sudo' command with -s/--shell option."
+ (dolist (args '(("--shell")
+ ("-s")))
+ (should (equal
+ (catch 'eshell-replace-command (apply #'eshell/sudo args))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/sudo:root@%s:%s"
+ tramp-default-host default-directory))))))))
+
+(ert-deftest em-tramp-test/sudo-user-shell ()
+ "Test Eshell `sudo' command with -s and -u options."
+ (should (equal
+ (catch 'eshell-replace-command (eshell/sudo "-u" "USER" "-s"))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/sudo:USER@%s:%s"
+ tramp-default-host default-directory)))))))
+
+(ert-deftest em-tramp-test/doas-basic ()
+ "Test Eshell `doas' command with default user."
+ (cl-letf (((symbol-function 'eshell-named-command)
+ #'mock-eshell-named-command))
+ (should (equal
+ (catch 'eshell-external (eshell/doas "echo" "hi"))
+ `(,(format "/doas:root@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("hi")))))
+ (should (equal
+ (catch 'eshell-external (eshell/doas "echo" "-u" "hi"))
+ `(,(format "/doas:root@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("-u" "hi")))))))
+
+(ert-deftest em-tramp-test/doas-user ()
+ "Test Eshell `doas' command with specified user."
+ (cl-letf (((symbol-function 'eshell-named-command)
+ #'mock-eshell-named-command))
+ (should (equal
+ (catch 'eshell-external (eshell/doas "-u" "USER" "echo" "hi"))
+ `(,(format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("hi")))))
+ (should (equal
+ (catch 'eshell-external
+ (eshell/doas "-u" "USER" "echo" "-u" "hi"))
+ `(,(format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("-u" "hi")))))))
+
+(ert-deftest em-tramp-test/doas-shell ()
+ "Test Eshell `doas' command with -s/--shell option."
+ (dolist (args '(("--shell")
+ ("-s")))
+ (should (equal
+ (catch 'eshell-replace-command (apply #'eshell/doas args))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/doas:root@%s:%s"
+ tramp-default-host default-directory))))))))
+
+(ert-deftest em-tramp-test/doas-user-shell ()
+ "Test Eshell `doas' command with -s and -u options."
+ (should (equal
+ (catch 'eshell-replace-command (eshell/doas "-u" "USER" "-s"))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)))))))
+
;;; em-tramp-tests.el ends here
diff --git a/test/lisp/eshell/esh-util-tests.el
b/test/lisp/eshell/esh-util-tests.el
new file mode 100644
index 0000000000..1cbd015999
--- /dev/null
+++ b/test/lisp/eshell/esh-util-tests.el
@@ -0,0 +1,57 @@
+;;; esh-util-tests.el --- esh-util 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 'esh-util)
+
+;;; Tests:
+
+(ert-deftest esh-util-test/eshell-stringify/string ()
+ "Test that `eshell-stringify' preserves the value of strings."
+ (should (equal (eshell-stringify "hello") "hello")))
+
+(ert-deftest esh-util-test/eshell-stringify/number ()
+ "Test that `eshell-stringify' converts numbers to strings."
+ (should (equal (eshell-stringify 42) "42"))
+ (should (equal (eshell-stringify 4.2) "4.2")))
+
+(ert-deftest esh-util-test/eshell-stringify/t ()
+ "Test that `eshell-stringify' treats `t' according to `eshell-stringify-t'."
+ (let ((eshell-stringify-t t))
+ (should (equal (eshell-stringify t) "t")))
+ (let ((eshell-stringify-t nil))
+ (should (equal (eshell-stringify t) nil))))
+
+(ert-deftest esh-util-test/eshell-stringify/nil ()
+ "Test that `eshell-stringify' converts nil to a string."
+ (should (equal (eshell-stringify nil) "nil")))
+
+(ert-deftest esh-util-test/eshell-stringify/list ()
+ "Test that `eshell-stringify' correctly stringifies lists."
+ (should (equal (eshell-stringify '(1 2 3)) "(1 2 3)"))
+ (should (equal (eshell-stringify '((1 2) (3 . 4)))
+ "((1 2)\n (3 . 4))")))
+
+(ert-deftest esh-util-test/eshell-stringify/complex ()
+ "Test that `eshell-stringify' correctly stringifies complex objects."
+ (should (equal (eshell-stringify (list 'quote 'hello)) "'hello")))
+
+;;; esh-util-tests.el ends here
diff --git a/test/lisp/eshell/esh-var-tests.el
b/test/lisp/eshell/esh-var-tests.el
index d9b2585a32..245a8e6a26 100644
--- a/test/lisp/eshell/esh-var-tests.el
+++ b/test/lisp/eshell/esh-var-tests.el
@@ -497,12 +497,13 @@ inside double-quotes"
(ert-deftest esh-var-test/alias/function ()
"Test using a variable alias defined as a function."
- (with-temp-eshell
- (push `("ALIAS" ,(lambda () "value") nil t) eshell-variable-aliases-list)
- (eshell-match-command-output "echo $ALIAS" "value\n")
- (eshell-match-command-output "set ALIAS hello"
- "Variable `ALIAS' is not settable\n"
- nil t)))
+ (let ((text-quoting-style 'grave))
+ (with-temp-eshell
+ (push `("ALIAS" ,(lambda () "value") nil t) eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello"
+ "Variable `ALIAS' is not settable\n"
+ nil t))))
(ert-deftest esh-var-test/alias/function-pair ()
"Test using a variable alias defined as a pair of getter/setter functions."
@@ -558,12 +559,13 @@ This should get/set the value bound to the symbol."
This should get the value bound to the symbol, but fail to set
it, since the setter is nil."
(with-temp-eshell
- (let ((eshell-test-value "value"))
+ (let ((eshell-test-value "value")
+ (text-quoting-style 'grave))
(push '("ALIAS" (eshell-test-value . nil)) eshell-variable-aliases-list)
(eshell-match-command-output "echo $ALIAS" "value\n")
(eshell-match-command-output "set ALIAS hello"
- "Variable `ALIAS' is not settable\n"
- nil t))))
+ "Variable `ALIAS' is not settable\n"
+ nil t))))
(ert-deftest esh-var-test/alias/export ()
"Test that `export' properly sets variable aliases."
diff --git a/test/lisp/net/eudc-resources/ecompleterc
b/test/lisp/net/eudc-resources/ecompleterc
new file mode 100644
index 0000000000..9019b26c9f
--- /dev/null
+++ b/test/lisp/net/eudc-resources/ecompleterc
@@ -0,0 +1,7 @@
+((mail
+ ("larsi@gnus.org" 38154 1516109510 "Lars Ingebrigtsen <larsi@ecomplete.org>")
+ ("kfogel@red-bean.com" 10 1516065455 "Karl Fogel <kfogel@ecomplete.com>")
+ ("behse@ecomplete.org" 10 1516065455 "behse@ecomplete.org"))
+ (phone
+ ("Lars Ingebrigtsen" 0 0 "+1 234 5678 9012")
+ ("Karl Fogel" 0 0 "+33 701 4567 8901")))
diff --git a/test/lisp/net/eudc-resources/mailrc
b/test/lisp/net/eudc-resources/mailrc
new file mode 100644
index 0000000000..c565f71837
--- /dev/null
+++ b/test/lisp/net/eudc-resources/mailrc
@@ -0,0 +1,3 @@
+alias lars "Lars Ingebrigtsen <larsi@mail-abbrev.com>"
+alias karl "Karl Fogel <kfogel@mail-abbrev.com>"
+alias emacsheroes lars karl
diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el
index 915006a97c..c326dcc793 100644
--- a/test/lisp/net/eudc-tests.el
+++ b/test/lisp/net/eudc-tests.el
@@ -152,4 +152,120 @@
(should (eq 'b (eudc-lax-plist-get '(nil a "a" a) 'a 'b)))
(should (eq 'b (eudc-lax-plist-get '(a nil "nil" nil) nil 'b)))))
+;; eudc-rfc5322-quote-phrase (string)
+(ert-deftest eudc-test-rfc5322-quote-phrase ()
+ "Tests for RFC5322 compliant phrase quoting."
+ ;; atext-token "[:alpha:][:digit:]!#$%&'*+/=?^_`{|}~-"
+ (should (equal (eudc-rfc5322-quote-phrase "Foo Bar !#$%&'*+/=?^_`{|}~-")
+ "Foo Bar !#$%&'*+/=?^_`{|}~-"))
+ (should (equal (eudc-rfc5322-quote-phrase "Foo, Bar !#$%&'*+/=?^_`{|}~-")
+ "\"Foo, Bar !#$%&'*+/=?^_`{|}~-\"")))
+
+;; eudc-rfc5322-valid-comment-p (string)
+(ert-deftest eudc-test-rfc5322-valid-comment-p ()
+ "Tests for RFC5322 compliant comments."
+ ;; cctext-token "\u005D-\u007E\u002A-\u005B\u0021-\u0027" + fwsp-token (TAB,
LF, SPC)
+ ;; Printable US-ASCII characters not including "(", ")", or "\".
+ (let ((good-chars (append (number-sequence #x09 #x0a)
+ (number-sequence #x20 #x20)
+ (number-sequence #x21 #x27)
+ (number-sequence #x2a #x5b)
+ (number-sequence #x5d #x7e)))
+ (bad-chars (append (number-sequence #x00 #x08)
+ (number-sequence #x0b #x1f)
+ (number-sequence #x28 #x29)
+ (number-sequence #x5c #x5c)
+ (number-sequence #x7f #xff))))
+ (dolist (gc good-chars)
+ (should (eq (eudc-rfc5322-valid-comment-p (format "%c" gc)) t)))
+ (dolist (bc bad-chars)
+ (should (eq (eudc-rfc5322-valid-comment-p (format "%c" bc)) nil)))))
+
+;; eudc-rfc5322-make-address (address &optional firstname name comment)
+(ert-deftest eudc-test-make-address ()
+ "Tests for RFC5322 compliant email address formatting."
+ (should (equal (eudc-rfc5322-make-address "")
+ nil))
+ (should (equal (eudc-rfc5322-make-address nil)
+ nil))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org")
+ "j.sixpack@example.org"))
+ (should (equal (eudc-rfc5322-make-address "<j.sixpack@example.org>")
+ "<j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ "Joey")
+ "Joey <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ "Joey"
+ "Sixpack")
+ "Joey Sixpack <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ "Joey"
+ "Sixpack"
+ "ten-packs are fine, too")
+ "Joey Sixpack <j.sixpack@example.org> \
+(ten-packs are fine, too)"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ ""
+ "Sixpack, Joey")
+ "\"Sixpack, Joey\" <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ nil
+ "Sixpack, Joey")
+ "\"Sixpack, Joey\" <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ nil
+ nil
+ "Duh!")
+ "j.sixpack@example.org (Duh!)"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ nil
+ nil
+ "Duh\\!")
+ "j.sixpack@example.org")))
+
+(require 'ert-x) ; ert-with-temp-directory
+
+(defvar ecomplete-database-file (ert-resource-file "ecompleterc"))
+
+(ert-deftest eudcb-ecomplete ()
+ "Test the ecomplete back-end."
+ (ert-with-temp-directory home
+ (with-environment-variables (("HOME" home))
+ (let ((eudc-ignore-options-file t))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "brigts")))
+ '(((mail . "Lars Ingebrigtsen
<larsi@ecomplete.org>")))))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "karl")))
+ '(((mail . "Karl Fogel <kfogel@ecomplete.com>")))))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "behs")))
+ '(((mail . "behse@ecomplete.org")))))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "louie")))
+ nil))))))
+
+(ert-with-temp-directory
+ home
+ (ert-deftest eudcb-mailabbrev ()
+ "Test the mailabbrev back-end."
+ (with-environment-variables
+ (("HOME" home))
+ (let ((mail-personal-alias-file (ert-resource-file "mailrc"))
+ (eudc-ignore-options-file t))
+ (should (equal (eudc-mailabbrev-query-internal '((email . "lars")))
+ '(((email . "larsi@mail-abbrev.com")
+ (name . "Lars Ingebrigtsen")))))
+ (should (equal (eudc-mailabbrev-query-internal '((name . "lars")))
+ '(((email . "larsi@mail-abbrev.com")
+ (name . "Lars Ingebrigtsen")))))
+ (should (equal (eudc-mailabbrev-query-internal '((phone . "lars")))
+ nil))
+ (should (equal (eudc-mailabbrev-query-internal '((firstname . "karl")))
+ '(((email . "kfogel@mail-abbrev.com")
+ (name . "Karl Fogel")))))
+ (should (equal (eudc-mailabbrev-query-internal '((email . "louie")))
+ nil))
+ (should (equal (eudc-mailabbrev-query-internal '((name . "emacsheroes")))
+ '(((email . "Lars Ingebrigtsen <larsi@mail-abbrev.com>, \
+Karl Fogel <kfogel@mail-abbrev.com")))))))))
+
+(provide 'eudc-tests)
;;; eudc-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 2db4449438..46fef558bf 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4616,10 +4616,13 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(load tmp-name 'noerror 'nomessage))
(should-not (featurep 'tramp-test-load))
(write-region "(provide 'tramp-test-load)" nil tmp-name)
- ;; `load' in lread.c does not pass `must-suffix'. Why?
- ;;(should-error
- ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
- ;; :type 'file-error)
+ ;; `load' in lread.c passes `must-suffix' since Emacs 29.
+ ;; In Ange-FTP, `must-suffix' is ignored.
+ (when (and (tramp--test-emacs29-p)
+ (not (tramp--test-ange-ftp-p)))
+ (should-error
+ (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
+ :type 'file-error))
(load tmp-name nil 'nomessage 'nosuffix)
(should (featurep 'tramp-test-load)))
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 8330525394..f871b7bc7d 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -5592,6 +5592,23 @@ else:
(equal (list (python-tests-look-at "else:" -1 t))
(python-info-dedenter-opening-block-positions)))))
+(ert-deftest python-info-dedenter-opening-block-positions-6 ()
+ "Test multiline block start."
+ (python-tests-with-temp-buffer
+ "
+def func():
+ if (
+ cond1 or
+ cond2
+ ):
+ something()
+ else
+"
+ (python-tests-look-at "else\n")
+ (should
+ (equal (list (python-tests-look-at "if (" -1 t))
+ (python-info-dedenter-opening-block-positions)))))
+
(ert-deftest python-info-dedenter-opening-block-message-1 ()
"Test dedenters inside strings are ignored."
(python-tests-with-temp-buffer
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 97f425f6f4..d067f3e586 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -73,6 +73,29 @@
(should (= (count-lines (point) (point)) 0))))
+;;; `execute-extended-command'
+
+(ert-deftest simple-execute-extended-command--shorter ()
+ ;; This test can be flaky with completion frameworks other than the
+ ;; default, so just skip it in interactive sessions.
+ (skip-unless noninteractive)
+ (should (equal (execute-extended-command--shorter
+ "display-line-numbers-mode"
+ "display-line")
+ "di-n")))
+
+(ert-deftest simple-execute-extended-command--describe-binding-msg ()
+ (should (equal (execute-extended-command--describe-binding-msg
+ 'foo "m" nil)
+ "You can run the command ‘foo’ with m"))
+ (should (equal (execute-extended-command--describe-binding-msg
+ 'foo [14] nil)
+ "You can run the command ‘foo’ with C-n"))
+ (should (equal (execute-extended-command--describe-binding-msg
+ 'display-line-numbers-mode nil "di-n")
+ "You can run the command ‘display-line-numbers-mode’ with M-x
di-n")))
+
+
;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
(declare (indent 0)
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index b6d0b1446a..67dd00104b 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -44,6 +44,9 @@
;; Non alphanumeric characters can be found in URIs
("ftp://example.net/~foo!;#bar=baz&goo=bob" 3 url
"ftp://example.net/~foo!;#bar=baz&goo=bob")
("bzr+ssh://user@example.net:5/a%20d,5" 34 url
"bzr+ssh://user@example.net:5/a%20d,5")
+ ;; IPv6 brackets enclosed in [markup]
+ ("[http://[::1]:8000/foo]" 10 url "http://[::1]:8000/foo")
+ ("[http://[fe08::7:8%eth0]]" 10 url "http://[fe08::7:8%eth0]")
;; <url:...> markup
("Url: <url:foo://1.example.com>..." 8 url "foo://1.example.com")
("Url: <url:foo://2.example.com>..." 30 url "foo://2.example.com")
diff --git a/test/manual/noverlay/Makefile.in b/test/manual/noverlay/Makefile.in
index beef1dbc09..3c8dba1ce1 100644
--- a/test/manual/noverlay/Makefile.in
+++ b/test/manual/noverlay/Makefile.in
@@ -1,26 +1,41 @@
+### @configure_input@
+
+# Copyright (C) 2017-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/>.
+
PROGRAM = itree-tests
-LIBS = check
+PACKAGES = check
top_srcdir = @top_srcdir@
-CFLAGS += -O0 -g3 $(shell pkg-config --cflags $(LIBS)) -I $(top_srcdir)/src
-LDFLAGS += $(shell pkg-config --libs $(LIBS)) -lm
+top_builddir = @top_builddir@
+CPPFLAGS += -I $(top_srcdir)/src
+CFLAGS += -O0 -g3 $(shell pkg-config --cflags $(PACKAGES))
+LDLIBS += $(shell pkg-config --libs $(PACKAGES)) -lm
OBJECTS = itree-tests.o
CC = gcc
-EMACS ?= ../../../src/emacs
+EMACS ?= $(top_builddir)/src/emacs
-.PHONY: all check have-libcheck
+.PHONY: all check clean distclean perf
all: check
-have-libcheck:
- pkg-config --cflags $(LIBS)
-
-check: have-libcheck $(PROGRAM)
+check: $(PROGRAM)
./check-sanitize.sh ./$(PROGRAM)
-itree-tests.o: emacs-compat.h itree-tests.c $(top_srcdir)/src/itree.c
$(top_srcdir)/src/itree.h
-
-$(PROGRAM): $(OBJECTS)
- $(CC) $(CFLAGS) $(LDFLAGS) $(OBJECTS) -o $(PROGRAM)
+itree-tests.o: emacs-compat.h $(top_srcdir)/src/itree.c
$(top_srcdir)/src/itree.h
perf:
-$(EMACS) -Q -l ./overlay-perf.el -f perf-run-batch
diff --git a/test/manual/noverlay/check-sanitize.sh
b/test/manual/noverlay/check-sanitize.sh
index 03eedce8a6..9a67818dc8 100755
--- a/test/manual/noverlay/check-sanitize.sh
+++ b/test/manual/noverlay/check-sanitize.sh
@@ -1,11 +1,33 @@
-#!/bin/bash
+#!/usr/bin/env bash
+### check-sanitize.sh - strip confusing parts of Check error output
+
+## Copyright (C) 2017-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/>.
+
+set -o pipefail
prog=$1
shift
[ -z "$prog" ] && {
- echo "usage:$(basename $0) CHECK_PRGOGRAM";
+ echo "usage:$(basename $0) CHECK_PROGRAM";
exit 1;
}
-"$prog" "$@" | sed -e 's/^\([^:]\+\):\([0-9]\+\):[PFE]:[^:]*:\([^:]*\):[^:]*:
*\(.*\)/\1:\2:\3:\4/'
+# FIXME: This would be unnecessary if
+# compilation-error-regexp-alist-alist understood libcheck OOTB.
+"$prog" "$@" | sed -e
's/^\([^:]\+\):\([0-9]\+\):\([PFE]\):\([^:]*\):\([^:]*\):[^:]*:\(.*\)/\1:\2:\3:\4:\5:\6/'
diff --git a/test/manual/noverlay/emacs-compat.h
b/test/manual/noverlay/emacs-compat.h
index 812f8e48a3..d2448b12db 100644
--- a/test/manual/noverlay/emacs-compat.h
+++ b/test/manual/noverlay/emacs-compat.h
@@ -1,8 +1,28 @@
+/* Mock necessary parts of lisp.h.
+
+Copyright (C) 2017-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/>. */
+
#ifndef TEST_COMPAT_H
#define TEST_COMPAT_H
-#include <stdio.h>
#include <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
typedef int Lisp_Object;
@@ -28,20 +48,24 @@ void
emacs_abort ()
{
fprintf (stderr, "Aborting...\n");
- exit (1);
+ exit (EXIT_FAILURE);
}
#ifndef eassert
#define eassert(cond) \
do { \
if (! (cond)) { \
- fprintf (stderr, "\n%s:%d:eassert condition failed: %s\n", \
- __FILE__, __LINE__ ,#cond); \
- exit (1); \
+ fprintf (stderr, "%s:%d:eassert condition failed: %s\n", \
+ __FILE__, __LINE__ , # cond); \
+ exit (EXIT_FAILURE); \
} \
} while (0)
#endif
+#ifndef eassume
+#define eassume eassert
+#endif
+
#ifndef max
#define max(x,y) ((x) >= (y) ? (x) : (y))
#endif
@@ -49,4 +73,4 @@ emacs_abort ()
#define min(x,y) ((x) <= (y) ? (x) : (y))
#endif
-#endif
+#endif /* TEST_COMPAT_H */
diff --git a/test/manual/noverlay/itree-tests.c
b/test/manual/noverlay/itree-tests.c
index a318389213..278e65f9bf 100644
--- a/test/manual/noverlay/itree-tests.c
+++ b/test/manual/noverlay/itree-tests.c
@@ -1,7 +1,28 @@
+/* Test the interval data-structure in itree.c.
+
+Copyright (c) 2017-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/>. */
+
#include <config.h>
-#include <check.h>
-#include <stdlib.h>
+
#include <stdarg.h>
+#include <stdlib.h>
+
+#include <check.h>
#include "emacs-compat.h"
#define EMACS_LISP_H /* lisp.h inclusion guard */
@@ -9,7 +30,14 @@
#define ITREE_TESTING
#include "itree.c"
-/* Basic tests of the interval_tree data-structure. */
+/* Globals. */
+
+static struct itree_tree tree;
+static struct itree_node A, B, C, D, E;
+static struct itree_node N_05, N_10, N_15, N_20, N_30, N_40;
+static struct itree_node N_50, N_70, N_80, N_90, N_85, N_95;
+
+/* Basic tests of the itree_tree data-structure. */
/*
+===================================================================================+
* | Insert
@@ -17,25 +45,21 @@
/* The graphs below display the trees after each insertion (as they
should be). See the source code for the different cases
- applied. */
-
-#define N_50 (n[0])
-#define N_30 (n[1])
-#define N_20 (n[2])
-#define N_10 (n[3])
-#define N_15 (n[4])
-#define N_05 (n[5])
-
-#define DEF_TEST_SETUP() \
- struct interval_tree tree; \
- struct interval_node n[6]; \
- interval_tree_init (&tree); \
- const int values[] = {50, 30, 20, 10, 15, 5}; \
- for (int i = 0; i < 6; ++i) \
- { \
- n[i].begin = values[i]; \
- n[i].end = values[i]; \
+ applied. */
+
+static void
+test_insert1_setup (void)
+{
+ enum { N = 6 };
+ const int values[N] = {50, 30, 20, 10, 15, 5};
+ struct itree_node *nodes[N] = {&N_50, &N_30, &N_20, &N_10, &N_15, &N_05};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ {
+ nodes[i]->begin = nodes[i]->end = values[i];
+ nodes[i]->otick = tree.otick;
}
+}
START_TEST (test_insert_1)
{
@@ -43,10 +67,9 @@ START_TEST (test_insert_1)
* [50]
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (&N_50 == tree.root);
+ ck_assert (! N_50.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
}
END_TEST
@@ -58,17 +81,16 @@ START_TEST (test_insert_2)
* (30)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_30);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_30.color == ITREE_RED);
- ck_assert (&N_50 == tree.root);
- ck_assert (N_30.parent == &N_50);
- ck_assert (N_50.left == &N_30);
- ck_assert (N_50.right == &tree.nil);
- ck_assert (N_30.left == &tree.nil);
- ck_assert (N_30.right == &tree.nil);
+ ck_assert (! N_50.red);
+ ck_assert (N_30.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
+ ck_assert_ptr_eq (N_30.parent, &N_50);
+ ck_assert_ptr_eq (N_50.left, &N_30);
+ ck_assert_ptr_null (N_50.right);
+ ck_assert_ptr_null (N_30.left);
+ ck_assert_ptr_null (N_30.right);
}
END_TEST
@@ -80,20 +102,19 @@ START_TEST (test_insert_3)
* (20) (50)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_30);
interval_tree_insert (&tree, &N_20);
- ck_assert (N_50.color == ITREE_RED);
- ck_assert (N_30.color == ITREE_BLACK);
- ck_assert (N_20.color == ITREE_RED);
- ck_assert (&N_30 == tree.root);
- ck_assert (N_50.parent == &N_30);
- ck_assert (N_30.right == &N_50);
- ck_assert (N_30.left == &N_20);
- ck_assert (N_20.left == &tree.nil);
- ck_assert (N_20.right == &tree.nil);
- ck_assert (N_20.parent == &N_30);
+ ck_assert (N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_20.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_20);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_30);
}
END_TEST
@@ -107,25 +128,24 @@ START_TEST (test_insert_4)
* (10)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_30);
interval_tree_insert (&tree, &N_20);
interval_tree_insert (&tree, &N_10);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_30.color == ITREE_BLACK);
- ck_assert (N_20.color == ITREE_BLACK);
- ck_assert (N_10.color == ITREE_RED);
- ck_assert (&N_30 == tree.root);
- ck_assert (N_50.parent == &N_30);
- ck_assert (N_30.right == &N_50);
- ck_assert (N_30.left == &N_20);
- ck_assert (N_20.left == &N_10);
- ck_assert (N_20.right == &tree.nil);
- ck_assert (N_20.parent == &N_30);
- ck_assert (N_10.parent == &N_20);
- ck_assert (N_20.left == &N_10);
- ck_assert (N_10.right == &tree.nil);
+ ck_assert (! N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (! N_20.red);
+ ck_assert (N_10.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_20);
+ ck_assert_ptr_eq (N_20.left, &N_10);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_30);
+ ck_assert_ptr_eq (N_10.parent, &N_20);
+ ck_assert_ptr_eq (N_20.left, &N_10);
+ ck_assert_ptr_null (N_10.right);
}
END_TEST
@@ -139,31 +159,29 @@ START_TEST (test_insert_5)
* (10) (20)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_30);
interval_tree_insert (&tree, &N_20);
interval_tree_insert (&tree, &N_10);
interval_tree_insert (&tree, &N_15);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_30.color == ITREE_BLACK);
- ck_assert (N_20.color == ITREE_RED);
- ck_assert (N_10.color == ITREE_RED);
- ck_assert (N_15.color == ITREE_BLACK);
- ck_assert (&N_30 == tree.root);
- ck_assert (N_50.parent == &N_30);
- ck_assert (N_30.right == &N_50);
- ck_assert (N_30.left == &N_15);
- ck_assert (N_20.left == &tree.nil);
- ck_assert (N_20.right == &tree.nil);
- ck_assert (N_20.parent == &N_15);
- ck_assert (N_10.parent == &N_15);
- ck_assert (N_20.left == &tree.nil);
- ck_assert (N_10.right == &tree.nil);
- ck_assert (N_15.right == &N_20);
- ck_assert (N_15.left == &N_10);
- ck_assert (N_15.parent == &N_30);
-
+ ck_assert (! N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_20.red);
+ ck_assert (N_10.red);
+ ck_assert (! N_15.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_15);
+ ck_assert_ptr_eq (N_10.parent, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_10.right);
+ ck_assert_ptr_eq (N_15.right, &N_20);
+ ck_assert_ptr_eq (N_15.left, &N_10);
+ ck_assert_ptr_eq (N_15.parent, &N_30);
}
END_TEST
@@ -179,67 +197,54 @@ START_TEST (test_insert_6)
* (5)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_30);
interval_tree_insert (&tree, &N_20);
interval_tree_insert (&tree, &N_10);
interval_tree_insert (&tree, &N_15);
interval_tree_insert (&tree, &N_05);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_30.color == ITREE_BLACK);
- ck_assert (N_20.color == ITREE_BLACK);
- ck_assert (N_10.color == ITREE_BLACK);
- ck_assert (N_15.color == ITREE_RED);
- ck_assert (N_05.color == ITREE_RED);
- ck_assert (&N_30 == tree.root);
- ck_assert (N_50.parent == &N_30);
- ck_assert (N_30.right == &N_50);
- ck_assert (N_30.left == &N_15);
- ck_assert (N_20.left == &tree.nil);
- ck_assert (N_20.right == &tree.nil);
- ck_assert (N_20.parent == &N_15);
- ck_assert (N_10.parent == &N_15);
- ck_assert (N_20.left == &tree.nil);
- ck_assert (N_10.right == &tree.nil);
- ck_assert (N_15.right == &N_20);
- ck_assert (N_15.left == &N_10);
- ck_assert (N_15.parent == &N_30);
- ck_assert (N_05.parent == &N_10);
- ck_assert (N_10.left == &N_05);
- ck_assert (N_05.right == &tree.nil);
+ ck_assert (! N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (! N_20.red);
+ ck_assert (! N_10.red);
+ ck_assert (N_15.red);
+ ck_assert (N_05.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_15);
+ ck_assert_ptr_eq (N_10.parent, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_10.right);
+ ck_assert_ptr_eq (N_15.right, &N_20);
+ ck_assert_ptr_eq (N_15.left, &N_10);
+ ck_assert_ptr_eq (N_15.parent, &N_30);
+ ck_assert_ptr_eq (N_05.parent, &N_10);
+ ck_assert_ptr_eq (N_10.left, &N_05);
+ ck_assert_ptr_null (N_05.right);
}
END_TEST
-#undef N_50
-#undef N_30
-#undef N_20
-#undef N_10
-#undef N_15
-#undef N_05
-#undef DEF_TEST_SETUP
-
/* These are the mirror cases to the above ones. */
-#define N_50 (n[0])
-#define N_70 (n[1])
-#define N_80 (n[2])
-#define N_90 (n[3])
-#define N_85 (n[4])
-#define N_95 (n[5])
-
-#define DEF_TEST_SETUP() \
- struct interval_tree tree; \
- struct interval_node n[6]; \
- interval_tree_init (&tree); \
- const int values[] = {50, 70, 80, 90, 85, 95}; \
- for (int i = 0; i < 6; ++i) \
- { \
- n[i].begin = values[i]; \
- n[i].end = values[i]; \
+static void
+test_insert2_setup (void)
+{
+ enum { N = 6 };
+ const int values[] = {50, 70, 80, 90, 85, 95};
+ struct itree_node *nodes[N] = {&N_50, &N_70, &N_80, &N_90, &N_85, &N_95};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ {
+ nodes[i]->begin = nodes[i]->end = values[i];
+ nodes[i]->otick = tree.otick;
}
+}
START_TEST (test_insert_7)
{
@@ -247,10 +252,9 @@ START_TEST (test_insert_7)
* [50]
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (&N_50 == tree.root);
+ ck_assert (! N_50.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
}
END_TEST
@@ -262,17 +266,16 @@ START_TEST (test_insert_8)
* (70)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_70);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_70.color == ITREE_RED);
- ck_assert (&N_50 == tree.root);
- ck_assert (N_70.parent == &N_50);
- ck_assert (N_50.right == &N_70);
- ck_assert (N_50.left == &tree.nil);
- ck_assert (N_70.right == &tree.nil);
- ck_assert (N_70.left == &tree.nil);
+ ck_assert (! N_50.red);
+ ck_assert (N_70.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
+ ck_assert_ptr_eq (N_70.parent, &N_50);
+ ck_assert_ptr_eq (N_50.right, &N_70);
+ ck_assert_ptr_null (N_50.left);
+ ck_assert_ptr_null (N_70.right);
+ ck_assert_ptr_null (N_70.left);
}
END_TEST
@@ -284,20 +287,19 @@ START_TEST (test_insert_9)
* (50) (80)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_70);
interval_tree_insert (&tree, &N_80);
- ck_assert (N_50.color == ITREE_RED);
- ck_assert (N_70.color == ITREE_BLACK);
- ck_assert (N_80.color == ITREE_RED);
- ck_assert (&N_70 == tree.root);
- ck_assert (N_50.parent == &N_70);
- ck_assert (N_70.right == &N_80);
- ck_assert (N_70.left == &N_50);
- ck_assert (N_80.right == &tree.nil);
- ck_assert (N_80.left == &tree.nil);
- ck_assert (N_80.parent == &N_70);
+ ck_assert (N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (N_80.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_80);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_70);
}
END_TEST
@@ -311,25 +313,24 @@ START_TEST (test_insert_10)
* (90)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_70);
interval_tree_insert (&tree, &N_80);
interval_tree_insert (&tree, &N_90);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_70.color == ITREE_BLACK);
- ck_assert (N_80.color == ITREE_BLACK);
- ck_assert (N_90.color == ITREE_RED);
- ck_assert (&N_70 == tree.root);
- ck_assert (N_50.parent == &N_70);
- ck_assert (N_70.right == &N_80);
- ck_assert (N_70.left == &N_50);
- ck_assert (N_80.right == &N_90);
- ck_assert (N_80.left == &tree.nil);
- ck_assert (N_80.parent == &N_70);
- ck_assert (N_90.parent == &N_80);
- ck_assert (N_80.right == &N_90);
- ck_assert (N_90.left == &tree.nil);
+ ck_assert (! N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (! N_80.red);
+ ck_assert (N_90.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_80);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_eq (N_80.right, &N_90);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_70);
+ ck_assert_ptr_eq (N_90.parent, &N_80);
+ ck_assert_ptr_eq (N_80.right, &N_90);
+ ck_assert_ptr_null (N_90.left);
}
END_TEST
@@ -343,30 +344,29 @@ START_TEST (test_insert_11)
* (80) (90)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_70);
interval_tree_insert (&tree, &N_80);
interval_tree_insert (&tree, &N_90);
interval_tree_insert (&tree, &N_85);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_70.color == ITREE_BLACK);
- ck_assert (N_80.color == ITREE_RED);
- ck_assert (N_90.color == ITREE_RED);
- ck_assert (N_85.color == ITREE_BLACK);
- ck_assert (&N_70 == tree.root);
- ck_assert (N_50.parent == &N_70);
- ck_assert (N_70.right == &N_85);
- ck_assert (N_70.left == &N_50);
- ck_assert (N_80.right == &tree.nil);
- ck_assert (N_80.left == &tree.nil);
- ck_assert (N_80.parent == &N_85);
- ck_assert (N_90.parent == &N_85);
- ck_assert (N_80.right == &tree.nil);
- ck_assert (N_90.left == &tree.nil);
- ck_assert (N_85.right == &N_90);
- ck_assert (N_85.left == &N_80);
- ck_assert (N_85.parent == &N_70);
+ ck_assert (! N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (N_80.red);
+ ck_assert (N_90.red);
+ ck_assert (! N_85.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_85);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_85);
+ ck_assert_ptr_eq (N_90.parent, &N_85);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_90.left);
+ ck_assert_ptr_eq (N_85.right, &N_90);
+ ck_assert_ptr_eq (N_85.left, &N_80);
+ ck_assert_ptr_eq (N_85.parent, &N_70);
}
END_TEST
@@ -383,139 +383,90 @@ START_TEST (test_insert_12)
* (95)
*/
- DEF_TEST_SETUP ();
interval_tree_insert (&tree, &N_50);
interval_tree_insert (&tree, &N_70);
interval_tree_insert (&tree, &N_80);
interval_tree_insert (&tree, &N_90);
interval_tree_insert (&tree, &N_85);
interval_tree_insert (&tree, &N_95);
- ck_assert (N_50.color == ITREE_BLACK);
- ck_assert (N_70.color == ITREE_BLACK);
- ck_assert (N_80.color == ITREE_BLACK);
- ck_assert (N_90.color == ITREE_BLACK);
- ck_assert (N_85.color == ITREE_RED);
- ck_assert (N_95.color == ITREE_RED);
- ck_assert (&N_70 == tree.root);
- ck_assert (N_50.parent == &N_70);
- ck_assert (N_70.right == &N_85);
- ck_assert (N_70.left == &N_50);
- ck_assert (N_80.right == &tree.nil);
- ck_assert (N_80.left == &tree.nil);
- ck_assert (N_80.parent == &N_85);
- ck_assert (N_90.parent == &N_85);
- ck_assert (N_80.right == &tree.nil);
- ck_assert (N_90.left == &tree.nil);
- ck_assert (N_85.right == &N_90);
- ck_assert (N_85.left == &N_80);
- ck_assert (N_85.parent == &N_70);
- ck_assert (N_95.parent == &N_90);
- ck_assert (N_90.right == &N_95);
- ck_assert (N_95.left == &tree.nil);
+ ck_assert (! N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (! N_80.red);
+ ck_assert (! N_90.red);
+ ck_assert (N_85.red);
+ ck_assert (N_95.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_85);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_85);
+ ck_assert_ptr_eq (N_90.parent, &N_85);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_90.left);
+ ck_assert_ptr_eq (N_85.right, &N_90);
+ ck_assert_ptr_eq (N_85.left, &N_80);
+ ck_assert_ptr_eq (N_85.parent, &N_70);
+ ck_assert_ptr_eq (N_95.parent, &N_90);
+ ck_assert_ptr_eq (N_90.right, &N_95);
+ ck_assert_ptr_null (N_95.left);
}
END_TEST
-#undef N_50
-#undef N_70
-#undef N_80
-#undef N_90
-#undef N_85
-#undef N_95
-#undef DEF_TEST_SETUP
-
-struct interval_tree*
-test_get_tree4 (struct interval_node **n)
-{
- static struct interval_tree tree;
- static struct interval_node nodes[4];
- memset (&tree, 0, sizeof (struct interval_tree));
- memset (&nodes, 0, 4 * sizeof (struct interval_node));
- interval_tree_init (&tree);
- for (int i = 0; i < 4; ++i)
- {
- nodes[i].begin = 10 * (i + 1);
- nodes[i].end = nodes[i].begin;
- interval_tree_insert (&tree, &nodes[i]);
- }
- *n = nodes;
- return &tree;
-}
-
-static void
-shuffle (int *index, int n)
-{
- for (int i = n - 1; i >= 0; --i)
- {
- int j = random () % (i + 1);
- int h = index[j];
- index[j] = index[i];
- index[i] = h;
- }
-}
-
-#define N_10 (nodes[0])
-#define N_20 (nodes[1])
-#define N_30 (nodes[2])
-#define N_40 (nodes[3])
-
START_TEST (test_insert_13)
{
- struct interval_node *nodes = NULL;
- struct interval_tree *tree = test_get_tree4 (&nodes);
-
-
- ck_assert (tree->root == &N_20);
- ck_assert (N_20.left == &N_10);
- ck_assert (N_20.right == &N_30);
- ck_assert (N_30.right == &N_40);
- ck_assert (N_10.color == ITREE_BLACK);
- ck_assert (N_20.color == ITREE_BLACK);
- ck_assert (N_30.color == ITREE_BLACK);
- ck_assert (N_40.color == ITREE_RED);
+ enum { N = 4 };
+ const int values[N] = {10, 20, 30, 40};
+ struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ itree_insert (&tree, nodes[i], values[i], values[i]);
+
+ ck_assert_ptr_eq (tree.root, &N_20);
+ ck_assert_ptr_eq (N_20.left, &N_10);
+ ck_assert_ptr_eq (N_20.right, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_40);
+ ck_assert (! N_10.red);
+ ck_assert (! N_20.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_40.red);
}
END_TEST
START_TEST (test_insert_14)
{
- struct interval_tree tree;
- struct interval_node nodes[3];
-
- nodes[0].begin = nodes[1].begin = nodes[2].begin = 10;
- nodes[0].end = nodes[1].end = nodes[2].end = 10;
+ enum { N = 3 };
+ struct itree_node nodes[N];
+ interval_tree_init (&tree);
- for (int i = 0; i < 3; ++i)
- interval_tree_insert (&tree, &nodes[i]);
- for (int i = 0; i < 3; ++i)
+ for (int i = 0; i < N; ++i)
+ itree_insert (&tree, &nodes[i], 10, 10);
+ for (int i = 0; i < N; ++i)
ck_assert (interval_tree_contains (&tree, &nodes[i]));
}
END_TEST
-
-
/*
+===================================================================================+
* | Remove
*
+===================================================================================+
*/
-#define A (nodes[0])
-#define B (nodes[1])
-#define C (nodes[2])
-#define D (nodes[3])
-#define E (nodes[4])
-
/* Creating proper test trees for the formal tests via insertions is
- way to tedious, so we just fake it and only test the
- fix-routine. */
-#define DEF_TEST_SETUP() \
- struct interval_tree tree; \
- struct interval_node nodes[5]; \
- interval_tree_init (&tree); \
- tree.root = &B; \
- A.parent = &B; B.parent = &tree.nil; C.parent = &D; \
- D.parent = &B; E.parent = &D; \
- A.left = A.right = C.left = C.right = &tree.nil; \
- E.left = E.right = &tree.nil; \
- B.left = &A; B.right = &D; D.left = &C; D.right = &E \
+ way too tedious, so we just fake it and only test the
+ fix-routine. */
+static void
+test_remove1_setup (void)
+{
+ interval_tree_init (&tree);
+ tree.root = &B;
+ A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D;
+ A.left = A.right = C.left = C.right = E.left = E.right = NULL;
+ B.left = &A; B.right = &D;
+ D.left = &C; D.right = &E;
+ A.offset = B.offset = C.offset = D.offset = E.offset = 0;
+ A.otick = B.otick = C.otick = D.otick = E.otick = tree.otick;
+}
/* 1.a -> 2.a
* [B]
@@ -525,126 +476,106 @@ END_TEST
* [C] [E]
*/
-
START_TEST (test_remove_1)
{
- DEF_TEST_SETUP ();
- B.color = A.color = C.color = E.color = ITREE_BLACK;
- D.color = ITREE_RED;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_RED);
- ck_assert (D.color == ITREE_BLACK);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.left == &A);
- ck_assert (B.right == &C);
- ck_assert (C.parent == &B);
- ck_assert (E.parent == &D);
- ck_assert (D.right == &E);
- ck_assert (D.left == &B);
- ck_assert (tree.root == &D);
+ B.red = A.red = C.red = E.red = false;
+ D.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_eq (B.right, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (D.right, &E);
+ ck_assert_ptr_eq (D.left, &B);
+ ck_assert_ptr_eq (tree.root, &D);
}
END_TEST
/* 2.a */
START_TEST (test_remove_2)
{
- DEF_TEST_SETUP ();
- B.color = D.color = A.color = C.color = E.color = ITREE_BLACK;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_BLACK);
- ck_assert (D.color == ITREE_RED);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.left == &A);
- ck_assert (B.right == &D);
- ck_assert (C.parent == &D);
- ck_assert (E.parent == &D);
- ck_assert (tree.root == &B);
+ B.red = D.red = A.red = C.red = E.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_eq (B.right, &D);
+ ck_assert_ptr_eq (C.parent, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &B);
}
END_TEST
-/* 3.a -> 4.a*/
+/* 3.a -> 4.a */
START_TEST (test_remove_3)
{
- DEF_TEST_SETUP ();
- D.color = A.color = E.color = ITREE_BLACK;
- B.color = C.color = ITREE_RED;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_BLACK);
- ck_assert (D.color == ITREE_BLACK);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.left == &A);
- ck_assert (B.right == &tree.nil);
- ck_assert (&C == tree.root);
- ck_assert (C.left == &B);
- ck_assert (C.right == &D);
- ck_assert (E.parent == &D);
- ck_assert (D.left == &tree.nil);
-
+ D.red = A.red = E.red = false;
+ B.red = C.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_null (B.right);
+ ck_assert_ptr_eq (&C, tree.root);
+ ck_assert_ptr_eq (C.left, &B);
+ ck_assert_ptr_eq (C.right, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_null (D.left);
}
END_TEST
/* 4.a */
START_TEST (test_remove_4)
{
- DEF_TEST_SETUP ();
- B.color = C.color = E.color = ITREE_RED;
- A.color = D.color = ITREE_BLACK;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_RED);
- ck_assert (D.color == ITREE_BLACK);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.left == &A);
- ck_assert (B.right == &C);
- ck_assert (C.parent == &B);
- ck_assert (E.parent == &D);
- ck_assert (tree.root == &D);
+ B.red = C.red = E.red = true;
+ A.red = D.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_eq (B.right, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &D);
}
END_TEST
-
-#undef A
-#undef B
-#undef C
-#undef D
-#undef E
-#undef DEF_TEST_SETUP
-
-/* These are the mirrored cases. */
-
-#define A (nodes[0])
-#define B (nodes[1])
-#define C (nodes[2])
-#define D (nodes[3])
-#define E (nodes[4])
-
-#define DEF_TEST_SETUP() \
- struct interval_tree tree; \
- struct interval_node nodes[5]; \
- interval_tree_init (&tree); \
- tree.root = &B; \
- A.parent = &B; B.parent = &tree.nil; C.parent = &D; \
- D.parent = &B; E.parent = &D; \
- A.right = A.left = C.right = C.left = &tree.nil; \
- E.right = E.left = &tree.nil; \
- B.right = &A; B.left = &D; D.right = &C; D.left = &E \
+/* These are the mirrored cases. */
+
+static void
+test_remove2_setup (void)
+{
+ interval_tree_init (&tree);
+ tree.root = &B;
+ A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D;
+ A.right = A.left = C.right = C.left = E.right = E.left = NULL;
+ B.right = &A; B.left = &D;
+ D.right = &C; D.left = &E;
+}
/* 1.b -> 2.b
* [B]
@@ -654,161 +585,159 @@ END_TEST
* [C] [E]
*/
-
START_TEST (test_remove_5)
{
- DEF_TEST_SETUP ();
- B.color = A.color = C.color = E.color = ITREE_BLACK;
- D.color = ITREE_RED;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_RED);
- ck_assert (D.color == ITREE_BLACK);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.right == &A);
- ck_assert (B.left == &C);
- ck_assert (C.parent == &B);
- ck_assert (E.parent == &D);
- ck_assert (D.left == &E);
- ck_assert (D.right == &B);
- ck_assert (tree.root == &D);
+ B.red = A.red = C.red = E.red = false;
+ D.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_eq (B.left, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (D.left, &E);
+ ck_assert_ptr_eq (D.right, &B);
+ ck_assert_ptr_eq (tree.root, &D);
}
END_TEST
/* 2.b */
START_TEST (test_remove_6)
{
- DEF_TEST_SETUP ();
- B.color = D.color = A.color = C.color = E.color = ITREE_BLACK;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_BLACK);
- ck_assert (D.color == ITREE_RED);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.right == &A);
- ck_assert (B.left == &D);
- ck_assert (C.parent == &D);
- ck_assert (E.parent == &D);
- ck_assert (tree.root == &B);
+ B.red = D.red = A.red = C.red = E.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_eq (B.left, &D);
+ ck_assert_ptr_eq (C.parent, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &B);
}
END_TEST
-/* 3.b -> 4.b*/
+/* 3.b -> 4.b */
START_TEST (test_remove_7)
{
- DEF_TEST_SETUP ();
- D.color = A.color = E.color = ITREE_BLACK;
- B.color = C.color = ITREE_RED;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_BLACK);
- ck_assert (D.color == ITREE_BLACK);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.right == &A);
- ck_assert (B.left == &tree.nil);
- ck_assert (&C == tree.root);
- ck_assert (C.right == &B);
- ck_assert (C.left == &D);
- ck_assert (E.parent == &D);
- ck_assert (D.right == &tree.nil);
-
+ D.red = A.red = E.red = false;
+ B.red = C.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_null (B.left);
+ ck_assert_ptr_eq (&C, tree.root);
+ ck_assert_ptr_eq (C.right, &B);
+ ck_assert_ptr_eq (C.left, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_null (D.right);
}
END_TEST
/* 4.b */
START_TEST (test_remove_8)
{
- DEF_TEST_SETUP ();
- B.color = C.color = E.color = ITREE_RED;
- A.color = D.color = ITREE_BLACK;
- interval_tree_remove_fix (&tree, &A);
-
- ck_assert (A.color == ITREE_BLACK);
- ck_assert (B.color == ITREE_BLACK);
- ck_assert (C.color == ITREE_RED);
- ck_assert (D.color == ITREE_BLACK);
- ck_assert (E.color == ITREE_BLACK);
- ck_assert (A.parent == &B);
- ck_assert (B.right == &A);
- ck_assert (B.left == &C);
- ck_assert (C.parent == &B);
- ck_assert (E.parent == &D);
- ck_assert (tree.root == &D);
+ B.red = C.red = E.red = true;
+ A.red = D.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_eq (B.left, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &D);
}
END_TEST
-
-#undef A
-#undef B
-#undef C
-#undef D
-#undef E
-#undef DEF_TEST_SETUP
-
-
START_TEST (test_remove_9)
{
- struct interval_node *nodes = NULL;
- struct interval_tree *tree = test_get_tree4 (&nodes);
+ enum { N = 4 };
+ const int values[N] = {10, 20, 30, 40};
+ struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ itree_insert (&tree, nodes[i], values[i], values[i]);
- ck_assert (tree->root == &N_20);
+ ck_assert (tree.root == &N_20);
ck_assert (N_20.left == &N_10);
ck_assert (N_20.right == &N_30);
ck_assert (N_30.right == &N_40);
- ck_assert (N_20.color == ITREE_BLACK);
- ck_assert (N_10.color == ITREE_BLACK);
- ck_assert (N_30.color == ITREE_BLACK);
- ck_assert (N_40.color == ITREE_RED);
-
- interval_tree_remove (tree, &N_10);
-
- ck_assert (tree->root == &N_30);
- ck_assert (N_30.parent == &tree->nil);
- ck_assert (N_30.left == &N_20);
- ck_assert (N_30.right == &N_40);
- ck_assert (N_20.color == ITREE_BLACK);
- ck_assert (N_30.color == ITREE_BLACK);
- ck_assert (N_40.color == ITREE_BLACK);
+ ck_assert (! N_20.red);
+ ck_assert (! N_10.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_40.red);
+
+ itree_remove (&tree, &N_10);
+
+ ck_assert_ptr_eq (tree.root, &N_30);
+ ck_assert_ptr_null (N_30.parent);
+ ck_assert_ptr_eq (N_30.left, &N_20);
+ ck_assert_ptr_eq (N_30.right, &N_40);
+ ck_assert (! N_20.red);
+ ck_assert (! N_30.red);
+ ck_assert (! N_40.red);
}
END_TEST
-#define N 3
+static void
+shuffle (int *index, int n)
+{
+ for (int i = n - 1; i >= 0; --i)
+ {
+ int j = random () % (i + 1);
+ int h = index[j];
+ index[j] = index[i];
+ index[i] = h;
+ }
+}
START_TEST (test_remove_10)
{
- struct interval_tree tree;
- struct interval_node nodes[N];
+ enum { N = 3 };
int index[N];
-
+ for (int i = 0; i < N; ++i)
+ index[i] = i;
srand (42);
+ shuffle (index, N);
+
interval_tree_init (&tree);
+ struct itree_node nodes[N];
for (int i = 0; i < N; ++i)
{
- nodes[i].begin = (i + 1) * 10;
- nodes[i].end = nodes[i].begin + 1;
- index[i] = i;
+ ptrdiff_t pos = (i + 1) * 10;
+ itree_insert (&tree, &nodes[index[i]], pos, pos + 1);
}
- shuffle (index, N);
- for (int i = 0; i < N; ++i)
- interval_tree_insert (&tree, &nodes[index[i]]);
shuffle (index, N);
for (int i = 0; i < N; ++i)
{
ck_assert (interval_tree_contains (&tree, &nodes[index[i]]));
- interval_tree_remove (&tree, &nodes[index[i]]);
+ itree_remove (&tree, &nodes[index[i]]);
}
- ck_assert (tree.root == &tree.nil);
- ck_assert (tree.size == 0);
+ ck_assert_ptr_null (tree.root);
+ ck_assert_int_eq (tree.size, 0);
}
END_TEST
@@ -819,70 +748,57 @@ END_TEST
START_TEST (test_generator_1)
{
- struct interval_tree tree;
- struct interval_node node, *n;
- struct interval_generator *g;
+ struct itree_node node, *n;
+ struct itree_iterator *g;
interval_tree_init (&tree);
- node.begin = 10;
- node.end = 20;
- interval_tree_insert (&tree, &node);
- g = interval_generator_create (&tree);
- interval_generator_reset (g, 0, 30, ITREE_ASCENDING);
- n = interval_generator_next (g);
- ck_assert (n == &node);
- ck_assert (n->begin == 10 && n->end == 20);
- ck_assert (interval_generator_next (g) == NULL);
- ck_assert (interval_generator_next (g) == NULL);
- ck_assert (interval_generator_next (g) == NULL);
- interval_generator_destroy (g);
-
- g = interval_generator_create (&tree);
- interval_generator_reset (g, 30, 50, ITREE_ASCENDING);
- ck_assert (interval_generator_next (g) == NULL);
- ck_assert (interval_generator_next (g) == NULL);
- ck_assert (interval_generator_next (g) == NULL);
- interval_generator_destroy (g);
+
+ itree_insert (&tree, &node, 10, 20);
+ g = itree_iterator_start (&tree, 0, 30, ITREE_ASCENDING, NULL, 0);
+ n = itree_iterator_next (g);
+ ck_assert_ptr_eq (n, &node);
+ ck_assert_int_eq (n->begin, 10);
+ ck_assert_int_eq (n->end, 20);
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ itree_iterator_finish (g);
+
+ g = itree_iterator_start (&tree, 30, 50, ITREE_ASCENDING, NULL, 0);
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ itree_iterator_finish (g);
}
END_TEST
-void
-test_check_generator (struct interval_tree *tree,
+static void
+test_check_generator (struct itree_tree *tree,
ptrdiff_t begin, ptrdiff_t end,
int n, ...)
{
va_list ap;
- struct interval_generator *g = interval_generator_create (tree);
- interval_generator_reset (g, begin, end, ITREE_ASCENDING);
+ struct itree_iterator *g =
+ itree_iterator_start (tree, begin, end, ITREE_ASCENDING, NULL, 0);
va_start (ap, n);
for (int i = 0; i < n; ++i)
{
- ptrdiff_t begin = va_arg (ap, ptrdiff_t);
- struct interval_node *node = interval_generator_next (g);
- ck_assert (node);
- ck_assert_int_eq (node->begin, begin);
+ struct itree_node *node = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (node);
+ ck_assert_int_eq (node->begin, va_arg (ap, ptrdiff_t));
}
va_end (ap);
- ck_assert (! interval_generator_next (g));
- ck_assert (! interval_generator_next (g));
- interval_generator_destroy (g);
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ itree_iterator_finish (g);
}
-#define DEF_TEST_SETUP() \
-
-
START_TEST (test_generator_2)
{
- struct interval_tree tree;
- struct interval_node nodes[3];
-
interval_tree_init (&tree);
-
- for (int i = 0; i < 3; ++i) {
- nodes[i].begin = 10 * (i + 1);
- nodes[i].end = 10 * (i + 2);
- interval_tree_insert (&tree, &nodes[i]);
- }
+ struct itree_node nodes[3];
+ for (int i = 0; i < 3; ++i)
+ itree_insert (&tree, &nodes[i], 10 * (i + 1), 10 * (i + 2));
test_check_generator (&tree, 0, 50, 3,
10, 20, 30);
@@ -902,72 +818,56 @@ START_TEST (test_generator_2)
}
END_TEST
-
-struct interval_node*
-test_create_tree (struct interval_tree *tree, int n,
- bool doshuffle, ...)
+static void
+test_create_tree (struct itree_node *nodes, int n, bool doshuffle)
{
- va_list ap;
- struct interval_node *nodes = calloc (n, sizeof (struct interval_node));
int *index = calloc (n, sizeof (int));
-
- interval_tree_init (tree);
- va_start (ap, doshuffle);
for (int i = 0; i < n; ++i)
+ index[i] = i;
+ if (doshuffle)
{
- ptrdiff_t begin = va_arg (ap, ptrdiff_t);
- ptrdiff_t end = va_arg (ap, ptrdiff_t);
- nodes[i].begin = begin;
- nodes[i].end = end;
- index[i] = i;
+ srand (42);
+ shuffle (index, n);
}
- va_end (ap);
- srand (42);
- if (doshuffle)
- shuffle (index, n);
+
+ interval_tree_init (&tree);
for (int i = 0; i < n; ++i)
- interval_tree_insert (tree, &nodes[index[i]]);
+ {
+ struct itree_node *node = &nodes[index[i]];
+ itree_insert (&tree, node, node->begin, node->end);
+ }
free (index);
-
- return nodes;
}
START_TEST (test_generator_3)
{
- struct interval_tree tree;
- struct interval_node *nodes = NULL;
-
- nodes = test_create_tree (&tree, 3, true,
- 10, 10,
- 10, 10,
- 10, 10);
+ enum { N = 3 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 10},
+ {.begin = 10, .end = 10},
+ {.begin = 10, .end = 10}};
+ test_create_tree (nodes, N, true);
test_check_generator (&tree, 0, 10, 0);
- test_check_generator (&tree, 10, 10, 3, 10, 10, 10);
- test_check_generator (&tree, 10, 20, 3, 10, 10, 10);
- free (nodes);
+ test_check_generator (&tree, 10, 10, 3,
+ 10, 10, 10);
+ test_check_generator (&tree, 10, 20, 3,
+ 10, 10, 10);
}
END_TEST
-#define FOREACH(n, g) \
- for ((n) = interval_generator_next (g); (n) != NULL; \
- (n) = interval_generator_next (g))
-
START_TEST (test_generator_5)
{
- struct interval_tree tree;
- struct interval_node *nodes;
- struct interval_generator *g;
- nodes = test_create_tree (&tree, 4, false,
- 10, 30,
- 20, 40,
- 30, 50,
- 40, 60);
- g = interval_generator_create (&tree);
- interval_generator_reset (g, 0, 100, ITREE_PRE_ORDER);
- for (int i = 0; i < 4; ++i)
+ enum { N = 4 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 30},
+ {.begin = 20, .end = 40},
+ {.begin = 30, .end = 50},
+ {.begin = 40, .end = 60}};
+ test_create_tree (nodes, N, false);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 0, 100, ITREE_PRE_ORDER, NULL, 0);
+ for (int i = 0; i < N; ++i)
{
- struct interval_node *n = interval_generator_next (g);
- ck_assert (n);
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (n);
switch (i)
{
case 0: ck_assert_int_eq (20, n->begin); break;
@@ -976,28 +876,24 @@ START_TEST (test_generator_5)
case 3: ck_assert_int_eq (40, n->begin); break;
}
}
- interval_generator_destroy (g);
- free (nodes);
-
+ itree_iterator_finish (g);
}
END_TEST
START_TEST (test_generator_6)
{
- struct interval_tree tree;
- struct interval_node *nodes;
- struct interval_generator *g;
- nodes = test_create_tree (&tree, 4, true,
- 10, 30,
- 20, 40,
- 30, 50,
- 40, 60);
- g = interval_generator_create (&tree);
- interval_generator_reset (g, 0, 100, ITREE_ASCENDING);
- for (int i = 0; i < 4; ++i)
+ enum { N = 4 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 30},
+ {.begin = 20, .end = 40},
+ {.begin = 30, .end = 50},
+ {.begin = 40, .end = 60}};
+ test_create_tree (nodes, N, true);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 0, 100, ITREE_ASCENDING, NULL, 0);
+ for (int i = 0; i < N; ++i)
{
- struct interval_node *n = interval_generator_next (g);
- ck_assert (n);
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (n);
switch (i)
{
case 0: ck_assert_int_eq (10, n->begin); break;
@@ -1006,28 +902,24 @@ START_TEST (test_generator_6)
case 3: ck_assert_int_eq (40, n->begin); break;
}
}
- interval_generator_destroy (g);
- free (nodes);
-
+ itree_iterator_finish (g);
}
END_TEST
START_TEST (test_generator_7)
{
- struct interval_tree tree;
- struct interval_node *nodes;
- struct interval_generator *g;
- nodes = test_create_tree (&tree, 4, true,
- 10, 30,
- 20, 40,
- 30, 50,
- 40, 60);
- g = interval_generator_create (&tree);
- interval_generator_reset (g, 0, 100, ITREE_DESCENDING);
- for (int i = 0; i < 4; ++i)
+ enum { N = 4 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 30},
+ {.begin = 20, .end = 40},
+ {.begin = 30, .end = 50},
+ {.begin = 40, .end = 60}};
+ test_create_tree (nodes, N, true);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 0, 100, ITREE_DESCENDING, NULL, 0);
+ for (int i = 0; i < N; ++i)
{
- struct interval_node *n = interval_generator_next (g);
- ck_assert (n);
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (n);
switch (i)
{
case 0: ck_assert_int_eq (40, n->begin); break;
@@ -1036,48 +928,41 @@ START_TEST (test_generator_7)
case 3: ck_assert_int_eq (10, n->begin); break;
}
}
- interval_generator_destroy (g);
- free (nodes);
-
+ itree_iterator_finish (g);
}
END_TEST
START_TEST (test_generator_8)
{
- struct interval_tree tree;
- struct interval_node *nodes, *n;
- struct interval_generator *g;
- nodes = test_create_tree (&tree, 2, false,
- 20, 30,
- 40, 50);
- g = interval_generator_create (&tree);
- interval_generator_reset (g, 1, 60, ITREE_DESCENDING);
- n = interval_generator_next (g);
+ enum { N = 2 };
+ struct itree_node nodes[N] = {{.begin = 20, .end = 30},
+ {.begin = 40, .end = 50}};
+ test_create_tree (nodes, N, false);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 1, 60, ITREE_DESCENDING, NULL, 0);
+ struct itree_node *n = itree_iterator_next (g);
ck_assert_int_eq (n->begin, 40);
- interval_generator_narrow (g, 50, 60);
- n = interval_generator_next (g);
- ck_assert (n == NULL);
- free (nodes);
+ itree_iterator_narrow (g, 50, 60);
+ n = itree_iterator_next (g);
+ ck_assert_ptr_null (n);
+ itree_iterator_finish (g);
}
END_TEST
-
START_TEST (test_generator_9)
{
- struct interval_tree tree;
- struct interval_node *nodes, *n;
- struct interval_generator *g;
- nodes = test_create_tree (&tree, 2, false,
- 25, 25,
- 20, 30);
- g = interval_generator_create (&tree);
- interval_generator_reset (g, 1, 30, ITREE_DESCENDING);
- n = interval_generator_next (g);
+ enum { N = 2 };
+ struct itree_node nodes[N] = {{.begin = 25, .end = 25},
+ {.begin = 20, .end = 30}};
+ test_create_tree (nodes, N, false);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 1, 30, ITREE_DESCENDING, NULL, 0);
+ struct itree_node *n = itree_iterator_next (g);
ck_assert_int_eq (n->begin, 25);
- interval_generator_narrow (g, 25, 35);
- n = interval_generator_next (g);
+ itree_iterator_narrow (g, 25, 30);
+ n = itree_iterator_next (g);
ck_assert_int_eq (n->begin, 20);
- free (nodes);
+ itree_iterator_finish (g);
}
END_TEST
@@ -1086,22 +971,20 @@ END_TEST
* | Insert Gap
*
+===================================================================================+
*/
-static struct interval_tree gap_tree;
-static struct interval_node gap_node;
+static struct itree_tree gap_tree;
+static struct itree_node gap_node;
-#define N_BEG (interval_tree_validate (&gap_tree, &gap_node)->begin)
-#define N_END (interval_tree_validate (&gap_tree, &gap_node)->end)
+#define N_BEG (itree_node_begin (&gap_tree, &gap_node))
+#define N_END (itree_node_end (&gap_tree, &gap_node))
static void
test_setup_gap_node (ptrdiff_t begin, ptrdiff_t end,
bool front_advance, bool rear_advance)
{
interval_tree_init (&gap_tree);
- gap_node.begin = begin;
- gap_node.end = end;
gap_node.front_advance = front_advance;
gap_node.rear_advance = rear_advance;
- interval_tree_insert (&gap_tree, &gap_node);
+ itree_insert (&gap_tree, &gap_node, begin, end);
}
static void
@@ -1112,8 +995,8 @@ test_setup_gap_node_noadvance (ptrdiff_t begin, ptrdiff_t
end)
START_TEST (test_gap_insert_1)
{
- test_setup_gap_node (100, 200, false, false);
- interval_tree_insert_gap (&gap_tree, 100 + 10, 20);
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 100 + 10, 20, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200 + 20);
}
@@ -1121,8 +1004,8 @@ END_TEST
START_TEST (test_gap_insert_2)
{
- test_setup_gap_node (100, 200, false, false);
- interval_tree_insert_gap (&gap_tree, 300, 10);
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 300, 10, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200);
}
@@ -1130,8 +1013,8 @@ END_TEST
START_TEST (test_gap_insert_3)
{
- test_setup_gap_node (100, 200, false, false);
- interval_tree_insert_gap (&gap_tree, 0, 15);
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 0, 15, false);
ck_assert_int_eq (N_BEG, 100 + 15);
ck_assert_int_eq (N_END, 200 + 15);
}
@@ -1140,7 +1023,7 @@ END_TEST
START_TEST (test_gap_insert_4)
{
test_setup_gap_node (100, 200, true, false);
- interval_tree_insert_gap (&gap_tree, 100, 20);
+ itree_insert_gap (&gap_tree, 100, 20, false);
ck_assert_int_eq (N_BEG, 100 + 20);
ck_assert_int_eq (N_END, 200 + 20);
@@ -1149,8 +1032,8 @@ END_TEST
START_TEST (test_gap_insert_5)
{
- test_setup_gap_node (100, 200, false, false);
- interval_tree_insert_gap (&gap_tree, 100, 20);
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 100, 20, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200 + 20);
@@ -1160,7 +1043,7 @@ END_TEST
START_TEST (test_gap_insert_6)
{
test_setup_gap_node (100, 200, false, true);
- interval_tree_insert_gap (&gap_tree, 200, 20);
+ itree_insert_gap (&gap_tree, 200, 20, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200 + 20);
@@ -1169,8 +1052,8 @@ END_TEST
START_TEST (test_gap_insert_7)
{
- test_setup_gap_node (100, 200, false, false);
- interval_tree_insert_gap (&gap_tree, 200, 20);
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 200, 20, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200);
@@ -1180,7 +1063,7 @@ END_TEST
START_TEST (test_gap_insert_8)
{
test_setup_gap_node (100, 100, true, true);
- interval_tree_insert_gap (&gap_tree, 100, 20);
+ itree_insert_gap (&gap_tree, 100, 20, false);
ck_assert_int_eq (N_BEG, 100 + 20);
ck_assert_int_eq (N_END, 100 + 20);
@@ -1190,7 +1073,7 @@ END_TEST
START_TEST (test_gap_insert_9)
{
test_setup_gap_node (100, 100, false, true);
- interval_tree_insert_gap (&gap_tree, 100, 20);
+ itree_insert_gap (&gap_tree, 100, 20, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 100 + 20);
@@ -1200,7 +1083,7 @@ END_TEST
START_TEST (test_gap_insert_10)
{
test_setup_gap_node (100, 100, true, false);
- interval_tree_insert_gap (&gap_tree, 100, 20);
+ itree_insert_gap (&gap_tree, 100, 20, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 100);
@@ -1209,8 +1092,8 @@ END_TEST
START_TEST (test_gap_insert_11)
{
- test_setup_gap_node (100, 100, false, false);
- interval_tree_insert_gap (&gap_tree, 100, 20);
+ test_setup_gap_node_noadvance (100, 100);
+ itree_insert_gap (&gap_tree, 100, 20, false);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 100);
@@ -1225,7 +1108,7 @@ END_TEST
START_TEST (test_gap_delete_1)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 100 + 10, 20);
+ itree_delete_gap (&gap_tree, 100 + 10, 20);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200 - 20);
@@ -1235,7 +1118,7 @@ END_TEST
START_TEST (test_gap_delete_2)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 200 + 10, 20);
+ itree_delete_gap (&gap_tree, 200 + 10, 20);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200);
@@ -1245,7 +1128,7 @@ END_TEST
START_TEST (test_gap_delete_3)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 200, 20);
+ itree_delete_gap (&gap_tree, 200, 20);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 200);
@@ -1255,7 +1138,7 @@ END_TEST
START_TEST (test_gap_delete_4)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 100 - 20, 20);
+ itree_delete_gap (&gap_tree, 100 - 20, 20);
ck_assert_int_eq (N_BEG, 100 - 20);
ck_assert_int_eq (N_END, 200 - 20);
@@ -1265,7 +1148,7 @@ END_TEST
START_TEST (test_gap_delete_5)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 70, 20);
+ itree_delete_gap (&gap_tree, 70, 20);
ck_assert_int_eq (N_BEG, 100 - 20);
ck_assert_int_eq (N_END, 200 - 20);
@@ -1275,7 +1158,7 @@ END_TEST
START_TEST (test_gap_delete_6)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 80, 100);
+ itree_delete_gap (&gap_tree, 80, 100);
ck_assert_int_eq (N_BEG, 80);
ck_assert_int_eq (N_END, 100);
}
@@ -1284,7 +1167,7 @@ END_TEST
START_TEST (test_gap_delete_7)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 120, 100);
+ itree_delete_gap (&gap_tree, 120, 100);
ck_assert_int_eq (N_BEG, 100);
ck_assert_int_eq (N_END, 120);
}
@@ -1293,7 +1176,7 @@ END_TEST
START_TEST (test_gap_delete_8)
{
test_setup_gap_node_noadvance (100, 200);
- interval_tree_delete_gap (&gap_tree, 100 - 20, 200 + 20);
+ itree_delete_gap (&gap_tree, 100 - 20, 200 + 20);
ck_assert_int_eq (N_BEG, 100 - 20);
ck_assert_int_eq (N_END, 100 - 20);
@@ -1302,36 +1185,58 @@ END_TEST
-Suite * basic_suite ()
+static Suite *
+basic_suite ()
{
- Suite *s = suite_create ("basic_suite");
- TCase *tc = tcase_create ("basic_test");
+ Suite *s = suite_create ("basic");
+ TCase *tc = tcase_create ("insert1");
+ tcase_add_checked_fixture (tc, test_insert1_setup, NULL);
tcase_add_test (tc, test_insert_1);
tcase_add_test (tc, test_insert_2);
tcase_add_test (tc, test_insert_3);
tcase_add_test (tc, test_insert_4);
tcase_add_test (tc, test_insert_5);
tcase_add_test (tc, test_insert_6);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("insert2");
+ tcase_add_checked_fixture (tc, test_insert2_setup, NULL);
tcase_add_test (tc, test_insert_7);
tcase_add_test (tc, test_insert_8);
tcase_add_test (tc, test_insert_9);
tcase_add_test (tc, test_insert_10);
tcase_add_test (tc, test_insert_11);
tcase_add_test (tc, test_insert_12);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("insert3");
tcase_add_test (tc, test_insert_13);
+ tcase_add_test (tc, test_insert_14);
+ suite_add_tcase (s, tc);
+ tc = tcase_create ("remove1");
+ tcase_add_checked_fixture (tc, test_remove1_setup, NULL);
tcase_add_test (tc, test_remove_1);
tcase_add_test (tc, test_remove_2);
tcase_add_test (tc, test_remove_3);
tcase_add_test (tc, test_remove_4);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("remove2");
+ tcase_add_checked_fixture (tc, test_remove2_setup, NULL);
tcase_add_test (tc, test_remove_5);
tcase_add_test (tc, test_remove_6);
tcase_add_test (tc, test_remove_7);
tcase_add_test (tc, test_remove_8);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("remove3");
tcase_add_test (tc, test_remove_9);
tcase_add_test (tc, test_remove_10);
+ suite_add_tcase (s, tc);
+ tc = tcase_create ("generator");
tcase_add_test (tc, test_generator_1);
tcase_add_test (tc, test_generator_2);
tcase_add_test (tc, test_generator_3);
@@ -1340,7 +1245,9 @@ Suite * basic_suite ()
tcase_add_test (tc, test_generator_7);
tcase_add_test (tc, test_generator_8);
tcase_add_test (tc, test_generator_9);
+ suite_add_tcase (s, tc);
+ tc = tcase_create ("insert_gap");
tcase_add_test (tc, test_gap_insert_1);
tcase_add_test (tc, test_gap_insert_2);
tcase_add_test (tc, test_gap_insert_3);
@@ -1352,7 +1259,9 @@ Suite * basic_suite ()
tcase_add_test (tc, test_gap_insert_9);
tcase_add_test (tc, test_gap_insert_10);
tcase_add_test (tc, test_gap_insert_11);
+ suite_add_tcase (s, tc);
+ tc = tcase_create ("delete_gap");
tcase_add_test (tc, test_gap_delete_1);
tcase_add_test (tc, test_gap_delete_2);
tcase_add_test (tc, test_gap_delete_3);
@@ -1361,21 +1270,20 @@ Suite * basic_suite ()
tcase_add_test (tc, test_gap_delete_6);
tcase_add_test (tc, test_gap_delete_7);
tcase_add_test (tc, test_gap_delete_8);
-
- /* tcase_set_timeout (tc, 120); */
suite_add_tcase (s, tc);
+
return s;
}
int
main (void)
{
- int nfailed;
Suite *s = basic_suite ();
SRunner *sr = srunner_create (s);
- srunner_run_all (sr, CK_NORMAL);
- nfailed = srunner_ntests_failed (sr);
+ init_itree ();
+ srunner_run_all (sr, CK_ENV);
+ int nfailed = srunner_ntests_failed (sr);
srunner_free (sr);
return (nfailed == 0) ? EXIT_SUCCESS : EXIT_FAILURE;
}
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index e020732524..3fc52eaf8b 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -275,6 +275,62 @@ with parameters from the *Messages* buffer modification."
(with-temp-buffer
(should (eq (buffer-base-buffer (current-buffer)) nil))))
+(ert-deftest buffer-tests--overlays-indirect-bug58928 ()
+ (with-temp-buffer
+ (insert "hello world")
+ (let* ((base (current-buffer))
+ (ol1 (make-overlay (+ 2 (point-min)) (+ 8 (point-min))))
+ (ib (make-indirect-buffer
+ base (generate-new-buffer-name "bug58928")))
+ (ol2 (with-current-buffer ib
+ (make-overlay (+ 2 (point-min)) (+ 8 (point-min))))))
+ (should (equal (overlay-start ol1) (overlay-start ol2)))
+ (should (equal (overlay-end ol1) (overlay-end ol2)))
+ (goto-char (+ 3 (point-min)))
+ (insert "a") (delete-char 2)
+ (should (equal (overlay-start ol1) (overlay-start ol2)))
+ (should (equal (overlay-end ol1) (overlay-end ol2)))
+ (with-current-buffer ib
+ (goto-char (+ 4 (point-min)))
+ (insert "a") (delete-char 2))
+ (should (equal (overlay-start ol1) (overlay-start ol2)))
+ (should (equal (overlay-end ol1) (overlay-end ol2))))))
+
+(ert-deftest buffer-tests--overlays-indirect-evaporate ()
+ "Verify that deleting text evaporates overlays in every related buffer.
+
+Deleting characters from either a base or an indirect buffer
+should evaporate overlays in both."
+ ;; Loop twice, erasing from the base buffer the first time and the
+ ;; indirect buffer the second.
+ (dolist (erase-where '(base indirect))
+ (ert-info ((format "erase-where %S" erase-where))
+ (with-temp-buffer
+ (insert "xxx")
+ (let* ((beg 2)
+ (end 3)
+ (base (current-buffer))
+ (base-overlay (make-overlay beg end base))
+ (indirect (make-indirect-buffer
+ base
+ (generate-new-buffer-name
+ (concat (buffer-name base) "-indirect"))))
+ (indirect-overlay (make-overlay beg end indirect)))
+ (overlay-put base-overlay 'evaporate t)
+ (overlay-put indirect-overlay 'evaporate t)
+ (with-current-buffer (pcase-exhaustive erase-where
+ (`base base)
+ (`indirect indirect))
+ (delete-region beg end))
+ (ert-info ((prin1-to-string
+ `(,base ,base-overlay ,indirect ,indirect-overlay)))
+ (should (not (buffer-live-p (overlay-buffer base-overlay))))
+ (should (not (buffer-live-p (overlay-buffer indirect-overlay))))
+ (should (equal nil (with-current-buffer base
+ (overlays-in (point-min) (point-max)))))
+ (should (equal nil (with-current-buffer indirect
+ (overlays-in (point-min) (point-max)))))))))))
+
(ert-deftest overlay-evaporation-after-killed-buffer ()
(let* ((ols (with-temp-buffer
(insert "toto")
@@ -1272,7 +1328,51 @@ Regression test for bug#58706."
(delete-overlay left)
(should (= 2 (length (overlays-in 1 (point-max))))))))
+;; +==========================================================================+
+;; | Moving overlays with insert-before-markers
+;; +==========================================================================+
+(ert-deftest test-overlay-insert-before-markers-at-start ()
+ "`insert-before-markers' always advances an overlay's start.
+Test both front-advance and non-front-advance overlays."
+ (dolist (front-advance '(nil t))
+ (ert-info ((format "front-advance %S" front-advance))
+ (with-temp-buffer
+ (insert "1234")
+ (let* ((beg (1+ (point-min)))
+ (end (1+ beg))
+ (overlay (make-overlay beg end nil front-advance nil)))
+ (goto-char beg)
+ (insert-before-markers "x")
+ (should (equal (1+ beg) (overlay-start overlay)))
+ (should (equal (1+ end) (overlay-end overlay))))))))
+
+(ert-deftest test-overlay-insert-before-markers-at-end ()
+ "`insert-before-markers' always advances an overlay's end.
+Test both rear-advance and non-rear-advance overlays."
+ (dolist (rear-advance '(nil t))
+ (ert-info ((format "rear-advance %S" rear-advance))
+ (with-temp-buffer
+ (insert "1234")
+ (let* ((beg (1+ (point-min)))
+ (end (1+ beg))
+ (overlay (make-overlay beg end nil nil rear-advance)))
+ (goto-char end)
+ (insert-before-markers "x")
+ (should (equal beg (overlay-start overlay)))
+ (should (equal (1+ end) (overlay-end overlay))))))))
+
+(ert-deftest test-overlay-insert-before-markers-empty ()
+ (dolist (advance-args '((nil nil) (t nil) (nil t) (t t)))
+ (ert-info ((format "advance args %S" advance-args))
+ (with-temp-buffer
+ (insert "1234")
+ (let* ((pos (1+ (point-min)))
+ (overlay (apply #'make-overlay pos pos nil advance-args)))
+ (goto-char pos)
+ (insert-before-markers "x")
+ (should (equal (1+ pos) (overlay-start overlay)))
+ (should (equal (1+ pos) (overlay-end overlay))))))))
;; +==========================================================================+
;; | Moving by deletions
@@ -1624,7 +1724,7 @@ Regression test for bug#58706."
This test works best when Emacs is configured with
--enable-checking=yes. This is a little bit like fuzz testing,
-except this test has no way to reduce to a minimal failng test
+except this test has no way to reduce to a minimal failing test
case. Regardless, by exercising many corner cases bugs can be
found using Emacs' internal consistency assertions."
(let* (
@@ -8280,65 +8380,92 @@ dicta sunt, explicabo. "))
(remove-overlays)
(should (= (length (overlays-in (point-min) (point-max))) 0))))
-(ert-deftest test-kill-buffer-auto-save-default ()
- (ert-with-temp-file file
- (let (auto-save)
- ;; Always answer yes.
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- (kill-buffer (current-buffer))
- (should (file-exists-p auto-save)))
- (when auto-save
- (ignore-errors (delete-file auto-save))))))))
-
-(ert-deftest test-kill-buffer-auto-save-delete ()
+(defun test-kill-buffer-auto-save (auto-save-answer body-func)
+ "Test helper for `kill-buffer-delete-auto-save' tests.
+
+Call BODY-FUNC with the current buffer set to a buffer visiting a
+temporary file. Around the call, mock the \"Buffer modified;
+kill anyway?\" and \"Delete auto-save file?\" prompts, answering
+\"yes\" for the former and AUTO-SAVE-ANSWER for the latter. The
+expectation should be the characters `?y' or `?n', or `nil' if no
+prompt is expected. The test fails if the \"Delete auto-save
+file?\" prompt does not either prompt is not issued as expected.
+Finally, kill the buffer and its temporary file."
(ert-with-temp-file file
- (let (auto-save)
- (should (file-exists-p file))
- (setq kill-buffer-delete-auto-save-files t)
- ;; Always answer yes.
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- ;; This should delete the auto-save file.
- (kill-buffer (current-buffer))
- (should-not (file-exists-p auto-save)))
- (ignore-errors (delete-file file))
- (when auto-save
- (ignore-errors (delete-file auto-save)))))
- ;; Answer no to deletion.
- (cl-letf (((symbol-function #'yes-or-no-p)
- (lambda (prompt)
- (not (string-search "Delete auto-save file" prompt)))))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- ;; This should not delete the auto-save file.
- (kill-buffer (current-buffer))
- (should (file-exists-p auto-save)))
- (when auto-save
- (ignore-errors (delete-file auto-save))))))))
+ (should (file-exists-p file))
+ (save-excursion
+ (find-file file)
+ (should (equal file (buffer-file-name)))
+ (let ((buffer (current-buffer))
+ (auto-save-prompt-happened nil))
+ (cl-letf (((symbol-function #'read-multiple-choice)
+ (lambda (prompt choices &rest _)
+ (should (string-search "modified; kill anyway?" prompt))
+ (let ((answer (assq ?y choices)))
+ (should answer)
+ answer)))
+ ((symbol-function #'yes-or-no-p)
+ (lambda (prompt)
+ (should (string-search "Delete auto-save file?" prompt))
+ (setq auto-save-prompt-happened t)
+ (pcase-exhaustive auto-save-answer
+ (?y t)
+ (?n nil)))))
+ (funcall body-func)
+ (should (equal (null auto-save-prompt-happened)
+ (null auto-save-answer))))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil)
+ (kill-buffer)))))))
+
+(ert-deftest test-kill-buffer-auto-save-default ()
+ (let ((kill-buffer-delete-auto-save-files nil))
+ (test-kill-buffer-auto-save
+ nil
+ (lambda ()
+ (let (auto-save)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))))))
+
+(ert-deftest test-kill-buffer-auto-save-delete-yes ()
+ (let ((kill-buffer-delete-auto-save-files t))
+ (test-kill-buffer-auto-save
+ ?y
+ (lambda ()
+ (let (auto-save)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should-not (file-exists-p auto-save)))))))
+
+(ert-deftest test-kill-buffer-auto-save-delete-no ()
+ (let ((kill-buffer-delete-auto-save-files t))
+ (test-kill-buffer-auto-save
+ ?n
+ (lambda ()
+ (let (auto-save)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should not delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save))
+ (delete-file auto-save))))))
(ert-deftest test-buffer-modifications ()
(ert-with-temp-file file