[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/improved-locked-narrowing ba9315b164: Merge master into feature/
|
From: |
Gregory Heytings |
|
Subject: |
feature/improved-locked-narrowing ba9315b164: Merge master into feature/improved-locked-narrowing. |
|
Date: |
Thu, 24 Nov 2022 08:22:15 -0500 (EST) |
branch: feature/improved-locked-narrowing
commit ba9315b1641b483f2bf843c38dcdba0cd1643a55
Merge: aef803d6c3 a3b654e069
Author: Gregory Heytings <gregory@heytings.org>
Commit: Gregory Heytings <gregory@heytings.org>
Merge master into feature/improved-locked-narrowing.
---
.clang-format | 14 +-
.dir-locals.el | 6 +-
.gitignore | 1 +
CONTRIBUTE | 7 +-
ChangeLog.1 | 2 +-
ChangeLog.2 | 6 +-
ChangeLog.3 | 234 ++--
Makefile.in | 10 +-
admin/authors.el | 2 +-
admin/cus-test.el | 2 +-
admin/emake | 17 +
admin/git-bisect-start | 40 +
admin/grammars/srecode-template.wy | 2 +-
admin/last-chance.el | 2 +-
admin/notes/bug-triage | 2 +-
admin/notes/repo | 4 +
configure.ac | 7 +
doc/emacs/ChangeLog.1 | 4 +-
doc/emacs/custom.texi | 6 +-
doc/emacs/dired.texi | 2 +-
doc/emacs/maintaining.texi | 7 +
doc/emacs/mark.texi | 17 +-
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/display.texi | 2 +-
doc/lispref/edebug.texi | 29 +-
doc/lispref/errors.texi | 2 +-
doc/lispref/functions.texi | 2 +-
doc/lispref/help.texi | 4 +-
doc/lispref/internals.texi | 20 +-
doc/lispref/intro.texi | 2 +
doc/lispref/minibuf.texi | 2 +-
doc/lispref/processes.texi | 4 +
doc/lispref/searching.texi | 39 +-
doc/lispref/strings.texi | 2 +-
doc/misc/ChangeLog.1 | 15 +-
doc/misc/Makefile.in | 14 +-
doc/misc/auth.texi | 18 +
doc/misc/cl.texi | 4 +-
doc/misc/ede.texi | 168 +--
doc/misc/efaq.texi | 2 +-
doc/misc/eglot.texi | 39 +-
doc/misc/erc.texi | 31 +-
doc/misc/eshell.texi | 11 +-
doc/misc/eudc.texi | 143 ++-
doc/misc/flymake.texi | 2 +-
doc/misc/gnus.texi | 39 +-
doc/misc/message.texi | 2 +-
doc/misc/modus-themes.org | 8 +-
doc/misc/org.org | 2 +-
doc/misc/reftex.texi | 4 +-
doc/misc/ses.texi | 4 +-
doc/misc/srecode.texi | 2 +-
doc/misc/tramp.texi | 2 +-
doc/misc/transient.texi | 2 +-
doc/misc/vip.texi | 4 +-
etc/ERC-NEWS | 25 +-
etc/NEWS | 148 ++-
etc/NEWS.27 | 2 +-
etc/NEWS.28 | 4 +-
etc/NEXTSTEP | 2 +-
etc/ORG-NEWS | 8 +-
etc/PROBLEMS | 56 +-
etc/TODO | 2 +-
etc/publicsuffix.txt | 259 ++--
etc/themes/dichromacy-theme.el | 38 +-
lib-src/ebrowse.c | 63 +-
lib-src/emacsclient.c | 2 +-
lisp/ChangeLog.10 | 4 +-
lisp/ChangeLog.12 | 8 +-
lisp/ChangeLog.13 | 6 +-
lisp/ChangeLog.14 | 2 +-
lisp/ChangeLog.15 | 6 +-
lisp/ChangeLog.16 | 27 +-
lisp/ChangeLog.17 | 2 +-
lisp/ChangeLog.3 | 3 +-
lisp/ChangeLog.4 | 2 +-
lisp/ChangeLog.6 | 2 +-
lisp/ChangeLog.7 | 10 +-
lisp/ChangeLog.8 | 4 +-
lisp/ChangeLog.9 | 2 +-
lisp/ansi-osc.el | 2 +-
lisp/apropos.el | 11 +-
lisp/auth-source-pass.el | 112 +-
lisp/bookmark.el | 35 +-
lisp/bs.el | 50 +-
lisp/buff-menu.el | 54 +-
lisp/calc/calc-graph.el | 2 +-
lisp/calendar/diary-lib.el | 6 +-
lisp/cedet/ChangeLog.1 | 11 +-
lisp/cedet/ede.el | 2 +-
lisp/cedet/ede/makefile-edit.el | 2 +-
lisp/cedet/ede/proj.el | 6 +-
lisp/cedet/ede/project-am.el | 4 +-
lisp/cedet/semantic.el | 10 +-
lisp/cedet/semantic/analyze/fcn.el | 4 +-
lisp/cedet/semantic/bovine/c.el | 4 +-
lisp/cedet/semantic/complete.el | 2 +-
lisp/cedet/semantic/db-ebrowse.el | 2 +-
lisp/cedet/semantic/db-find.el | 2 +-
lisp/cedet/semantic/decorate/include.el | 2 +-
lisp/cedet/semantic/edit.el | 2 +-
lisp/cedet/semantic/grm-wy-boot.el | 4 +-
lisp/cedet/semantic/idle.el | 2 +-
lisp/cedet/semantic/scope.el | 4 +-
lisp/cedet/semantic/symref/grep.el | 11 +-
lisp/cedet/semantic/symref/list.el | 5 +-
lisp/cedet/semantic/util-modes.el | 2 +-
lisp/cedet/srecode/document.el | 3 +-
lisp/cedet/srecode/extract.el | 2 +-
lisp/cedet/srecode/semantic.el | 4 +-
lisp/comint.el | 8 +
lisp/cus-edit.el | 58 +-
lisp/cus-theme.el | 40 +-
lisp/dired-aux.el | 15 +-
lisp/dired.el | 6 +-
lisp/dnd.el | 4 +-
lisp/dynamic-setting.el | 18 +-
lisp/emacs-lisp/bytecomp.el | 17 +-
lisp/emacs-lisp/checkdoc.el | 4 +-
lisp/emacs-lisp/cl-macs.el | 2 +
lisp/emacs-lisp/comp.el | 4 +-
lisp/emacs-lisp/ert.el | 2 +-
lisp/emacs-lisp/hierarchy.el | 2 +-
lisp/emacs-lisp/multisession.el | 11 +
lisp/emacs-lisp/oclosure.el | 6 +-
lisp/emacs-lisp/package-vc.el | 791 ++++++++++++
lisp/emacs-lisp/package.el | 299 +++--
lisp/emacs-lisp/rmc.el | 2 +-
lisp/emacs-lisp/seq.el | 126 +-
lisp/emacs-lisp/shortdoc.el | 26 +-
lisp/emacs-lisp/smie.el | 2 +-
lisp/emacs-lisp/subr-x.el | 4 +
lisp/emacs-lisp/tcover-ses.el | 2 +-
lisp/emacs-lisp/text-property-search.el | 10 +-
lisp/erc/ChangeLog.1 | 9 +-
lisp/erc/erc-backend.el | 269 +++-
lisp/erc/erc-common.el | 274 +++++
lisp/erc/erc-compat.el | 157 +++
lisp/erc/erc-dcc.el | 7 +-
lisp/erc/erc-goodies.el | 17 +-
lisp/erc/erc-networks.el | 37 +-
lisp/erc/erc-pcomplete.el | 4 +
lisp/erc/erc.el | 606 ++++-----
lisp/eshell/em-prompt.el | 8 +
lisp/eshell/em-tramp.el | 94 +-
lisp/eshell/esh-mode.el | 8 +
lisp/eshell/esh-proc.el | 2 +-
lisp/eshell/esh-util.el | 13 +-
lisp/face-remap.el | 57 +-
lisp/faces.el | 23 +-
lisp/files.el | 2 +-
lisp/filesets.el | 4 +-
lisp/forms.el | 28 +-
lisp/gnus/ChangeLog.1 | 2 +-
lisp/gnus/ChangeLog.3 | 8 +-
lisp/gnus/gnus-search.el | 2 +-
lisp/gnus/gnus-start.el | 2 +-
lisp/gnus/message.el | 1 +
lisp/gnus/mml.el | 2 +-
lisp/gnus/nnimap.el | 2 +-
lisp/gnus/nnrss.el | 6 +-
lisp/gnus/nnvirtual.el | 2 +-
lisp/htmlfontify.el | 2 +-
lisp/icomplete.el | 2 +-
lisp/info.el | 2 +-
lisp/international/emoji.el | 3 +-
lisp/international/titdic-cnv.el | 7 +
lisp/jka-compr.el | 2 +-
lisp/keymap.el | 60 +-
lisp/language/ethio-util.el | 92 +-
lisp/language/ethiopic.el | 7 +
lisp/language/ind-util.el | 11 +-
lisp/language/tibet-util.el | 7 +
lisp/language/tibetan.el | 7 +
lisp/ldefs-boot.el | 265 +++-
lisp/leim/quail/ethiopic.el | 7 +
lisp/leim/quail/indian.el | 4 +-
lisp/leim/quail/japanese.el | 2 +-
lisp/leim/quail/misc-lang.el | 2 +-
lisp/leim/quail/tibetan.el | 7 +
lisp/mail/feedmail.el | 17 +-
lisp/mail/ietf-drums-date.el | 4 +-
lisp/mail/mail-hist.el | 23 +-
lisp/mail/rfc6068.el | 4 +-
lisp/mail/rmail.el | 12 +-
lisp/mail/rmailsum.el | 245 +++-
lisp/mail/supercite.el | 2 +-
lisp/man.el | 99 +-
lisp/mh-e/ChangeLog.1 | 4 +-
lisp/mh-e/ChangeLog.2 | 4 +-
lisp/minibuffer.el | 83 +-
lisp/mpc.el | 2 +-
lisp/net/ange-ftp.el | 4 +-
lisp/net/browse-url.el | 24 +
lisp/net/dbus.el | 1 +
lisp/net/dictionary.el | 7 +-
lisp/net/eudc-capf.el | 11 +-
lisp/net/eudc-vars.el | 13 +-
lisp/net/eudc.el | 24 +-
lisp/net/eudcb-ecomplete.el | 108 ++
lisp/net/eudcb-mailabbrev.el | 130 ++
lisp/net/eww.el | 6 +-
lisp/net/network-stream.el | 4 +
lisp/net/rcirc.el | 23 +-
lisp/net/tramp-archive.el | 24 +-
lisp/net/tramp-compat.el | 2 +-
lisp/net/tramp-crypt.el | 2 +-
lisp/net/tramp.el | 22 +-
lisp/net/trampver.el | 2 +-
lisp/nxml/nxml-mode.el | 2 +-
lisp/nxml/rng-cmpct.el | 22 +-
lisp/obsolete/vi.el | 4 +-
lisp/org/ChangeLog.1 | 30 +-
lisp/org/ob-tangle.el | 4 +-
lisp/org/ol.el | 2 +-
lisp/org/org-ctags.el | 2 -
lisp/org/org-faces.el | 2 +-
lisp/org/org-protocol.el | 1 -
lisp/outline.el | 168 ++-
lisp/proced.el | 26 +-
lisp/profiler.el | 131 +-
lisp/progmodes/cc-bytecomp.el | 2 +-
lisp/progmodes/cc-cmds.el | 2 +-
lisp/progmodes/cc-defs.el | 2 +-
lisp/progmodes/cc-engine.el | 85 +-
lisp/progmodes/cc-langs.el | 10 +-
lisp/progmodes/cc-mode.el | 10 +-
lisp/progmodes/cperl-mode.el | 66 +-
lisp/progmodes/cpp.el | 101 +-
lisp/progmodes/dcl-mode.el | 60 +-
lisp/progmodes/ebnf2ps.el | 8 +-
lisp/progmodes/eglot.el | 190 +--
lisp/progmodes/elisp-mode.el | 67 +-
lisp/progmodes/flymake.el | 2 +-
lisp/progmodes/hideshow.el | 110 +-
lisp/progmodes/mixal-mode.el | 3 -
lisp/progmodes/octave.el | 72 +-
lisp/progmodes/perl-mode.el | 4 +-
lisp/progmodes/prog-mode.el | 2 +-
lisp/progmodes/project.el | 66 +-
lisp/progmodes/python.el | 1 +
lisp/progmodes/sh-script.el | 2 +-
lisp/progmodes/simula.el | 42 +-
lisp/progmodes/sql.el | 64 +-
lisp/progmodes/verilog-mode.el | 2 +-
lisp/progmodes/xref.el | 7 +-
lisp/repeat.el | 65 +-
lisp/replace.el | 2 +-
lisp/rot13.el | 11 +-
lisp/savehist.el | 6 +-
lisp/scroll-bar.el | 2 +-
lisp/server.el | 17 +-
lisp/shell.el | 8 +
lisp/simple.el | 34 +-
lisp/so-long.el | 4 +-
lisp/startup.el | 37 +-
lisp/subr.el | 24 +-
lisp/tab-bar.el | 169 ++-
lisp/tab-line.el | 34 +-
lisp/textmodes/css-mode.el | 38 +-
lisp/textmodes/flyspell.el | 4 +-
lisp/textmodes/reftex-cite.el | 2 +-
lisp/textmodes/reftex-index.el | 2 +-
lisp/textmodes/table.el | 4 +-
lisp/textmodes/tex-mode.el | 4 +-
lisp/thingatpt.el | 2 +-
lisp/thread.el | 26 +-
lisp/url/ChangeLog.1 | 2 +-
lisp/url/url-irc.el | 32 +-
lisp/vc/add-log.el | 2 +-
lisp/vc/diff-mode.el | 2 +-
lisp/vc/ediff-diff.el | 35 +-
lisp/vc/ediff-util.el | 2 +-
lisp/vc/smerge-mode.el | 5 +-
lisp/vc/vc-bzr.el | 6 +
lisp/vc/vc-dav.el | 2 +-
lisp/vc/vc-git.el | 37 +-
lisp/vc/vc-hg.el | 6 +
lisp/vc/vc-rcs.el | 2 +-
lisp/vc/vc-svn.el | 9 +-
lisp/vc/vc.el | 102 +-
lisp/vcursor.el | 82 +-
lisp/whitespace.el | 2 +-
lisp/window.el | 41 +-
lisp/woman.el | 26 +-
lisp/x-dnd.el | 4 +-
lisp/xwidget.el | 10 +-
msdos/autogen/config.in | 2 +-
nt/inc/ms-w32.h | 2 +-
src/ChangeLog.10 | 2 +-
src/ChangeLog.11 | 6 +-
src/ChangeLog.12 | 8 +-
src/ChangeLog.13 | 14 +-
src/ChangeLog.5 | 2 +-
src/ChangeLog.6 | 2 +-
src/ChangeLog.7 | 8 +-
src/ChangeLog.8 | 6 +-
src/alloc.c | 19 +-
src/buffer.c | 119 +-
src/buffer.h | 1 -
src/callproc.c | 1 +
src/comp.c | 4 +-
src/dbusbind.c | 4 +-
src/dispextern.h | 3 +-
src/emacs-module.c | 2 +-
src/emacs.c | 7 +-
src/eval.c | 5 +-
src/font.h | 6 +-
src/fontset.c | 12 +-
src/frame.c | 115 +-
src/frame.h | 1 +
src/ftcrfont.c | 38 +-
src/ftfont.h | 7 +
src/gnutls.c | 12 +-
src/haiku_support.cc | 18 +
src/haiku_support.h | 2 +-
src/haikufns.c | 17 +-
src/haikuselect.c | 2 +-
src/haikuterm.c | 15 +-
src/image.c | 30 +-
src/insdel.c | 57 +-
src/itree.c | 700 ++++++-----
src/itree.h | 55 +-
src/keyboard.c | 57 +-
src/lisp.h | 3 +-
src/lread.c | 21 +-
src/nsfns.m | 17 +-
src/nsimage.m | 2 +
src/nsterm.m | 33 +-
src/pdumper.c | 8 +-
src/pgtkfns.c | 24 +-
src/pgtkterm.c | 257 ++--
src/pgtkterm.h | 11 +-
src/print.c | 4 +-
src/process.c | 3 +-
src/search.c | 37 +-
src/sqlite.c | 36 +-
src/w32fns.c | 27 +-
src/w32inevt.c | 2 +-
src/xdisp.c | 62 +-
src/xfaces.c | 20 +-
src/xfns.c | 42 +-
src/xselect.c | 9 +-
src/xsettings.c | 12 +-
src/xterm.c | 889 ++++++++++----
src/xterm.h | 23 +-
test/lisp/auth-source-pass-tests.el | 275 ++++-
test/lisp/cedet/srecode/fields-tests.el | 2 +-
test/lisp/dired-tests.el | 11 +
test/lisp/emacs-lisp/cl-macs-tests.el | 6 +
.../emacs-lisp/package-resources/elpa-packages.eld | 3 +
.../newer-versions/elpa-packages.eld | 3 +
.../package-resources/signed/elpa-packages.eld | 3 +
.../package-resources/signed/elpa-packages.eld.sig | Bin 0 -> 119 bytes
.../package-resources/signed/update-signatures.sh | 1 +
.../with-nil-entry/elpa-packages.eld | 3 +
test/lisp/emacs-lisp/syntax-tests.el | 2 +-
test/lisp/erc/erc-dcc-tests.el | 120 +-
test/lisp/erc/erc-networks-tests.el | 19 +-
test/lisp/erc/erc-scenarios-base-reconnect.el | 46 +
test/lisp/erc/erc-scenarios-misc.el | 28 +
test/lisp/erc/erc-services-tests.el | 27 +-
test/lisp/erc/erc-tests.el | 247 +++-
test/lisp/erc/resources/erc-d/erc-d-tests.el | 1 +
test/lisp/erc/resources/erc-scenarios-common.el | 3 +-
test/lisp/erc/resources/join/legacy/foonet.eld | 2 +-
test/lisp/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/browse-url-tests.el | 9 +
test/lisp/net/dbus-tests.el | 6 +-
test/lisp/net/eudc-resources/bbdb | 3 +
test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif | 15 +
.../dc=gnu,dc=org/cn=emacs-ert-test-1.ldif | 17 +
.../dc=gnu,dc=org/cn=emacs-ert-test-2.ldif | 17 +
test/lisp/net/eudc-resources/ecompleterc | 7 +
test/lisp/net/eudc-resources/mailrc | 3 +
test/lisp/net/eudc-resources/slapd.conf | 7 +
test/lisp/net/eudc-tests.el | 156 +++
test/lisp/net/mailcap-tests.el | 2 +-
test/lisp/net/tramp-tests.el | 11 +-
test/lisp/progmodes/python-tests.el | 17 +
test/lisp/server-tests.el | 41 +
test/lisp/simple-tests.el | 24 +
test/lisp/subr-tests.el | 2 +-
test/lisp/thingatpt-tests.el | 3 +
test/lisp/vc/vc-tests.el | 2 +-
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/manual/noverlay/overlay-perf.el | 2 +-
test/src/buffer-tests.el | 326 +++--
test/src/comp-resources/comp-test-funcs.el | 8 +-
test/src/comp-tests.el | 4 +-
test/src/eval-tests.el | 2 +-
test/src/font-tests.el | 2 +-
test/src/thread-tests.el | 2 +-
402 files changed, 10336 insertions(+), 4551 deletions(-)
diff --git a/.clang-format b/.clang-format
index ac9f95c88a..2208240a66 100644
--- a/.clang-format
+++ b/.clang-format
@@ -1,12 +1,18 @@
Language: Cpp
BasedOnStyle: GNU
AlignEscapedNewlinesLeft: true
+AlignOperands: Align
AlwaysBreakAfterReturnType: TopLevelDefinitions
BreakBeforeBinaryOperators: All
BreakBeforeBraces: GNU
ColumnLimit: 70
ContinuationIndentWidth: 2
-ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE, ITREE_FOREACH]
+ForEachMacros:
+ - FOR_EACH_TAIL
+ - FOR_EACH_TAIL_SAFE
+ - FOR_EACH_LIVE_BUFFER
+ - ITREE_FOREACH
+ - FOR_EACH_ALIST_VALUE
IncludeCategories:
- Regex: '^<config\.h>$'
Priority: -1
@@ -16,11 +22,17 @@ IncludeCategories:
Priority: 2
- Regex: '.*'
Priority: 3
+WhitespaceSensitiveMacros:
+ - STR
+ - CALL1I
+ - CALL2I
+ - STR_VALUE
KeepEmptyLinesAtTheStartOfBlocks: false
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..f0ab46236f 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -7,9 +7,11 @@
(emacs-lisp-docstring-fill-column . 65)
(vc-git-annotate-switches . "-w")
(bug-reference-url-format . "https://debbugs.gnu.org/%s";)
- (diff-add-log-use-relative-names . t)))
+ (diff-add-log-use-relative-names . t)
+ (vc-prepare-patches-separately . nil)))
(c-mode . ((c-file-style . "GNU")
- (c-noise-macro-names . ("INLINE" "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/.gitignore b/.gitignore
index a7828d3386..e6310b644a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -25,6 +25,7 @@
# Personal customization.
.dir-locals-2.el
+.no-advice-on-failure
# Built by 'autogen.sh'.
/aclocal.m4
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..483dec2542 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -9317,7 +9317,7 @@
optional.
* src/buffer.c (Fbarf_if_buffer_read_only): Rename argument POS
- to POSITION to keep consisteny with doc-string.
+ to POSITION to keep consistent with doc-string.
2016-02-01 Paul Eggert <eggert@cs.ucla.edu>
@@ -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.
@@ -34464,7 +34464,7 @@
* lisp/emacs-lisp/package.el: Make archive and status pseudo-keywords
(package--has-keyword-p): Understand "arc:xxxx" and "status:xxxx"
- as special keywords which match agains package archive and status
+ as special keywords which match against package archive and status
respectively.
* etc/NEWS: Document it.
diff --git a/ChangeLog.3 b/ChangeLog.3
index f2245a4ed5..d27a14d427 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -4043,7 +4043,7 @@
* doc/emacs/maintaining.texi (Basic VC Editing): Mention Dired buffer.
- * doc/emacs/text.texi (Outline Mode): Replace S-TAB with with S-<TAB>.
+ * doc/emacs/text.texi (Outline Mode): Replace S-TAB with S-<TAB>.
* etc/NEWS: Add some missing +++/--- and move some related items closer.
@@ -5557,7 +5557,7 @@
Fix ert errors when there's a test that binds `debug-on-error'
* lisp/emacs-lisp/ert.el (ert--run-test-internal): Don't infloop
- on errors when signalling errors (bug#51131).
+ on errors when signaling errors (bug#51131).
2021-10-10 Paul Eggert <eggert@cs.ucla.edu>
@@ -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'.
@@ -12670,7 +12670,7 @@
2021-09-03 Lars Ingebrigtsen <larsi@gnus.org>
- Fix `describe-function' for autoloaded adviced functions
+ Fix `describe-function' for autoloaded advised functions
* lisp/emacs-lisp/nadvice.el (advice--make-single-doc): Factor
out.
@@ -20026,7 +20026,7 @@
Add query command removed in 4ff1f66b12
- * lisp/net/rcirc.el (query): Readd accidentally removed command
+ * lisp/net/rcirc.el (query): Re-add accidentally removed command.
2021-07-06 Philip Kaludercic <philipk@posteo.net>
@@ -21063,7 +21063,7 @@
Fix prompting for large files when loading literally
* lisp/files.el (find-file-noselect): Don't include "literally" in
- the "large file" prompt if we're gonna load literally anyway
+ the "large file" prompt if we're going to load literally anyway
(bug#49144).
2021-06-21 Lars Ingebrigtsen <larsi@gnus.org>
@@ -21772,7 +21772,7 @@
EIEIO: Promote the CLOS behavior over the EIEIO-specific behavior
- Change docs to advertize `slot-value` rather than `oref`.
+ Change docs to advertise `slot-value` rather than `oref`.
Change the implementation of `:initform` to better match the CLOS
semantics,
while preserving the EIEIO semantics, but warn when encountering cases
where the two diverge.
@@ -21790,8 +21790,8 @@
* lisp/emacs-lisp/eieio.el (defclass): Warn about inapplicable
`:initarg` and about uses of init forms that are ambiguous.
- (oref): Don't advertize the deprecated use of initargs as slot names.
- (oref-default): Don't advertize the deprecated case where it returns the
+ (oref): Don't advertise the deprecated use of initargs as slot names.
+ (oref-default): Don't advertise the deprecated case where it returns the
initform's value.
(initialize-instance): Use `macroexp-const-p`.
* lisp/emacs-lisp/eieio-core.el (eieio--unbound): Rename from
@@ -27204,7 +27204,7 @@
2021-04-25 Andrea Corallo <akrl@sdf.org>
- Merge branch 'feature/native-comp' into into trunk
+ Merge branch 'feature/native-comp' into trunk
2021-04-25 Lars Ingebrigtsen <larsi@gnus.org>
@@ -34265,7 +34265,7 @@
Use `length=' and family where possible in native comp code
* lisp/emacs-lisp/comp-cstr.el (comp-intersect-typesets)
- (comp-cstr-imm): Use Use `length=' and family where possible.
+ (comp-cstr-imm): Use `length=' and family where possible.
* lisp/emacs-lisp/comp.el (comp-add-cond-cstrs-target-block)
(comp-compute-dominator-frontiers)
(batch-byte-native-compile-for-bootstrap): Likewise.
@@ -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.
@@ -36674,7 +36674,7 @@
2021-02-24 Andrea Corallo <akrl@sdf.org>
- Fix async compilation and paramenter naming
+ Fix async compilation and parameter naming
* lisp/emacs-lisp/comp.el (native--compile-async)
(native-compile-async): Fix broken parameter renaming.
@@ -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>
@@ -40177,7 +40177,7 @@
* lisp/simple.el (recenter-current-error): New command.
* lisp/progmodes/grep.el (grep-mode-map):
- Delete bidings for n and p.
+ Delete bindings for n and p.
* lisp/progmodes/compile.el (compilation-minor-mode-map):
Move here the n and p bindings.
@@ -41213,7 +41213,7 @@
2021-02-02 Lars Ingebrigtsen <larsi@gnus.org>
- Fix up invalid_syntax error signalling
+ Fix up invalid_syntax error signaling
* src/lread.c (invalid_syntax_lisp): Instead of putting the
line/column in a string, signal an error containing the numbers as
@@ -41694,7 +41694,7 @@
in a global minor mode. This commit fixes bug #45792.
* lisp/international/quail.el (quail-show-guidance): Test the major
mode is
- not minibuffer-inactive-mode before proceding with the function.
+ not minibuffer-inactive-mode before proceeding with the function.
2021-01-31 Lars Ingebrigtsen <larsi@gnus.org>
@@ -43613,7 +43613,7 @@
RFC2047-encode invalid Subject/From headers (bug#45925). This
will make them be displayed more consistently in the Summary
buffer (but still "wrong" sometimes, since there's not that much
- we can guess at at this stage, charset wise).
+ we can guess at this stage, charset wise).
(nnml-parse-head): Use it.
2021-01-22 Michael Albinus <michael.albinus@gmx.de>
@@ -48572,7 +48572,7 @@
c-laomib-loop. Insert code which calls c-laomib-loop minimally, with
the help
of the new cache.
- * lisp/progmodes/cc-mode.el (c-basic-common-init): Initialize the new
cach
+ * lisp/progmodes/cc-mode.el (c-basic-common-init): Initialize the new
cache
(at mode start).
(c-before-change): Invalidate the new cache.
(c-fl-decl-start): Add an extra check (> (point) bod-lim) to prevent
looping.
@@ -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)
@@ -50078,7 +50078,7 @@
Optimize c-parse-state for large buffers with few (if any) braces.
* lisp/progmodes/cc-engine.el (c-get-fallback-scan-pos): Search a
maximum of
- 50,000 characters back for the two BODs. Return nil if we dont' find
them.
+ 50,000 characters back for the two BODs. Return nil if we don't find
them.
(c-parse-state-get-strategy): For strategy `forward', always use the
position
`good-pos' for `start-point', even when there's a change of current
macro.
Deal with a possible return value of nil from c-get-fallback-scan-pos
(as
@@ -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).
@@ -54142,7 +54142,7 @@
Tweak the face of unknown backend indicators in flymake
* lisp/progmodes/flymake.el (flymake--mode-line-format): Don't put
- a face on the the "?" unknown backend indicator, because that
+ a face on the "?" unknown backend indicator, because that
looks odd in inactive windows (bug#44689).
2020-11-24 Paul W. Rankin <pwr@skeletons.cc>
@@ -55996,7 +55996,7 @@
2020-11-12 Andrea Corallo <akrl@sdf.org>
- Unline some functions to optimize bootstrap time
+ Uninline some functions to optimize bootstrap time
* lisp/emacs-lisp/comp.el (comp-mvar-value-vld-p)
(comp-mvar-value, comp-mvar-fixnum-p, comp-set-op-p)
@@ -56612,7 +56612,7 @@
2020-11-07 Andrea Corallo <akrl@sdf.org>
- Allow for manually bumbing new native compiler ABI versions
+ Allow for manually bumping new native compiler ABI versions
* src/comp.c (ABI_VERSION): Define macro.
(hash_native_abi): Include ABI_VERSION in the hashing.
@@ -61229,7 +61229,7 @@
2020-10-14 Andrea Corallo <akrl@sdf.org>
- Have `native-elisp-load' return the last registerd function
+ Have `native-elisp-load' return the last registered function
* lisp/emacs-lisp/comp.el (comp-emit-for-top-level): Synthesize
'top_level_run' so it returns the last value returned by
@@ -63478,7 +63478,7 @@
user-error when there's a wrong password (bug#43704).
(epa--wrong-password-p): New function.
(epa-file-insert-file-contents): Use it, and stash the error away
- for later signalling.
+ for later signaling.
* lisp/emacs-lisp/subr-x.el (if-let): Autoload.
@@ -65831,7 +65831,7 @@
Better error handling after calling 'gcc_jit_context_compile_to_file'
- Typically errors are catched in 'compile_function' but in case
+ Typically errors are caught in 'compile_function' but in case
libgccjit throw an error only afterwards while compiling the whole
compilation unit we have to report it correctly.
@@ -67774,7 +67774,7 @@
2020-09-05 Lars Ingebrigtsen <larsi@gnus.org>
- Revert "Display name with with spaces, but keep symbol name underneath"
+ Revert "Display name with spaces, but keep symbol name underneath"
This reverts commit e0c77bb62c1c950a82ea0517646d989dc5c1fe27.
@@ -67854,7 +67854,7 @@
2020-09-05 ej-32u <ej32u@protonmail.com> (tiny change)
- Display name with with spaces, but keep symbol name underneath
+ Display name with spaces, but keep symbol name underneath
* lisp/cus-edit.el (custom-unlispify-menu-entry): Display the
pretty name, but keep the real symbol name as the value (bug#41905).
@@ -73089,7 +73089,7 @@
* lisp/textmodes/tex-mode.el (tex-font-lock-keywords-2): End the
expression before the terminating $ in constructions like $\it
identifiername$
- (bug#28277). This avoids italicising the final $ character.
+ (bug#28277). This avoids italicizing the final $ character.
This fixes the final $ of the final test case here:
@@ -73421,7 +73421,7 @@
2020-08-08 Lars Ingebrigtsen <larsi@gnus.org>
- Modernise a code example in os.texi
+ Modernize a code example in os.texi
* doc/lispref/os.texi (Session Management): Use
with-current-buffer in the example instead of save+switch (bug#40341).
@@ -75687,7 +75687,7 @@
* lisp/net/eww.el (eww-list-bookmarks): Don't show buffer if there
are no bookmarks. (Bug#41385)
- (eww-bookmark-prepare): Move signalling an error if there are no
+ (eww-bookmark-prepare): Move signaling an error if there are no
bookmarks from here...
(eww-read-bookmarks): ...to here. Add new argument `error-out' to
control this.
@@ -75941,7 +75941,7 @@
2020-07-13 Andrea Corallo <akrl@sdf.org>
- Rework the backend to allocate arument arrays for call by references
+ Rework the backend to allocate argument arrays for call by references
* src/comp.c (comp_t): Add 'zero' field.
(emit_limple_call_ref): Allocate an array to host the parameters
@@ -76328,7 +76328,7 @@
Add a simple pass to infer pure functions not explicitly declared as
such. Use this information only during compilation (speed 3) to
- optimize out function calls whe possible.
+ optimize out function calls when possible.
2020-07-09 Andrea Corallo <akrl@sdf.org>
@@ -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.
@@ -78012,7 +78012,7 @@
cd4f75bb86 Rename default function to next-error-buffer-unnavigated-c...
1dff0a8949 * lisp/image-mode.el (image-toggle-display-image): Fix fit...
a71d1787f1 * doc/misc/tramp.texi (Predefined connection information):...
- 079b0dc430 Delete, don't kill, dir dir fragments in icomplete-fido-ba...
+ 079b0dc430 Delete, don't kill, dir fragments in icomplete-fido-ba...
6cdecc2659 Revert markup change in with-coding-priority docs
22f4fba8a9 * lisp/emulation/cua-rect.el (cua--rectangle-region-insert...
6b9eac6759 * lisp/simple.el (shell-command-on-region): Fix docstring.
@@ -78249,7 +78249,7 @@
(comp-latch-make-fill): New function.
(comp-emit-uncond-jump, comp-emit-cond-jump): Update to emit
latches.
- (comp-new-block-sym): Add a postfix paramenter.
+ (comp-new-block-sym): Add a postfix parameter.
2020-06-13 Andrea Corallo <akrl@sdf.org>
@@ -78602,7 +78602,7 @@
Fix comp-call-optim-form-call for null `callee'
* lisp/emacs-lisp/comp.el (comp-call-optim-form-call): Guard
- agains null `calle'.
+ against null `calle'.
2020-06-07 Glenn Morris <rgm@gnu.org>
@@ -79675,7 +79675,7 @@
Simply return the directory selected by the user.
(project-switch-project-find-file): Remove.
(project-switch-project-dired): Rename to project-dired and make
- it follow the convention of existing projec tcommands.
+ it follow the convention of existing project tcommands.
(project-switch-project-eshell): Ditto.
(project-switch-project): Instead of passing the project instance
to the command, just bind default-directory.
@@ -80910,7 +80910,7 @@
'lambda_gc_guard' 'lambda_c_name_idx_h' 'data_imp_relocs'
'loaded_once' fields.
- * src/comp.c (load_comp_unit): Use compilaiton unit 'loaded_once'
+ * src/comp.c (load_comp_unit): Use compilation unit 'loaded_once'
field.
(make_subr, Fcomp__register_lambda): New functions.
(Fcomp__register_subr): Make use of 'make_subr'.
@@ -81264,7 +81264,7 @@
Fix bug #40992 whilst still allowing breakpoint highlights in edebug
Strategy: when an instrumented function gets re-evaluated, save the
former
- value of its symbol's `edebug' property in the new propery
`ghost-edebug'. If
+ value of its symbol's `edebug' property in the new property
`ghost-edebug'. If
this function is still being edebugged, edebug will then access its
info from
this new property.
@@ -83843,7 +83843,7 @@
Implement position independent dump.
- Set the filename for every compilation unit as realtive to obtain a
+ Set the filename for every compilation unit as relative to obtain a
position independent dump.
* lisp/loadup.el: Modify filename for every compilation unit as
@@ -84397,7 +84397,7 @@
* lisp/arc-mode.el: Rewrite displaying the summaries
- Completely rewrite the code that displayes the summaries, so all
+ Completely rewrite the code that displays the summaries, so all
backends share the same code.
(archive--summarize-descs): New function.
@@ -86075,7 +86075,7 @@
Merge remote-tracking branch 'savannah/master' into HEAD
-2020-03-10 AndreaCorallo <akrl@sdf.org>
+2020-03-10 Andrea Corallo <akrl@sdf.org>
* Improve load_comp_unit
@@ -86084,7 +86084,7 @@
Guard also data_ephemeral_vec against compiler optimizations.
-2020-03-10 AndreaCorallo <akrl@sdf.org>
+2020-03-10 Andrea Corallo <akrl@sdf.org>
* Fix store_function_docstring for native functions
@@ -86098,7 +86098,7 @@
native_intspec and native_doc fields has to be reached by the subr
cause are not anymore in the CU.
-2020-03-10 AndreaCorallo <akrl@sdf.org>
+2020-03-10 Andrea Corallo <akrl@sdf.org>
* Set relocation class as ephemeral in `comp-limplify-top-level'
@@ -86547,17 +86547,17 @@
* lisp/replace.el (occur-1): Update default-directory in occur buffer.
-2020-03-04 AndreaCorallo <akrl@sdf.org>
+2020-03-04 Andrea Corallo <akrl@sdf.org>
* Do not crash if the output directory is created in the meanwhile
-2020-03-03 AndreaCorallo <akrl@sdf.org>
+2020-03-03 Andrea Corallo <akrl@sdf.org>
Hash eln ABI once and add it to the output compilation path
Fix org for eln new compilation folder layout
-2020-03-03 AndreaCorallo <akrl@sdf.org>
+2020-03-03 Andrea Corallo <akrl@sdf.org>
Rework `find-lisp-object-file-name'
@@ -86668,7 +86668,7 @@
and 'fill-column' values. (Bug#36837)
(whitespace-lines-regexp): New function.
-2020-03-01 AndreaCorallo <akrl@sdf.org>
+2020-03-01 Andrea Corallo <akrl@sdf.org>
* ; Clean-up out of date comment
@@ -86718,11 +86718,11 @@
* src/pdumper.c (dump_object): Fix hash for Lisp_Type after commit
202c3319a28c029d6971dccea92f92425c5e8067.
-2020-02-29 AndreaCorallo <akrl@sdf.org>
+2020-02-29 Andrea Corallo <akrl@sdf.org>
Introduce 'effective_load_path'
-2020-02-29 AndreaCorallo <akrl@sdf.org>
+2020-02-29 Andrea Corallo <akrl@sdf.org>
* Keep comp-subr-list into pure space
@@ -87689,7 +87689,7 @@
(lispref/modes.texi): Explain avoiding lambdas on hooks.
-2020-02-06 AndreaCorallo <akrl@sdf.org>
+2020-02-06 Andrea Corallo <akrl@sdf.org>
Add system-configuration in the compilation output path
@@ -87713,7 +87713,7 @@
Add function ssa-status as `comp-func' slot and have `comp-clean-ssa'
to run when necessary.
-2020-03-01 AndreaCorallo <akrl@sdf.org>
+2020-03-01 Andrea Corallo <akrl@sdf.org>
Remove relocation index form LIMPLE setimm
@@ -87739,21 +87739,21 @@
Merge remote-tracking branch 'savannah/master' into HEAD
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
* ; Add a TODO for a future optimization
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
Store optimize qualities into .eln files
For now just comp-speed and comp-debug are stored.
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
- Rename d-base allocation classe into d-default
+ Rename d-base allocation class into d-default
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
Add ephemeral relocation data class
@@ -87793,7 +87793,7 @@
Test 'comp-eq' should not assume any string hashing policy
-2020-02-21 AndreaCorallo <akrl@sdf.org>
+2020-02-21 Andrea Corallo <akrl@sdf.org>
Emit 'top_level_run' objects as impure
@@ -87801,7 +87801,7 @@
Verify '--with-nativecomp' has also '--with-dumping=pdumper'
-2020-02-21 AndreaCorallo <akrl@sdf.org>
+2020-02-21 Andrea Corallo <akrl@sdf.org>
Reorder m-var slots
@@ -87819,7 +87819,7 @@
Use `sxhash-eq' to generate mvar SSA ids
-2020-02-15 AndreaCorallo <akrl@sdf.org>
+2020-02-15 Andrea Corallo <akrl@sdf.org>
Speed 2 goes default
@@ -87832,7 +87832,7 @@
Every function call by reference gets use one unique array of
arguments.
-2020-02-14 AndreaCorallo <akrl@sdf.org>
+2020-02-14 Andrea Corallo <akrl@sdf.org>
Clean-up old gc disable refuse in comp-tests-non-locals
@@ -88071,7 +88071,7 @@
Always define subr-native-elisp-p also without native compiler
-2020-02-03 AndreaCorallo <akrl@sdf.com>
+2020-02-03 Andrea Corallo <akrl@sdf.com>
Fix load_comp_unit for non zero speeds
@@ -90740,7 +90740,7 @@
compute dominator tree
- ssa and endge number generation with generator
+ ssa and edge number generation with generator
add edge computation
@@ -91228,7 +91228,7 @@
optimize primitive native call
- propagate contant types and optimize self calls
+ propagate constant types and optimize self calls
introduce stack_el_t
@@ -91466,7 +91466,7 @@
introduce CASE_CALL_NARGS macro and add various ops
- symbol_function set fset fget fget Bsubstring
+ symbol_function set fset fget Bsubstring
2020-01-01 Andrea Corallo <andrea_corallo@yahoo.it>
@@ -93578,7 +93578,7 @@
2021-02-03 Michael Albinus <michael.albinus@gmx.de>
- Fix an error in tramp-sh-handle-make-process. Dont' merge with master
+ Fix an error in tramp-sh-handle-make-process. Don't merge with master
* lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Don't use heredoc
script whent the argument contains a string.
@@ -95039,7 +95039,7 @@
2020-06-13 João Távora <joaotavora@gmail.com>
- Delete, don't kill, dir dir fragments in icomplete-fido-backward-updir
+ Delete, don't kill, dir fragments in icomplete-fido-backward-updir
Reported by: Andrew Schwartzmeyer <andrew@schwartzmeyer.com>
@@ -101413,7 +101413,7 @@
vc-hg: prompt for branch to merge
* lisp/vc/vc-hg.el (vc-hg-merge-branch): Prompt for revision to merge.
- (vc-hg-revision-table): Use branches, tags and bookmarks as competion
+ (vc-hg-revision-table): Use branches, tags and bookmarks as completion
candidates.
* etc/NEWS: Mention changes of vc-hg.el
@@ -101483,7 +101483,7 @@
(Create_Pixmap_From_Bitmap_Data):
(xpm_load): Use new function.
* src/xterm.c (x_composite_image): Use PictOpOver when there is a mask
- so the transparency is honoured.
+ so the transparency is honored.
(x_draw_image_foreground_1): Use x_composite_image.
2019-11-29 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -103042,7 +103042,7 @@
open-paren-in-column-0-is-defun-start to nil) fixes bug #37910. It may
also
have fixed bug #5490 and bug #18072.
- * lisp/progmodes/cc-engine.el (c-state-cache-non-literal-place): Remove
thi
+ * lisp/progmodes/cc-engine.el (c-state-cache-non-literal-place): Remove
this
non-sensical function, replacing it with ....
(c-state-cache-lower-good-pos): New function.
(c-renarrow-state-cache, c-append-lower-brace-pair-to-state-cache)
@@ -110631,7 +110631,7 @@
Fix reversed check in mm-possibly-verify-or-decrypt
* lisp/gnus/mm-decode.el (mm-possibly-verify-or-decrypt): Fix
- reverse check thinko that made unverified singed messages not
+ reverse check thinko that made unverified signed messages not
display correctly.
2019-09-27 Wilson Snyder <wsnyder@wsnyder.org>
@@ -113664,7 +113664,7 @@
Make the NSM not pop up an X dialogue on non-mouse actions
* lisp/emacs-lisp/rmc.el (read-multiple-choice): Don't pop up X
- dialogues on (url-retrieve "https://expired.badssl.com/"; #'ignore)
+ dialogs on (url-retrieve "https://expired.badssl.com/"; #'ignore)
and the like.
2019-09-04 Lars Ingebrigtsen <larsi@gnus.org>
@@ -115157,7 +115157,7 @@
2019-08-21 Lars Ingebrigtsen <larsi@gnus.org>
- Make hide-ifdef-mode-prefix-key customisable
+ Make hide-ifdef-mode-prefix-key customizable
* lisp/progmodes/hideif.el (hide-ifdef-mode-prefix-key): Make into
a defcustom since it seems like this is something that should be
@@ -117900,7 +117900,7 @@
(readbyte_from_file): Assert that `infile` is set.
(close_infile_unwind): Reset `infile` to its previous value rather than
to NULL.
- (Fload): Remember the previous value of `infile` before chaning it.
+ (Fload): Remember the previous value of `infile` before changing it.
(readevalloop): Don't set `infile` any more.
2019-07-31 Paul Eggert <eggert@cs.ucla.edu>
@@ -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>
@@ -130261,7 +130261,7 @@
8192 bytes is a reasonable number nowadays given typical file
system design.
* test/lisp/image-tests.el (image-tests--emacs-images-directory):
- New contant.
+ New constant.
(image-type-from-file-header-test): New test.
2019-05-18 Michael Albinus <michael.albinus@gmx.de>
@@ -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.
@@ -130710,7 +130710,7 @@
Fix diff-mode face problem when used in terminals (Bug#35695)
In a terminal supporting 256 colors, both diff-added and diff-removed
- was mapped to the same greyish color.
+ was mapped to the same grayish color.
* lisp/vc/diff-mode.el: Modify the colors of diff-removed,
diff-added, diff-refine-removed, and diff-refine-added when
@@ -136480,7 +136480,7 @@
Check gnus-newsgroup-dependencies is hash table in gnus-id-to-thread
* lisp/gnus/gnus-sum.el (gnus-id-to-thread): If dependencies haven't
- been initialized yet, don't blow up. Mimicks previous (non hasht
+ been initialized yet, don't blow up. Mimics previous (non hash
table) behavior.
2019-03-31 Mattias Engdegård <mattiase@acm.org>
@@ -140170,7 +140170,7 @@
* doc/misc/eshell.texi (Built-ins): Fix alias description
- Dear eamcs developers, eshells current documentation first states
+ Dear emacs developers, eshell's current documentation first states
that alias definitions are not saved to an alias file, later that
they are saved to an alias file. I tested it and the latter is
correct.
@@ -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
@@ -158744,7 +158744,7 @@
2018-04-17 Basil L. Contovounesios <contovob@tcd.ie>
- Modernise face specs and set version tags in eww/shr
+ Modernize face specs and set version tags in eww/shr
* lisp/net/shr.el (shr-strike-through, shr-link, shr-selected-link):
Set :version tag (bug#31200).
@@ -159218,10 +159218,10 @@
2018-04-14 Lars Ingebrigtsen <larsi@gnus.org>
- Modernise a Gnus function a bit
+ Modernize a Gnus function a bit
* lisp/gnus/gnus-start.el (gnus-update-active-hashtb-from-killed):
- Modernise code a bit.
+ Modernize code a bit.
2018-04-14 Lars Ingebrigtsen <larsi@gnus.org>
@@ -165960,7 +165960,7 @@
cl-loop: Calculate the array length just once
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause):
- Dont calculate the array length on each iteration (Bug#29866).
+ Don't calculate the array length on each iteration (Bug#29866).
2018-01-07 Philipp Stephani <phst@google.com>
@@ -166738,7 +166738,7 @@
5a7d009 * lisp/vc/smerge-mode.el (smerge-refine): Replace obsolete al...
e019c35 FOR_EACH_FRAME no longer assumes frame-list
d64b88d * src/font.c (Ffont_info): Doc fix. (Bug#29682)
- 92b2604 Modernise message.el face spec syntax
+ 92b2604 Modernize message.el face spec syntax
b1efbe6 Update message.el obsolete face aliases
2494c14 ; * lisp/comint.el (comint-terminfo-terminal): Add a :version...
12ad276 Improve documentation of TERM environment variable
@@ -167034,7 +167034,7 @@
5a7d0095a4 * lisp/vc/smerge-mode.el (smerge-refine): Replace obsolete...
e019c35df6 FOR_EACH_FRAME no longer assumes frame-list
d64b88da2f * src/font.c (Ffont_info): Doc fix. (Bug#29682)
- 92b2604a7f Modernise message.el face spec syntax
+ 92b2604a7f Modernize message.el face spec syntax
b1efbe6564 Update message.el obsolete face aliases
2494c14e76 ; * lisp/comint.el (comint-terminfo-terminal): Add a :vers...
12ad276d15 Improve documentation of TERM environment variable
@@ -169297,7 +169297,7 @@
2e1b3522b8 Improve documentation of 'line-number-display-width'
5b6e59cfdb Implement vc-default-dir-extra-headers for vc-rcs
22adeca42a In NEWS give advice on use of `switch-to-buffer' (Bug#28645)
- 2c3e6f1ddc Dont update primary selection with winner-undo
+ 2c3e6f1ddc Don't update primary selection with winner-undo
b38724ab67 Work around ImageMagick bug 825
20cc68e871 Document rectangle-preview option more (Bug#27974)
a0b7b301dd Do not reject https://gnu.org in commit messages
@@ -172340,7 +172340,7 @@
* doc/misc/eshell.texi (Built-ins): Fix alias description
- Dear eamcs developers, eshells current documentation first states
+ Dear emacs developers, eshell's current documentation first states
that alias definitions are not saved to an alias file, later that
they are saved to an alias file. I tested it and the latter is
correct.
@@ -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>
@@ -181827,7 +181827,7 @@
2017-12-15 Basil L. Contovounesios <contovob@tcd.ie>
- Modernise message.el face spec syntax
+ Modernize message.el face spec syntax
* lisp/gnus/message.el (message-header-to, message-header-cc)
(message-header-subject, message-header-newsgroups)
@@ -184352,7 +184352,7 @@
* src/lisp.h (COMMON_MULTIPLE): Move here from alloc.c.
* src/thread.c (THREAD_ALIGNMENT): New macro.
- (main_thread): Use THREAD_ALIGNMENT to align propertly. (Bug#29040)
+ (main_thread): Use THREAD_ALIGNMENT to align properly. (Bug#29040)
2017-10-28 Eli Zaretskii <eliz@gnu.org>
@@ -185296,10 +185296,10 @@
2017-10-17 Tino Calancha <tino.calancha@gmail.com>
Noam Postavsky <npostavs@gmail.com>
- Dont update primary selection with winner-undo
+ Don't update primary selection with winner-undo
* lisp/winner.el (winner-set):
- Dont update primary selection when select-enable-primary
+ Don't update primary selection when select-enable-primary
is non-nil (Bug#28631).
2017-10-17 Paul Eggert <eggert@cs.ucla.edu>
@@ -185648,7 +185648,7 @@
Add mode map to Flymake diagnostic button
* lisp/progmodes/flymake.el (flymake--diagnostics-buffer-entries): Add
- keymap propery.
+ keymap property.
2017-10-10 João Távora <joaotavora@gmail.com>
@@ -192051,7 +192051,7 @@
2017-08-09 Tino Calancha <tino.calancha@gmail.com>
- Ask files for deletion in buffer order: top first, botton later
+ Ask files for deletion in buffer order: top first, bottom later
* lisp/dired.el (dired-do-flagged-delete, dired-do-delete):
Call `nreverse' t invert the output of `dired-map-over-marks'.
@@ -194580,7 +194580,7 @@
2017-07-09 R. Bernstein <rocky@gnu.org>
- Add realgud faces faces to whiteboard...
+ Add realgud faces to whiteboard...
Adjust wheatgrass to use underline for enabled/disabled breakpoints
@@ -195520,7 +195520,7 @@
Ignore mouse-movement for describe-key-briefly (Bug#12204)
- * lisp/help.el (help-read-key-sequence): Add optional argument ot
+ * lisp/help.el (help-read-key-sequence): Add optional argument to
ignore `mouse-movement' events.
(describe-key-briefly): Use it.
* doc/emacs/help.texi (Key Help):
@@ -198690,7 +198690,7 @@
(tramp-adb-ls-toolbox-regexp):
Ignore addition links column on Android 7.
(tramp-adb-get-ls-command):
- Dont use --color=none when using toybox (Android 7). It's not
+ Don't use --color=none when using toybox (Android 7). It's not
possible to disable coloring explicitly for toybox ls.
2017-05-27 Svante Carl v. Erichsen <Svante.v.Erichsen@web.de> (tiny change)
@@ -199186,7 +199186,7 @@
2017-05-23 Paul Eggert <eggert@cs.ucla.edu>
- Don't warn about missing brances on macOS
+ Don't warn about missing branches on macOS
On macOS, removing -Wmissing-braces is not enough; the warning has to
be disabled explicitly.
@@ -208945,7 +208945,7 @@
Revamp quitting and fix infloops
- This fixes some infinite loops that cannot be quitted out of,
+ This fixes some infinite loops that cannot be quit out of,
e.g., (defun foo () (nth most-positive-fixnum '#1=(1 . #1#)))
when byte-compiled and when run under X. See:
https://lists.gnu.org/r/emacs-devel/2017-01/msg00577.html
@@ -214158,7 +214158,7 @@
refactor systhread.h
This refactors systhread.h to move the notion of a "lisp mutex"
- into thread.c. This lets us make make the global lock and
+ into thread.c. This lets us make the global lock and
post_acquire_global_lock static.
2012-08-17 Tom Tromey <tromey@redhat.com>
@@ -218796,7 +218796,7 @@
* lib/stdint.in.h, m4/extensions.m4, m4/stdint.m4, m4/stdio_h.m4:
* m4/sys_types_h.m4: Copy from gnulib.
* lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
- * lib/limits.in.h, m4/limits-h.m4: New files, copie from gnulib.
+ * lib/limits.in.h, m4/limits-h.m4: New files, copied from gnulib.
* nt/gnulib.mk: Merge changes from lib/gnulib.mk.
2016-09-15 Michael Albinus <michael.albinus@gmx.de>
@@ -219462,7 +219462,7 @@
2016-09-02 Stefan Monnier <monnier@iro.umontreal.ca>
- Check actual contents before promting about changed file
+ Check actual contents before prompting about changed file
* lisp/userlock.el (userlock--check-content-unchanged)
(userlock--ask-user-about-supersession-threat): New functions.
@@ -220696,7 +220696,7 @@
* lisp/progmodes/cc-mode.el (c-after-change): When we detect a missing
invocation of c-before-change-functions, we assume the changed region
is the
- entire buffer, and call c-before-change explicitly before proceding.
+ entire buffer, and call c-before-change explicitly before proceeding.
2016-08-09 Alan Mackenzie <acm@muc.de>
@@ -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
@@ -223962,10 +223962,10 @@
2016-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
- Advertize set-keymap-parent as replacement for copy-keymap
+ Advertise set-keymap-parent as replacement for copy-keymap
* doc/lispref/keymaps.texi (Creating Keymaps):
- * src/keymap.c (Fcopy_keymap): Advertize set-keymap-parent as
replacement.
+ * src/keymap.c (Fcopy_keymap): Advertise set-keymap-parent as
replacement.
2016-06-15 Ted Zlatanov <tzz@lifelogs.com>
@@ -226537,7 +226537,7 @@
Fix Bug#10085
* lisp/net/tramp.el (tramp-find-foreign-file-name-handler):
- Add optional arguments OPERATION and COMPETION. Handle
+ Add optional arguments OPERATION and COMPLETION. Handle
`file-name-as-directory', `file-name-directory' and
`file-name-nondirectory' also in completion mode.
(tramp-file-name-handler): Use it. (Bug#10085)
@@ -226854,7 +226854,7 @@
2016-04-30 Lars Ingebrigtsen <larsi@gnus.org>
- Document mode mode line variables
+ Document mode line variables
* doc/lispref/modes.texi (Mode Line Variables): Document
`mode-line-front-space, `mode-line-misc-info',
@@ -227546,7 +227546,7 @@
of the data end marker from here... (bug#23020).
(smtpmail-send-data): ... to here, so that we don't get a
"Sending done" before we've sent the final "." (which can make
- the SMPT server reject the email.
+ the SMTP server reject the email.
2016-04-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -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/Makefile.in b/Makefile.in
index 45b4a59e3d..93609a4e16 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -405,16 +405,18 @@ actual-all: ${SUBDIR} info
$(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lis
# ADVICE-ON-FAILURE-END:bootstrap
advice-on-failure:
+ @[ -f .no-advice-on-failure ] && exit ${exit-status}; true
@echo >&2 '***'
@echo >&2 '*** '"\"make ${make-target}\" failed with exit status
${exit-status}."
@echo >&2 '***'
@cat Makefile | \
- sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q};' | \
- sed 's/^# /*** /' | grep -v '^*** ADVICE-ON-FAILURE-' >&2
+ sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q;};' | \
+ sed 's/^# /*** /' | grep -v '^\*\*\* ADVICE-ON-FAILURE-' >&2
@echo >&2 '***'
@exit ${exit-status}
sanity-check:
+ @[ -f .no-advice-on-failure ] && exit 0; true
@v=$$(src/emacs${EXEEXT} --batch --eval \
'(progn (defun f (n) (if (= 0 n) 1 (* n (f (- n 1))))) (princ (f
10)))' \
2> /dev/null); \
@@ -423,8 +425,8 @@ sanity-check:
echo >&2 '*** '"\"make ${make-target}\" succeeded, but Emacs is not
functional."; \
echo >&2 '***'; \
cat Makefile | \
- sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q};' | \
- sed 's/^# /*** /' | grep -v '^*** ADVICE-ON-FAILURE-' >&2; \
+ sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q;};' | \
+ sed 's/^# /*** /' | grep -v '^\*\*\* ADVICE-ON-FAILURE-' >&2; \
echo >&2 '***'; \
exit 1
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/cus-test.el b/admin/cus-test.el
index 22d5a3a151..7e73f2e44a 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -131,7 +131,7 @@ Names should be as they appear in loaddefs.el.")
;; Don't create a file `abbrev-file-name'.
(setq save-abbrevs nil)
-;; Avoid compile logs from adviced functions.
+;; Avoid compile logs from advised functions.
(eval-after-load "bytecomp"
'(setq ad-default-compilation-action 'never))
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/grammars/srecode-template.wy
b/admin/grammars/srecode-template.wy
index c3531ebd54..7ba73d2921 100644
--- a/admin/grammars/srecode-template.wy
+++ b/admin/grammars/srecode-template.wy
@@ -126,7 +126,7 @@ variable
: SET symbol insertable-string-list newline
(VARIABLE-TAG $2 nil $3)
| SET symbol number newline
- ;; This so a common error w/ priority works.
+ ;; This so a common error with priority works.
;; Note that "number" still has a string value in the lexer.
(VARIABLE-TAG $2 nil (list $3))
| SHOW symbol newline
diff --git a/admin/last-chance.el b/admin/last-chance.el
index 30d6a25a28..45d470cacd 100644
--- a/admin/last-chance.el
+++ b/admin/last-chance.el
@@ -41,7 +41,7 @@
;;
;; will show you any references to `change-log-date-face' in the
;; *.el files in a new buffer (in Grep mode). Hopefully you see
-;; only the obsolete declaration and can proceed w/ its removal.
+;; only the obsolete declaration and can proceed with its removal.
;; If not, please DTRT and refrain from the removal until those
;; references are properly transitioned.
;;
diff --git a/admin/notes/bug-triage b/admin/notes/bug-triage
index 3d9a275c9d..bee7242337 100644
--- a/admin/notes/bug-triage
+++ b/admin/notes/bug-triage
@@ -73,7 +73,7 @@ the ones that are not reproducible on the current release.
know if you are able to? If I don't hear back in a few
weeks, I'll just close this bug as unreproducible."
[ ] Check that the priority is reasonable. Most bugs should be
- marked as normal, but crashers and security issues can be
+ marked as normal, but crashes and security issues can be
marked as serious.
3. Your changes will take some time to take effect. After a period of
minutes
to hours, you will get a mail telling you the control message has been
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..6669e28e6b 100644
--- a/doc/emacs/ChangeLog.1
+++ b/doc/emacs/ChangeLog.1
@@ -1356,7 +1356,7 @@
* dired.texi (Dired Deletion, Marks vs Flags): Document Emacs 24.3
changes to the mark and unmark commands.
- (Comparison in Dired): Document chages to dired-diff. Remove M-=,
+ (Comparison in Dired): Document changes to dired-diff. Remove M-=,
which is no longer bound to dired-backup-diff.
2012-10-23 Bastien Guerry <bzg@gnu.org>
@@ -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/custom.texi b/doc/emacs/custom.texi
index 08ada2a70b..aaf41d2aef 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -805,12 +805,12 @@ C-h v fill-column @key{RET}
displays something like this:
@example
-fill-column is a variable defined in ‘C source code’.
+fill-column is a variable defined in @quoteleft{}C source code@quoteright{}.
Its value is 70
Automatically becomes buffer-local when set.
This variable is safe as a file local variable if its value
- satisfies the predicate ‘integerp’.
+ satisfies the predicate @quoteleft{}integerp@quoteright{}.
Probably introduced at or before Emacs version 18.
Documentation:
@@ -1659,7 +1659,7 @@ events.
or lower case; @acronym{ASCII} or non-@acronym{ASCII}) are reserved
for users. Emacs itself will never bind those key sequences, and
Emacs extensions should avoid binding them. In other words, users can
-bind key sequences like @kbd{C-c a} or @kbd{C-c ç} and rely on these
+bind key sequences like @kbd{C-c a} or @kbd{C-c @,{c}} and rely on these
never being shadowed by other Emacs bindings.
@node Prefix Keymaps
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index a9b4ff783d..7a382c0566 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -807,7 +807,7 @@ should create non-existent directories in @var{new}.
The option @code{dired-create-destination-dirs-on-trailing-dirsep},
when set in addition to @code{dired-create-destination-dirs}, controls
-wether a trailing directory separator at the destination is treated
+whether a trailing directory separator at the destination is treated
specially. In that case, when renaming a directory @samp{old} to
@samp{new/} and no directory @samp{new} exists already, it will be
created and @samp{old} is moved into the newly created directory.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 3e03bd817a..44e9e1896f 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1832,6 +1832,8 @@ directory. @xref{Top,Eshell,Eshell, eshell, Eshell: The
Emacs Shell}.
@item C-x p b
Switch to another buffer belonging to the current project
(@code{project-switch-to-buffer}).
+@item C-x p C-b
+List the project buffers (@code{project-list-buffers}).
@item C-x p k
Kill all live buffers that belong to the current project
(@code{project-kill-buffers}).
@@ -1847,6 +1849,11 @@ switch between buffers that belong to the current
project by prompting
for a buffer to switch and considering only the current project's
buffers as candidates for completion.
+@findex project-list-buffers
+ Like the command @code{list-buffers} (@pxref{List Buffers}), the
+command @kbd{C-x p C-b} (@code{project-list-buffers}) displays a list
+of existing buffers, but only belonging to the current project.
+
@findex project-kill-buffers
@vindex project-kill-buffer-conditions
@vindex project-kill-buffers-display-buffer-list
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index db96093a17..5472a288d1 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -50,10 +50,10 @@ Ring}. Additionally, some commands will have an effect
even on an
inactive region (for example @dfn{upcase-region}). You can also
reactivate the region with commands like @kbd{C-x C-x}.
- The above default behavior is known as Transient Mark mode.
-Disabling Transient Mark mode switches Emacs to an alternative
-behavior, in which the region is usually not highlighted.
-@xref{Disabled Transient Mark}.
+ The above behavior, which is the default in interactive sessions, is
+known as Transient Mark mode. Disabling Transient Mark mode switches
+Emacs to an alternative behavior, in which the region is usually not
+highlighted. @xref{Disabled Transient Mark}.
@vindex highlight-nonselected-windows
Setting the mark in one buffer has no effect on the marks in other
@@ -455,10 +455,11 @@ motion keys will extend the region set by shift-selection.
The default behavior of the mark and region, in which setting the
mark activates it and highlights the region, is called Transient Mark
-mode. This is a minor mode that is enabled by default. It can be
-toggled with @kbd{M-x transient-mark-mode}, or with the
-@samp{Highlight Active Region} menu item in the @samp{Options} menu.
-Turning it off switches Emacs to an alternative mode of operation:
+mode. This is a minor mode that is enabled by default in interactive
+sessions. It can be toggled with @kbd{M-x transient-mark-mode}, or
+with the @samp{Highlight Active Region} menu item in the
+@samp{Options} menu. Turning it off switches Emacs to an alternative
+mode of operation:
@itemize @bullet
@item
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 420da09097..cd4c113ae5 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-install-selected-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-install-selected-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-rebuild
+ If you maintain your own packages you might want to use a local
+checkout instead of cloning a remote repository. You can do this by
+using @code{package-vc-install-from-checkout}, which creates a symbolic link
+from the package directory (@pxref{Package Files}) to your checkout
+and initializes the code. Note that you might have to use
+@code{package-vc-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/display.texi b/doc/lispref/display.texi
index c75107fb58..10a1a18dd1 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2273,7 +2273,7 @@ complex text shaping requires that for some scripts.
When that
happens, characters no longer map in a simple way to display columns,
and display layout decisions with such strings, such as truncating too
wide strings, can be a complex job. This function helps in performing
-suvh jobs: it splits up its argument @var{string} into a list of
+such jobs: it splits up its argument @var{string} into a list of
substrings, where each substring produces a single grapheme cluster
that should be displayed as a unit. Lisp programs can then use this
list to construct visually-valid substrings of @var{string} which will
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/errors.texi b/doc/lispref/errors.texi
index 44a62dcebc..cb05290abd 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -242,7 +242,7 @@ The message is @samp{Cannot determine image type}.
@xref{Images}.
@item inhibited-interaction
The message is @samp{User interaction while inhibited}. This error is
-signalled when @code{inhibit-interaction} is non-@code{nil} and a user
+signaled when @code{inhibit-interaction} is non-@code{nil} and a user
interaction function (like @code{read-from-minibuffer}) is called.
@end table
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 7ffde7d43d..9d5a266191 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -734,7 +734,7 @@ a list of symbols representing the function alias chain,
else
@result{} (b c)
@end example
-If there's a loop in the definitions, an error will be signalled. If
+If there's a loop in the definitions, an error will be signaled. If
@var{noerror} is non-@code{nil}, the non-looping parts of the chain is
returned instead.
@end defun
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/internals.texi b/doc/lispref/internals.texi
index ea1679f693..4640b6d759 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -554,12 +554,17 @@ trigger another garbage collection. You can use the
result returned by
object type; space allocated to the contents of buffers does not count.
The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in
-@file{alloc.c}. Since it's defined in @code{word_size} units, the value
-is 400,000 for the default 32-bit configuration and 800,000 for the 64-bit
-one. If you specify a larger value, garbage collection will happen less
-often. This reduces the amount of time spent garbage collecting, but
-increases total memory use. You may want to do this when running a program
-that creates lots of Lisp data.
+@file{alloc.c}. Since it's defined in @code{word_size} units, the
+value is 400,000 for the default 32-bit configuration and 800,000 for
+the 64-bit one. If you specify a larger value, garbage collection
+will happen less often. This reduces the amount of time spent garbage
+collecting, but increases total memory use. You may want to do this
+when running a program that creates lots of Lisp data. However, we
+recommend against increasing the threshold for prolonged periods of
+time, and advise that you never set it higher than needed for the
+program to run in reasonable time. Using thresholds higher than
+necessary could potentially cause system-wide memory pressure, and
+should therefore be avoided.
You can make collections more frequent by specifying a smaller value, down
to 1/10th of @code{GC_DEFAULT_THRESHOLD}. A value less than this minimum
@@ -576,6 +581,9 @@ garbage collection occurs only when both criteria are
satisfied.
As the heap size increases, the time to perform a garbage collection
increases. Thus, it can be desirable to do them less frequently in
proportion.
+
+As with @code{gc-cons-threshold}, do not enlarge this more than
+necessary, and never for prolonged periods of time.
@end defopt
Control over the garbage collector via @code{gc-cons-threshold} and
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/minibuf.texi b/doc/lispref/minibuf.texi
index 089ae41f32..332a453619 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2745,7 +2745,7 @@ Here's a typical use case:
If @code{my-client-handling-function} ends up calling something that
asks the user for something (via @code{y-or-n-p} or
@code{read-from-minibuffer} or the like), an
-@code{inhibited-interaction} error is signalled instead. The server
+@code{inhibited-interaction} error is signaled instead. The server
code then catches that error and reports it to the client.
@node Minibuffer Misc
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..1c5e7c1e2f 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>
@@ -3525,7 +3525,7 @@
2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
- * org.texi (The clock table): Mention that ACHIVED trees
+ * org.texi (The clock table): Mention that ARCHIVED trees
contribute to the clock table.
2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
@@ -4420,12 +4420,7 @@
2011-02-05 Era Eriksson <era+tramp@iki.fi> (tiny change)
- * tramp.texi:
- Replace "delimet" with "delimit" globally.
- Replace "explicite" with "explicit" globally.
- Replace "instead of" with "instead" where there was nothing after "of".
- Audit use of comma before interrogative pronoun, "that", or "which".
- Minor word order, spelling, wording changes.
+ * tramp.texi: Minor word order, spelling, wording changes.
2011-02-04 Teodor Zlatanov <tzz@lifelogs.com>
@@ -5868,7 +5863,7 @@
2009-09-02 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Effort estimates): Document new effort setting commands.
- (Agenda commands): Document the new keys fro agenda time motion.
+ (Agenda commands): Document the new keys for agenda time motion.
Document entry text mode. Improve documentation of the keys to include
inactive time stamps into the agenda view.
(Feedback): Document the new bug report command.
@@ -10409,7 +10404,7 @@
* sc.texi (Emacs 18 MUAs):
* speedbar.texi (Top):
* url.texi (History):
- Delete duplicate duplicate words.
+ Delete duplicate words.
2005-07-16 Johan Bockgård <bojohan@users.sourceforge.net> (tiny change)
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index b6eef7ea79..a7dbbbb48f 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -68,13 +68,13 @@ DOCMISC_W32 = @DOCMISC_W32@
## Info files to build and install on all platforms.
INFO_COMMON = auth autotype bovine calc ccmode cl \
- dbus dired-x ebrowse ede ediff edt eglot eieio \
- emacs-mime epa erc ert eshell eudc efaq eww \
- flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \
- mairix-el message mh-e modus-themes newsticker nxml-mode octave-mode \
- org pcl-cvs pgg rcirc remember reftex sasl \
- sc semantic ses sieve smtpmail speedbar srecode todo-mode transient \
- tramp url vhdl-mode vip viper vtable widget wisent woman
+ dbus dired-x ebrowse ede ediff edt efaq eglot eieio \
+ emacs-gnutls emacs-mime epa erc ert eshell eudc eww \
+ flymake forms gnus htmlfontify idlwave ido info.info \
+ mairix-el message mh-e modus-themes newsticker nxml-mode \
+ octave-mode org pcl-cvs pgg rcirc reftex remember sasl \
+ sc semantic ses sieve smtpmail speedbar srecode todo-mode \
+ tramp transient url vhdl-mode vip viper vtable widget wisent woman
## Info files to install on current platform.
INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_W32)
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 9dc63af6bc..872e5f88f5 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -526,6 +526,8 @@ If several entries match, the one matching the most items
(where an
while searching for an entry matching the @code{rms} user on host
@code{gnu.org} and port @code{22}, then the entry
@file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}.
+However, such processing is not applied when the option
+@code{auth-source-pass-extra-parameters} is set to @code{t}.
Users of @code{pass} may also be interested in functionality provided
by other Emacs packages:
@@ -549,6 +551,22 @@ Set this variable to a string that should separate an host
name from a
port in an entry. Defaults to @samp{:}.
@end defvar
+@defvar auth-source-pass-extra-query-keywords
+This expands the selection of available keywords to include
+@code{:max} and @code{:require} and tells more of them to accept a
+list of query parameters as an argument. When searching, it also
+favors the @samp{rms@@gnu.org.gpg} form for usernames over the
+@samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user}
+param was provided.
+
+In general, if you prefer idiosyncrasies traditionally exhibited by
+this backend, such as prioritizing field count in a filename, try
+setting this option to @code{nil}. But, if you experience problems
+predicting the outcome of searches relative to other auth-source
+backends or encounter code expecting to query multiple backends
+uniformly, try flipping it back to @code{t} (the default).
+@end defvar
+
@node Help for developers
@chapter Help for developers
diff --git a/doc/misc/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..0463d068c2 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
@@ -2536,7 +2536,7 @@ Call this when a user finishes customizing @var{TARGET}.
@end deffn
@deffn Method project-edit-file-target :AFTER ot
-Edit the target @var{OT} associated w/ this file.
+Edit the target @var{OT} associated with this file.
@end deffn
@deffn Method ede-documentation :AFTER this
@@ -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
@@ -3563,7 +3563,7 @@ Run the current project in the debugger.
@end deffn
@deffn Method project-edit-file-target :AFTER obj
-Edit the target associated w/ this file.
+Edit the target associated with this file.
@end deffn
@node project-am-objectcode
@@ -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/erc.texi b/doc/misc/erc.texi
index 3db83197f9..0d807e323e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -79,6 +79,7 @@ Advanced Usage
* Connecting:: Ways of connecting to an IRC server.
* Sample Configuration:: An example configuration file.
+* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@end detailmenu
@@ -526,6 +527,7 @@ Translate morse code in messages
@menu
* Connecting:: Ways of connecting to an IRC server.
* Sample Configuration:: An example configuration file.
+* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@end menu
@@ -861,7 +863,8 @@ The default value for all three options is the function
@code{erc-auth-source-search}. It tries to merge relevant contextual
parameters with those provided or discovered from the logical connection
or the underlying transport. Some auth-source back ends may not be
-compatible; netrc, plstore, json, and secrets are currently supported.
+compatible; netrc, plstore, json, secrets, and pass are currently
+supported.
@end defopt
@subheading Full name
@@ -990,6 +993,32 @@ stuff, to the current ERC buffer."
;; (setq erc-kill-server-buffer-on-quit t)
@end lisp
+@node Integrations
+@section Integrations
+@cindex integrations
+
+@subheading URL
+For anything to work, you'll want to set @code{url-irc-function} to
+@code{url-irc-erc}. As a rule of thumb, libraries relying directly on
+@code{url-retrieve} should be fine out the box from Emacs 29.1 onward.
+On older versions of Emacs, you may need to @code{(require 'erc)}
+beforehand. @pxref{Retrieving URLs,,, url, URL}.
+
+For other apps and libraries, such as those relying on the
+higher-level @code{browse-url}, you'll oftentimes be asked to specify
+a pattern, sometimes paired with a function that accepts a string URL
+as a first argument. For example, with EWW, you may need to tack
+something like @code{"\\|\\`irc6?s?:"} onto the end of
+@code{eww-use-browse-url}. But with @code{gnus-button-alist}, you'll
+need a function as well:
+
+@lisp
+ '("\\birc6?s?://[][a-z0-9.,@@_:+%?&/#-]+" 0 t browse-url-irc 0)
+@end lisp
+
+@noindent
+Users on Emacs 28 and below may need to use @code{browse-url} instead.
+
@node Options
@section Options
@cindex options
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index ff368c9dc4..e6ddcf11df 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
@@ -1123,7 +1126,7 @@ Repeatedly evaluate @var{commands} until
@var{conditional} is
satisfied.
@item for @var{var} in @var{list}@dots{} @{ @var{commands} @}
-Iterate over each element of of @var{list}, storing the element in
+Iterate over each element of @var{list}, storing the element in
@var{var} and evaluating @var{commands}. If @var{list} is not a list,
treat it as a list of one element. If you specify multiple
@var{lists}, this will iterate over each of them in turn.
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index 0037ba78d3..0e1ff67c1f 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 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/message.texi b/doc/misc/message.texi
index 6a6beb7a1f..cfad4f4e07 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -1005,7 +1005,7 @@ that they can deposit messages and lock the door, while
your private
key corresponds to the opening combination for the safe.)
Thus, you need to perform the following steps for e-mail encryption,
-typically outside Emacs. See, for example, the
+typically outside Emacs. See, for example,
@uref{https://www.gnupg.org/gph/en/manual.html, The GNU Privacy
Handbook} for details covering the standard @acronym{OpenPGP} with
@acronym{GnuPG}.
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index c5accd0789..db92dfb481 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
@@ -3649,7 +3649,7 @@ specification of that variable looks like this:
With the exception of ~org-verbatim~ and ~org-code~ faces, everything else
uses the corresponding type of emphasis: a bold typographic weight, or
-italicised, underlined, and struck through text.
+italicized, underlined, and struck through text.
The best way for users to add some extra attributes, such as a
foreground color, is to define their own faces and assign them to the
@@ -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/org.org b/doc/misc/org.org
index ae3ca0b64f..6ad8c462cc 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -16569,7 +16569,7 @@ identifying a reference in the bibliography.
- Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or
a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving information useful or
necessary
- fo the comprehension of the citation but not included in the
+ for the comprehension of the citation but not included in the
reference.
- A single citation can cite more than one reference ; the keys are
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index b30e5aeaa4..9c543a4c0f 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
@@ -5292,7 +5292,7 @@ Some improvements for XEmacs compatibility.
@itemize @bullet
@item
Fixed bug with @samp{%F} in a label prefix. Added new escapes
-@samp{%m} and @samp{%M} for mater file name and master directory.
+@samp{%m} and @samp{%M} for master file name and master directory.
@end itemize
@noindent @b{Version 4.24}
diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi
index 6d0415cdbb..e3ef11ebc0 100644
--- a/doc/misc/ses.texi
+++ b/doc/misc/ses.texi
@@ -750,13 +750,13 @@ when you pass a cell name to the @command{ses-jump}
command (@kbd{j}),
it changes the entered cell name to that where to jump. The default
setting @code{upcase} allows you to enter the cell name in low
case. Another use of @code{ses-jump-cell-name-function} could be some
-internationalisation to convert non latin characters into latin
+internationalization to convert non latin characters into latin
equivalents to name the cell. Instead of a cell name, the function may
return cell coordinates in the form of a cons, for instance @code{(0
. 0)} for cell @code{A1}, @code{(1 . 0)} for cell @code{A2}, etc.
@vindex ses-jump-prefix-function
-@code{ses-jump-prefix-function} is a customisable variable by default
+@code{ses-jump-prefix-function} is a customizable variable by default
set to the @code{ses-jump-prefix} function. This function is called
when you give a prefix argument to the @command{ses-jump} command
(@kbd{j}). It returns a cell name or cell coordinates corresponding to
diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi
index a0cbf7e33f..d7356fef58 100644
--- a/doc/misc/srecode.texi
+++ b/doc/misc/srecode.texi
@@ -1595,7 +1595,7 @@ from a user perspective during basic interactive
insertion via
NOTES ON THIS CHAPTER:
-These conventions are being worked on. Check w/ CEDET-DEVEL mailing
+These conventions are being worked on. Check with CEDET-DEVEL mailing
list if you want to support a language, or write an application and
provide your opinions on this topic. Any help is appreciated.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 99a268367b..19f82b2447 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -4225,7 +4225,7 @@ non-@code{nil}, or invoke that command with a negative
argument like
@value{tramp}'s implementation of @code{make-process} and
@code{start-file-process} requires a serious overhead for
initialization, every process invocation. This is needed for handling
-interactive dialogues when connecting the remote host (like providing
+interactive dialogs when connecting the remote host (like providing
a password), and initial environment setup.
Sometimes, this is not needed. Instead of starting a remote shell and
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/doc/misc/vip.texi b/doc/misc/vip.texi
index df65d70cb1..8e192d7e40 100644
--- a/doc/misc/vip.texi
+++ b/doc/misc/vip.texi
@@ -1203,11 +1203,11 @@ Move point backward to the character @var{ch} on the
line. Signal error if
@var{ch} could not be found (@code{vip-find-char-backward}).
@item t @var{ch}
@kindex 164 t @r{(}@code{vip-goto-char-forward}@r{)}
-Move point forward upto the character @var{ch} on the line. Signal error if
+Move point forward up to the character @var{ch} on the line. Signal error if
@var{ch} could not be found (@code{vip-goto-char-forward}).
@item T @var{ch}
@kindex 124 T @r{(}@code{vip-goto-char-backward}@r{)}
-Move point backward upto the character @var{ch} on the line. Signal error if
+Move point backward up to the character @var{ch} on the line. Signal error if
@var{ch} could not be found (@code{vip-goto-char-backward}).
@item ;
@kindex 073 ; @r{(}@code{vip-repeat-find}@r{)}
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 988eb1e09c..f638d4717a 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -77,6 +77,13 @@ blanks when 'erc-send-whitespace-lines' is active. New
options have
also been added for warning when input spans multiple lines. Although
off by default, new users are encouraged to enable them.
+** URL handling has improved.
+Clicking on 'irc://' and 'ircs://' links elsewhere in Emacs now does
+the right thing most of the time. However, for security reasons,
+users are now prompted to confirm connection parameters prior to lift
+off. See the new '(erc) Integrations' section in the Info manual to
+override this.
+
** Miscellaneous behavioral changes impacting the user experience.
A bug has been fixed that saw prompts being mangled, doubled, or
erased in server buffers upon disconnection. Instead, input prompts
@@ -98,6 +105,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 +121,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 a185967483..9345cb06f5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -112,7 +112,8 @@ 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.
+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.
@@ -164,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.
@@ -370,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
@@ -433,6 +439,12 @@ The user options 'url-gateway-rlogin-host',
'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name'
are also obsolete.
+---
+** The user function 'url-irc-function' now takes a 'scheme' argument.
+The user option 'url-irc-function' is now called with a sixth argument
+corresponding to the scheme portion of the target URL. For example,
+this would be "ircs" for a URL like "ircs://irc.libera.chat".
+
---
** The linum.el library is now obsolete.
We recommend using either the built-in 'display-line-numbers-mode', or
@@ -706,6 +718,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
@@ -1076,6 +1097,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.
@@ -1373,6 +1401,14 @@ If non-nil and there's only one matching option,
auto-select that.
If non-nil, this user option describes what entries not to add to the
database stored on disk.
+** Auth-Source
+
++++
+*** New user option 'auth-source-pass-extra-query-keywords'.
+Whether to recognize additional keyword params, like ':max' and
+':require', as well as accept lists of query terms paired with
+applicable keywords.
+
** Dired
+++
@@ -1428,8 +1464,8 @@ This command visits the file on the current line with EWW.
** Elisp
---
-*** New command 'elisp-eval-buffer' (bound to 'C-c C-e').
-This command evals the forms in the current buffer.
+*** New command 'elisp-eval-region-or-buffer' (bound to 'C-c C-e').
+This command evals the forms in the active region or in the whole buffer.
---
*** New commands 'elisp-byte-compile-file' and 'elisp-byte-compile-buffer'.
@@ -1469,6 +1505,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
---
@@ -1548,6 +1588,36 @@ 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)
+++
@@ -1858,8 +1928,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
@@ -1924,6 +1992,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
@@ -1970,6 +2045,18 @@ 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.
+
** EWW/SHR
+++
@@ -2062,13 +2149,20 @@ The older form still works but is undocumented.
---
*** Rmail partial summaries can now be applied one on top of the other.
-You can now narrow the filtering of messages by the summary's criteria
-(recipients, topic, senders, etc.) by making a summary of the already
-summarized messages. For example, invoking 'rmail-summary-by-senders',
-followed by 'rmail-summary-by-topic' will produce a summary where both
-the senders and the topic are according to your selection. The new
-user option 'rmail-summary-apply-filters-consecutively' controls
-whether the stacking of the filters is in effect.
+You can now narrow the set of messages selected by Rmail summary's
+criteria (recipients, topic, senders, etc.) by making a summary of the
+already summarized messages. For example, invoking
+'rmail-summary-by-senders', followed by 'rmail-summary-by-topic' will
+produce a summary where both the senders and the topic are according
+to your selection. The new user option
+'rmail-summary-progressively-narrow' controls whether the stacking of
+the filters is in effect; customize it to a non-nil value to enable
+this feature.
+
+---
+*** New Rmail summary: by thread.
+The new command 'rmail-summary-by-thread' produces a summary of
+messages that belong to a single thread of discussion.
** EIEIO
@@ -2132,6 +2226,10 @@ it with new 'term-{faint,italic,slow-blink,fast-blink}'
faces.
*** 'project-find-file' and 'project-or-external-find-file' now accept
a prefix argument which is interpreted to mean "include all files".
++++
+*** New command 'project-list-buffers' bound to 'C-x p C-b'.
+This command displays a list of buffers from the current project.
+
+++
*** 'project-kill-buffers' can display the list of buffers to kill.
Customize the user option 'project-kill-buffers-display-buffer-list'
@@ -2550,6 +2648,17 @@ This user option decides which URL scheme that
'browse-url' and
related functions will use by default. For example, you could
customize this to "https" to always prefer HTTPS URLs.
+---
+*** New user option 'browse-url-irc-function'.
+This option specifies a function for opening irc:// links. It
+defaults to the new function 'browse-url-irc'.
+
+---
+*** New function 'browse-url-irc'.
+This multipurpose autoloaded function can be used for opening irc://
+and ircs:// URLS by any caller that passes a URL string as an initial
+arg.
+
---
*** Support for the Netscape web browser has been removed.
This support has been obsolete since Emacs 25.1. The final version of
@@ -2776,6 +2885,9 @@ remote host are shown. Alternatively, the user option
*** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'.
The old name is still available as an obsolete function alias.
+---
+*** The url-irc library now understands ircs:// links.
+
---
*** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'.
It copies the current line into the kill ring.
@@ -2883,7 +2995,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.
+++
@@ -3963,6 +4075,12 @@ This function allows defining a number of keystrokes
with one form.
** New macro 'defvar-keymap'.
This macro allows defining keymap variables more conveniently.
+** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap.
+Use ':repeat t' to have all bindings be repeatable or for more
+advanced usage:
+
+ ':repeat (:enter (commands ...) :exit (commands ...))'
+
---
** 'kbd' can now be used in built-in, preloaded libraries.
It no longer depends on edmacro.el and cl-lib.el.
@@ -4252,5 +4370,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..9982296aaa 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.
@@ -2771,7 +2771,7 @@ If non-nil, it is a regexp that should match a valid
cover image.
*** 'shell-script-mode' now supports 'outline-minor-mode'.
The outline headings have lines that start with "###".
-*** fileloop will now skip missing files instead of signalling an error.
+*** fileloop will now skip missing files instead of signaling an error.
*** 'tabulated-list-mode' can now restore original display order.
Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode',
diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP
index dacbed2045..0570f70795 100644
--- a/etc/NEXTSTEP
+++ b/etc/NEXTSTEP
@@ -206,7 +206,7 @@ Release History
keys, fix border and box drawing, remove
glitches in modeline drawing, support
overstrike for unavailable bold fonts, fix XPM
- related crasher bugs. Incremental font
+ related crashes. Incremental font
metrics caching and other performance
improvements. Shared-lisp builds now possible.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 3c164b1282..3b6ab2e2ad 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -2847,7 +2847,7 @@ can pass the converted path to the =sqlcmd= tool.
**** Improved support of header arguments for postgresql
-The postgresql engine in a sql code block supports now ~:dbport~ nd
+The postgresql engine in a sql code block now supports ~:dbport~ and
~:dbpassword~ as header arguments.
**** Support for additional plantuml output formats
@@ -5763,7 +5763,7 @@ that Calc formulas can operate on them.
**** org-ctags.el (Paul Sexton)
Targets like =<<my target>>= can now be found by Emacs' etag
- functionality, and Org-mode links can be used to to link to
+ functionality, and Org-mode links can be used to link to
etags, also in non-Org-mode files. For details, see the file
/org-ctags.el/.
@@ -6120,7 +6120,7 @@ that Calc formulas can operate on them.
code that is actually evaluated comprises the code block contents,
augmented with the extra code which assigns the referenced data to
variables. It is now possible to preview expanded contents, and
- also to expand code during during tangling. This expansion takes
+ also to expand code during tangling. This expansion takes
into account all header arguments, and variables.
A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block'
@@ -6235,7 +6235,7 @@ that Calc formulas can operate on them.
**** Localized clock tables
- Clock tables now support a new new =:lang= parameter, allowing
+ Clock tables now support a new =:lang= parameter, allowing
the user to customize the localization of the table headers. See
the variable =org-clock-clocktable-language-setup= which controls
available translated strings.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index aaecc41f6e..2169ed0f80 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1640,16 +1640,21 @@ X expects to find it.
*** Improving performance with slow X connections.
-There are several ways to improve this performance, any subset of which can
-be carried out at the same time:
+There are several ways to improve this performance, any subset of
+which can be carried out at the same time:
-1) If you don't need X Input Methods (XIM) for entering text in some
+1) Use the "--with-x-toolkit=no" build of Emacs. By not relying on
+ any toolkit (exhibiting potentially slow behavior), it has been
+ made very fast over networks exhibiting high latency, but suitable
+ bandwidth.
+
+2) If you don't need X Input Methods (XIM) for entering text in some
language you use, you can improve performance on WAN links by using
the X resource useXIM to turn off use of XIM. This does not affect
the use of Emacs's own input methods, which are part of the Leim
package.
-2) If the connection is very slow, you might also want to consider
+3) If the connection is very slow, you might also want to consider
switching off scroll bars, menu bar, and tool bar. Adding the
following forms to your .emacs file will accomplish that, but only
after the initial frame is displayed:
@@ -1665,26 +1670,45 @@ be carried out at the same time:
Emacs.menuBar: off
Emacs.toolBar: off
-3) Use ssh to forward the X connection, and enable compression on this
+4) Use ssh to forward the X connection, and enable compression on this
forwarded X connection (ssh -XC remotehostname emacs ...).
-4) Use lbxproxy on the remote end of the connection. This is an interface
- to the low bandwidth X extension in most modern X servers, which
- improves performance dramatically, at the slight expense of correctness
- of the X protocol. lbxproxy achieves the performance gain by grouping
- several X requests in one TCP packet and sending them off together,
- instead of requiring a round-trip for each X request in a separate
- packet. The switches that seem to work best for emacs are:
- -noatomsfile -nowinattr -cheaterrors -cheatevents
- Note that the -nograbcmap option is known to cause problems.
- For more about lbxproxy, see:
+ Keep in mind that this does not help with latency problems, only
+ andwidth ones.
+
+5) Use lbxproxy on the remote end of the connection. This is an
+ interface to the low bandwidth X extension in some outdated X
+ servers, which improves performance dramatically, at the slight
+ expense of correctness of the X protocol. lbxproxy achieves the
+ performance gain by grouping several X requests in one TCP packet
+ and sending them off together, instead of requiring a round-trip
+ for each X request in a separate packet. The switches that seem to
+ work best for emacs are: -noatomsfile -nowinattr -cheaterrors
+ -cheatevents Note that the -nograbcmap option is known to cause
+ problems. For more about lbxproxy, see:
http://www.x.org/archive/X11R6.8.0/doc/lbxproxy.1.html
-5) If copying and killing is slow, try to disable the interaction with the
+ Keep in mind that lbxproxy and the LBX extension are now obsolete.
+
+6) If copying and killing is slow, try to disable the interaction with the
native system's clipboard by adding these lines to your .emacs file:
+
(setq interprogram-cut-function nil)
(setq interprogram-paste-function nil)
+7) If selecting text with the mouse is slow, the main culprit is
+ likely `select-active-regions', coupled with a program monitoring
+ the clipboard on the X server you are connected to. Try turning
+ that off.
+
+ However, over networks with moderate to high latency, with no
+ clipboard monitor running, the bottleneck is likely to be
+ `mouse-position' instead. Set the variable
+ `x-use-fast-mouse-position' to either any non-nil value, or to the
+ symbol `really-fast' if that is still too slow. Doing so will also
+ cause Emacs features that relies on accurate mouse position
+ reporting to stop working reliably.
+
*** Emacs gives the error, Couldn't find per display information.
This can result if the X server runs out of memory because Emacs uses
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/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
index fe44d520cc..c9d73983b5 100644
--- a/etc/themes/dichromacy-theme.el
+++ b/etc/themes/dichromacy-theme.el
@@ -39,7 +39,7 @@ Ansi-Color faces are included."
(bluegreen "#009e73")
(yellow "#f8ec59")
(blue "#0072b2")
- (vermillion "#d55e00")
+ (vermilion "#d55e00")
(redpurple "#cc79a7")
(bluegray "#848ea9"))
(custom-theme-set-faces
@@ -51,9 +51,9 @@ Ansi-Color faces are included."
`(highlight ((,class (:foreground ,blue :background "#e5e5e5"))))
`(region ((,class (:foreground unspecified :background ,yellow))))
`(secondary-selection ((,class (:background "#e5e5e5"))))
- `(isearch ((,class (:foreground "white" :background ,vermillion))))
+ `(isearch ((,class (:foreground "white" :background ,vermilion))))
`(lazy-highlight ((,class (:foreground "white" :background ,redpurple))))
- `(trailing-whitespace ((,class (:background ,vermillion))))
+ `(trailing-whitespace ((,class (:background ,vermilion))))
;; Mode line faces
`(mode-line ((,class (:box (:line-width -1 :style released-button)
:background "#e5e5e5" :foreground "black"))))
@@ -62,17 +62,17 @@ Ansi-Color faces are included."
:foreground "black"))))
;; Escape and prompt faces
`(minibuffer-prompt ((,class (:weight bold :foreground ,blue))))
- `(escape-glyph ((,class (:foreground ,vermillion))))
- `(homoglyph ((,class (:foreground ,vermillion))))
+ `(escape-glyph ((,class (:foreground ,vermilion))))
+ `(homoglyph ((,class (:foreground ,vermilion))))
`(error ((,class (:weight bold :slant italic
- :foreground ,vermillion))))
+ :foreground ,vermilion))))
`(warning ((,class (:foreground ,orange))))
`(success ((,class (:foreground ,bluegreen))))
;; Font lock faces
`(font-lock-builtin-face ((,class (:foreground ,blue))))
`(font-lock-comment-face ((,class (:slant italic :foreground ,bluegreen))))
- `(font-lock-constant-face ((,class (:weight bold :foreground ,vermillion))))
- `(font-lock-function-name-face ((,class (:foreground ,vermillion))))
+ `(font-lock-constant-face ((,class (:weight bold :foreground ,vermilion))))
+ `(font-lock-function-name-face ((,class (:foreground ,vermilion))))
`(font-lock-keyword-face ((,class (:weight bold :foreground ,skyblue))))
`(font-lock-string-face ((,class (:foreground ,bluegray))))
`(font-lock-type-face ((,class (:weight bold :foreground ,blue))))
@@ -81,8 +81,8 @@ Ansi-Color faces are included."
`(link ((,class (:underline t :foreground ,blue))))
`(link-visited ((,class (:underline t :foreground ,redpurple))))
;; Gnus faces
- `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermillion))))
- `(gnus-group-news-1-low ((,class (:foreground ,vermillion))))
+ `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermilion))))
+ `(gnus-group-news-1-low ((,class (:foreground ,vermilion))))
`(gnus-group-news-2 ((,class (:weight bold :foreground ,orange))))
`(gnus-group-news-2-low ((,class (:foreground ,orange))))
`(gnus-group-news-3 ((,class (:weight bold :foreground ,skyblue))))
@@ -92,8 +92,8 @@ Ansi-Color faces are included."
`(gnus-group-news-5 ((,class (:weight bold :foreground ,blue))))
`(gnus-group-news-5-low ((,class (:foreground ,blue))))
`(gnus-group-news-low ((,class (:foreground ,bluegreen))))
- `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermillion))))
- `(gnus-group-mail-1-low ((,class (:foreground ,vermillion))))
+ `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermilion))))
+ `(gnus-group-mail-1-low ((,class (:foreground ,vermilion))))
`(gnus-group-mail-2 ((,class (:weight bold :foreground ,orange))))
`(gnus-group-mail-2-low ((,class (:foreground ,orange))))
`(gnus-group-mail-3 ((,class (:weight bold :foreground ,skyblue))))
@@ -103,13 +103,13 @@ Ansi-Color faces are included."
`(gnus-header-from ((,class (:weight bold :foreground ,blue))))
`(gnus-header-subject ((,class (:foreground ,orange))))
`(gnus-header-name ((,class (:foreground ,skyblue))))
- `(gnus-header-newsgroups ((,class (:foreground ,vermillion))))
+ `(gnus-header-newsgroups ((,class (:foreground ,vermilion))))
;; Image-Dired
- `(image-dired-thumb-flagged ((,class (:background ,vermillion))))
+ `(image-dired-thumb-flagged ((,class (:background ,vermilion))))
`(image-dired-thumb-mark ((,class (:background ,orange))))
;; Message faces
`(message-header-name ((,class (:foreground ,skyblue))))
- `(message-header-cc ((,class (:foreground ,vermillion))))
+ `(message-header-cc ((,class (:foreground ,vermilion))))
`(message-header-other ((,class (:foreground ,bluegreen))))
`(message-header-subject ((,class (:foreground ,orange))))
`(message-header-to ((,class (:weight bold :foreground ,blue))))
@@ -122,8 +122,8 @@ Ansi-Color faces are included."
:slant unspecified :underline ,redpurple))))
;; ANSI color
`(ansi-color-black ((,class (:background "black" :foreground "black"))))
- `(ansi-color-red ((,class (:background ,vermillion
- :foreground ,vermillion))))
+ `(ansi-color-red ((,class (:background ,vermilion
+ :foreground ,vermilion))))
`(ansi-color-green ((,class (:background ,bluegreen
:foreground ,bluegreen))))
`(ansi-color-yellow ((,class (:background ,yellow :foreground ,yellow))))
@@ -134,8 +134,8 @@ Ansi-Color faces are included."
`(ansi-color-white ((,class (:background "gray90" :foreground "gray90"))))
`(ansi-color-bright-black ((,class (:background "black"
:foreground "black"))))
- `(ansi-color-bright-red ((,class (:background ,vermillion
- :foreground ,vermillion))))
+ `(ansi-color-bright-red ((,class (:background ,vermilion
+ :foreground ,vermilion))))
`(ansi-color-bright-green ((,class (:background ,bluegreen
:foreground ,bluegreen))))
`(ansi-color-bright-yellow ((,class (:background ,yellow
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 641570da02..d3af926b63 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -1574,6 +1574,67 @@ yylex (void)
end_string:
return end_char == '\'' ? CCHAR : CSTRING;
+ case 'R':
+ if (GET (c) == '"')
+ {
+ /* C++11 rstrings. */
+
+#define RSTRING_EOF_CHECK \
+ do { \
+ if (c == '\0') \
+ { \
+ yyerror ("unterminated c++11 rstring", NULL); \
+ UNGET (); \
+ return CSTRING; \
+ } \
+ } while (0)
+
+ char *rstring_prefix_start = in;
+
+ while (GET (c) != '(')
+ {
+ RSTRING_EOF_CHECK;
+ if (c == '"')
+ {
+ yyerror ("malformed c++11 rstring", NULL);
+ return CSTRING;
+ }
+ }
+ char *rstring_prefix_end = in - 1;
+ while (TRUE)
+ {
+ switch (GET (c))
+ {
+ default:
+ RSTRING_EOF_CHECK;
+ break;
+ case '\n':
+ INCREMENT_LINENO;
+ break;
+ case ')':
+ {
+ char *in_saved = in;
+ char *prefix = rstring_prefix_start;
+ while (prefix != rstring_prefix_end && GET (c) == *prefix)
+ {
+ RSTRING_EOF_CHECK;
+ prefix++;
+ }
+ if (prefix == rstring_prefix_end)
+ {
+ if (GET (c) == '"')
+ return CSTRING;
+ RSTRING_EOF_CHECK;
+ }
+ in = in_saved;
+ }
+ }
+ }
+ }
+
+ UNGET ();
+ /* Fall through to identifiers and keywords. */
+ FALLTHROUGH;
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g':
case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n':
@@ -1581,7 +1642,7 @@ yylex (void)
case 'v': case 'w': case 'x': case 'y': case 'z':
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G':
case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N':
- case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U':
+ case 'O': case 'P': case 'Q': case 'S': case 'T': case 'U':
case 'V': case 'W': case 'X': case 'Y': case 'Z': case '_':
{
/* Identifier and keywords. */
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 425db8cfac..ee124ea135 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -2240,7 +2240,7 @@ main (int argc, char **argv)
char *str = unquote_argument (p + strlen ("-error "));
if (!skiplf)
printf ("\n");
- fprintf (stderr, "*ERROR*: %s", str);
+ message (true, "*ERROR*: %s", str);
if (str[0])
skiplf = str[strlen (str) - 1] == '\n';
exit_status = EXIT_FAILURE;
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 6053ffa65a..de73fe7f0a 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -1737,7 +1737,7 @@
(bibtex-find-crossref, bibtex-find-entry): New funs.
(bibtex-find-entry-location): Rename to bibtex-prepare-new-entry, use
bibtex-lessp, Simplify.
- (bibtex-validate): Simplify. Fixe bug of internal variable
+ (bibtex-validate): Simplify. Fix bug of internal variable
questionable-month.
(bibtex-remove-OPT-or-ALT): Use when.
(bibtex-remove-delimiters, bibtex-kill-field, bibtex-kill-entry)
@@ -9449,7 +9449,7 @@
Use shy group.
(outline-level) <var>: Update calling convention.
(outline-level) <fun>: Take advantage of it.
- (outline-demote): Don't assume the match-data is still uptodate.
+ (outline-demote): Don't assume the match-data is still up-to-date.
(outline-up-heading): Simplify and make sure the match data is
properly set at the end.
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index a89e515510..0796965a9b 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -1556,7 +1556,7 @@
(org-search-not-self): Rename from `org-search-not-link'.
(org-open-link-marker): New variable.
(org-open-at-point): Set `org-open-link-marker'.
- (org-print-icalendar-entries): Fixe bug with excluding DONE
+ (org-print-icalendar-entries): Fix bug with excluding DONE
entries from the exported list.
(org-edit-formula-lisp-indent): New command.
(orgtbl-to-texinfo, orgtbl-to-html): New functions.
@@ -5243,7 +5243,7 @@
2006-10-11 Ilya Zakharevich <ilyaz@cpan.org>
- * progmodes/cperl-mode.el: Merge from upstream, upto version 5.22.
+ * progmodes/cperl-mode.el: Merge from upstream, up to version 5.22.
After 5.0:
(cperl-add-tags-recurse-noxs-fullpath): New function (for -batch mode).
@@ -5551,7 +5551,7 @@
(cperl-next-interpolated-REx-1): Likewise.
"\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions.
Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx'.
- (cperl-praise): Mention finded interpolated RExen.
+ (cperl-praise): Mention finding interpolated RExen.
After 5.19:
(cperl-init-faces): Highlight %$foo, @$foo too.
@@ -11874,7 +11874,7 @@
* files.el (hack-local-variables-confirm): Don't prompt for ! if
enable-local-variables is set to always query, or there is no
- savable variable.
+ saveable variable.
2006-03-10 Bill Wohler <wohler@newt.com>
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index 369aec81ef..326003d9d9 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -1070,7 +1070,7 @@
* international/mule-cmds.el (char-code-property-alist): New variable.
(define-char-code-property): New function.
(get-char-code-property, put-char-code-property): Handle a
- char-table registerd in char-code-property-alist.
+ char-table registered in char-code-property-alist.
(set-language-environment): Check :ascii-compatible-p property of
nonascii charset instead of its dimension.
@@ -13901,7 +13901,7 @@
2007-07-23 Stefan Monnier <monnier@iro.umontreal.ca>
* ses.el (ses-cleanup): Prevent Emacs from spuriously checking if the
- underlying file is uptodate.
+ underlying file is up-to-date.
2007-07-23 Christopher J. Madsen <cjm@cjmweb.net>
@@ -15245,7 +15245,7 @@
2007-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/autoload.el (autoload-modified-buffers): New var.
- (autoload-find-destination): Keep it uptodate.
+ (autoload-find-destination): Keep it up-to-date.
(autoload-save-buffers): New fun.
(update-file-autoloads): Use it. Re-add the "up to date" message.
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index 686746abe0..8d8c611778 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -6103,7 +6103,7 @@
* international/quail.el (quail-show-guidance): Don't create
a guidance-frame if current buffer is not a minibuffer, since even if
selected-window is mini-p, the buffer will never be displayed in it, so
- it wil be usable for guidance.
+ it will be usable for guidance.
2008-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 23e61ff787..8a21c291e7 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'.
@@ -22575,7 +22575,7 @@
2009-06-28 Juri Linkov <juri@jurta.org>
- * help-fns.el (describe-function-1): Correctly locate adviced
+ * help-fns.el (describe-function-1): Correctly locate advised
functions in hyperlink (Bug#2438).
2009-06-28 Chong Yidong <cyd@stupidchicken.com>
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index f0a50bb4bc..7b57c014d2 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.
@@ -10931,7 +10931,7 @@
2012-05-29 Aaron S. Hawley <aaron.s.hawley@gmail.com>
- * vc/vc.el (vc-revert, vc-rollback): Dont kill vc-diff buffer on
+ * vc/vc.el (vc-revert, vc-rollback): Don't kill vc-diff buffer on
revert (Bug#11488).
2012-05-29 Juri Linkov <juri@jurta.org>
@@ -15340,7 +15340,7 @@
* subr.el (with-selected-frame): Mention that the selected frame
is restored (bug#9980).
- * ibuffer.el (ibuffer-mode): List the bindings in the corrent map
+ * ibuffer.el (ibuffer-mode): List the bindings in the correct map
(bug#9759).
* mail/smtpmail.el (password-cache-add): Remove unused declaration.
@@ -22838,15 +22838,14 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * international/quail.el (quail-insert-kbd-layout): and and -> and.
- * kermit.el: and and -> and.
- * net/ldap.el (ldap-search-internal): to to -> to.
- * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise.
- * progmodes/js.el (js-mode): and and -> and.
- * textmodes/artist.el (artist-move-to-xy): at at -> at.
- (artist-draw-region-trim-line-endings): if if -> if.
- And Safetyc -> Safety.
- * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a.
+ * international/quail.el (quail-insert-kbd-layout):
+ * kermit.el:
+ * net/ldap.el (ldap-search-internal):
+ * progmodes/vhdl-mode.el (vhdl-offsets-alist):
+ * progmodes/js.el (js-mode):
+ * textmodes/artist.el (artist-move-to-xy):
+ (artist-draw-region-trim-line-endings):
+ * textmodes/reftex-dcr.el (reftex-view-crossref): Fix typos.
2011-05-10 Glenn Morris <rgm@gnu.org>
Stefan Monnier <monnier@iro.umontreal.ca>
@@ -24104,7 +24103,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.3 b/lisp/ChangeLog.3
index 7f5ceb4b85..e23226b844 100644
--- a/lisp/ChangeLog.3
+++ b/lisp/ChangeLog.3
@@ -7326,8 +7326,7 @@
1991-07-13 Jim Blandy (jimb@churchy.gnu.ai.mit.edu)
* info.el (Info-find-node): Call buffer-flush-undo with one arg,
- instead of none. Change call to get-buffer-c>reate to
- get-buffer-create.
+ instead of none. Fix typo in call to get-buffer-create.
* startup.el (command-line): Remove the arguments from
command-line-args as we process them.
diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4
index e965dbb5ef..ea0502975e 100644
--- a/lisp/ChangeLog.4
+++ b/lisp/ChangeLog.4
@@ -6858,7 +6858,7 @@
1993-07-26 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* frame.el (frame-notice-user-settings): Don't reapply a parm
- whose value is ot changed (as far as we know) since frame-initialize.
+ whose value is not changed (as far as we know) since frame-initialize.
* simple.el (kill-ring-save): Delete spurious `message' call.
(set-mark): If POS is nil, call deactivate-mark.
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index e2128b94c0..27d522aaf2 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -7392,7 +7392,7 @@
(ada-format-paramlist): Simplified a regexp.
(ada-indent-current): On first line of the buffer, indent to column 0.
Don't reindent if new position is the same as the old one. Thus, a
- correctly indended line is not modified.
+ correctly indented line is not modified.
(ada-get-indent-subprog): Simplified a regexp.
(ada-goto-matching-decl-start): Distinguish between normal type
declaration and protected types, which are more like procedures.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 747a9ffab9..3220832454 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>
@@ -20821,7 +20821,7 @@
function word-help-find-help-file.
(word-help-guess-all): New subroutine.
(word-help-guess): Use word-help-guess-all.
- May optionally copy only upto the cursor,
+ May optionally copy only up to the cursor,
instead of the entire keyword.
1997-01-01 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index 78fc7e2056..a14d682192 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -4356,7 +4356,7 @@
1999-07-21 Gerd Moellmann <gerd@gnu.org>
* scroll-bar.el (scroll-bar-toolkit-scroll): New.
- (global): Use different key bindings if using tookit scroll bars.
+ (global): Use different key bindings if using toolkit scroll bars.
1999-07-21 Gerd Moellmann <gerd@gnu.org>
@@ -9712,7 +9712,7 @@
(ps-mule-font-info-database-ps-bdf): New variable.
(ccl-encode-ethio-unicode): Bug of CCL code fixed.
(ps-mule-generate-font): Give CHARSET arg to FONT-FUNC function
- registerd in FONT-SPEC.
+ registered in FONT-SPEC.
(ps-mule-bitmap-prologue): Fix PostScript code to realize correct
character width of bitmap fonts.
(ps-mule-generate-bitmap-font): Give COLUMNS arg to PostScript
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index a8ebe81e7d..4cb10d2d55 100644
--- a/lisp/ChangeLog.9
+++ b/lisp/ChangeLog.9
@@ -789,7 +789,7 @@
(command-line-1): If inhibit-startup-buffer-menu is set, don't
display the buffer menu. From Simon Josefsson <jas@extundo.com>.
- This allows upto 99999 messages in the summary without screwing up
+ This allows up to 99999 messages in the summary without screwing up
the summary sorting. Previously 9999 was the maximum. Added to NEWS.
* mail/rmailsum.el (rmail-make-summary-line)
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..a731926f45 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>.
@@ -493,7 +492,7 @@ Intended as a value for `revert-buffer-function'."
\\{apropos-mode-map}"
(make-local-variable 'apropos--current)
(setq-local revert-buffer-function #'apropos--revert-buffer)
- (setq-local outline-regexp "^[^ \n]+"
+ (setq-local outline-search-function #'outline-search-level
outline-level (lambda () 1)
outline-minor-mode-cycle t
outline-minor-mode-highlight t
@@ -652,7 +651,8 @@ while a list of strings is used as a word list."
(defun apropos (pattern &optional do-all)
"Show all meaningful Lisp symbols whose names match PATTERN.
Symbols are shown if they are defined as functions, variables, or
-faces, or if they have nonempty property lists.
+faces, or if they have nonempty property lists, or if they are
+known keywords.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
@@ -1188,7 +1188,8 @@ as a heading."
(insert-text-button (symbol-name symbol)
'type 'apropos-symbol
'skip apropos-multi-type
- 'face 'apropos-symbol)
+ 'face 'apropos-symbol
+ 'outline-level 1)
(setq button-end (point))
(if (and (eq apropos-sort-by-scores 'verbose)
(cadr apropos-item))
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 0955e2ed07..dc274843e1 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -55,13 +55,27 @@
:type 'string
:version "27.1")
+(defcustom auth-source-pass-extra-query-keywords t
+ "Whether to consider additional keywords when performing a query.
+Specifically, when the value is t, recognize the `:max' and
+`:require' keywords and accept lists of query parameters for
+certain keywords, such as `:host' and `:user'. Also, wrap all
+returned secrets in a function and forgo any further results
+filtering unless given an applicable `:require' argument. When
+this option is nil, do none of that, and enact the narrowing
+behavior described toward the bottom of the Info node `(auth) The
+Unix password store'."
+ :type 'boolean
+ :version "29.1")
+
(cl-defun auth-source-pass-search (&rest spec
&key backend type host user port
+ require max
&allow-other-keys)
"Given some search query, return matching credentials.
See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE,
-HOST, USER and PORT."
+HOST, USER, PORT, REQUIRE, and MAX."
(cl-assert (or (null type) (eq type (oref backend type)))
t "Invalid password-store search: %s %s")
(cond ((eq host t)
@@ -70,6 +84,8 @@ HOST, USER and PORT."
((null host)
;; Do not build a result, as none will match when HOST is nil
nil)
+ (auth-source-pass-extra-query-keywords
+ (auth-source-pass--build-result-many host port user require max))
(t
(when-let ((result (auth-source-pass--build-result host port user)))
(list result)))))
@@ -89,6 +105,39 @@ HOSTS can be a string or a list of strings."
(seq-subseq retval 0 -2)) ;; remove
password
retval))))
+(defvar auth-source-pass--match-regexp nil)
+
+(defun auth-source-pass--match-regexp (s)
+ (rx-to-string ; autoloaded
+ `(: (or bot "/")
+ (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@")
+ (group-n 10 (+ (not (in ?\ ?/ ?@ ,s))))
+ (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s))))))
+ (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s))))
+ (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s)))))
+ (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s)))))))
+ eot)
+ 'no-group))
+
+(defun auth-source-pass--build-result-many (hosts ports users require max)
+ "Return multiple `auth-source-pass--build-result' values."
+ (unless (listp hosts) (setq hosts (list hosts)))
+ (unless (listp users) (setq users (list users)))
+ (unless (listp ports) (setq ports (list ports)))
+ (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp
+ auth-source-pass-port-separator))
+ (rv (auth-source-pass--find-match-many hosts users ports
+ require (or max 1))))
+ (when auth-source-debug
+ (auth-source-pass--do-debug "final result: %S" rv))
+ (let (out)
+ (dolist (e rv out)
+ (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1
+ (v (auth-source--obfuscate s)))
+ (setf (plist-get e :secret)
+ (lambda () (auth-source--deobfuscate v))))
+ (push e out)))))
+
;;;###autoload
(defun auth-source-pass-enable ()
"Enable auth-source-password-store."
@@ -206,6 +255,67 @@ HOSTS can be a string or a list of strings."
hosts
(list hosts))))
+(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
+ (when (string-match auth-source-pass--match-regexp path)
+ (puthash path
+ `( :host ,(or (match-string 10 path) (match-string 11 path))
+ ,@(if-let* ((tr (match-string 21 path)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 path)))
+ :port ,(and-let* ((p (or (match-string 30 path)
+ (match-string 31 path)))
+ (n (string-to-number p)))
+ (if (or (zerop n) (not port-number-p))
+ (format "%s" p)
+ n)))
+ seen)))
+
+(defun auth-source-pass--match-parts (parts key value require)
+ (let ((mv (plist-get parts key)))
+ (if (memq key require)
+ (and value (equal mv value))
+ (or (not value) (not mv) (equal mv value)))))
+
+(defun auth-source-pass--find-match-many (hosts users ports require max)
+ "Return plists for valid combinations of HOSTS, USERS, PORTS."
+ (let ((seen (make-hash-table :test #'equal))
+ (entries (auth-source-pass-entries))
+ out suffixed suffixedp)
+ (catch 'done
+ (dolist (host hosts out)
+ (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+ (unless (or (not (equal "443" p)) (string-prefix-p "https://"; host))
+ (setq p nil))
+ (dolist (user (or users (list u)))
+ (dolist (port (or ports (list p)))
+ (dolist (e entries)
+ (when-let*
+ ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed
+ seen e (integerp port))))
+ ((equal host (plist-get m :host)))
+ ((auth-source-pass--match-parts m :port port require))
+ ((auth-source-pass--match-parts m :user user require))
+ (parsed (auth-source-pass-parse-entry e))
+ ;; For now, ignore body-content pairs, if any,
+ ;; from `auth-source-pass--parse-data'.
+ (secret (or (auth-source-pass--get-attr 'secret parsed)
+ (not (memq :secret require)))))
+ (push
+ `( :host ,host ; prefer user-provided :host over h
+ ,@(and-let* ((u (plist-get m :user))) (list :user u))
+ ,@(and-let* ((p (plist-get m :port))) (list :port p))
+ ,@(and secret (not (eq secret t)) (list :secret secret)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))))
+
(defun auth-source-pass--disambiguate (host &optional user port)
"Return (HOST USER PORT) after disambiguation.
Disambiguate between having user provided inside HOST (e.g.,
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index b57ad12986..7f3a264f53 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -365,8 +365,8 @@ BOOKMARK-RECORD is, e.g., one element from
`bookmark-alist'."
(car bookmark-record))
(defun bookmark-type-from-full-record (bookmark-record)
- "Return then type of BOOKMARK-RECORD.
-BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. It's
+ "Return the type of BOOKMARK-RECORD.
+BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. Its
type is read from the symbol property named
`bookmark-handler-type' read on the record handler function."
(let ((handler (bookmark-get-handler bookmark-record)))
@@ -1396,20 +1396,25 @@ after a bookmark was set in it."
(interactive (list (bookmark-completing-read "Bookmark to relocate")))
(bookmark-maybe-historicize-string bookmark-name)
(bookmark-maybe-load-default-file)
- (let* ((bmrk-filename (bookmark-get-filename bookmark-name))
- (newloc (abbreviate-file-name
- (expand-file-name
- (read-file-name
- (format "Relocate %s to: " bookmark-name)
- (file-name-directory bmrk-filename))))))
- (bookmark-set-filename bookmark-name newloc)
- (bookmark-update-last-modified bookmark-name)
- (setq bookmark-alist-modification-count
- (1+ bookmark-alist-modification-count))
- (if (bookmark-time-to-save-p)
+ (let ((bmrk-filename (bookmark-get-filename bookmark-name)))
+ ;; FIXME: Make `bookmark-relocate' support bookmark Types
+ ;; besides files and directories.
+ (unless bmrk-filename
+ (user-error "Cannot relocate bookmark of type \"%s\""
+ (bookmark-type-from-full-record
+ (bookmark-get-bookmark bookmark-name))))
+ (let ((newloc (abbreviate-file-name
+ (expand-file-name
+ (read-file-name
+ (format "Relocate %s to: " bookmark-name)
+ (file-name-directory bmrk-filename))))))
+ (bookmark-set-filename bookmark-name newloc)
+ (bookmark-update-last-modified bookmark-name)
+ (setq bookmark-alist-modification-count
+ (1+ bookmark-alist-modification-count))
+ (when (bookmark-time-to-save-p)
(bookmark-save))
- (bookmark-bmenu-surreptitiously-rebuild-list)))
-
+ (bookmark-bmenu-surreptitiously-rebuild-list))))
;;;###autoload
(defun bookmark-insert-location (bookmark-name &optional no-history)
diff --git a/lisp/bs.el b/lisp/bs.el
index aabc2dc558..1fd31fb3b8 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -25,7 +25,7 @@
;;; Commentary:
-;; The bs-package contains a main function bs-show for popping up a
+;; The bs package contains a main function `bs-show' for popping up a
;; buffer in a way similar to `list-buffers' and `electric-buffer-list':
;; The new buffer offers a Buffer Selection Menu for manipulating
;; the buffer list and buffers.
@@ -42,18 +42,18 @@
;;; Quick Installation and Customization:
-;; To display the bs menu, do
+;; To display the bs menu, type
;; M-x bs-show
-;; To customize its behavior, do
+;; To customize its behavior, type
;; M-x bs-customize
;;; More Commentary:
-;; bs-show will generate a new buffer named *buffer-selection*, which shows
+;; `bs-show' will generate a new buffer named *buffer-selection*, which shows
;; all buffers or a subset of them, and has possibilities for deleting,
-;; saving and selecting buffers. For more details see docstring of
-;; function `bs-mode'. A current configuration describes which buffers appear
-;; in *buffer-selection*. See docstring of variable `bs-configurations' for
+;; saving and selecting buffers. For more details see docstring of
+;; function `bs-mode'. A current configuration describes which buffers appear
+;; in *buffer-selection*. See docstring of variable `bs-configurations' for
;; more details.
;;
;; The package bs combines the advantages of the Emacs functions
@@ -70,7 +70,7 @@
;;; Cycling through buffers
-;; This package offers two functions for buffer cycling. If you want to cycle
+;; This package offers two functions for buffer cycling. If you want to cycle
;; through buffer list you can use `bs-cycle-next' or `bs-cycle-previous'.
;; Bind these function to a key like
;; (global-set-key [(f9)] 'bs-cycle-previous)
@@ -80,7 +80,7 @@
;; to go through internal buffers like *Messages*.
;;
;; Cycling through buffers ignores sorting because sorting destroys
-;; the logical buffer list. If buffer list is sorted by size you
+;; the logical buffer list. If buffer list is sorted by size you
;; won't be able to cycle to the smallest buffer.
;;; Customization:
@@ -114,7 +114,7 @@
;; When cycling through buffer list the functions for cycling will use
;; the current configuration of bs to calculate the buffer list.
;; If you want to use a different configuration for cycling you have to set
-;; the variable `bs-cycle-configuration-name'. You can customize this variable.
+;; the variable `bs-cycle-configuration-name'. You can customize this
variable.
;;
;; For example: If you use the configuration called "files-and-scratch" you
;; can cycle through all file buffers and *scratch* although your current
@@ -390,9 +390,9 @@ column title to highlight.
FACE is a face used to fontify the sorted column title. A value of nil means
don't highlight.
The new sort aspect will be inserted into list `bs-sort-functions'."
- (let ((tupel (assoc name bs-sort-functions)))
- (if tupel
- (setcdr tupel (list fun regexp-for-sorting face))
+ (let ((tuple (assoc name bs-sort-functions)))
+ (if tuple
+ (setcdr tuple (list fun regexp-for-sorting face))
(setq bs-sort-functions
(cons (list name fun regexp-for-sorting face)
bs-sort-functions)))))
@@ -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."
@@ -1236,13 +1240,13 @@ by buffer configuration `bs-cycle-configuration-name'."
(bs-set-configuration (or bs-cycle-configuration-name
bs-default-configuration))
(let ((bs-buffer-sort-function nil)
(bs--current-sort-function nil))
- (let* ((tupel (bs-next-buffer (if (or (eq last-command
+ (let* ((tuple (bs-next-buffer (if (or (eq last-command
'bs-cycle-next)
(eq last-command
'bs-cycle-previous))
bs--cycle-list)))
- (next (car tupel))
- (cycle-list (cdr tupel)))
+ (next (car tuple))
+ (cycle-list (cdr tuple)))
;; We don't want the frame iconified if the only window in the frame
;; happens to be dedicated.
(bury-buffer (current-buffer))
@@ -1268,13 +1272,13 @@ by buffer configuration `bs-cycle-configuration-name'."
(bs-set-configuration (or bs-cycle-configuration-name
bs-default-configuration))
(let ((bs-buffer-sort-function nil)
(bs--current-sort-function nil))
- (let* ((tupel (bs-previous-buffer (if (or (eq last-command
+ (let* ((tuple (bs-previous-buffer (if (or (eq last-command
'bs-cycle-next)
(eq last-command
'bs-cycle-previous))
bs--cycle-list)))
- (prev-buffer (car tupel))
- (cycle-list (cdr tupel)))
+ (prev-buffer (car tuple))
+ (cycle-list (cdr tuple)))
(switch-to-buffer prev-buffer nil t)
(setq bs--cycle-list (append (last cycle-list)
(reverse (cdr (reverse cycle-list)))))
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index abf152f058..aa5f70edf2 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -1,7 +1,6 @@
;;; buff-menu.el --- Interface for viewing and manipulating buffers -*-
lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-1995, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
@@ -101,6 +100,13 @@ as it is by default."
This is set by the prefix argument to `buffer-menu' and related
commands.")
+(defvar-local Buffer-menu-filter-predicate nil
+ "Function to filter out buffers in the buffer list.
+Buffers that don't satisfy the predicate will be skipped.
+The value should be a function of one argument; it will be
+called with the buffer. If this function returns non-nil,
+then the buffer will be displayed in the buffer list.")
+
(defvar-keymap Buffer-menu-mode-map
:doc "Local keymap for `Buffer-menu-mode' buffers."
:parent tabulated-list-mode-map
@@ -133,10 +139,12 @@ commands.")
"M-s a C-s" #'Buffer-menu-isearch-buffers
"M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp
"M-s a C-o" #'Buffer-menu-multi-occur
-
"<mouse-2>" #'Buffer-menu-mouse-select
"<follow-link>" 'mouse-face)
+(put 'Buffer-menu-delete :advertised-binding "d")
+(put 'Buffer-menu-this-window :advertised-binding "f")
+
(easy-menu-define Buffer-menu-mode-menu Buffer-menu-mode-map
"Menu for `Buffer-menu-mode' buffers."
'("Buffer-Menu"
@@ -236,6 +244,26 @@ In Buffer Menu mode, the following commands are defined:
(lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
+(defun buffer-menu--display-help ()
+ (message "%s"
+ (substitute-command-keys
+ (concat
+ "Commands: "
+ "\\<Buffer-menu-mode-map>"
+ "\\[Buffer-menu-delete], "
+ "\\[Buffer-menu-save], "
+ "\\[Buffer-menu-execute], "
+ "\\[Buffer-menu-unmark]; "
+ "\\[Buffer-menu-this-window], "
+ "\\[Buffer-menu-other-window], "
+ "\\[Buffer-menu-1-window], "
+ "\\[Buffer-menu-2-window], "
+ "\\[Buffer-menu-mark], "
+ "\\[Buffer-menu-select]; "
+ "\\[Buffer-menu-not-modified], "
+ "\\[Buffer-menu-toggle-read-only]; "
+ "\\[quit-window] to quit; \\[describe-mode] for help"))))
+
(defun buffer-menu (&optional arg)
"Switch to the Buffer Menu.
By default, the Buffer Menu lists all buffers except those whose
@@ -261,8 +289,7 @@ the `Buffer-menu-name-width', `Buffer-menu-size-width' and
`Buffer-menu-mode-width' variables."
(interactive "P")
(switch-to-buffer (list-buffers-noselect arg))
- (message
- "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ (buffer-menu--display-help))
(defun buffer-menu-other-window (&optional arg)
"Display the Buffer Menu in another window.
@@ -273,8 +300,7 @@ with a space (which are for internal use). With prefix
argument
ARG, show only buffers that are visiting files."
(interactive "P")
(switch-to-buffer-other-window (list-buffers-noselect arg))
- (message
- "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ (buffer-menu--display-help))
;;;###autoload
(defun list-buffers (&optional arg)
@@ -597,19 +623,23 @@ This behaves like invoking \\[read-only-mode] in that
buffer."
;;; Functions for populating the Buffer Menu.
;;;###autoload
-(defun list-buffers-noselect (&optional files-only buffer-list)
+(defun list-buffers-noselect (&optional files-only buffer-list
filter-predicate)
"Create and return a Buffer Menu buffer.
This is called by `buffer-menu' and others as a subroutine.
If FILES-ONLY is non-nil, show only file-visiting buffers.
If BUFFER-LIST is non-nil, it should be a list of buffers; it
-means list those buffers and no others."
+means list those buffers and no others.
+If FILTER-PREDICATE is non-nil, it should be a function
+that filters out buffers from the list of buffers.
+See more at `Buffer-menu-filter-predicate'."
(let ((old-buffer (current-buffer))
(buffer (get-buffer-create "*Buffer List*")))
(with-current-buffer buffer
(Buffer-menu-mode)
(setq Buffer-menu-files-only
(and files-only (>= (prefix-numeric-value files-only) 0)))
+ (setq Buffer-menu-filter-predicate filter-predicate)
(list-buffers--refresh buffer-list old-buffer)
(tabulated-list-print))
buffer))
@@ -631,6 +661,8 @@ means list those buffers and no others."
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
+ (filter-predicate (and (functionp Buffer-menu-filter-predicate)
+ Buffer-menu-filter-predicate))
entries name-width)
;; Collect info for each buffer we're interested in.
(dolist (buffer (or buffer-list
@@ -644,7 +676,9 @@ means list those buffers and no others."
(and (or (not (string= (substring name 0 1) " "))
file)
(not (eq buffer buffer-menu-buffer))
- (or file show-non-file))))
+ (or file show-non-file)
+ (or (not filter-predicate)
+ (funcall filter-predicate buffer)))))
(push (list buffer
(vector (cond
((eq buffer old-buffer) ".")
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index a95967bef4..5735126bf5 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1414,7 +1414,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(defun calc-gnuplot-command (&rest args)
"Send ARGS to Gnuplot.
-Returns nil if Gnuplot signalled an error."
+Returns nil if Gnuplot signaled an error."
(calc-graph-init)
(let ((cmd (concat (mapconcat 'identity args " ") "\n")))
(or (calc-graph-w32-p)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 98e91aaa75..9a2baf1e43 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)
@@ -1769,7 +1769,7 @@ These functions give the date in alternative calendrical
systems:
`diary-islamic-date', `diary-julian-date', `diary-mayan-date',
`diary-persian-date'
-Theses functions only produce output on certain dates:
+These functions only produce output on certain dates:
`diary-lunar-phases' - phases of moon (on the appropriate days)
`diary-hebrew-omer' - Omer count, within 50 days after Passover
diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1
index aa54bdd9b0..78275f4db3 100644
--- a/lisp/cedet/ChangeLog.1
+++ b/lisp/cedet/ChangeLog.1
@@ -459,7 +459,7 @@
* semantic/scope.el (semantic-analyze-scoped-types-default): If we
cannot find a type in the typecache, also look into the types
we already found. This is necessary since in C++, a 'using
- namespace' can be dependend on a previous one.
+ namespace' can be dependent on a previous one.
(semantic-completable-tags-from-type): When creating the list of
completable types, pull in types which are referenced through
'using' statements, and also preserve their filenames.
@@ -1546,7 +1546,7 @@
(ede-proj-makefile-dependencies): Update pattern rule so that
resulting parsers are also byte-compiled.
(semantic-ede-grammar-compiler-bovine)
- (semantic-ede-source-grammar-wisent): Remove .elc from gargage
+ (semantic-ede-source-grammar-wisent): Remove .elc from garbage
pattern, since this is already covered by the elisp compiler.
(project-compile-target): Add compatibility code for Emacs 23,
which does not have `byte-recompile-file'.
@@ -1915,10 +1915,9 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * ede/pmake.el (ede-proj-makefile-garbage-patterns): the the -> the
+ * ede/pmake.el (ede-proj-makefile-garbage-patterns):
* semantic/complete.el (semantic-complete-read-tag-local-members):
- Likewise.
- * ede.el (ede-auto-add-method): then then -> then
+ * ede.el (ede-auto-add-method): Fix typos.
2011-04-23 Juanma Barranquero <lekktu@gmail.com>
@@ -3098,7 +3097,7 @@
* ede/proj-prog.el (project-run-target): New method.
* ede/proj-obj.el (ede-cc-linker): Rename from ede-gcc-linker.
- (ede-g++-linker): Change Change link lines.
+ (ede-g++-linker): Change link lines.
* ede/pmake.el (ede-pmake-insert-variable-shared):
When searching for old variables, go to the end of the buffer and
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/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index 1b424bc6d0..5aaa5b2687 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -35,7 +35,7 @@
;; SOURCE always keep in the order of .c, .h, the other stuff.
;;; Things to do
-;; makefile-fill-paragraph -- refill a macro w/ backslashes
+;; makefile-fill-paragraph -- refill a macro with backslashes
;; makefile-insert-macro -- insert "foo = "
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 7a486754a0..398e08a1a9 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -43,7 +43,7 @@
(autoload 'ede-proj-target-scheme "ede/proj-scheme"
"Target class for a group of lisp files." nil nil)
(autoload 'ede-proj-target-makefile-miscelaneous "ede/proj-misc"
- "Target class for a group of miscellaneous w/ a special makefile." nil nil)
+ "Target class for a group of miscellaneous with a special makefile." nil nil)
(autoload 'ede-proj-target-makefile-program "ede/proj-prog"
"Target class for building a program." nil nil)
(autoload 'ede-proj-target-makefile-archive "ede/proj-archive"
@@ -67,7 +67,7 @@
"Target class for a group of lisp files.")
(eieio-defclass-autoload 'ede-proj-target-makefile-miscelaneous
'(ede-proj-target-makefile)
"ede/proj-misc"
- "Target class for a group of miscellaneous w/ a special makefile.")
+ "Target class for a group of miscellaneous with a special makefile.")
(eieio-defclass-autoload 'ede-proj-target-makefile-program
'(ede-proj-target-makefile-objectcode)
"ede/proj-prog"
"Target class for building a program.")
@@ -543,7 +543,7 @@ Converts all symbols into the objects to be used."
(when (slot-exists-p obj 'compiler)
(let ((comp (oref obj compiler)))
(if comp
- ;; Now that we have a pre-set compilers to use, convert tye symbols
+ ;; Now that we have a pre-set compilers to use, convert type symbols
;; into objects for ease of use
(setq comp (if (listp comp)
(mapcar #'symbol-value comp)
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index de6936ad1a..75fde2043c 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -195,7 +195,7 @@ other meta-variable based on this name.")
"Add the current buffer into a project.
_FILE is ignored.
OT is the object target. DIR is the directory to start in."
- (let* ((target (if ede-object (error "Already associated w/ a target")
+ (let* ((target (if ede-object (error "Already associated with a target")
(let ((amf (project-am-load default-directory)))
(if (not amf) (error "No project file"))
(completing-read "Target: "
@@ -231,7 +231,7 @@ OT is the object target. DIR is the directory to start in."
(setq ede-object nil))
(cl-defmethod project-edit-file-target ((obj project-am-target))
- "Edit the target associated w/ this file."
+ "Edit the target associated with this file."
(find-file (concat (oref obj path) "Makefile.am"))
(goto-char (point-min))
(makefile-move-to-macro (project-am-macro obj))
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 3166279de4..adb4705620 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -186,13 +186,13 @@ during a flush when the cache is given a new value of
nil.")
"State of the current parse tree.")
(defmacro semantic-parse-tree-unparseable ()
- "Indicate that the current buffer is unparseable.
+ "Indicate that the current buffer is unparsable.
It is also true that the parse tree will need either updating or
a rebuild. This state will be changed when the user edits the buffer."
'(setq semantic-parse-tree-state 'unparseable))
(defmacro semantic-parse-tree-unparseable-p ()
- "Return non-nil if the current buffer has been marked unparseable."
+ "Return non-nil if the current buffer has been marked unparsable."
'(eq semantic-parse-tree-state 'unparseable))
(defmacro semantic-parse-tree-set-needs-update ()
@@ -528,14 +528,14 @@ If the buffer cache is out of date, attempt an
incremental reparse.
If the buffer has not been parsed before, or if the incremental reparse
fails, then parse the entire buffer.
If a lexical error had been previously discovered and the buffer
-was marked unparseable, then do nothing, and return the cache."
+was marked unparsable, then do nothing, and return the cache."
(and
;; Is this a semantic enabled buffer?
(semantic-active-p)
;; Application hooks say the buffer is safe for parsing
(run-hook-with-args-until-failure
'semantic--before-fetch-tags-hook)
- ;; If the buffer was previously marked unparseable,
+ ;; If the buffer was previously marked unparsable,
;; then don't waste our time.
(not (semantic-parse-tree-unparseable-p))
;; The parse tree actually needs to be refreshed
@@ -606,7 +606,7 @@ Does nothing if the current buffer doesn't need reparsing."
;; do them here, then all the bovination hooks are not run, and
;; we save lots of time.
(cond
- ;; If the buffer was previously marked unparseable,
+ ;; If the buffer was previously marked unparsable,
;; then don't waste our time.
((semantic-parse-tree-unparseable-p)
nil)
diff --git a/lisp/cedet/semantic/analyze/fcn.el
b/lisp/cedet/semantic/analyze/fcn.el
index 7f60162115..ef372b5d8b 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -67,12 +67,12 @@ Return the string representing the compound name.")
"For a SEQUENCE of tags, all with good names, pick the best one.
If SEQUENCE is made up of namespaces, merge the namespaces together.
If SEQUENCE has several prototypes, find the non-prototype.
-If SEQUENCE has some items w/ no type information, find the one with a type.
+If SEQUENCE has some items with no type information, find the one with a type.
If SEQUENCE is all prototypes, or has no prototypes, get the first one.
Optional TAGCLASS indicates to restrict the return to only
tags of TAGCLASS."
- ;; If there is a srew up and we get just one tag.. massage over it.
+ ;; If there is a screw up and we get just one tag.. massage over it.
(when (semantic-tag-p sequence)
(setq sequence (list sequence)))
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index d4ce20589e..5e08413a96 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1344,7 +1344,7 @@ Optional argument STAR and REF indicate the number of *
and & in the typedef."
:reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
;; A function post-const is funky. Try stuff
:methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
- ;; prototypes are functions w/ no body
+ ;; prototypes are functions with no body
:prototype-flag (if (nth 8 tokenpart) t)
;; Pure virtual
:pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
@@ -2015,7 +2015,7 @@ have to be wrapped in that namespace."
(setq txt (concat txt (format "%S" arg)))
(setq sv (cdr sv)))
- ;; This is optional, and potentially fraught w/ errors.
+ ;; This is optional, and potentially fraught with errors.
(condition-case nil
(dolist (lt sv)
(setq txt (concat txt " " (semantic-lex-token-text lt))))
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index dc270603a0..00fe081acb 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -667,7 +667,7 @@ Similar to `minibuffer-contents' when completing in the
minibuffer."
)
(delete-overlay semantic-complete-inline-overlay)
(setq semantic-complete-inline-overlay nil)
- ;; DONT restore the window configuration if we just
+ ;; DON'T restore the window configuration if we just
;; switched windows!
(when (eq buf (current-buffer))
(set-window-configuration wc))
diff --git a/lisp/cedet/semantic/db-ebrowse.el
b/lisp/cedet/semantic/db-ebrowse.el
index f0e1d9f029..fa608c7c46 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -275,7 +275,7 @@ For instance:
/home/<username>/.semanticdb/!usr!include!BROWSE"
(let ((ans nil)
(efcn (symbol-function 'ebrowse-show-progress)))
(fset 'ebrowse-show-progress (lambda (&rest _junk) nil))
- (unwind-protect ;; Protect against errors w/ ebrowse
+ (unwind-protect ; Protect against errors with ebrowse
(setq ans (list B (ebrowse-read)))
;; These items must always happen
(erase-buffer)
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 3012af41c5..e9d5aaa177 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1277,7 +1277,7 @@ associated with that tag should be loaded into a buffer."
;;; Specialty Search Routines
(defun semanticdb-find-tags-external-children-of-type
(type &optional path find-file-match)
- "Search for all tags defined outside of TYPE w/ TYPE as a parent.
+ "Search for all tags defined outside of TYPE with TYPE as a parent.
See `semanticdb-find-translate-path' for details on PATH.
FIND-FILE-MATCH indicates that any time a match is found, the file
associated with that tag should be loaded into a buffer."
diff --git a/lisp/cedet/semantic/decorate/include.el
b/lisp/cedet/semantic/decorate/include.el
index 144e2ce018..fe510c371e 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -330,7 +330,7 @@ This mode provides a nice context menu on the include
statements."
)
))
- ;; @TODO - if not a tag w/ a position, we need to get one. How?
+ ;; @TODO - if not a tag with a position, we need to get one. How?
(when (semantic-tag-with-position-p tag)
(let ((ol (semantic-decorate-tag tag
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 4efc283520..d752ecdf38 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -40,7 +40,7 @@
;; of themselves that can be edited w/out affecting the definition of
;; that tag.
;;
-;; 2. Tags w/ positioned children could have a property of an
+;; 2. Tags with positioned children could have a property of an
;; overlay marking the region in themselves that contain the
;; children. This could be used to better improve splicing near
;; the beginning and end of the child lists.
diff --git a/lisp/cedet/semantic/grm-wy-boot.el
b/lisp/cedet/semantic/grm-wy-boot.el
index 376fab89c2..7fff36a3d0 100644
--- a/lisp/cedet/semantic/grm-wy-boot.el
+++ b/lisp/cedet/semantic/grm-wy-boot.el
@@ -396,12 +396,12 @@
(let
((s $1))
(if
- (string-match "^{[
\n ]*" s)
+ (string-match "^{[\^M\n ]*" s)
(setq s
(substring s
(match-end 0))))
(if
- (string-match "[
\n ]*}$" s)
+ (string-match "[\^M\n ]*}$" s)
(setq s
(substring s 0
(match-beginning 0))))
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 2d6f26919d..e53dd9104a 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -396,7 +396,7 @@ Uses `semantic-idle-work-for-on-buffer' to do the work."
(semanticdb-save-all-db-idle)
)
- ;; Done w/ processing
+ ;; Done with processing
nil))))
;; Done
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 83e7ed66c1..45964a1a17 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -577,7 +577,7 @@ such as `public' or `private'."
(if (semantic-tag-file-name TAG)
;; If it has a filename, just go with it...
(setq copyslots (cons TAG copyslots))
- ;; Otherwise, copy the tag w/ the guessed filename.
+ ;; Otherwise, copy the tag with the guessed filename.
(setq copyslots (cons (semantic-tag-copy TAG nil fname)
copyslots)))
)
@@ -822,7 +822,7 @@ hits in order, with the first tag being in the closest
scope."
ans)
;; Not a real scope. Our scope calculation analyze parts of
;; what it finds, and needs to pass lists through to do it's work.
- ;; Tread that list as a singly entry.
+ ;; Treat that list as a singly entry.
(if class
(semantic-find-tags-by-class class scope)
scope)
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/cedet/semantic/symref/list.el
b/lisp/cedet/semantic/symref/list.el
index eacbb6f1f8..1cb5d5b04a 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -51,7 +51,7 @@ Display the references in `semantic-symref-results-mode'."
(let ((ct (semantic-current-tag)))
;; Must have a tag...
(when (not ct) (error "Place cursor inside tag to be searched for"))
- ;; Check w/ user.
+ ;; Check with user.
(when (not (y-or-n-p (format "Find references for %s? "
(semantic-tag-name ct))))
(error "Quit"))
@@ -378,7 +378,8 @@ BUTTON is the button that was clicked."
(defun semantic-symref-list-on-hit-p ()
"Return the line number if the cursor is on a buffer line with a hit.
-Hits are the line of code from the buffer, not the tag summar or file lines."
+Hits are the line of code from the buffer, not the tag summary or
+file lines."
(save-excursion
(end-of-line)
(let* ((ol (car (overlays-at (1- (point)))))) ;; trust this for now
diff --git a/lisp/cedet/semantic/util-modes.el
b/lisp/cedet/semantic/util-modes.el
index 96d1de5a26..bcded23aec 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -133,7 +133,7 @@ symbol whose value is such a string."
semantic-minor-mode-alist))))
(semantic-mode-line-update)
- ;; Semantic minor modes don't work w/ Desktop restore.
+ ;; Semantic minor modes don't work with Desktop restore.
;; This line will disable this minor mode from being restored
;; by Desktop.
(when (boundp 'desktop-minor-mode-handlers)
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index a25d1441f1..c264ebaa70 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -29,7 +29,8 @@
;;
;;; Origins:
;;
-;; Document was first written w/ cparse, a custom regexp based c parser.
+;; Document was first written with cparse, a custom regexp based c
+;; parser.
;;
;; Document was then ported to cedet/semantic using sformat (super
;; format) as the templating engine.
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index 7d4539dcb4..f218f1c6e9 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -219,7 +219,7 @@ Return nil if nothing was extracted."
;; With a name, do the insertion.
(let ((subdict (srecode-dictionary-add-section-dictionary
dict (oref ins object-name))))
- (error "Need to implement include w/ name extractor")
+ (error "Need to implement include with name extractor")
;; Recurse into the new template while no errors.
(while (condition-case nil
(progn
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index ea7fda004e..c5ceb89d2d 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -43,8 +43,8 @@
;;; The SEMANTIC TAG inserter
;;
-;; Put a tag into the dictionary that can be used w/ arbitrary
-;; lisp expressions.
+;; Put a tag into the dictionary that can be used with arbitrary
+;; Lisp expressions.
(defclass srecode-semantic-tag (srecode-dictionary-compound-value)
((prime :initarg :prime
diff --git a/lisp/comint.el b/lisp/comint.el
index 07ced8d321..93b97cb22b 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -604,6 +604,14 @@ via PTYs.")
menu-bar-final-items))
map))
+(defvar-keymap comint-repeat-map
+ :doc "Keymap to repeat comint key sequences. Used in `repeat-mode'."
+ "C-n" #'comint-next-prompt
+ "C-p" #'comint-previous-prompt)
+
+(put #'comint-next-prompt 'repeat-map 'comint-repeat-map)
+(put #'comint-previous-prompt 'repeat-map 'comint-repeat-map)
+
;; Fixme: Is this still relevant?
(defvar comint-ptyp t
"Non-nil if communications via pty; false if by pipe. Buffer local.
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 209e270942..81e62f88cf 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1541,7 +1541,7 @@ BEG..END is the line where the file info is located."
(when (< alt-col other-col)
(setq other-col alt-col)
(setq other (point)))))
- ;; Keep positions uptodate when we insert stuff.
+ ;; Keep positions up-to-date when we insert stuff.
(if (> other file) (setq other (copy-marker other)))
(setq file (copy-marker file))
;; Main loop.
@@ -3028,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/dnd.el b/lisp/dnd.el
index b2e93a63de..7708695346 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -325,7 +325,7 @@ in that list instead."
(defun dnd-begin-text-drag (text &optional frame action allow-same-frame)
"Begin dragging TEXT from FRAME.
-Initate a drag-and-drop operation allowing the user to drag text
+Initiate a drag-and-drop operation allowing the user to drag text
from Emacs to another program (the drop target), then block until
the drop is completed or is canceled.
@@ -381,7 +381,7 @@ currently being held down. It should only be called upon a
(defun dnd-begin-file-drag (file &optional frame action allow-same-frame)
"Begin dragging FILE from FRAME.
-Initate a drag-and-drop operation allowing the user to drag a file
+Initiate a drag-and-drop operation allowing the user to drag a file
from Emacs to another program (the drop target), then block until
the drop happens or is canceled.
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 8ac9a1e9e6..ee6d1ceb35 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -51,19 +51,11 @@ the current form for the frame (i.e. hinting or somesuch
changed)."
;; Set the font on all current and future frames, as though
;; the `default' face had been "set for this session":
(set-frame-font new-font nil frame-list)
- ;; Just redraw the existing fonts on all frames:
- (dolist (f frame-list)
- (let ((frame-font
- (or (font-get (face-attribute 'default :font f 'default)
- :user-spec)
- (frame-parameter f 'font-parameter))))
- (when frame-font
- (set-frame-parameter f 'font-parameter frame-font)
- (set-face-attribute 'default f
- :width 'normal
- :weight 'normal
- :slant 'normal
- :font frame-font))))))))
+ ;; Just reconsider the existing fonts on all frames on each
+ ;; display, by clearing the font and face caches. This will
+ ;; cause all fonts to be recreated.
+ (dolist (frame frame-list)
+ (reconsider-frame-fonts frame))))))
(defun dynamic-setting-handle-config-changed-event (event)
"Handle config-changed-event on the display in EVENT.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9f29ffbb8e..f176e769bf 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,22 @@ 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))))
+ ;; Directory is requested to be ignored
+ (not (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)
@@ -3626,7 +3637,7 @@ lambda-expression."
(byte-compile-out base-op tmp)))
(defun byte-compile-dynamic-variable-bind (var)
- "Generate code to bind the lexical variable VAR to the top-of-stack value."
+ "Generate code to bind the dynamic variable VAR to the top-of-stack value."
(byte-compile-check-variable var 'let-bind)
(push var byte-compile-bound-variables)
(byte-compile-dynamic-variable-op 'byte-varbind var))
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 3f9bc28e0b..3bddb93b64 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -2265,8 +2265,8 @@ buffer, otherwise stop after the first error."
(unless (and sym (or (boundp sym) (fboundp sym)))
;; Find out how we spell-check this word.
(unless (or
- ;; All caps w/ option th, or s tacked on the end
- ;; for pluralization or number.
+ ;; All caps with option th, or s tacked on the
+ ;; end for pluralization or number.
(string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word)
(looking-at "}") ; a keymap expression
)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index beafee1d63..43a2ed9205 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -656,6 +656,8 @@ its argument list allows full Common Lisp conventions."
(check `(while ,var
(cond
((memq (car ,var) ',(append keys allow))
+ (unless (cdr ,var)
+ (error "Missing argument for %s" (car ,var)))
(setq ,var (cdr (cdr ,var))))
((car (cdr (memq (quote ,@allow) ,restarg)))
(setq ,var nil))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 863e895efd..0ee094c34d 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2823,7 +2823,7 @@ blocks."
(first-processed (l)
(if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l)))
p
- (signal 'native-ice "cant't find first preprocessed"))))
+ (signal 'native-ice "can't find first preprocessed"))))
(when-let ((blocks (comp-func-blocks comp-func))
(entry (gethash 'entry blocks))
@@ -4358,6 +4358,6 @@ of (commands) to run simultaneously."
(provide 'comp)
-;; LocalWords: limplified limplified limplification limplify Limple LIMPLE
libgccjit elc eln
+;; LocalWords: limplified limplification limplify Limple LIMPLE libgccjit elc
eln
;;; comp.el ends here
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 047b0069bb..c25ade22d6 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -208,7 +208,7 @@ is run. If a macro (possibly with side effects) is to be
tested,
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.
+in batch mode, an error is signaled.
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
[:tags \\='(TAG...)] BODY...)"
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index fb5d518b22..d955019a9d 100644
--- a/lisp/emacs-lisp/hierarchy.el
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -191,7 +191,7 @@ PARENTFN, CHILDRENFN, ACCEPTFN, and DELAY-CHILDREN-P have
the same meaning as in
(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
"Add to HIERARCHY the sub-lists in LIST.
-If WRAP is non-nil, allow duplicate items in LIST by wraping each
+If WRAP is non-nil, allow duplicate items in LIST by wrapping each
item in a cons (id . item). The root's id is 1.
CHILDRENFN is a function (defaults to `cdr') taking LIST as a
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..6dc47000fa
--- /dev/null
+++ b/lisp/emacs-lisp/package-vc.el
@@ -0,0 +1,791 @@
+;;; 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.
+;;
+;; - Add a heuristic for guessing a `:lisp-dir' when cloning directly
+;; from a URL.
+
+;;; 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)
+
+(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-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
+
+;;;###autoload
+(defun package-vc-install-selected-packages ()
+ "Ensure packages specified in `package-vc-selected-packages' are installed."
+ (interactive)
+ (pcase-dolist (`(,name . ,spec) package-vc-selected-packages)
+ (when (stringp name)
+ (setq name (intern name)))
+ (let ((pkg-descs (assoc name package-alist #'string=)))
+ (unless (seq-some #'package-vc-p (cdr pkg-descs))
+ (cond
+ ((null spec)
+ (package-vc-install name))
+ ((stringp spec)
+ (package-vc-install name nil spec))
+ ((listp spec)
+ (package-vc--archives-initialize)
+ (package-vc--unpack (cadr pkg-descs) 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, describing a package specification. Valid
+ key/value pairs 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 keys are ignored.
+
+This user option differs from `package-selected-packages' in that
+it is meant to be specified manually. If you want to install all
+the packages in the list, you cal also use
+`package-vc-install-selected-packages'.
+
+Note that this option will not override an existing source
+package installation or revert the checked out revision."
+ :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)))))
+ :initialize #'custom-initialize-default
+ :set (lambda (sym val)
+ (custom-set-default sym val)
+ (package-vc-install-selected-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 as
+specified in `package-vc-selected-packages'.")
+
+(defvar package-vc--archive-data-alist nil
+ "List of package specification metadata for archives.
+Each element of the list has the form (ARCHIVE . PLIST), where
+PLIST keys are one of:
+
+ `:version' (integer)
+ Indicates the version of the file formatting, to be compared
+ with `package-vc--elpa-packages-version'.
+
+ `:vc-backend' (symbol)
+ A symbol of the default VC backend to use if a package specification
+ does not indicate a backend. The value ought to be a member of
+ `vc-handled-backends'. If omitted, `vc-clone' will fall back on
+ `package-vc-default-backend'.
+
+All other values are ignored.")
+
+(defun package-vc--desc->spec (pkg-desc &optional name)
+ "Retrieve the package specification for PKG-DESC.
+The optional argument NAME can be used to override the default
+name for PKG-DESC."
+ (alist-get
+ (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)
+ (apply #'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)
+
+(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)
+ "Return the version number for the source 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))
+ (name (symbol-name (package-desc-name pkg-desc))))
+ (or (plist-get pkg-spec :main-file)
+ (expand-file-name
+ (concat name ".el")
+ (file-name-concat
+ (or (package-desc-dir pkg-desc)
+ (expand-file-name name 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 for package PKG-DESC from documentation source in FILE.
+FILE can be an Org file, indicated by its \".org\" extension,
+otherwise it's assumed to be an Info file."
+ (let* ((pkg-name (package-desc-name pkg-desc))
+ (default-directory (package-desc-dir pkg-desc))
+ (output (expand-file-name (format "%s.info" pkg-name)))
+ clean-up)
+ (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)
+ (setq clean-up t)))
+ (with-current-buffer (get-buffer-create " *package-vc doc*")
+ (erase-buffer)
+ (cond
+ ((/= 0 (call-process "makeinfo" nil t nil
+ "--no-split" file "-o" output))
+ (message "Failed to build manual %s, see buffer %S"
+ file (buffer-name)))
+ ((/= 0 (call-process "install-info" nil t nil
+ output (expand-file-name "dir")))
+ (message "Failed to install manual %s, see buffer %S"
+ output (buffer-name)))
+ ((kill-buffer))))
+ (when clean-up
+ (delete-file file))))
+
+(defun package-vc--unpack-1 (pkg-desc pkg-dir)
+ "Prepare PKG-DESC that is already checked-out in PKG-DIR.
+This includes downloading missing dependencies, generating
+autoloads, generating a package description file (used to
+identify a package as a source package later on), building
+documentation and marking the package as installed."
+ ;; Remove any previous instance of PKG-DESC from `package-alist'
+ (let ((pkgs (assq (package-desc-name pkg-desc) package-alist)))
+ (when pkgs
+ (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs)))))
+
+ ;; 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))
+ (pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
+ ;; Generate autoloads
+ (let* ((name (package-desc-name pkg-desc))
+ (auto-name (format "%s-autoloads.el" name))
+ (extras (package-desc-extras pkg-desc))
+ (lisp-dir (alist-get :lisp-dir extras)))
+ (package-generate-autoloads
+ name (file-name-concat pkg-dir lisp-dir))
+ (when lisp-dir
+ (write-region
+ (with-temp-buffer
+ (insert ";; Autoload indirection for package-vc\n\n")
+ (prin1 `(load (expand-file-name
+ ,(file-name-concat lisp-dir auto-name)
+ (or (and load-file-name
+ (file-name-directory load-file-name))
+ (car load-path))))
+ (current-buffer))
+ (buffer-string))
+ nil (expand-file-name auto-name pkg-dir))))
+
+ ;; Generate package file
+ (package-vc--generate-description-file pkg-desc pkg-file)
+
+ ;; 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 :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)))
+ (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)
+ (error "There already exists a checkout for %s" name)))
+ (package-vc--clone pkg-desc pkg-spec pkg-dir rev)
+
+ (when lisp-dir
+ (push (cons :lisp-dir lisp-dir)
+ (package-desc-extras pkg-desc)))
+ (package-vc--unpack-1 pkg-desc pkg-dir)))
+
+(defun package-vc--read-package-name (prompt &optional allow-url installed)
+ "Query the user for a source package and return a name with PROMPT.
+If the optional argument ALLOW-URL is non-nil, the user is also
+allowed to specify a non-package name. If the optional argument
+INSTALLED is non-nil, the selection will be filtered down to
+source packages that have already been installed."
+ (package-vc--archives-initialize)
+ (completing-read prompt (if installed package-alist package-archive-contents)
+ (if installed
+ (lambda (pkg) (package-vc-p (cadr pkg)))
+ (lambda (pkg)
+ (or (package-vc--desc->spec (cadr pkg))
+ ;; If we have no explicit VC data, we can try a
kind of
+ ;; heuristic and use the URL header, that might
already be
+ ;; pointing towards a repository, and use that as a
backup
+ (and-let* ((extras (package-desc-extras (cadr pkg)))
+ (url (alist-get :url extras))
+ ((package-vc--guess-backend url)))))))
+ (not allow-url)))
+
+(defun package-vc--read-package-desc (prompt &optional installed)
+ "Query the user for a source package and return a description with PROMPT.
+If the optional argument INSTALLED is non-nil, the selection will
+be filtered down to source packages that have already been
+installed, and the package description will be that of an
+installed package."
+ (cadr (assoc (package-vc--read-package-name prompt nil installed)
+ (if installed package-alist package-archive-contents)
+ #'string=)))
+
+;;;###autoload
+(defun package-vc-update-all ()
+ "Attempt to update all installed VC packages."
+ (interactive)
+ (dolist (package package-alist)
+ (dolist (pkg-desc (cdr package))
+ (when (package-vc-p pkg-desc)
+ (package-vc-update pkg-desc))))
+ (message "Done updating packages."))
+
+;;;###autoload
+(defun package-vc-update (pkg-desc)
+ "Attempt to update the package PKG-DESC."
+ (interactive (list (package-vc--read-package-desc "Update source package: "
t)))
+ ;; HACK: To run `package-vc--unpack-1' after checking out the new
+ ;; revision, we insert a hook into `vc-post-command-functions', and
+ ;; remove it right after it ran. To avoid running the hook multiple
+ ;; times or even for the wrong repository (as `vc-pull' is often
+ ;; asynchronous), we extract the relevant arguments using a pseudo
+ ;; filter for `vc-filter-command-function', executed only for the
+ ;; side effect, and store them in the lexical scope. When the hook
+ ;; is run, we check if the arguments are the same (`eq') as the ones
+ ;; previously extracted, and only in that case will be call
+ ;; `package-vc--unpack-1'. Ugh...
+ ;;
+ ;; If there is a better way to do this, it should be done.
+ (cl-assert (package-vc-p pkg-desc))
+ (letrec ((pkg-dir (package-desc-dir pkg-desc))
+ (vc-flags)
+ (vc-filter-command-function
+ (lambda (command file-or-list flags)
+ (setq vc-flags flags)
+ (list command file-or-list flags)))
+ (post-upgrade
+ (lambda (_command _file-or-list flags)
+ (when (and (file-equal-p pkg-dir default-directory)
+ (eq flags vc-flags))
+ (unwind-protect
+ (with-demoted-errors "Failed to activate: %S"
+ (package-vc--unpack-1 pkg-desc pkg-dir))
+ (remove-hook 'vc-post-command-functions post-upgrade))))))
+ (add-hook 'vc-post-command-functions post-upgrade)
+ (with-demoted-errors "Failed to fetch: %S"
+ (let ((default-directory pkg-dir))
+ (vc-pull)))))
+
+(defun package-vc--archives-initialize ()
+ "Initialize package.el and fetch package specifications."
+ (package--archives-initialize)
+ (unless package-vc--archive-data-alist
+ (package-vc--download-and-read-archives)))
+
+(defun package-vc--release-rev (pkg-desc)
+ "Return the latest revision that bumps the \"Version\" tag for PKG-DESC.
+If no such revision can be found, return nil."
+ (with-current-buffer (find-file-noselect (package-vc--main-file pkg-desc))
+ (vc-buffer-sync)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (cond
+ ((re-search-forward
+ (concat (lm-get-header-re "package-version") ".*$")
+ (lm-code-start) t))
+ ((re-search-forward
+ (concat (lm-get-header-re "version") ".*$")
+ (lm-code-start) t)))
+ (ignore-error vc-not-supported
+ (vc-call-backend (vc-backend (buffer-file-name))
+ 'last-change
+ (buffer-file-name)
+ (line-number-at-pos nil t))))))))
+
+;;;###autoload
+(defun package-vc-install (package &optional name rev backend)
+ "Fetch a PACKAGE and set it up for using with Emacs.
+
+If PACKAGE is a string containing an URL, download the package
+from the repository at that URL; the function will try to guess
+the name of the package from the URL. This can be overridden by
+passing the optional argument NAME. If PACKAGE is a cons-cell,
+it should have the form (NAME . SPEC), where NAME is a symbol
+indicating the package name and SPEC is a plist as described in
+`package-vc-selected-packages'. Otherwise PACKAGE 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.
+
+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-heuristic-alist' to guess the backend.
+Note that by default, a source package will be prioritized over a
+regular package, but it will not remove a source package."
+ (interactive
+ (progn
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (package-vc--archives-initialize)
+ (let* ((name-or-url (package-vc--read-package-name
+ "Fetch and install package: " t))
+ (name (file-name-base name-or-url)))
+ (list name-or-url (intern (string-remove-prefix "emacs-" name))
+ (and current-prefix-arg :last-release)))))
+ (package-vc--archives-initialize)
+ (cond
+ ((null package)
+ (signal 'wrong-type-argument nil))
+ ((consp package)
+ (package-vc--unpack
+ (package-desc-create :name (car package)
+ :kind 'vc)
+ (cdr package)
+ rev))
+ ((and-let* (((stringp package))
+ (backend (or backend (package-vc--guess-backend package))))
+ (package-vc--unpack
+ (package-desc-create
+ :name (or name (intern (file-name-base package)))
+ :kind 'vc)
+ (list :vc-backend backend :url package)
+ rev)))
+ ((and-let* ((desc (assoc package package-archive-contents #'string=)))
+ (package-vc--unpack
+ (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 `%s' has no VC data" package))
+ rev)))
+ ((user-error "Unknown package to fetch: %s" package))))
+
+;;;###autoload
+(defun package-vc-checkout (pkg-desc directory &optional rev)
+ "Clone the sources for PKG-DESC into DIRECTORY and visit that directory.
+Unlike `package-vc-install', this does not yet set up the package
+for use with Emacs; use `package-vc-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
+ (let* ((name (package-vc--read-package-name "Fetch package source: ")))
+ (list (cadr (assoc name 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 `%s' has no VC data"
+ (package-desc-name pkg-desc)))))
+ (package-vc--clone pkg-desc pkg-spec directory rev)
+ (find-file directory)))
+
+;;;###autoload
+(defun package-vc-install-from-checkout (dir 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 (expand-file-name dir) pkg-dir)
+ (package-vc--unpack-1
+ (package-desc-create
+ :name (intern name)
+ :kind 'vc)
+ (file-name-as-directory pkg-dir))))
+
+;;;###autoload
+(defun package-vc-rebuild (pkg-desc)
+ "Rebuild the installation for package given by PKG-DESC.
+Rebuilding an installation means scraping for new autoload
+cookies, re-compiling Emacs Lisp files, building and installing
+any documentation, downloading any missing dependencies. This
+command does not fetch new revisions from a remote server. That
+is the responsibility of `package-vc-update'. Interactively,
+prompt for the name of the package to rebuild."
+ (interactive (list (package-vc--read-package-desc "Rebuild package: " t)))
+ (package-vc--unpack-1 pkg-desc (package-desc-dir pkg-desc)))
+
+;;;###autoload
+(defun package-vc-prepare-patch (pkg-desc subject revisions)
+ "Send patch for REVISIONS to maintainer of the package PKG using SUBJECT.
+The function uses `vc-prepare-patch', passing SUBJECT and
+REVISIONS directly. PKG-DESC must be a package description.
+Interactively, prompt for PKG-DESC, SUBJECT, and REVISIONS. When
+invoked with a numerical prefix argument, use the last N
+revisions. When invoked interactively in a Log View buffer with
+marked revisions, use those."
+ (interactive
+ (list (package-vc--read-package-desc "Package to prepare a patch for: " t)
+ (and (not vc-prepare-patches-separately)
+ (read-string "Subject: " "[PATCH] " nil nil t))
+ (vc-prepare-patch-prompt-revisions)))
+ (let ((default-directory (package-desc-dir pkg-desc)))
+ (vc-prepare-patch (package-maintainers pkg-desc t)
+ subject revisions)))
+
+(provide 'package-vc)
+;;; package-vc.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index f3077cbbdb..c1545a2870 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))
@@ -1048,10 +1090,15 @@ untar into a directory named DIR; otherwise, signal an
error."
(backup-inhibited t)
(version-control 'never))
(loaddefs-generate
- pkg-dir output-file
- nil
- "(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))")
+ pkg-dir output-file nil
+ (prin1-to-string
+ '(add-to-list
+ 'load-path
+ ;; Add the directory that will contain the autoload file to
+ ;; the load path. We don't hard-code `pkg-dir', to avoid
+ ;; issues if the package directory is moved around.
+ (or (and load-file-name (file-name-directory load-file-name))
+ (car load-path)))))
(let ((buf (find-buffer-visiting output-file)))
(when buf (kill-buffer buf)))
auto-name))
@@ -1068,11 +1115,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)))
@@ -1314,10 +1363,7 @@ is non-nil, don't propagate connection errors (does not
apply to
errors signaled by ERROR-FORM or by BODY).
\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)"
- (declare (indent defun)
- ;; FIXME: This should be something like
- ;; `form def-body &rest form', but that doesn't work.
- (debug (form &rest sexp)))
+ (declare (indent defun) (debug (sexp body)))
(while (keywordp (car body))
(setq body (cdr (cdr body))))
`(package--with-response-buffer-1 ,url (lambda () ,@body)
@@ -1601,13 +1647,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 +1785,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'.
+ (when async
+ (cl-pushnew (cons archive file) package--downloads-in-progress
+ :test #'equal))
(package--with-response-buffer (cdr archive) :file file
:async async
- :error-form (package--update-downloads-in-progress archive)
+ :error-form (package--update-downloads-in-progress (cons archive file))
(let* ((location (cdr archive))
(name (car archive))
(content (buffer-string))
@@ -1748,10 +1805,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 +1821,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 +1829,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 +1858,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 +2092,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 +2232,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 +2257,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 +2420,19 @@ installed), maybe you need to
\\[package-refresh-contents]")
pkg))
(declare-function comp-el-to-eln-filename "comp.c")
+(defvar package-vc-repository-store)
(defun package--delete-directory (dir)
- "Delete DIR recursively.
+ "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 (file-symlink-p (directory-file-name dir))
+ (delete-file (directory-file-name dir))
+ (delete-directory dir t)))
+
(defun package-delete (pkg-desc &optional force nosave)
"Delete package PKG-DESC.
@@ -2630,7 +2697,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 +2899,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 +2997,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 +3156,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 +3245,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 +3449,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 +3491,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 +3503,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 +3585,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 +3941,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 +4236,7 @@ packages."
"held"
"incompat"
"installed"
+ "source"
"new"
"unsigned")))
package-menu-mode)
@@ -4213,22 +4308,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 +4505,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 +4529,56 @@ 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))))
+(declare-function ietf-drums-parse-address "ietf-drums"
+ (string &optional decode))
+
+(defun package-maintainers (pkg-desc &optional no-error)
+ "Return an email address for the maintainers of PKG-DESC.
+The email address may contain commas, if there are multiple
+maintainers. If no maintainers are found, an error will be
+signaled. If the optional argument NO-ERROR is non-nil no error
+will be signaled in that case."
+ (unless (package-desc-p pkg-desc)
+ (error "Invalid package description: %S" pkg-desc))
+ (let* ((name (package-desc-name pkg-desc))
+ (extras (package-desc-extras pkg-desc))
+ (maint (alist-get :maintainer extras)))
+ (cond
+ ((and (null maint) (null no-error))
+ (user-error "Package `%s' has no explicit maintainer" name))
+ ((and (not (progn
+ (require 'ietf-drums)
+ (ietf-drums-parse-address maint)))
+ (null no-error))
+ (user-error "Package `%s' has no maintainer address" name))
+ ((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/rmc.el b/lisp/emacs-lisp/rmc.el
index dae6590b9b..1083a6868b 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -125,7 +125,7 @@
;;;###autoload
(defun read-multiple-choice (prompt choices &optional help-string show-help
long-form)
- "Ask user to select an entry from CHOICES, promting with PROMPT.
+ "Ask user to select an entry from CHOICES, prompting with PROMPT.
This function allows to ask the user a multiple-choice question.
CHOICES should be a list of the form (KEY NAME [DESCRIPTION]).
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 82ade0ac0c..1645da2eb0 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -63,8 +63,7 @@
;; preloaded. See also Bug#39761#26.
(defmacro seq-doseq (spec &rest body)
- "Loop over a sequence.
-Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
+ "Loop over a SEQUENCE, evaluating BODY with VAR bound to each of its
elements.
Similar to `dolist' but can be applied to lists, strings, and vectors.
@@ -95,7 +94,7 @@ name to be bound to the rest of SEQUENCE."
,@body))
(defmacro seq-setq (args sequence)
- "Assign to the variables in ARGS the elements of SEQUENCE.
+ "Assign the elements of SEQUENCE to the variables in ARGS.
ARGS can also include the `&rest' marker followed by a variable
name to be bound to the rest of SEQUENCE."
@@ -105,7 +104,7 @@ name to be bound to the rest of SEQUENCE."
;;; Basic seq functions that have to be implemented by new sequence types
(cl-defgeneric seq-elt (sequence n)
- "Return Nth element of SEQUENCE."
+ "Return the Nth element of SEQUENCE."
(elt sequence n))
;; Default gv setters for `seq-elt'.
@@ -118,7 +117,7 @@ name to be bound to the rest of SEQUENCE."
(setcar (nthcdr n sequence) store))
(cl-defgeneric seq-length (sequence)
- "Return the number of elements of SEQUENCE."
+ "Return the number of elements in SEQUENCE."
(length sequence))
(defun seq-first (sequence)
@@ -126,11 +125,12 @@ name to be bound to the rest of SEQUENCE."
(seq-elt sequence 0))
(defun seq-rest (sequence)
- "Return a sequence of the elements of SEQUENCE except the first one."
+ "Return SEQUENCE with its first element removed."
(seq-drop sequence 1))
(cl-defgeneric seq-do (function sequence)
- "Apply FUNCTION to each element of SEQUENCE, presumably for side effects.
+ "Apply FUNCTION to each element of SEQUENCE.
+Presumably, FUNCTION has useful side effects.
Return SEQUENCE."
(mapc function sequence))
@@ -216,8 +216,9 @@ the sequence, and its index within the sequence."
(mapcar function sequence))
(cl-defgeneric seq-mapn (function sequence &rest sequences)
- "Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
-The arity of FUNCTION must match the number of SEQUENCES, and the
+ "Return the result of applying FUNCTION to each element of SEQUENCEs.
+Like `seq-map', but FUNCTION is mapped over all SEQUENCEs.
+The arity of FUNCTION must match the number of SEQUENCEs, and the
mapping stops on the shortest sequence.
Return a list of the results.
@@ -232,7 +233,7 @@ Return a list of the results.
(nreverse result)))
(cl-defgeneric seq-drop (sequence n)
- "Remove the first N elements of SEQUENCE and return the result.
+ "Remove the first N elements of SEQUENCE and return the resulting sequence.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, SEQUENCE is returned."
@@ -243,7 +244,7 @@ If N is a negative integer or zero, SEQUENCE is returned."
;;;###autoload
(cl-defgeneric seq-take (sequence n)
- "Take the first N elements of SEQUENCE and return the result.
+ "Return the sequence made of the first N elements of SEQUENCE.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, an empty sequence is
@@ -252,14 +253,17 @@ returned."
(cl-defgeneric seq-drop-while (pred sequence)
"Remove the successive elements of SEQUENCE for which PRED returns non-nil.
-PRED is a function of one argument. The result is a sequence of
-the same type as SEQUENCE."
+PRED is a function of one argument. The function keeps removing
+elements from SEQUENCE until PRED returns nil for an element.
+Value is a sequence of the same type as SEQUENCE."
(seq-drop sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-take-while (pred sequence)
"Take the successive elements of SEQUENCE for which PRED returns non-nil.
-PRED is a function of one argument. The result is a sequence of
-the same type as SEQUENCE."
+PRED is a function of one argument. The function keeps collecting
+elements from SEQUENCE and adding them to the result until PRED
+returns nil for an element.
+Value is a sequence of the same type as SEQUENCE."
(seq-take sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-empty-p (sequence)
@@ -267,7 +271,7 @@ the same type as SEQUENCE."
(= 0 (seq-length sequence)))
(cl-defgeneric seq-sort (pred sequence)
- "Sort SEQUENCE using PRED as comparison function.
+ "Sort SEQUENCE using PRED as the sorting comparison function.
The result is a sequence of the same type as SEQUENCE."
(let ((result (seq-sort pred (append sequence nil))))
(seq-into result (type-of sequence))))
@@ -277,7 +281,7 @@ The result is a sequence of the same type as SEQUENCE."
;;;###autoload
(defun seq-sort-by (function pred sequence)
- "Sort SEQUENCE using PRED as a comparison function.
+ "Sort SEQUENCE transformed by FUNCTION using PRED as the comparison function.
Elements of SEQUENCE are transformed by FUNCTION before being
sorted. FUNCTION must be a function of one argument."
(seq-sort (lambda (a b)
@@ -300,7 +304,7 @@ sorted. FUNCTION must be a function of one argument."
(cl-defgeneric seq-concatenate (type &rest sequences)
"Concatenate SEQUENCES into a single sequence of type TYPE.
-TYPE must be one of following symbols: vector, string or list.
+TYPE must be one of following symbols: `vector', `string' or `list'.
\n(fn TYPE SEQUENCE...)"
(setq sequences (mapcar #'seq-into-sequence sequences))
@@ -322,8 +326,8 @@ of sequence."
(cl-defgeneric seq-into (sequence type)
"Concatenate the elements of SEQUENCE into a sequence of type TYPE.
-TYPE can be one of the following symbols: vector, string or
-list."
+TYPE can be one of the following symbols: `vector', `string' or
+`list'."
(pcase type
(`vector (seq--into-vector sequence))
(`string (seq--into-string sequence))
@@ -332,7 +336,7 @@ list."
;;;###autoload
(cl-defgeneric seq-filter (pred sequence)
- "Return a list of all elements for which (PRED element) is non-nil in
SEQUENCE."
+ "Return a list of all the elements in SEQUENCE for which PRED returns
non-nil."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall pred elt)
@@ -342,13 +346,13 @@ list."
;;;###autoload
(cl-defgeneric seq-remove (pred sequence)
- "Return a list of all the elements for which (PRED element) is nil in
SEQUENCE."
+ "Return a list of all the elements in SEQUENCE for which PRED returns nil."
(seq-filter (lambda (elt) (not (funcall pred elt)))
sequence))
;;;###autoload
(cl-defgeneric seq-remove-at-position (sequence n)
- "Return a copy of SEQUENCE where the element at N got removed.
+ "Return a copy of SEQUENCE with the element at index N removed.
N is the (zero-based) index of the element that should not be in
the result.
@@ -381,7 +385,7 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is
not called."
;;;###autoload
(cl-defgeneric seq-every-p (pred sequence)
- "Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
+ "Return non-nil if PRED returns non-nil for all the elements of SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(or (funcall pred elt)
@@ -390,8 +394,8 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is
not called."
;;;###autoload
(cl-defgeneric seq-some (pred sequence)
- "Return non-nil if PRED is satisfied for at least one element of SEQUENCE.
-If so, return the first non-nil value returned by PRED."
+ "Return non-nil if PRED returns non-nil for at least one element of SEQUENCE.
+If the value is non-nil, it is the first non-nil value returned by PRED."
(catch 'seq--break
(seq-doseq (elt sequence)
(let ((result (funcall pred elt)))
@@ -401,12 +405,12 @@ If so, return the first non-nil value returned by PRED."
;;;###autoload
(cl-defgeneric seq-find (pred sequence &optional default)
- "Return the first element for which (PRED element) is non-nil in SEQUENCE.
-If no element is found, return DEFAULT.
+ "Return the first element in SEQUENCE for which PRED returns non-nil.
+If no such element is found, return DEFAULT.
Note that `seq-find' has an ambiguity if the found element is
-identical to DEFAULT, as it cannot be known if an element was
-found or not."
+identical to DEFAULT, as in that case it is impossible to know
+whether an element was found or not."
(catch 'seq--break
(seq-doseq (elt sequence)
(when (funcall pred elt)
@@ -414,7 +418,7 @@ found or not."
default))
(cl-defgeneric seq-count (pred sequence)
- "Return the number of elements for which (PRED element) is non-nil in
SEQUENCE."
+ "Return the number of elements in SEQUENCE for which PRED returns non-nil."
(let ((count 0))
(seq-doseq (elt sequence)
(when (funcall pred elt)
@@ -422,8 +426,8 @@ found or not."
count))
(cl-defgeneric seq-contains (sequence elt &optional testfn)
- "Return the first element in SEQUENCE that is equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return the first element in SEQUENCE that is \"equal\" to ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(declare (obsolete seq-contains-p "27.1"))
(seq-some (lambda (e)
(when (funcall (or testfn #'equal) elt e)
@@ -431,8 +435,8 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
sequence))
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
- "Return non-nil if SEQUENCE contains an element equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return non-nil if SEQUENCE contains an element \"equal\" to ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(catch 'seq--break
(seq-doseq (e sequence)
(let ((r (funcall (or testfn #'equal) e elt)))
@@ -442,15 +446,16 @@ Equality is defined by the function TESTFN, which
defaults to `equal'."
(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
"Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements.
-This does not depend on the order of the elements.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+The order of the elements in the sequences is not important.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn))
sequence1)
(seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn))
sequence2)))
;;;###autoload
(cl-defgeneric seq-position (sequence elt &optional testfn)
- "Return the (zero-based) index of the first element in SEQUENCE equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return the (zero-based) index of the first element in SEQUENCE \"equal\" to
ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(let ((index 0))
(catch 'seq--break
(seq-doseq (e sequence)
@@ -461,11 +466,11 @@ Equality is defined by the function TESTFN, which
defaults to `equal'."
;;;###autoload
(cl-defgeneric seq-positions (sequence elt &optional testfn)
- "Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is non-nil.
+ "Return list of indices of SEQUENCE elements for which TESTFN returns
non-nil.
-TESTFN is a two-argument function which is passed each element of
-SEQUENCE as first argument and ELT as second. TESTFN defaults to
-`equal'.
+TESTFN is a two-argument function which is called with each element of
+SEQUENCE as the first argument and ELT as the second.
+TESTFN defaults to `equal'.
The result is a list of (zero-based) indices."
(let ((result '()))
@@ -479,7 +484,7 @@ The result is a list of (zero-based) indices."
;;;###autoload
(cl-defgeneric seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
-TESTFN is used to compare elements, or `equal' if TESTFN is nil."
+TESTFN is used to compare elements, and defaults to `equal'."
(let ((result '()))
(seq-doseq (elt sequence)
(unless (seq-contains-p result elt testfn)
@@ -514,15 +519,15 @@ TESTFN is used to compare elements, or `equal' if TESTFN
is nil."
(nreverse result)))
(cl-defgeneric seq-mapcat (function sequence &optional type)
- "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
-The result is a sequence of type TYPE, or a list if TYPE is nil."
+ "Concatenate the results of applying FUNCTION to each element of SEQUENCE.
+The result is a sequence of type TYPE; TYPE defaults to `list'."
(apply #'seq-concatenate (or type 'list)
(seq-map function sequence)))
(cl-defgeneric seq-partition (sequence n)
"Return list of elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
-negative integer or 0, nil is returned."
+negative integer or 0, the function returns nil."
(unless (< n 1)
(let ((result '()))
(while (not (seq-empty-p sequence))
@@ -532,8 +537,9 @@ negative integer or 0, nil is returned."
;;;###autoload
(cl-defgeneric seq-union (sequence1 sequence2 &optional testfn)
- "Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return a list of all the elements that appear in either SEQUENCE1 or
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(let* ((accum (lambda (acc elt)
(if (seq-contains-p acc elt testfn)
acc
@@ -544,8 +550,9 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
;;;###autoload
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
- "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return a list of all the elements that appear in both SEQUENCE1 and
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
(cons elt acc)
@@ -554,8 +561,9 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
'()))
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
- "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return list of all the elements that appear in SEQUENCE1 but not in
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
acc
@@ -591,7 +599,7 @@ SEQUENCE must be a sequence of numbers or markers."
(apply #'max (seq-into sequence 'list)))
(defun seq--count-successive (pred sequence)
- "Count successive elements for which (PRED element) is non-nil in SEQUENCE."
+ "Count successive elements in SEQUENCE for which PRED returns non-nil."
(let ((n 0)
(len (seq-length sequence)))
(while (and (< n len)
@@ -628,13 +636,13 @@ SEQUENCE must be a sequence of numbers or markers."
;; TODO: make public?
(defun seq--elt-safe (sequence n)
- "Return element of SEQUENCE at the index N.
+ "Return the element of SEQUENCE whose zero-based index is N.
If no element is found, return nil."
(ignore-errors (seq-elt sequence n)))
;;;###autoload
(cl-defgeneric seq-random-elt (sequence)
- "Return a random element from SEQUENCE.
+ "Return a randomly chosen element from SEQUENCE.
Signal an error if SEQUENCE is empty."
(if (seq-empty-p sequence)
(error "Sequence cannot be empty")
@@ -681,8 +689,8 @@ Signal an error if SEQUENCE is empty."
(concat sequence)))
(defun seq-split (sequence length)
- "Split SEQUENCE into a list of sub-sequences of at most LENGTH.
-All the sub-sequences will be of LENGTH, except the last one,
+ "Split SEQUENCE into a list of sub-sequences of at most LENGTH elements.
+All the sub-sequences will be LENGTH long, except the last one,
which may be shorter."
(when (< length 1)
(error "Sub-sequence length must be larger than zero"))
@@ -696,7 +704,7 @@ which may be shorter."
(nreverse result)))
(defun seq-keep (function sequence)
- "Apply FUNCTION to SEQUENCE and return all non-nil results."
+ "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results."
(delq nil (seq-map function sequence)))
(provide 'seq)
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index dbac03432c..8328324715 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -833,7 +833,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(seq-set-equal-p
:eval (seq-set-equal-p '(1 2 3) '(3 1 2)))
(seq-some
- :eval (seq-some #'cl-evenp '(1 2 3)))
+ :eval (seq-some #'floatp '(1 2.0 3)))
"Building Sequences"
(seq-concatenate
:eval (seq-concatenate 'vector '(1 2) '(c d)))
@@ -898,14 +898,14 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(seq-filter
:eval (seq-filter #'numberp '(a b 3 4 f 6)))
(seq-keep
- :eval (seq-keep #'cl-digit-char-p '(?6 ?a ?7)))
+ :eval (seq-keep #'car-safe '((1 2) 3 t (a . b))))
(seq-remove
:eval (seq-remove #'numberp '(1 2 c d 5)))
(seq-remove-at-position
:eval (seq-remove-at-position '(a b c d e) 3)
:eval (seq-remove-at-position [a b c d e] 0))
(seq-group-by
- :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6)))
+ :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6)))
(seq-union
:eval (seq-union '(1 2 3) '(3 5)))
(seq-difference
@@ -921,7 +921,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(seq-split
:eval (seq-split [0 1 2 3 5] 2))
(seq-take-while
- :eval (seq-take-while #'cl-evenp [2 4 9 6 5]))
+ :eval (seq-take-while #'integerp [1 2 3.0 4]))
(seq-uniq
:eval (seq-uniq '(a b d b a c))))
@@ -1374,13 +1374,20 @@ If SAME-WINDOW, don't pop to a new window."
(unless (bobp)
(insert "\n"))
(insert (propertize
- (concat (substitute-command-keys data) "\n\n")
+ (substitute-command-keys data)
+ 'face 'shortdoc-heading
+ 'shortdoc-section t
+ 'outline-level 1))
+ (insert (propertize
+ "\n\n"
'face 'shortdoc-heading
'shortdoc-section t)))
;; There may be functions not yet defined in the data.
((fboundp (car data))
(when prev
- (insert (make-separator-line)))
+ (insert (make-separator-line)
+ ;; This helps with hidden outlines (bug#53981)
+ (propertize "\n" 'face '(:height 0))))
(setq prev t)
(shortdoc--display-function data))))
(cdr (assq group shortdoc--groups))))
@@ -1397,7 +1404,7 @@ If SAME-WINDOW, don't pop to a new window."
(start-section (point))
arglist-start)
;; Function calling convention.
- (insert (propertize "(" 'shortdoc-function function))
+ (insert (propertize "(" 'shortdoc-function function 'outline-level 2))
(if (plist-get data :no-manual)
(insert-text-button
(symbol-name function)
@@ -1531,7 +1538,10 @@ Example:
(define-derived-mode shortdoc-mode special-mode "shortdoc"
"Mode for shortdoc."
- :interactive nil)
+ :interactive nil
+ (setq-local outline-search-function #'outline-search-level
+ outline-level (lambda ()
+ (get-text-property (point) 'outline-level))))
(defun shortdoc--goto-section (arg sym &optional reverse)
(unless (natnump arg)
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/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 6e4d88b4df..18087bc937 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -322,6 +322,10 @@ as the new values of the bound variables in the recursive
invocation."
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(with-current-buffer (get-buffer-create " *string-pixel-width*")
+ ;; `display-line-numbers-mode' is enabled in internal buffers
+ ;; that breaks width calculation, so need to disable (bug#59311)
+ (when (bound-and-true-p display-line-numbers-mode)
+ (display-line-numbers-mode -1))
(delete-region (point-min) (point-max))
(insert string)
(car (buffer-text-pixel-size nil nil t)))))
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index 2b1672ffd6..645b1a328f 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -569,7 +569,7 @@ spreadsheet files with invalid formatting."
(signal 'singularity-error nil)) ;Shouldn't get here
(singularity-error (error "No error from %s?" x))
(error nil)))
- ;;Test quit-handling in ses-update-cells. Cant' use `eval' here.
+ ;; Test quit-handling in ses-update-cells. Can't use `eval' here.
(let ((inhibit-quit t))
(setq quit-flag t)
(condition-case nil
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..64231f365e 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
@@ -11075,7 +11075,8 @@
stay at your current version. It seems fairly stable though.
That changed? erc-buffer-name handling was completely rewritten,
and erc-buffer-list local variable handling removed.
- Simplifies alot of code. Poke at it. read the diff. report bug/send
patches!
+ Simplifies a lot of code. Poke at it. Read the diff. Report
+ bug/send patches!
* erc.el: * Added variable listing when /set is used without args
@@ -11448,7 +11449,7 @@
2001-10-03 Mario Lang <mlang@delysid.org>
* erc.el:
- * Removed alot of (progn ...) where they were not necessary
+ * Removed a lot of (progn ...) where they were not necessary
* Changed some (if ...) without else part to (when ...)
* Some (while ...) to use (dolist ...)
* Fix for completion popup generating tracebacks.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index df9efe4b0c..15fd6ac50f 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
@@ -206,6 +299,9 @@ function `erc-server-process-alive' instead.")
(defvar-local erc--server-last-reconnect-count 0
"Snapshot of reconnect count when the connection was established.")
+(defvar-local erc--server-reconnect-timer nil
+ "Auto-reconnect timer for a network context.")
+
(defvar-local erc-server-quitting nil
"Non-nil if the user requests a quit.")
@@ -308,6 +404,16 @@ This only has an effect if `erc-server-auto-reconnect' is
non-nil."
If a key is pressed while ERC is waiting, it will stop waiting."
:type 'number)
+(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect
+ "Function called by the reconnect timer to create a new connection.
+Called with a server buffer as its only argument. Potential uses
+include exponential backoff and probing for connectivity prior to
+dialing. Use `erc-schedule-reconnect' to instead try again later
+and optionally alter the attempts tally."
+ :package-version '(ERC . "5.4.1") ; FIXME on next release
+ :type '(choice (function-item erc-server-delayed-reconnect)
+ function))
+
(defcustom erc-split-line-length 440
"The maximum length of a single message.
If a message exceeds this size, it is broken into multiple ones.
@@ -532,12 +638,18 @@ The current buffer is given by BUFFER."
(let ((p (plist-put parameters :nowait t)))
(apply #'open-network-stream name buffer host service p)))
+(defvar erc--server-connect-dumb-ipv6-regexp
+ ;; Not for validation (gives false positives).
+ (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot))
+
(defun erc-server-connect (server port buffer &optional client-certificate)
"Perform the connection and login using the specified SERVER and PORT.
We will store server variables in the buffer given by BUFFER.
CLIENT-CERTIFICATE may optionally be used to specify a TLS client
certificate to use for authentication when connecting over
TLS (see `erc-session-client-certificate' for more details)."
+ (when (string-match erc--server-connect-dumb-ipv6-regexp server)
+ (setq server (match-string 1 server)))
(let ((msg (erc-format-message 'connect ?S server ?p port)) process
(args `(,(format "erc-%s-%s" server port) nil ,server ,port)))
(when client-certificate
@@ -552,7 +664,8 @@ TLS (see `erc-session-client-certificate' for more
details)."
(setq erc-server-process process)
(setq erc-server-quitting nil)
(setq erc-server-reconnecting nil
- erc--server-reconnecting nil)
+ erc--server-reconnecting nil
+ erc--server-reconnect-timer nil)
(setq erc-server-timed-out nil)
(setq erc-server-banned nil)
(setq erc-server-error-occurred nil)
@@ -593,6 +706,7 @@ Make sure you are in an ERC buffer when running this."
(with-current-buffer buffer
(erc-update-mode-line)
(erc-set-active-buffer (current-buffer))
+ (setq erc--server-reconnecting t)
(setq erc-server-last-sent-time 0)
(setq erc-server-lines-sent 0)
(let ((erc-server-connect-function (or erc-session-connector
@@ -665,37 +779,59 @@ EVENT is the message received from the closed connection
process."
erc-server-reconnecting)
(erc--server-reconnect-p event)))
+(defconst erc--mode-line-process-reconnecting
+ '(:eval (erc-with-server-buffer
+ (and erc--server-reconnect-timer
+ (format ": reconnecting in %.1fs"
+ (- (timer-until erc--server-reconnect-timer
+ (current-time)))))))
+ "Mode-line construct showing seconds until next reconnect attempt.
+Move point around to refresh.")
+
+(defun erc--cancel-auto-reconnect-timer ()
+ (when erc--server-reconnect-timer
+ (cancel-timer erc--server-reconnect-timer)
+ (erc-display-message nil 'notice nil 'reconnect-canceled
+ ?u (buffer-name)
+ ?c (- (timer-until erc--server-reconnect-timer
+ (current-time))))
+ (setq erc--server-reconnect-timer nil)
+ (erc-update-mode-line)))
+
+(defun erc-schedule-reconnect (buffer &optional incr)
+ "Create and return a reconnect timer for BUFFER.
+When `erc-server-reconnect-attempts' is a number, increment
+`erc-server-reconnect-count' by INCR unconditionally."
+ (let ((count (and (integerp erc-server-reconnect-attempts)
+ (- erc-server-reconnect-attempts
+ (cl-incf erc-server-reconnect-count (or incr 1))))))
+ (erc-display-message nil 'error (current-buffer) 'reconnecting
+ ?m erc-server-reconnect-timeout
+ ?i (if count erc-server-reconnect-count "N")
+ ?n (if count erc-server-reconnect-attempts "A"))
+ (setq erc-server-reconnecting nil
+ erc--server-reconnect-timer
+ (run-at-time erc-server-reconnect-timeout nil
+ erc-server-reconnect-function buffer))))
+
(defun erc-process-sentinel-2 (event buffer)
"Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
- (if (not (buffer-live-p buffer))
- (erc-update-mode-line)
+ (when (buffer-live-p buffer)
(with-current-buffer buffer
- (let ((reconnect-p (erc--server-reconnect-p event)) message delay)
+ (let ((reconnect-p (erc--server-reconnect-p event)) message)
(setq message (if reconnect-p 'disconnected 'disconnected-noreconnect))
(erc-display-message nil 'error (current-buffer) message)
(if (not reconnect-p)
;; terminate, do not reconnect
(progn
- (setq erc--server-reconnecting nil)
+ (setq erc--server-reconnecting nil
+ erc--server-reconnect-timer nil)
(erc-display-message nil 'error (current-buffer)
'terminated ?e event)
- ;; Update mode line indicators
- (erc-update-mode-line)
(set-buffer-modified-p nil))
;; reconnect
- (condition-case nil
- (progn
- (setq erc-server-reconnecting nil
- erc--server-reconnecting t
- erc-server-reconnect-count (1+
erc-server-reconnect-count))
- (setq delay erc-server-reconnect-timeout)
- (run-at-time delay nil
- #'erc-server-delayed-reconnect buffer))
- (error (unless (integerp erc-server-reconnect-attempts)
- (message "%s ... %s"
- "Reconnecting until we succeed"
- "kill the ERC server buffer to stop"))
- (erc-server-delayed-reconnect buffer))))))))
+ (erc-schedule-reconnect buffer))))
+ (erc-update-mode-line)))
(defun erc-process-sentinel-1 (event buffer)
"Called when `erc-process-sentinel' has decided that we're disconnecting.
@@ -992,8 +1128,37 @@ See also `erc-server-send'."
;;;; Handling responses
+(defcustom erc-tags-format 'overridable
+ "Shape of the `tags' alist in `erc-response' objects.
+When set to `legacy', pre-5.5 parsing behavior takes effect for
+the tags portion of every message. The resulting alist contains
+conses of the form (STRING . LIST), in which LIST is comprised of
+at most one, possibly empty string. When set to nil, ERC only
+parses tags if an active module defines an implementation. It
+otherwise ignores them. In such cases, each alist element is a
+cons of a symbol and an optional, nonempty string.
+
+With the default value of `overridable', ERC behaves as it does
+with `legacy' except that it emits a warning whenever first
+encountering a message containing tags in a given Emacs session.
+But it only does so when a module implementing overriding,
+non-legacy behavior isn't already active in the current network
+context.
+
+Note that future bundled modules providing IRCv3 functionality
+will not be compatible with the legacy format. User code should
+eventually transition to expecting this \"5.5+ variant\" and set
+this option to nil."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :type '(choice (const nil)
+ (const legacy)
+ (const overridable)))
+
(defun erc-parse-tags (string)
"Parse IRCv3 tags list in STRING to a (tag . value) alist."
+ (erc--parse-message-tags string))
+
+(defun erc--parse-tags (string)
(let ((tags)
(tag-strings (split-string string ";")))
(dolist (tag-string tag-strings tags)
@@ -1003,6 +1168,28 @@ See also `erc-server-send'."
`(,pair))
tags)))))
+;; A benefit of this function being internal is not having to define a
+;; separate method just to ensure an `erc-tags-format' value of
+;; `legacy' always wins. A downside is that module code must take
+;; care to preserve that promise manually.
+
+(cl-defgeneric erc--parse-message-tags (string)
+ "Parse STRING into an alist of (TAG . VALUE) conses.
+Expect TAG to be a symbol and VALUE nil or a nonempty string.
+Don't split composite raw-input values containing commas;
+instead, leave them as a single string."
+ (when erc-tags-format
+ (unless (or (eq erc-tags-format 'legacy)
+ (get 'erc-parse-tags 'erc-v3-warned-p))
+ (put 'erc-parse-tags 'erc-v3-warned-p t)
+ (display-warning
+ 'ERC
+ (concat
+ "Legacy ERC tags behavior is currently in effect, but other modules,"
+ " including those bundled with ERC, may override this in future"
+ " releases. See `erc-tags-format' for more info.")))
+ (erc--parse-tags string)))
+
(defun erc-parse-server-response (proc string)
"Parse and act upon a complete line from an IRC server.
PROC is the process (connection) from which STRING was received.
@@ -1012,9 +1199,9 @@ PROCs `process-buffer' is `current-buffer' when this
function is called."
(let* ((tag-list (when (eq (aref string 0) ?@)
(substring string 1
(string-search " " string))))
- (msg (make-erc-response :unparsed string :tags (when tag-list
- (erc-parse-tags
- tag-list))))
+ (msg (make-erc-response :unparsed string :tags
+ (when tag-list
+ (erc--parse-message-tags tag-list))))
(string (if tag-list
(substring string (+ 1 (string-search " " string)))
string))
@@ -1662,16 +1849,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 +1858,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..23a1933798
--- /dev/null
+++ b/lisp/erc/erc-common.el
@@ -0,0 +1,274 @@
+;;; 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)))
+
+;; Beginning in 5.5/29.1, the `tags' field may take on one of two
+;; differing types. See `erc-tags-format' for details.
+
+(cl-defstruct (erc-response (:conc-name erc-response.))
+ (unparsed "" :type string)
+ (sender "" :type string)
+ (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..d23703394b 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -32,6 +32,7 @@
;;; Code:
(require 'compat nil 'noerror)
+(eval-when-compile (require 'cl-lib) (require 'url-parse))
;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(define-obsolete-function-alias 'erc-define-minor-mode
@@ -156,6 +157,162 @@ If START or END is negative, it counts from the end."
(setq i (1+ i) start (1+ start)))
res))))))
+
+;;;; Auth Source
+
+(declare-function auth-source-pass--get-attr
+ "auth-source-pass" (key entry-data))
+(declare-function auth-source-pass--disambiguate
+ "auth-source-pass" (host &optional user port))
+(declare-function auth-source-backend-parse-parameters
+ "auth-source-pass" (entry backend))
+(declare-function auth-source-backend "auth-source" (&rest slots))
+(declare-function auth-source-pass-entries "auth-source-pass" nil)
+(declare-function auth-source-pass-parse-entry "auth-source-pass" (entry))
+
+(defvar auth-sources)
+(defvar auth-source-backend-parser-functions)
+
+;; This hard codes `auth-source-pass-port-separator' to ":"
+(defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p)
+ (when (string-match (rx (or bot "/")
+ (or (: (? (group-n 20 (+ (not (in " /@")))) "@")
+ (group-n 10 (+ (not (in " /:@"))))
+ (? ":" (group-n 30 (+ (not (in " /:"))))))
+ (: (group-n 11 (+ (not (in " /:@"))))
+ (? ":" (group-n 31 (+ (not (in " /:")))))
+ (? "/" (group-n 21 (+ (not (in " /:")))))))
+ eot)
+ e)
+ (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e))
+ ,@(if-let* ((tr (match-string 21 e)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 e)))
+ :port ,(and-let* ((p (or (match-string 30 e)
+ (match-string 31 e)))
+ (n (string-to-number p)))
+ (if (or (zerop n) (not port-number-p))
+ (format "%s" p)
+ n)))
+ seen)))
+
+;; This looks bad, but it just inlines `auth-source-pass--find-match-many'.
+(defun erc-compat--29-auth-source-pass--build-result-many
+ (hosts users ports require max)
+ "Return a plist of HOSTS, PORTS, USERS, and secret."
+ (unless (listp hosts) (setq hosts (list hosts)))
+ (unless (listp users) (setq users (list users)))
+ (unless (listp ports) (setq ports (list ports)))
+ (unless max (setq max 1))
+ (let ((seen (make-hash-table :test #'equal))
+ (entries (auth-source-pass-entries))
+ (check (lambda (m k v)
+ (let ((mv (plist-get m k)))
+ (if (memq k require)
+ (and v (equal mv v))
+ (or (not v) (not mv) (equal mv v))))))
+ out suffixed suffixedp)
+ (catch 'done
+ (dolist (host hosts)
+ (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+ (unless (or (not (equal "443" p)) (string-prefix-p "https://"; host))
+ (setq p nil))
+ (dolist (user (or users (list u)))
+ (dolist (port (or ports (list p)))
+ (dolist (e entries)
+ (when-let*
+ ((m (or (gethash e seen)
+ (erc-compat--29-auth-source-pass--retrieve-parsed
+ seen e (integerp port))))
+ ((equal host (plist-get m :host)))
+ ((funcall check m :port port))
+ ((funcall check m :user user))
+ (parsed (auth-source-pass-parse-entry e))
+ (secret (or (auth-source-pass--get-attr 'secret parsed)
+ (not (memq :secret require)))))
+ (push
+ `( :host ,host ; prefer user-provided :host over h
+ ,@(and-let* ((u (plist-get m :user))) (list :user u))
+ ,@(and-let* ((p (plist-get m :port))) (list :port p))
+ ,@(and secret (not (eq secret t)) (list :secret secret)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))
+ (reverse out)))
+
+(cl-defun erc-compat--29-auth-source-pass-search
+ (&rest spec &key host user port require max &allow-other-keys)
+ ;; From `auth-source-pass-search'
+ (cl-assert (and host (not (eq host t)))
+ t "Invalid password-store search: %s %s")
+ (erc-compat--29-auth-source-pass--build-result-many
+ host user port require max))
+
+(defun erc-compat--29-auth-source-pass-backend-parse (entry)
+ (when (eq entry 'password-store)
+ (auth-source-backend-parse-parameters
+ entry (auth-source-backend
+ :source "."
+ :type 'password-store
+ :search-function #'erc-compat--29-auth-source-pass-search))))
+
+(defun erc-compat--auth-source-backend-parser-functions ()
+ (if (memq 'password-store auth-sources)
+ (progn
+ (require 'auth-source-pass)
+ `(,@(unless (bound-and-true-p auth-source-pass-extra-query-keywords)
+ '(erc-compat--29-auth-source-pass-backend-parse))
+ ,@auth-source-backend-parser-functions))
+ auth-source-backend-parser-functions))
+
+
+;;;; Misc 29.1
+
+(defmacro erc-compat--with-memoization (table &rest forms)
+ (declare (indent defun))
+ (cond
+ ((fboundp 'with-memoization)
+ `(with-memoization ,table ,@forms)) ; 29.1
+ ((fboundp 'cl--generic-with-memoization)
+ `(cl--generic-with-memoization ,table ,@forms))
+ (t `(progn ,@forms))))
+
+(defvar url-irc-function)
+
+(defun erc-compat--29-browse-url-irc (string &rest _)
+ (require 'url-irc)
+ (let* ((url (url-generic-parse-url string))
+ (url-irc-function
+ (if (function-equal url-irc-function 'url-irc-erc)
+ (lambda (host port chan user pass)
+ (erc-handle-irc-url host port chan user pass (url-type url)))
+ url-irc-function)))
+ (url-irc url)))
+
+(cond ((fboundp 'browse-url-irc)) ; 29
+ ((boundp 'browse-url-default-handlers) ; 28
+ (cl-pushnew '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+ browse-url-default-handlers))
+ ((boundp 'browse-url-browser-function) ; 27
+ (require 'browse-url)
+ (let ((existing browse-url-browser-function))
+ (setq browse-url-browser-function
+ (if (functionp existing)
+ (lambda (u &rest r)
+ (apply (if (string-match-p "\\`irc6?s?://" u)
+ #'erc-compat--29-browse-url-irc
+ existing)
+ u r))
+ (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+ existing))))))
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-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..b3e5fcf1a3 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)
@@ -1232,14 +1256,15 @@ server name and search for a match in
`erc-networks-alist'."
(defconst erc-networks--name-missing-sentinel (gensym "Unknown ")
"Value to cover rare case of a literal NETWORK=nil.")
-(defun erc-networks--determine ()
+(defun erc-networks--determine (&optional server)
"Return the name of the network as a symbol.
-Search `erc-networks-alist' for a known entity matching
+Search `erc-networks-alist' for a known entity matching SERVER or
`erc-server-announced-name'. If that fails, use the display name
given by the `RPL_ISUPPORT' NETWORK parameter."
(or (cl-loop for (name matcher) in erc-networks-alist
- when (and matcher (string-match (concat matcher "\\'")
- erc-server-announced-name))
+ when (and matcher
+ (string-match (concat matcher "\\'")
+ (or server erc-server-announced-name)))
return name)
(and-let* ((vanity (erc--get-isupport-entry 'NETWORK 'single))
((intern vanity))))
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index af8528dbc3..3ba18e835b 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -179,6 +179,10 @@ for use on `completion-at-point-function'."
(defun pcomplete/erc-mode/UNIGNORE ()
(pcomplete-here (erc-with-server-buffer erc-ignore-list)))
+(defun pcomplete/erc-mode/RECONNECT ()
+ (pcomplete-here '("cancel"))
+ (pcomplete-opt "a"))
+
;;; Functions that provide possible completions.
(defun pcomplete-erc-commands ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index db39e341b2..2312246e3e 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)
@@ -67,9 +70,7 @@
(require 'auth-source)
(require 'time-date)
(require 'iso8601)
-(eval-when-compile (require 'subr-x))
-
-(require 'erc-compat)
+(eval-when-compile (require 'subr-x) (require 'url-parse))
(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
@@ -1746,6 +1542,11 @@ symbol, it may have these values:
* ircs -> 994
* ircd -> 6667
* ircd-dalnet -> 7000"
+ ;; These were updated somewhat in 2022 to reflect modern standards
+ ;; and practices. See also:
+ ;;
+ ;; https://datatracker.ietf.org/doc/html/rfc7194#section-1
+ ;; https://www.iana.org/assignments/service-names-port-numbers
(cond
((symbolp port)
(erc-normalize-port (symbol-name port)))
@@ -1758,8 +1559,10 @@ symbol, it may have these values:
194)
((string-equal port "ircs")
994)
- ((string-equal port "ircd")
+ ((string-equal port "ircu") 6667) ; 6665-6669
+ ((string-equal port "ircd") ; nonstandard (irc-serv is 529)
6667)
+ ((string-equal port "ircs-u") 6697)
((string-equal port "ircd-dalnet")
7000)
(t
@@ -1841,40 +1644,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 +1690,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: "
@@ -2174,7 +1931,9 @@ removed from the list will be disabled."
If CONNECT is non-nil, connect to the server. Otherwise assume
already connected and just create a separate buffer for the new
-target CHANNEL.
+target given by CHANNEL, meaning these parameters are mutually
+exclusive. Note that CHANNEL may also be a query; its name has
+been retained for historical reasons.
Use PASSWD as user password on the server. If TGT-LIST is
non-nil, use it to initialize `erc-default-recipients'.
@@ -2282,12 +2041,12 @@ Returns the buffer for the given server or channel."
;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer)
- (when connect
- (erc-server-connect erc-session-server
- erc-session-port
- buffer
- erc-session-client-certificate))
- (erc-update-mode-line)
+ (if connect
+ (erc-server-connect erc-session-server
+ erc-session-port
+ buffer
+ erc-session-client-certificate)
+ (erc-update-mode-line))
;; Now display the buffer in a window as per user wishes.
(unless (eq buffer old-buffer)
@@ -2344,52 +2103,51 @@ parameters SERVER and NICK."
:group 'erc-hooks
:type '(repeat function))
+(defun erc--ensure-url (input)
+ (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input)
+ (when (and (string-match (rx (? (+ any) "@")
+ (or (group (* (not "[")) ":" (* any))
+ (+ any))
+ ":" (+ (not (any ":]"))) eot)
+ input)
+ (match-beginning 1))
+ (setq input (concat "[" (substring input (match-beginning 1)) "]")))
+ (setq input (concat "irc://" input)))
+ input)
+
;;;###autoload
(defun erc-select-read-args ()
"Prompt the user for values of nick, server, port, and password."
- (let (user-input server port nick passwd)
- (setq user-input (read-string
- "IRC server: "
- (erc-compute-server) 'erc-server-history-list))
-
- (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
- (setq port (erc-string-to-port (match-string 2 user-input))
- user-input (match-string 1 user-input))
- (setq port
- (erc-string-to-port (read-string
- "IRC port: " (erc-port-to-string
- (erc-compute-port))))))
-
- (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
- (setq nick (match-string 1 user-input)
- user-input (match-string 2 user-input))
- (setq nick
- (if (erc-already-logged-in server port nick)
- (read-string
- (erc-format-message 'nick-in-use ?n nick)
- nick 'erc-nick-history-list)
- (read-string
- "Nickname: " (erc-compute-nick nick)
- 'erc-nick-history-list))))
-
- (setq server user-input)
-
- (setq passwd (if erc-prompt-for-password
- (read-passwd "Server password: ")
- (with-suppressed-warnings ((obsolete erc-password))
- erc-password)))
+ (require 'url-parse)
+ (let* ((input (let ((d (erc-compute-server)))
+ (read-string (format "Server (default is %S): " d)
+ nil 'erc-server-history-list d)))
+ ;; For legacy reasons, also accept a URL without a scheme.
+ (url (url-generic-parse-url (erc--ensure-url input)))
+ (server (url-host url))
+ (sp (and (or (string-suffix-p "s" (url-type url))
+ (and (equal server erc-default-server)
+ (not (string-prefix-p "irc://" input))))
+ 'ircs-u))
+ (port (or (url-portspec url)
+ (erc-compute-port
+ (let ((d (erc-compute-port sp))) ; may be a string
+ (read-string (format "Port (default is %s): " d)
+ nil nil d)))))
+ ;; Trust the user not to connect twice accidentally. We
+ ;; can't use `erc-already-logged-in' to check for an existing
+ ;; connection without modifying it to consider USER and PASS.
+ (nick (or (url-user url)
+ (let ((d (erc-compute-nick)))
+ (read-string (format "Nickname (default is %S): " d)
+ nil 'erc-nick-history-list d))))
+ (passwd (or (url-password url)
+ (if erc-prompt-for-password
+ (read-passwd "Server password (optional): ")
+ (with-suppressed-warnings ((obsolete erc-password))
+ erc-password)))))
(when (and passwd (string= "" passwd))
(setq passwd nil))
-
- (while (erc-already-logged-in server port nick)
- ;; hmm, this is a problem when using multiple connections to a bnc
- ;; with the same nick. Currently this code prevents using more than one
- ;; bnc with the same nick. actually it would be nice to have
- ;; bncs transparent, so that erc-compute-buffer-name displays
- ;; the server one is connected to.
- (setq nick (read-string
- (erc-format-message 'nick-in-use ?n nick)
- nick 'erc-nick-history-list)))
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
@@ -2434,7 +2192,7 @@ interactively."
;;;###autoload
(cl-defun erc-tls (&key (server (erc-compute-server))
- (port (erc-compute-port))
+ (port (erc-compute-port 'ircs-u))
(nick (erc-compute-nick))
(user (erc-compute-user))
password
@@ -2877,8 +2635,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.
@@ -3477,7 +3233,9 @@ host but different ports would result in the one with
port 123 getting
the nod. Much the same would happen for entries sharing only a port:
the one with host foo would win."
(when-let*
- ((priority (map-keys defaults))
+ ((auth-source-backend-parser-functions
+ (erc-compat--auth-source-backend-parser-functions))
+ (priority (map-keys defaults))
(test (lambda (a b)
(catch 'done
(dolist (key priority)
@@ -4054,30 +3812,42 @@ the message given by REASON."
(put 'erc-cmd-GQUIT 'do-not-parse-args t)
(put 'erc-cmd-GQUIT 'process-not-needed t)
-(defun erc-cmd-RECONNECT ()
- "Try to reconnect to the current IRC server."
+(defun erc--cmd-reconnect ()
(let ((buffer (erc-server-buffer))
(process nil))
(unless (buffer-live-p buffer)
(setq buffer (current-buffer)))
(with-current-buffer buffer
+ (when erc--server-reconnect-timer
+ (erc--cancel-auto-reconnect-timer))
(setq erc-server-quitting nil)
(with-suppressed-warnings ((obsolete erc-server-reconnecting))
(setq erc-server-reconnecting t))
- (setq erc--server-reconnecting t)
(setq erc-server-reconnect-count 0)
(setq process (get-buffer-process (erc-server-buffer)))
(when process
(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)))
(setq erc--server-reconnecting nil
erc-server-reconnecting nil)))))
t)
+
+(defun erc-cmd-RECONNECT (&rest args)
+ "Try reconnecting to the current IRC server.
+Alternatively, CANCEL a scheduled attempt for either the current
+connection or, with -A, all applicable connections.
+
+\(fn [CANCEL [-A]])"
+ (pcase args
+ (`("cancel" "-a") (erc-buffer-filter #'erc--cancel-auto-reconnect-timer))
+ (`("cancel") (erc-with-server-buffer (erc--cancel-auto-reconnect-timer)))
+ (_ (erc--cmd-reconnect))))
+
(put 'erc-cmd-RECONNECT 'process-not-needed t)
(defun erc-cmd-SERVER (server)
@@ -4090,9 +3860,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 +5116,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 +5165,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 +5774,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
@@ -6653,7 +6413,7 @@ non-nil value is found.
- PORT (the argument passed to this function)
- The `erc-port' option
- The `erc-default-port' variable"
- (or port erc-port erc-default-port))
+ (erc-normalize-port (or port erc-port erc-default-port)))
;; time routines
@@ -6957,9 +6717,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.
@@ -6976,11 +6733,12 @@ shortened server name instead."
(?s . ,(erc-format-target-and/or-server))
(?S . ,(erc-format-target-and/or-network))
(?t . ,(erc-format-target))))
- (process-status (cond ((and (erc-server-process-alive)
- (not erc-server-connected))
- ":connecting")
- ((erc-server-process-alive)
- "")
+ (process-status (cond ((erc-server-process-alive buffer)
+ (unless erc-server-connected
+ ": connecting"))
+ ((erc-with-server-buffer
+ erc--server-reconnect-timer)
+ erc--mode-line-process-reconnecting)
(t
": CLOSED")))
(face (cond ((eq erc-header-line-face-method nil)
@@ -6991,7 +6749,7 @@ shortened server name instead."
'erc-header-line))))
(setq mode-line-buffer-identification
(list (format-spec erc-mode-line-format spec)))
- (setq mode-line-process (list process-status))
+ (setq mode-line-process process-status)
(let ((header (if erc-header-line-format
(format-spec erc-header-line-format spec)
nil)))
@@ -7176,6 +6934,8 @@ All windows are opened in the current frame."
(disconnected . "\n\nConnection failed! Re-establishing connection...\n")
(disconnected-noreconnect
. "\n\nConnection failed! Not re-establishing connection.\n")
+ (reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
+ (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
(finished . "\n\n*** ERC finished ***\n")
(terminated . "\n\n*** ERC terminated: %e\n")
(login . "Logging in as `%n'...")
@@ -7426,34 +7186,84 @@ This function should be on `erc-kill-channel-hook'."
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
-;; FIXME change user to nick, and use API to find server buffer
+(defcustom erc-url-connect-function nil
+ "When non-nil, a function used to connect to an IRC URL.
+Called with a string meant to represent a URL scheme, like
+\"ircs\", followed by any number of keyword arguments recognized
+by `erc' and `erc-tls'."
+ :group 'erc
+ :package-version '(ERC . "5.4.1") ; FIXME increment on release
+ :type '(choice (const nil) function))
+
+(defun erc--url-default-connect-function (scheme &rest plist)
+ (let* ((ircsp (if scheme
+ (string-suffix-p "s" scheme)
+ (or (eql 6697 (plist-get plist :port))
+ (yes-or-no-p "Connect using TLS? "))))
+ (erc-server (plist-get plist :server))
+ (erc-port (or (plist-get plist :port)
+ (and ircsp (erc-normalize-port 'ircs-u))
+ erc-port))
+ (erc-nick (or (plist-get plist :nick) erc-nick))
+ (erc-password (plist-get plist :password))
+ (args (erc-select-read-args)))
+ (unless ircsp
+ (setq ircsp (eql 6697 erc-port)))
+ (apply (if ircsp #'erc-tls #'erc) args)))
+
;;;###autoload
-(defun erc-handle-irc-url (host port channel user password)
- "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
+(defun erc-handle-irc-url (host port channel nick password &optional scheme)
+ "Use ERC to IRC on HOST:PORT in CHANNEL.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
-Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
- (let ((server-buffer
- (car (erc-buffer-filter
- (lambda ()
- (and (string-equal erc-session-server host)
- (= erc-session-port port)
- (erc-open-server-buffer-p)))))))
- (with-current-buffer (or server-buffer (current-buffer))
- (if (and server-buffer channel)
- (erc-cmd-JOIN channel)
- (erc-open host port (or user (erc-compute-nick))
(erc-compute-full-name)
- (not server-buffer) password nil channel
- (when server-buffer
- (get-buffer-process server-buffer)))))))
+Otherwise, connect to HOST:PORT as NICK and /join CHANNEL.
+
+Beginning with ERC 5.5, new connections require human intervention.
+Customize `erc-url-connect-function' to override this."
+ (when (eql port 0) (setq port nil))
+ (let* ((net (erc-networks--determine host))
+ (server-buffer
+ ;; Viable matches may slip through the cracks for unknown
+ ;; networks. Additional passes could likely improve things.
+ (car (erc-buffer-filter
+ (lambda ()
+ (and (not erc--target)
+ (erc-server-process-alive)
+ ;; Always trust a matched network.
+ (or (and net (eq net (erc-network)))
+ (and (string-equal erc-session-server host)
+ ;; Ports only matter when dialed hosts
+ ;; match and we have sufficient info.
+ (or (not port)
+ (= (erc-normalize-port erc-session-port)
+ port)))))))))
+ key deferred)
+ (unless server-buffer
+ (setq deferred t
+ server-buffer (apply (or erc-url-connect-function
+ #'erc--url-default-connect-function)
+ scheme
+ :server host
+ `(,@(and port (list :port port))
+ ,@(and nick (list :nick nick))
+ ,@(and password `(:password ,password))))))
+ (when channel
+ ;; These aren't percent-decoded by default
+ (when (string-prefix-p "%" channel)
+ (setq channel (url-unhex-string channel)))
+ (cl-multiple-value-setq (channel key) (split-string channel "[?]"))
+ (if deferred
+ ;; Alternatively, we could make this a defmethod, so when
+ ;; autojoin is loaded, it can do its own thing. Also, as
+ ;; with `erc-once-with-server-event', it's fine to set local
+ ;; hooks here because they're killed when reconnecting.
+ (with-current-buffer server-buffer
+ (letrec ((f (lambda (&rest _)
+ (remove-hook 'erc-after-connect f t)
+ (erc-cmd-JOIN channel key))))
+ (add-hook 'erc-after-connect f nil t)))
+ (with-current-buffer server-buffer
+ (erc-cmd-JOIN channel key))))))
(provide 'erc)
-(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-prompt.el b/lisp/eshell/em-prompt.el
index a1a91e7d63..a8744de1db 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -100,6 +100,14 @@ arriving, or after."
"C-c C-n" #'eshell-next-prompt
"C-c C-p" #'eshell-previous-prompt)
+(defvar-keymap eshell-prompt-repeat-map
+ :doc "Keymap to repeat eshell-prompt key sequences. Used in `repeat-mode'."
+ "C-n" #'eshell-next-prompt
+ "C-p" #'eshell-previous-prompt)
+
+(put #'eshell-next-prompt 'repeat-map 'eshell-prompt-repeat-map)
+(put #'eshell-previous-prompt 'repeat-map 'eshell-prompt-repeat-map)
+
;;; Functions:
(define-minor-mode eshell-prompt-mode
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-mode.el b/lisp/eshell/esh-mode.el
index 92523fd99e..4357a0e29a 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -280,6 +280,14 @@ This is used by `eshell-watch-for-password-prompt'."
"C-w" #'backward-kill-word
"C-y" #'eshell-repeat-argument)
+(defvar-keymap eshell-command-repeat-map
+ :doc "Keymap to repeat eshell-command key sequences. Used in `repeat-mode'."
+ "C-f" #'eshell-forward-argument
+ "C-b" #'eshell-backward-argument)
+
+(put #'eshell-forward-argument 'repeat-map 'eshell-command-repeat-map)
+(put #'eshell-backward-argument 'repeat-map 'eshell-command-repeat-map)
+
;;; User Functions:
(defun eshell-kill-buffer-function ()
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index bb928fc5fb..950922ea7f 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -552,7 +552,7 @@ See the variable `eshell-kill-processes-on-exit'."
(setq sigs (cdr sigs))))))
(defun eshell-query-kill-processes ()
- "Kill processes belonging to the current Eshell buffer, possibly w/ query."
+ "Kill processes belonging to the current Eshell buffer, possibly with query."
(when (and eshell-kill-processes-on-exit
eshell-process-list)
(save-window-excursion
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..a692015094 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
@@ -396,7 +397,11 @@ that have an explicit `:height' setting. The two
exceptions to
this are the `default' and `header-line' faces: they will both be
scaled even if they have an explicit `:height' setting.
-See also the related command `global-text-scale-adjust'."
+See also the related command `global-text-scale-adjust'. Unlike
+that command, which scales the font size with a increment,
+`text-scale-adjust' scales the font size with a factor,
+`text-scale-mode-step'. With a small `text-scale-mode-step'
+factor, the two commands behave similarly."
(interactive "p")
(let ((ev last-command-event)
(echo-keystrokes nil))
@@ -461,25 +466,30 @@ the `cdr' has the maximum font size, in units of 1/10 pt."
(defvar global-text-scale-adjust--default-height nil)
+(defvar global-text-scale-adjust--increment-factor 5)
+
;;;###autoload (define-key ctl-x-map [(control meta ?+)]
'global-text-scale-adjust)
;;;###autoload (define-key ctl-x-map [(control meta ?=)]
'global-text-scale-adjust)
;;;###autoload (define-key ctl-x-map [(control meta ?-)]
'global-text-scale-adjust)
;;;###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.
@@ -488,7 +498,10 @@ The variable `global-text-scale-adjust-resizes-frames'
controls
whether the frames are resized to keep the same number of lines
and characters per line when the font size is adjusted.
-See also the related command `text-scale-adjust'."
+See also the related command `text-scale-adjust'. Unlike that
+command, which scales the font size with a factor,
+`global-text-scale-adjust' scales the font size with an
+increment."
(interactive "p")
(when (display-graphic-p)
(unless global-text-scale-adjust--default-height
@@ -499,16 +512,24 @@ See also the related command `text-scale-adjust'."
(cur (face-attribute 'default :height))
(inc
(pcase key
- (?- (* (- increment) 5))
+ (?- (* (- increment)
+ global-text-scale-adjust--increment-factor))
(?0 (- global-text-scale-adjust--default-height cur))
- (_ (* increment 5))))
+ (_ (* increment
+ global-text-scale-adjust--increment-factor))))
(new (+ cur inc)))
(when (< (car global-text-scale-adjust-limits)
new
(cdr global-text-scale-adjust-limits))
(let ((frame-inhibit-implied-resize
(not global-text-scale-adjust-resizes-frames)))
- (set-face-attribute 'default nil :height new)))
+ (set-face-attribute 'default nil :height new)
+ (redisplay 'force)
+ (when (and (not (and (characterp key) (= key ?0)))
+ (= cur (face-attribute 'default :height)))
+ (setq global-text-scale-adjust--increment-factor
+ (1+ global-text-scale-adjust--increment-factor))
+ (global-text-scale-adjust increment))))
(when (characterp key)
(set-transient-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/faces.el b/lisp/faces.el
index 09e8110449..c69339e2fd 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -787,13 +787,12 @@ specified below. WIDTH specifies the width of the lines
to draw; it
defaults to 1. If WIDTH is negative, the absolute value is the width
of the lines, and draw top/bottom lines inside the characters area,
not around it. COLOR is the name of the color to draw in, default is
-the foreground color of the face for simple boxes, and the background
-color of the face for 3D boxes. STYLE specifies whether a 3D box
-should be draw. If STYLE is `released-button', draw a box looking
-like a released 3D button. If STYLE is `pressed-button' draw a box
-that appears like a pressed button. If STYLE is nil, the default if
-the property list doesn't contain a style specification, draw a 2D
-box.
+the background color of the face for 3D boxes and `flat-button', and
+the foreground color of the face for other boxes. STYLE specifies
+whether a 3D box should be draw. If STYLE is `released-button', draw
+a box looking like a released 3D button. If STYLE is `pressed-button'
+draw a box that appears like a pressed button. If STYLE is nil,
+`flat-button' or omitted, draw a 2D box.
`:inverse-video'
@@ -2201,8 +2200,13 @@ the X resource \"reverseVideo\" is present, handle that."
border-color cursor-color mouse-color
visibility scroll-bar-foreground
scroll-bar-background))
+ (delayed-font nil)
frame success)
(dolist (param delayed-params)
+ ;; Save the font used here. Once the frame is created, set the
+ ;; `font-parameter' frame parameter.
+ (when (and (eq param 'font) (assq 'font parameters))
+ (setq delayed-font (cdr (assq 'font parameters))))
(setq params (assq-delete-all param params)))
(setq frame (x-create-frame `((visibility . nil) . ,params)))
(unwind-protect
@@ -2213,6 +2217,11 @@ the X resource \"reverseVideo\" is present, handle that."
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
+ ;; The code above will not set the `font-parameter' frame
+ ;; property, which is used by dynamic-setting.el to respect
+ ;; fonts specified by the user via frame parameters (as
+ ;; opposed to face attributes). Set the parameter manually.
+ (set-frame-parameter frame 'font-parameter delayed-font)
;; Mark frame as 'was-invisible' when it was created as
;; invisible or iconified and PARAMETERS contains either a
;; width or height specification. This should be sufficient
diff --git a/lisp/files.el b/lisp/files.el
index a282532258..b947451369 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7294,7 +7294,7 @@ by `sh' are supported."
(setq i (1+ i))
"[]"))
(t "["))
- (prog1 ; copy everything upto next `]'.
+ (prog1 ; copy everything up to next `]'.
(substring wildcard
i
(setq j (string-search
diff --git a/lisp/filesets.el b/lisp/filesets.el
index aeebd907c3..9f07072e78 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -2390,6 +2390,7 @@ fileset thinks this is necessary or not."
(filesets-menu-cache-file-load))
(defun filesets-update-pre010505 ()
+ (declare (obsolete nil "29.1"))
(let ((msg (format-message
"Filesets: manual editing of user data required!
@@ -2435,7 +2436,8 @@ We apologize for the inconvenience.")))
((or (not cached-version)
(string< cached-version "1.5.5")
(boundp 'filesets-subdocument-patterns))
- (filesets-update-pre010505)))
+ (with-suppressed-warnings ((obsolete filesets-update-pre010505))
+ (filesets-update-pre010505))))
(filesets-update-cleanup))
(defun filesets-menu-cache-file-load ()
diff --git a/lisp/forms.el b/lisp/forms.el
index b97fdbe04c..97c7cb79d3 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -487,17 +487,11 @@ Commands: Equivalent keys in
read-only mode:
(make-local-variable 'forms-insert-after)
(make-local-variable 'forms-use-text-properties)
- ;; Filter functions.
- (make-local-variable 'forms-read-file-filter)
- (make-local-variable 'forms-write-file-filter)
- (make-local-variable 'forms-new-record-filter)
- (make-local-variable 'forms-modified-record-filter)
-
- ;; Make sure no filters exist.
- (setq forms-read-file-filter nil)
- (setq forms-write-file-filter nil)
- (setq forms-new-record-filter nil)
- (setq forms-modified-record-filter nil)
+ ;; Make sure no filters exist.
+ (setq-local forms-read-file-filter nil)
+ (setq-local forms-write-file-filter nil)
+ (setq-local forms-new-record-filter nil)
+ (setq-local forms-modified-record-filter nil)
;; Setup faces to show read-only and read-write fields.
(make-local-variable 'forms-ro-face)
@@ -615,10 +609,10 @@ Commands: Equivalent keys in
read-only mode:
(make-local-variable 'forms--the-record-list)
(make-local-variable 'forms--search-regexp)
- ; The keymaps are global, so multiple forms mode buffers can share them.
- ;(make-local-variable 'forms-mode-map)
- ;(make-local-variable 'forms-mode-ro-map)
- ;(make-local-variable 'forms-mode-edit-map)
+ ;; The keymaps are global, so multiple forms mode buffers can share them.
+ ;;(make-local-variable 'forms-mode-map)
+ ;;(make-local-variable 'forms-mode-ro-map)
+ ;;(make-local-variable 'forms-mode-edit-map)
(if forms-mode-map ; already defined
nil
;;(message "forms: building keymap...")
@@ -715,8 +709,8 @@ Commands: Equivalent keys in
read-only mode:
;;(message "forms: setting up... done.")
;; be helpful
- (forms--help)
-)
+ (forms--help))
+
(defun forms--process-format-list ()
;; Validate `forms-format-list' and set some global variables.
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..c55d6225e3 100644
--- a/lisp/gnus/ChangeLog.3
+++ b/lisp/gnus/ChangeLog.3
@@ -4243,7 +4243,7 @@
* gnus-msg.el (gnus-inews-do-gcc):
* message.el (message-send-mail):
* mml.el (mml-generate-mime): Share the value of the buffer-local
- `message-options' variable between a draft buffer and temprary working
+ `message-options' variable between a draft buffer and temporary working
buffers.
2011-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -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>
@@ -10876,7 +10876,7 @@
2010-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen)
- spec inser "*" if the group isn't active instead of 0.
+ spec insert "*" if the group isn't active instead of 0.
* nnimap.el (nnimap-request-group): Don't select the imap buffer before
opening the server.
@@ -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-search.el b/lisp/gnus/gnus-search.el
index b8f7e7a08f..7941496be6 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1943,7 +1943,7 @@ Assume \"size\" key is equal to \"larger\"."
(thread (alist-get 'thread query)))
(with-slots (switches config-directory) engine
`("find" ; command must come first
- "--nocolor" ; mu will always give coloured output otherwise
+ "--nocolor" ; mu will always give colored output otherwise
,(format "--muhome=%s" config-directory)
,@switches
,(if thread "-r" "")
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 4963fd083f..a4962f9d5f 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -173,7 +173,7 @@ properly with all servers."
Groups with levels less than `gnus-level-subscribed', which
should be less than this variable, are subscribed. Groups with
-levels from `gnus-level-subscribed' (exclusive) upto this
+levels from `gnus-level-subscribed' (exclusive) up to this
variable (inclusive) are unsubscribed. See also
`gnus-level-zombie', `gnus-level-killed' and the Info node `(gnus)Group
Levels' for details.")
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/mml.el b/lisp/gnus/mml.el
index e8291cfe6f..ebd0adf2e2 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1446,7 +1446,7 @@ will be computed and used."
(mml-insert-empty-tag 'part
'type type
;; icicles redefines read-file-name and returns a
- ;; string w/ text properties :-/
+ ;; string with text properties :-/
'filename (substring-no-properties file)
'disposition (or disposition "attachment")
'description description)
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/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 99e7b2a6f3..66cee52865 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -77,7 +77,7 @@ this variable to the list of fields to be ignored.")
"List of RSS addresses.")
(defvar nnrss-use-local nil
- "If non-nil nnrss will read the feeds from local files in nnrss-directory.")
+ "If non-nil nnrss will read the feeds from local files in
`nnrss-directory'.")
(defvar nnrss-description-field 'X-Gnus-Description
"Field name used for DESCRIPTION.
@@ -398,7 +398,7 @@ otherwise return nil."
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
(defun nnrss-fetch (url &optional local)
- "Fetch URL and put it in a the expected Lisp structure."
+ "Fetch URL and put it in the expected Lisp structure."
(mm-with-unibyte-buffer
;;some versions of url.el need this to close the connection quickly
(let (cs xmlform htmlform)
@@ -800,7 +800,7 @@ It is useful when `(setq nnrss-use-local t)'."
node))
(defun nnrss-find-el (tag data &optional found-list)
- "Find the all matching elements in the data.
+ "Find all the matching elements in the data.
Careful with this on large documents!"
(when (consp data)
(dolist (bit data)
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index e150cbf2b4..eec0347bcf 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -172,7 +172,7 @@ It is computed from the marks of individual component
groups.")
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-buffer-substring vbuf)
- ;; FIX FIX FIX, we should be able to sort faster than
+ ;; FIXME: we should be able to sort faster than
;; this if needed, since each cgroup is sorted, we just
;; need to merge
(sort-numeric-fields 1 (point-min) (point-max))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 34092b1417..df4c6ab079 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1937,7 +1937,7 @@ Otherwise, the link should be to the index file.
We are not yet concerned with the file extensions/tag line number and so on at
this point.
-If `hfy-split-index' is set, and the href wil be to an index file rather than
+If `hfy-split-index' is set, and the href will be to an index file rather than
a source file, append a .X to `hfy-index-file', where X is the uppercased
first character of TAG.
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/info.el b/lisp/info.el
index 02dde50dd6..8860a664bd 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2666,7 +2666,7 @@ new buffer."
(defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*"
;; We allow newline because this is also used in Info-follow-reference,
;; where the xref name might be wrapped over two lines.
- "Regexp that matches a menu entry name upto but not including the colon.
+ "Regexp that matches a menu entry name up to but not including the colon.
Because of ambiguities, this should be concatenated with something like
`:' and `Info-following-node-name-re'.")
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/titdic-cnv.el b/lisp/international/titdic-cnv.el
index d2a6ee1e9d..b942f5fabc 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -59,6 +59,13 @@
;; Near the end of this file, we also have a few other tools to convert
;; miscellaneous dictionaries.
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'quail)
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/keymap.el b/lisp/keymap.el
index 107565590c..eaeba96644 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -559,22 +559,45 @@ In addition to the keywords accepted by `define-keymap',
this
macro also accepts a `:doc' keyword, which (if present) is used
as the variable documentation string.
-\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY
DEFINITION]...)"
+The `:repeat' keyword can also be specified; it controls the
+`repeat-mode' behavior of the bindings in the keymap. When it is
+non-nil, all commands in the map will have the `repeat-map'
+symbol property.
+
+More control is available over which commands are repeatable; the
+value can also be a property list with properties `:enter' and
+`:exit', for example:
+
+ :repeat (:enter (commands ...) :exit (commands ...))
+
+`:enter' specifies the list of additional commands that only
+enter `repeat-mode'. When the list is empty, then by default all
+commands in the map enter `repeat-mode'. This is useful when
+there is a command that has the `repeat-map' symbol property, but
+doesn't exist in this specific map. `:exit' is a list of
+commands that exit `repeat-mode'. When the list is empty, no
+commands in the map exit `repeat-mode'. This is useful when a
+command exists in this specific map, but it doesn't have the
+`repeat-map' symbol property on its symbol.
+
+\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP REPEAT
&rest [KEY DEFINITION]...)"
(declare (indent 1))
(let ((opts nil)
- doc)
+ doc repeat props)
(while (and defs
(keywordp (car defs))
(not (eq (car defs) :menu)))
(let ((keyword (pop defs)))
(unless defs
(error "Uneven number of keywords"))
- (if (eq keyword :doc)
- (setq doc (pop defs))
- (push keyword opts)
- (push (pop defs) opts))))
+ (cond
+ ((eq keyword :doc) (setq doc (pop defs)))
+ ((eq keyword :repeat) (setq repeat (pop defs)))
+ (t (push keyword opts)
+ (push (pop defs) opts)))))
(unless (zerop (% (length defs) 2))
(error "Uneven number of key/definition pairs: %s" defs))
+
(let ((defs defs)
key seen-keys)
(while defs
@@ -585,9 +608,28 @@ as the variable documentation string.
(error "Duplicate definition for key '%s' in keymap '%s'"
key variable-name)
(push key seen-keys)))))
- `(defvar ,variable-name
- (define-keymap ,@(nreverse opts) ,@defs)
- ,@(and doc (list doc)))))
+
+ (when repeat
+ (let ((defs defs)
+ def)
+ (dolist (def (plist-get repeat :enter))
+ (push `(put ',def 'repeat-map ',variable-name) props))
+ (while defs
+ (pop defs)
+ (setq def (pop defs))
+ (when (and (memq (car def) '(function quote))
+ (not (memq (cadr def) (plist-get repeat :exit))))
+ (push `(put ,def 'repeat-map ',variable-name) props)))))
+
+ (let ((defvar-form
+ `(defvar ,variable-name
+ (define-keymap ,@(nreverse opts) ,@defs)
+ ,@(and doc (list doc)))))
+ (if repeat
+ `(progn
+ ,defvar-form
+ ,@(nreverse props))
+ defvar-form))))
(defun make-non-key-event (symbol)
"Mark SYMBOL as an event that shouldn't be returned from `where-is'."
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 2f76acfe7c..5b4252d779 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -30,6 +30,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'robin)
@@ -105,6 +112,8 @@
(defcustom ethio-primary-language 'tigrigna
"Symbol that defines the primary language in SERA --> FIDEL conversion.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The value should be one of: `tigrigna', `amharic' or `english'."
:version "28.1"
:type '(choice (const :tag "Tigrigna" tigrigna)
@@ -113,6 +122,8 @@ The value should be one of: `tigrigna', `amharic' or
`english'."
(defcustom ethio-secondary-language 'english
"Symbol that defines the secondary language in SERA --> FIDEL conversion.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The value should be one of: `tigrigna', `amharic' or `english'."
:version "28.1"
:type '(choice (const :tag "Tigrigna" tigrigna)
@@ -123,7 +134,9 @@ The value should be one of: `tigrigna', `amharic' or
`english'."
"Non-nil means associate ASCII colon with Ethiopic colon.
If nil, associate ASCII colon with Ethiopic word separator, i.e., two
vertically stacked dots. All SERA <--> FIDEL converters refer this
-variable."
+variable.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
@@ -131,7 +144,9 @@ variable."
"If non-nil, associate ASCII question mark with Ethiopic question mark.
The Ethiopic old style question mark is three vertically stacked dots.
If nil, associate ASCII question mark with Ethiopic stylized question
-mark. All SERA <--> FIDEL converters refer this variable."
+mark. All SERA <--> FIDEL converters refer this variable.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
@@ -140,13 +155,17 @@ mark. All SERA <--> FIDEL converters refer this
variable."
This happens in FIDEL --> SERA conversions. Isolated vowels at
word beginning do not get an apostrophe put before them.
If nil, put an apostrophe only between a 6th-form consonant and an
-isolated vowel."
+isolated vowel.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
(defcustom ethio-W-sixth-always nil
"Non-nil means convert the Wu-form of a 12-form consonant to \"W'\".
-This is instead of \"Wu\" in FIDEL --> SERA conversion."
+This is instead of \"Wu\" in FIDEL --> SERA conversion.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
@@ -216,6 +235,8 @@ If nil, use uppercases."
(defun ethio-sera-to-fidel-buffer (&optional secondary force)
"Convert the current buffer from SERA to FIDEL.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -241,6 +262,8 @@ See also the descriptions of the variables
(defun ethio-sera-to-fidel-region (begin end &optional secondary force)
"Convert the characters in region from SERA to FIDEL.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -496,7 +519,9 @@ changing anything."
;;;###autoload
(defun ethio-sera-to-fidel-marker (&optional force)
- "Convert the regions surrounded by \"<sera>\" and \"</sera>\" from SERA to
FIDEL.
+ "Convert regions surrounded by \"<sera>\" and \"</sera>\" from SERA to FIDEL.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
Assume that each region begins with `ethio-primary-language'.
The markers \"<sera>\" and \"</sera>\" themselves are not deleted."
(interactive "P")
@@ -528,7 +553,9 @@ The markers \"<sera>\" and \"</sera>\" themselves are not
deleted."
;;;###autoload
(defun ethio-fidel-to-sera-buffer (&optional secondary force)
- "Replace all the FIDEL characters in the current buffer to the SERA format.
+ "Convert all the FIDEL characters in the current buffer to the SERA format.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -548,8 +575,10 @@ See also the descriptions of the variables
;;;###autoload
(defun ethio-fidel-to-sera-region (begin end &optional secondary force)
- "Replace all the FIDEL characters in the region to the SERA format.
+ "Convert all the FIDEL characters in the region to the SERA format.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -667,6 +696,8 @@ See also the descriptions of the variables
;;;###autoload
(defun ethio-fidel-to-sera-marker (&optional force)
"Convert the regions surrounded by \"<sera>\" and \"</sera>\" from FIDEL to
SERA.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The markers \"<sera>\" and \"</sera>\" themselves are not deleted."
(interactive "P")
@@ -691,7 +722,8 @@ The markers \"<sera>\" and \"</sera>\" themselves are not
deleted."
;;;###autoload
(defun ethio-modify-vowel nil
- "Modify the vowel of the FIDEL that is under the cursor."
+ "Modify the vowel of the FIDEL that is under the cursor.
+FIDEL is the Amharic/Ethiopic alphabet."
(interactive)
(ethio-adjust-robin)
(let ((consonant (ethio-get-consonant (following-char)))
@@ -708,7 +740,9 @@ The markers \"<sera>\" and \"</sera>\" themselves are not
deleted."
(robin-convert-region (point-min) (point-max) "ethiopic-sera"))))))
(defun ethio-get-consonant (ch)
- "Return the consonant part of CH's SERA spelling in ethiopic-sera."
+ "Return the consonant part of CH's SERA spelling in ethiopic-sera.
+SERA (System for Ethiopic Representation in ASCII) is the Latin
+representation of Ethiopic script."
(let ((sera (get-char-code-property ch 'ethiopic-sera)))
(cond
((null sera) nil)
@@ -813,7 +847,8 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
;;;###autoload
(defun ethio-fidel-to-tex-buffer nil
- "Convert each fidel characters in the current buffer into a fidel-tex
command."
+ "Convert each FIDEL characters in the current buffer into a fidel-tex
command.
+FIDEL is the Amharic/Ethiopic alphabet."
(interactive)
(let ((buffer-read-only nil)
comp)
@@ -860,7 +895,8 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
;;;###autoload
(defun ethio-tex-to-fidel-buffer ()
- "Convert fidel-tex commands in the current buffer into fidel chars."
+ "Convert fidel-tex commands in the current buffer into FIDEL chars.
+FIDEL is the Amharic/Ethiopic alphabet."
(interactive)
(let ((inhibit-read-only t)
;; (p) (ch)
@@ -888,7 +924,7 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
;;;###autoload
(defun ethio-fidel-to-java-buffer nil
- "Convert Ethiopic characters into the Java escape sequences.
+ "Convert Ethiopic characters in the buffer into the Java escape sequences.
Each escape sequence is of the form \\uXXXX, where XXXX is the
character's codepoint (in hex) in Unicode.
@@ -907,7 +943,7 @@ Otherwise, [0-9A-F]."
;;;###autoload
(defun ethio-java-to-fidel-buffer nil
- "Convert the Java escape sequences into corresponding Ethiopic characters."
+ "Convert the Java escape sequences in the buffer into Ethiopic characters."
(let ((case-fold-search t)
(ucode))
(goto-char (point-min))
@@ -922,7 +958,17 @@ Otherwise, [0-9A-F]."
;;;###autoload
(defun ethio-find-file nil
- "Transliterate file content into Ethiopic depending on filename suffix."
+ "Transliterate file content into Ethiopic depending on filename suffix.
+If the file-name extension is \".sera\", convert from SERA to FIDEL.
+If the file-name extension is \".html\", convert regions enclosed
+by \"<sera>..</sera>\" from SERA to FIDEL.
+If the file-name extension is \".tex\", convert fidel-tex commands
+to FIDEL characters.
+If the file-name extension is \".java\", convert Java escape sequences
+to FIDEL characters.
+
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
(cond
((string-match "\\.sera$" (buffer-file-name))
@@ -956,7 +1002,17 @@ Otherwise, [0-9A-F]."
;;;###autoload
(defun ethio-write-file nil
- "Transliterate Ethiopic characters in ASCII depending on the file extension."
+ "Transliterate Ethiopic characters to ASCII depending on the file extension.
+If the file-name extension is \".sera\", convert from FIDEL to SERA.
+If the file-name extension is \".html\", convert FIDEL characters to
+SERA regions enclosed by \"<sera>..</sera>\".
+If the file-name extension is \".tex\", convert FIDEL characters
+to fidel-tex commands.
+If the file-name extension is \".java\", convert FIDEL characters to
+Java escape sequences.
+
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
(cond
((string-match "\\.sera$" (buffer-file-name))
@@ -1062,7 +1118,7 @@ With ARG, insert that many delimiters."
;; This function is not used any more.
(defun ethio-gemination nil
- "Compose the character before the point with the Ethiopic gemination mark.
+ "Compose the character before point with the Ethiopic gemination mark.
If the character is already composed, decompose it and remove the gemination
mark."
(interactive "*")
@@ -1081,7 +1137,9 @@ mark."
;;;
(robin-define-package "ethiopic-sera"
- "SERA transliteration system for Ethiopic."
+ "SERA transliteration system for Ethiopic.
+SERA (System for Ethiopic Representation in ASCII) is the Latin
+representation of Ethiopic script."
("he" ?ሀ)
("hu" ?ሁ)
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 1faba424ba..fb1e272843 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -27,6 +27,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(define-ccl-program ccl-encode-ethio-font
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 27facaa858..447ca0c20c 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -27,11 +27,18 @@
;; Finally, this program provides the compatibility support with
;; old implementation of Devanagari script.
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
;;; 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 +645,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/tibet-util.el b/lisp/language/tibet-util.el
index e7cb289b65..0f09c48d6d 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -32,6 +32,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(defconst tibetan-obsolete-glyphs
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index 0262798bb2..8121045789 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -34,6 +34,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
;;; Tibetan Character set.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index b992846b0b..3f36cfbba5 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,14 +10003,14 @@ 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.
Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
(fn HOST PORT CHANNEL USER PASSWORD)")
-(register-definition-prefixes "erc" '("define-erc-module" "erc-"))
+(register-definition-prefixes "erc" '("erc-"))
;;; Generated autoloads from erc/erc-autoaway.el
@@ -9992,6 +10033,11 @@ Otherwise, connect to HOST:PORT as USER and /join
CHANNEL.
(register-definition-prefixes "erc-capab" '("erc-capab-identify-"))
+;;; Generated autoloads from erc/erc-common.el
+
+(register-definition-prefixes "erc-common" '("define-erc-module" "erc-"))
+
+
;;; Generated autoloads from erc/erc-compat.el
(register-definition-prefixes "erc-compat" '("erc-"))
@@ -10178,7 +10224,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.
@@ -10888,6 +10936,23 @@ Edit the hotlist of directory servers in a specialized
buffer." t)
(register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-"))
+;;; Generated autoloads from net/eudcb-ecomplete.el
+
+(autoload 'eudc-ecomplete-query-internal "eudcb-ecomplete" "\
+Query `ecomplete' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `ecomplete'
+does not provide attributes in the usual sense, the
+back-end-specific attribute names in
+`eudc-ecomplete-attributes-translation-alist' are used as the
+KEY (that is, the \"type\" of match) when looking for matches in
+`ecomplete-database'.
+
+RETURN-ATTRS is ignored.
+
+(fn QUERY &optional RETURN-ATTRS)")
+(register-definition-prefixes "eudcb-ecomplete"
'("eudc-ecomplete-attributes-translation-alist"))
+
+
;;; Generated autoloads from net/eudcb-ldap.el
(register-definition-prefixes "eudcb-ldap" '("eudc-"))
@@ -10903,6 +10968,26 @@ Edit the hotlist of directory servers in a specialized
buffer." t)
(register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-"))
+;;; Generated autoloads from net/eudcb-mailabbrev.el
+
+(autoload 'eudc-mailabbrev-query-internal "eudcb-mailabbrev" "\
+Query `mailabbrev' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `mailabbrev'
+does not provide attributes in the usual sense, only the email,
+name, and firstname attributes in the QUERY are considered, and
+their values are matched against the alias names in the mailrc
+file. When a mailrc alias is a distribution list, that is it
+expands to more that one email address, the individual recipient
+specifications are formatted using `eudc-rfc5322-make-address',
+and returned as a comma-separated list in the email address
+attribute.
+
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'.
+
+(fn QUERY &optional RETURN-ATTRS)")
+
+
;;; Generated autoloads from emacs-lisp/ewoc.el
(autoload 'ewoc-create "ewoc" "\
@@ -11237,7 +11322,7 @@ See `text-scale-increase' for more details.
(define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
(autoload 'text-scale-adjust "face-remap" "\
Adjust the font size in the current buffer by INC steps.
-INC may be passed as a numeric prefix argument.
+Interactively, INC is the prefix numeric argument, and defaults to 1.
The actual adjustment made depends on the final component of the
keybinding used to invoke the command, with all modifiers removed:
@@ -11247,13 +11332,14 @@ keybinding used to invoke the command, with all
modifiers removed:
\\`0' Reset the font size to the global default
After adjusting, continue to read input events and further adjust
-the font size as long as the input event read
-(with all modifiers removed) is one of the above characters.
+the font size as long as the input event (with all modifiers removed)
+is one of the above characters.
-Each step scales the height of the default face by the variable
-`text-scale-mode-step' (a negative number of steps decreases the
-height by the same amount). As a special case, an argument of 0
-will remove any scaling currently active.
+Each step scales the height of the default face by the factor that
+is the value of `text-scale-mode-step' (a negative number of steps
+decreases the height by that factor). As a special case, an argument
+of 0 will remove any scaling currently active, thus resetting the
+font size to the original value.
This command is a special-purpose wrapper around the
`text-scale-increase' command which makes repetition convenient
@@ -11279,19 +11365,22 @@ Adjust the height of the default face by the scale in
the pinch event EVENT.
(define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust)
(define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust)
(autoload 'global-text-scale-adjust "face-remap" "\
-Globally adjust the font size by INCREMENT.
+Change (a.k.a. \"adjust\") the font size of all faces by INCREMENT.
-Interactively, INCREMENT may be passed as a numeric prefix argument.
+Interactively, INCREMENT is the prefix numeric argument, and defaults
+to 1. Positive values of INCREMENT increase the font size, negative
+values decrease it.
-The adjustment made depends on the final component of the key binding
-used to invoke the command, with all modifiers removed:
+When you invoke this command, it performs the initial change of the
+font size, and after that allows further changes by typing one of the
+following keys immediately after invoking the command:
\\`+', \\`=' Globally increase the height of the default face
\\`-' Globally decrease the height of the default face
\\`0' Globally reset the height of the default face
-After adjusting, further adjust the font size as long as the key,
-with all modifiers removed, is one of the above characters.
+(The change of the font size produced by these keys depends on the
+final component of the key sequence, with all modifiers removed.)
Buffer-local face adjustments have higher priority than global
face adjustments.
@@ -12292,6 +12381,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 +14487,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 +16013,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 +16025,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 +16066,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 +16083,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 +17504,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 +19658,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-"))
@@ -21160,6 +21263,9 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
+:noquery - when exiting Emacs and the network process is running,
+don't query the user if it's non-nil.
+
:shell-command is a `format-spec' string that can be used if
:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
@@ -23007,6 +23113,81 @@ Location of the file used to speed up activation of
packages at startup." :type
(register-definition-prefixes "package" '("bad-signature" "define-package"
"describe-package-1" "package-"))
+;;; Generated autoloads from emacs-lisp/package-vc.el
+
+(defvar package-vc-selected-packages 'nil "\
+List of packages that must be installed.
+Each member of the list is of the form (NAME . SPEC), where NAME
+is a symbol designating the package and SPEC is one of:
+
+- nil, if any package version can be installed;
+- a version string, if that specific revision is to be installed;
+- a property list of the form described in
+ `package-vc-archive-spec-alist', giving a package
+ specification.
+
+This user option differs from `package-selected-packages' in that
+it is meant to be specified manually. You can also use the
+function `package-vc-selected-packages' to apply the changes.")
+(custom-autoload 'package-vc-selected-packages "package-vc" nil)
+(autoload 'package-vc-install "package-vc" "\
+Fetch a package NAME-OR-URL and set it up for using with Emacs.
+If NAME-OR-URL is a URL, download the package from the repository
+at that URL; the function will try to guess the name of the package
+from the URL. Otherwise NAME-OR-URL should be a symbol whose name
+is the package name, and the URL for the package will be taken from
+the package's metadata.
+By default, this function installs the last version of the package
+available from its repository, but if REV is given and non-nil, it
+specifies the revision to install. If REV has the special value
+`:last-release' (interactively, the prefix argument), that stands
+for the last released version of the package.
+When calling from Lisp, optional argument NAME overrides the package
+name as deduced from NAME-OR-URL.
+Optional argument BACKEND specifies the VC backend to use for cloning
+the package's repository; this is only possible if NAME-OR-URL is a URL,
+a string. If BACKEND is omitted or nil, the function
+uses `package-vc--guess-backend' to guess the backend.
+
+(fn NAME-OR-URL &optional NAME REV BACKEND)" t)
+(autoload 'package-vc-checkout "package-vc" "\
+Clone the sources for PKG-DESC into DIRECTORY and visit that directory.
+Unlike `package-vc-install', this does not yet set up the package
+for use with Emacs; use `package-vc-link-directory' for setting
+the package up after this function finishes.
+Optional argument REV means to clone a specific version of the
+package; it defaults to the last version available from the
+package's repository. If REV has the special value
+`:last-release' (interactively, the prefix argument), that stands
+for the last released version of the package.
+
+(fn PKG-DESC DIRECTORY &optional REV)" t)
+(autoload 'package-vc-install-from-checkout "package-vc" "\
+Set up the package NAME in DIR by linking it into the ELPA directory.
+Interactively, prompt the user for DIR, which should be a directory
+under version control, typically one created by `package-vc-checkout'.
+If invoked interactively with a prefix argument, prompt the user
+for the NAME of the package to set up. Otherwise infer the package
+name from the base name of DIR.
+
+(fn DIR NAME)" t)
+(autoload 'package-vc-refresh "package-vc" "\
+Refresh the installation for package given by PKG-DESC.
+Interactively, prompt for the name of the package to refresh.
+
+(fn PKG-DESC)" t)
+(autoload 'package-vc-prepare-patch "package-vc" "\
+Send patch for REVISIONS to maintainer of the package PKG using SUBJECT.
+SUBJECT and REVISIONS are passed on to `vc-prepare-patch', which see.
+PKG must be a package description.
+Interactively, prompt for PKG, SUBJECT, and REVISIONS. However,
+if the current buffer has marked commit log entries, REVISIONS
+are the tags of the marked entries, see `log-view-get-marked'.
+
+(fn PKG SUBJECT REVISIONS)" t)
+(register-definition-prefixes "package-vc" '("package-vc-"))
+
+
;;; Generated autoloads from emacs-lisp/package-x.el
(autoload 'package-upload-file "package-x" "\
@@ -24559,7 +24740,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 8 2)) package--builtin-versions)
+(push (purecopy '(project 0 8 3)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -25621,6 +25802,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 +26683,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.
@@ -26685,6 +26868,8 @@ Return ROT13 encryption of STRING.
(fn STRING)")
(autoload 'rot13-region "rot13" "\
ROT13 encrypt the region between START and END in current buffer.
+If invoked interactively and the buffer is read-only, a message
+will be printed instead.
(fn START END)" t)
(autoload 'rot13-other-window "rot13" "\
@@ -33026,7 +33211,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/ethiopic.el b/lisp/leim/quail/ethiopic.el
index c8753effe0..df4bf596cb 100644
--- a/lisp/leim/quail/ethiopic.el
+++ b/lisp/leim/quail/ethiopic.el
@@ -26,6 +26,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'quail)
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 31a34bc1de..8fe81a2217 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -371,9 +371,9 @@ 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.
+ "Customizable Tamil phonetic input method.
To change the translation rules of the input method, customize
`tamil-translation-rules'.
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index df080fc0e8..fb8b9e6166 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -359,7 +359,7 @@ input method.
The input method `japanese-zenkaku' is used to enter full width
JISX0208 characters corresponding to typed ASCII characters.
-List of the all key sequences for Roman-Kana transliteration is shown
+List of all the key sequences for Roman-Kana transliteration is shown
at the tail.
:: Kana-Kanji conversion ::
diff --git a/lisp/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/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el
index ca44f7022d..7f0848d04b 100644
--- a/lisp/leim/quail/tibetan.el
+++ b/lisp/leim/quail/tibetan.el
@@ -33,6 +33,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'quail)
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 2ae916e3ac..97d20cca15 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 "")
@@ -2775,7 +2766,7 @@ return that value."
(cond
;; nil means do nothing
((eq nil feedmail-date-generator) nil)
- ;; t is the same a using the function feedmail-default-date-generator, so
let it and recurse
+ ;; t is the same as using the function feedmail-default-date-generator, so
let it and recurse
((eq t feedmail-date-generator)
(let ((feedmail-date-generator (feedmail-default-date-generator
maybe-file)))
(feedmail-fiddle-date maybe-file)))
@@ -2831,7 +2822,7 @@ probably not appropriate for you."
(cond
;; nil means do nothing
((eq nil feedmail-message-id-generator) nil)
- ;; t is the same a using the function
feedmail-default-message-id-generator, so let it and recurse
+ ;; t is the same as using the function
feedmail-default-message-id-generator, so let it and recurse
((eq t feedmail-message-id-generator)
(let ((feedmail-message-id-generator
(feedmail-default-message-id-generator maybe-file)))
(feedmail-fiddle-message-id maybe-file)))
@@ -2873,7 +2864,7 @@ probably not appropriate for you."
(cond
;; nil means do nothing
((eq nil feedmail-x-mailer-line) nil)
- ;; t is the same a using the function feedmail-default-x-mailer-generator,
so let it and recurse
+ ;; t is the same as using the function feedmail-default-x-mailer-generator,
so let it and recurse
((eq t feedmail-x-mailer-line)
(let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
(feedmail-fiddle-x-mailer)))
diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el
index ddef7f11b6..034854dce5 100644
--- a/lisp/mail/ietf-drums-date.el
+++ b/lisp/mail/ietf-drums-date.el
@@ -126,7 +126,7 @@ treat them as whitespace (per RFC822)."
(defun ietf-drums-parse-date-string (time-string &optional error no-822)
"Parse an RFC5322 or RFC822 date, passed as TIME-STRING.
The optional ERROR parameter causes syntax errors to be flagged
-by signalling an instance of the date-parse-error condition. The
+by signaling an instance of the date-parse-error condition. The
optional NO-822 parameter disables the more lax RFC822 syntax,
which is permitted by default.
@@ -162,7 +162,7 @@ DST is returned as -1)."
(time (list nil nil nil nil nil nil nil -1 nil)))
(cl-labels ((set-matched-slot (slot index token)
;; Assign a slot value from match data if index is
- ;; non-nil, else from token, signalling an error if
+ ;; non-nil, else from token, signaling an error if
;; enabled and it's out of range.
(let ((value (if index
(cl-parse-integer (match-string index
token))
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/rfc6068.el b/lisp/mail/rfc6068.el
index 54035b6698..4863f3582c 100644
--- a/lisp/mail/rfc6068.el
+++ b/lisp/mail/rfc6068.el
@@ -43,9 +43,9 @@ string instead of decoding as utf-8."
(defun rfc6068-parse-mailto-url (mailto-url)
"Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
-MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell w/ a
+MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell with a
key of `Body' is a special case and is considered a header for this purpose.
-The returned alist is intended for use w/ the `compose-mail' interface.
+The returned alist is intended for use with the `compose-mail' interface.
Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., & -> &), before
calling this function."
(let ((case-fold-search t)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index f095d5e9c0..2421b283e6 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.
@@ -2597,7 +2599,7 @@ is greater than zero; otherwise, show it in full."
"Handle a \"Mail-Followup-To\" header field with an unknown mailing list.
Ask the user whether to add that list name to `mail-mailing-lists'."
;; FIXME s-r not needed? Use rmail-get-header?
- ;; We have not narrowed to the headers at ths point?
+ ;; We have not narrowed to the headers at this point?
(save-restriction
(let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t)))
(when mail-followup-to
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 0144a34e5e..b30c32aaff 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -50,23 +50,40 @@ Setting this option to nil might speed up the generation of
summaries."
:type 'boolean
:group 'rmail-summary)
-(defcustom rmail-summary-apply-filters-consecutively nil
- "If non-nil, Rmail summary commands apply filtering on top existing
filtering.
-When this variable is non-nil, `rmail-summary-by-*' commands work on the
-current summary, and so their filtering can be stacked one on top of another.
-This allows gradual narrowing of the selection of the messages."
+(defcustom rmail-summary-progressively-narrow nil
+ "Non-nil means progressively narrow the set of messages produced by summary.
+This allows to apply the summary criteria on top one another,
+thus progressively narrowing the selection of the messages produced
+by each summary criteria.
+For example, applying `rmail-summary-by-senders' on top
+of `rmail-summary-by-topic' produces a summary of messages
+with the specified Subjects that were sent from specified
+sending addresses.
+This way, the user can apply one summary on top of another,
+and keep narrowing the resulting list of messages."
:type 'boolean
:version "29.1"
:group 'rmail-summary)
(defvar rmail-summary-currently-displayed-msgs nil
- "String made of `y' and `n'.
-The character at position i tells wether message i is shown in the
-summary or not. First character is ignored.
-Used when applying `rmail-summary-by-*' commands consecutively. Filled
-by `rmail-summary-fill-displayed-messages'.")
+ "Boolean vector that tells which messages are displayed in the summary.
+First element is ignored. Used when applying rmail-summary-by-*
+commands consecutively. Filled by
+`rmail-summary-populate-displayed-messages'.")
(put 'rmail-summary-currently-displayed-msgs 'permanent-local t)
+(defvar rmail-summary-message-ids-hash-table nil
+ "Hash table linking Message IDs of messages with their indices.")
+
+(defvar rmail-summary-subjects-hash-table nil
+ "Hash table linking subjects with index of the first message with that
subject.")
+
+(defvar rmail-summary-message-parents-vector nil
+ "Vector that holds a list of indices of parents for each message.
+Message A is parent to message B if the id of A appear in the
+References or In-reply-to fields of B, or if A is the first
+message with the same subject as B. First element is ignored.")
+
(defvar rmail-summary-font-lock-keywords
'(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
("^ *[0-9]+-.*" . font-lock-type-face) ; Unread.
@@ -284,33 +301,85 @@ by `rmail-summary-fill-displayed-messages'.")
(defun rmail-update-summary (&rest _)
(apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
-(defun rmail-summary-fill-displayed-messages ()
- "Fill the rmail-summary-currently-displayed-msgs string."
+(defun rmail-summary-populate-displayed-messages ()
+ "Populate the `rmail-summary-currently-displayed-msgs' vector."
(with-current-buffer rmail-buffer
- (with-current-buffer rmail-summary-buffer
- (setq rmail-summary-currently-displayed-msgs
- (make-string (1+ rmail-total-messages) ?n))
- (goto-char (point-min))
- (while (not (eobp))
- (aset rmail-summary-currently-displayed-msgs
- (string-to-number (thing-at-point 'line))
- ?y)
- (forward-line 1)))))
-
-(defun rmail-summary-negate ()
- "Toggle display of messages that match the summary and those which do not."
+ (let ((totmsgs rmail-total-messages))
+ (with-current-buffer rmail-summary-buffer
+ (setq rmail-summary-currently-displayed-msgs
+ (make-bool-vector (1+ totmsgs) nil))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (aset rmail-summary-currently-displayed-msgs
+ (string-to-number (thing-at-point 'line))
+ t)
+ (forward-line 1))))))
+
+(defun rmail-summary-fill-message-ids-hash-table ()
+ "Fill `rmail-summary-message-ids-hash-table'."
+ (with-current-buffer rmail-buffer
+ (setq rmail-summary-message-ids-hash-table (make-hash-table :test 'equal
:size 1024))
+ (let ((msgnum 1))
+ (while (<= msgnum rmail-total-messages)
+ (let ((id (rmail-get-header "Message-ID" msgnum)))
+ (puthash id (cons (cons id msgnum) (gethash id
rmail-summary-message-ids-hash-table))
+ rmail-summary-message-ids-hash-table))
+ (setq msgnum (1+ msgnum))))))
+
+(defun rmail-summary--split-header-field (name &optional msgnum)
+ (let ((header (rmail-get-header name msgnum)))
+ (if header
+ (split-string header "[ \f\t\n\r\v,;]+"))))
+
+(defun rmail-summary-fill-message-parents-vector ()
+ "Fill `rmail-summary-message-parents-vector'."
+ (with-current-buffer rmail-buffer
+ (rmail-summary-fill-message-ids-hash-table)
+ (setq rmail-summary-subjects-hash-table
+ (make-hash-table :test 'equal :size 1024))
+ (setq rmail-summary-message-parents-vector
+ (make-vector (1+ rmail-total-messages) nil))
+ (let ((msgnum 1))
+ (while (<= msgnum rmail-total-messages)
+ (let* ((parents nil)
+ (subject (rmail-simplified-subject msgnum))
+ (subj-cell (gethash subject rmail-summary-subjects-hash-table))
+ (subj-par (assoc subject subj-cell))
+ (refs (rmail-summary--split-header-field "References" msgnum))
+ (reply-to (rmail-summary--split-header-field "In-reply-to"
+ msgnum)))
+ (if subj-par
+ (setq parents (cons (cdr subj-par) parents))
+ (puthash subject (cons (cons subject msgnum) subj-cell)
+ rmail-summary-subjects-hash-table))
+ (dolist (id (append refs reply-to))
+ (let ((ent
+ (assoc id
+ (gethash id rmail-summary-message-ids-hash-table))))
+ (if ent
+ (setq parents (cons (cdr ent) parents)))))
+ (aset rmail-summary-message-parents-vector msgnum parents)
+ (setq msgnum (1+ msgnum)))))))
+
+(defun rmail-summary-invert ()
+ "Invert the criteria of the current summary.
+That is, show the messages that are not displayed, and hide
+the messages that are displayed."
(interactive)
- (rmail-summary-fill-displayed-messages)
- (rmail-new-summary "Negate"
+ (rmail-summary-populate-displayed-messages)
+ (rmail-new-summary "Invert"
'(rmail-summary-by-regexp ".*")
(lambda (msg)
(if
- (= (aref rmail-summary-currently-displayed-msgs msg)
- ?n)
- (progn
- (aset rmail-summary-currently-displayed-msgs msg
?y) t)
- (progn
- (aset rmail-summary-currently-displayed-msgs msg ?n)
nil)))))
+ (not (aref rmail-summary-currently-displayed-msgs
msg))
+ (aset rmail-summary-currently-displayed-msgs msg t)
+ (aset rmail-summary-currently-displayed-msgs msg
nil)))))
+
+(defun rmail-summary--exists-1 ()
+ "Like `rmail-summary-exists', but works in both main and summary buffers."
+ (with-current-buffer rmail-buffer
+ (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
+ rmail-summary-buffer)))
;;;###autoload
(defun rmail-summary ()
@@ -318,6 +387,63 @@ by `rmail-summary-fill-displayed-messages'.")
(interactive)
(rmail-new-summary "All" '(rmail-summary) nil))
+(defun rmail-summary-direct-descendants (msgnum encountered-msgs)
+ "Find all direct descendants of MSGNUM, ignoring ENCOUNTERED-MSGS.
+Assumes `rmail-summary-message-parents-vector' is filled. Ignores messages
+already ticked in ENCOUNTERED-MSGS."
+ (let (desc
+ (msg 1))
+ (while (<= msg rmail-total-messages)
+ (when (and
+ (not (aref encountered-msgs msg))
+ (memq msgnum (aref rmail-summary-message-parents-vector msg)))
+ (setq desc (cons msg desc)))
+ (setq msg (1+ msg)))
+ desc))
+
+(defun rmail-summary--walk-thread-message-recursively (msgnum encountered-msgs)
+ "Add parents and descendants of message MSGNUM to ENCOUNTERED-MSGS,
recursively."
+ (unless (aref encountered-msgs msgnum)
+ (aset encountered-msgs msgnum t)
+ (let ((walk-thread-msg
+ (lambda (msg)
+ (rmail-summary--walk-thread-message-recursively
+ msg encountered-msgs))))
+ (mapc walk-thread-msg
+ (aref rmail-summary-message-parents-vector msgnum))
+ (mapc walk-thread-msg
+ (rmail-summary-direct-descendants msgnum encountered-msgs)))))
+
+;;;###autoload
+(defun rmail-summary-by-thread (&optional msgnum)
+ "Display a summary of messages in the same discussion thread as MSGNUM.
+Interactively, prompt for MSGNUM, defaulting to the current message.
+Threads are based on the \"Subject\", \"References\" and \"In-reply-to\"
+headers of the messages."
+ (interactive
+ (let* ((msg rmail-current-message)
+ (prompt (concat "Show thread containing message number")))
+ (list (read-number prompt msg))))
+ (with-current-buffer rmail-buffer
+ (unless msgnum
+ (setq msgnum rmail-current-message))
+ (unless (and rmail-summary-message-parents-vector
+ (= (length rmail-summary-message-parents-vector)
+ (1+ rmail-total-messages)))
+ (rmail-summary-fill-message-parents-vector))
+ (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil)))
+ (rmail-summary--walk-thread-message-recursively msgnum enc-msgs)
+ (rmail-new-summary (format "thread containing message %d" msgnum)
+ (list 'rmail-summary-by-thread msgnum)
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (lambda (msg _msgnum)
+ (and (aref
rmail-summary-currently-displayed-msgs msg)
+ (aref enc-msgs msg)))
+ (lambda (msg _msgnum)
+ (aref enc-msgs msg)))
+ msgnum))))
+
;;;###autoload
(defun rmail-summary-by-labels (labels)
"Display a summary of all messages with one or more LABELS.
@@ -327,14 +453,15 @@ LABELS should be a string containing the desired labels,
separated by commas."
(setq labels (or rmail-last-multi-labels
(error "No label specified"))))
(setq rmail-last-multi-labels labels)
- (if rmail-summary-apply-filters-consecutively
- (rmail-summary-fill-displayed-messages))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary (concat "labels " labels)
(list 'rmail-summary-by-labels labels)
- (if rmail-summary-apply-filters-consecutively
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
(lambda (msg l)
- (and (= (aref rmail-summary-currently-displayed-msgs
msg)
- ?y)
+ (and (aref rmail-summary-currently-displayed-msgs
msg)
(rmail-message-labels-p msg l)))
'rmail-message-labels-p)
(concat " \\("
@@ -349,15 +476,16 @@ but if PRIMARY-ONLY is non-nil (prefix arg given),
only look in the To and From fields.
RECIPIENTS is a regular expression."
(interactive "sRecipients to summarize by: \nP")
- (if rmail-summary-apply-filters-consecutively
- (rmail-summary-fill-displayed-messages))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary
(concat "recipients " recipients)
(list 'rmail-summary-by-recipients recipients primary-only)
- (if rmail-summary-apply-filters-consecutively
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
(lambda (msg r &optional po)
- (and (= (aref rmail-summary-currently-displayed-msgs msg)
- ?y)
+ (and (aref rmail-summary-currently-displayed-msgs msg)
(rmail-message-recipients-p msg r po)))
'rmail-message-recipients-p)
recipients primary-only))
@@ -388,14 +516,15 @@ Emacs will list the message in the summary."
(setq regexp (or rmail-last-regexp
(error "No regexp specified"))))
(setq rmail-last-regexp regexp)
- (if rmail-summary-apply-filters-consecutively
- (rmail-summary-fill-displayed-messages))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary (concat "regexp " regexp)
(list 'rmail-summary-by-regexp regexp)
- (if rmail-summary-apply-filters-consecutively
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
(lambda (msg r)
- (and (= (aref rmail-summary-currently-displayed-msgs
msg)
- ?y)
+ (and (aref rmail-summary-currently-displayed-msgs
msg)
(rmail-message-regexp-p msg r)))
'rmail-message-regexp-p)
regexp))
@@ -443,15 +572,16 @@ SUBJECT is a regular expression."
(if subject ", default current subject" "")
"): ")))
(list (read-string prompt nil nil subject) current-prefix-arg)))
- (if rmail-summary-apply-filters-consecutively
- (rmail-summary-fill-displayed-messages))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary
(concat "about " subject)
(list 'rmail-summary-by-topic subject whole-message)
- (if rmail-summary-apply-filters-consecutively
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
(lambda (msg s &optional wm)
- (and (= (aref rmail-summary-currently-displayed-msgs msg)
- ?y)
+ (and (aref rmail-summary-currently-displayed-msgs msg)
(rmail-message-subject-p msg s wm)))
'rmail-message-subject-p)
subject whole-message))
@@ -477,15 +607,16 @@ sender of the current message."
(if sender ", default this message's sender" "")
"): ")))
(list (read-string prompt nil nil sender))))
- (if rmail-summary-apply-filters-consecutively
- (rmail-summary-fill-displayed-messages))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary
(concat "senders " senders)
(list 'rmail-summary-by-senders senders)
- (if rmail-summary-apply-filters-consecutively
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
(lambda (msg s)
- (and (= (aref rmail-summary-currently-displayed-msgs msg)
- ?y)
+ (and (aref rmail-summary-currently-displayed-msgs msg)
(rmail-message-senders-p msg s)))
'rmail-message-senders-p)
senders))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 98f46a3af5..558785de14 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1350,7 +1350,7 @@ buffer."
nesting)))
(defun sc-add-citation-level ()
- "Add a citation level for nested citation style w/ coercion."
+ "Add a citation level for nested citation style with coercion."
(let* ((nesting (sc-guess-nesting))
(citation (make-string (1+ (length nesting))
(string-to-char sc-citation-delimiter)))
diff --git a/lisp/man.el b/lisp/man.el
index 7ba7bee417..3802362da0 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -331,7 +331,7 @@ This regexp should not start with a `^' character.")
;; This used to have leading space [ \t]*, but was removed because it
;; causes false page splits on an occasional NAME with leading space
;; inside a manpage. And `Man-heading-regexp' doesn't have [ \t]* anyway.
-(defvar Man-first-heading-regexp "^NAME$\\|^[ \t]*No manual entry fo.*$"
+(defvar Man-first-heading-regexp "^NAME$\\|^[ \t]*No manual entry for.*$"
"Regular expression describing first heading on a manpage.
This regular expression should start with a `^' character.")
@@ -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
@@ -1082,13 +1077,13 @@ to auto-complete your input based on the installed
manual pages."
;; unless COLUMNS or MANWIDTH is set. This isn't a problem on
;; a tty. man(1) says:
;; MANWIDTH
- ;; If $MANWIDTH is set, its value is used as the line
- ;; length for which manual pages should be formatted.
- ;; If it is not set, manual pages will be formatted
- ;; with a line length appropriate to the current ter-
- ;; minal (using an ioctl(2) if available, the value of
- ;; $COLUMNS, or falling back to 80 characters if nei-
- ;; ther is available).
+ ;; If $MANWIDTH is set, its value is used as the line
+ ;; length for which manual pages should be formatted.
+ ;; If it is not set, manual pages will be formatted
+ ;; with a line length appropriate to the current
+ ;; terminal (using an ioctl(2) if available, the value
+ ;; of $COLUMNS, or falling back to 80 characters if
+ ;; neither is available).
(when (or window-system
(not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
;; Since the page buffer is displayed beforehand,
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index 00e52df2bb..d6893fb9ec 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -2944,7 +2944,7 @@
change fixes that.
* mh-utils.el (mh-show-mode): Setup mh-show-mode to display
- elipsis for truncated header fields and to skip over them quickly.
+ ellipsis for truncated header fields and to skip over them quickly.
(mh-clean-msg-header): Make another pass over the message header
fields truncating long headers.
@@ -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/mh-e/ChangeLog.2 b/lisp/mh-e/ChangeLog.2
index 5f2dd299f8..fd597f0c00 100644
--- a/lisp/mh-e/ChangeLog.2
+++ b/lisp/mh-e/ChangeLog.2
@@ -360,8 +360,8 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * mh-alias.el (mh-alias-minibuffer-confirm-address): if if -> if it
- * mh-scan.el (mh-scan-destination-width): in in -> in
+ * mh-alias.el (mh-alias-minibuffer-confirm-address):
+ * mh-scan.el (mh-scan-destination-width): Fix typos.
2011-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 4898dfdb98..6bb0fa3ae9 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -850,7 +850,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/mpc.el b/lisp/mpc.el
index 1775e7d5e7..f878c6ca29 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -447,7 +447,7 @@ which will be concatenated with proper quoting before
passing them to MPD."
;;; Support for regularly updated current status information ;;;;;;;;;;;;;;;
;; Exported elements:
-;; `mpc-status' holds the uptodate data.
+;; `mpc-status' holds the up-to-date data.
;; `mpc-status-callbacks' holds the registered callback functions.
;; `mpc-status-refresh' forces a refresh of the data.
;; `mpc-status-stop' stops the automatic updating.
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/browse-url.el b/lisp/net/browse-url.el
index 1597f3651a..7ac6396d31 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -222,6 +222,14 @@ be used instead."
(function :tag "Other function"))
:version "26.1")
+(defcustom browse-url-irc-function 'browse-url-irc
+ "Function to open an irc:// link."
+ :type '(choice
+ (function-item :tag "Emacs IRC" :value browse-url-irc)
+ (const :tag "None" nil)
+ (function :tag "Other function"))
+ :version "29.1")
+
(defcustom browse-url-button-regexp
(concat
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|"
@@ -547,6 +555,11 @@ process), or nil (we don't know)."
(function-put 'browse-url--man 'browse-url-browser-kind
#'browse-url--browser-kind-man)
+(defun browse-url--irc (url &rest args)
+ "Call `browse-url-irc-function' with URL and ARGS."
+ (funcall browse-url-irc-function url args))
+(function-put 'browse-url--irc 'browse-url-browser-kind 'internal)
+
(defun browse-url--browser (url &rest args)
"Call `browse-url-browser-function' with URL and ARGS."
(funcall browse-url-browser-function url args))
@@ -565,6 +578,7 @@ process), or nil (we don't know)."
(defvar browse-url-default-handlers
'(("\\`mailto:"; . browse-url--mailto)
("\\`man:" . browse-url--man)
+ ("\\`irc6?s?://" . browse-url--irc)
(browse-url--non-html-file-url-p . browse-url-emacs))
"Like `browse-url-handlers' but populated by Emacs and packages.
@@ -1510,6 +1524,16 @@ used instead of `browse-url-new-window-flag'."
(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
+;; --- irc ---
+
+;;;###autoload
+(defun browse-url-irc (url &rest _)
+ "Call `url-irc' directly after parsing URL.
+This function is a fit for options like `gnus-button-alist'."
+ (url-irc (url-generic-parse-url url)))
+
+(function-put 'browse-url-irc 'browse-url-browser-kind 'internal)
+
;; --- mailto ---
(autoload 'rfc6068-parse-mailto-url "rfc6068")
diff --git a/lisp/net/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-capf.el b/lisp/net/eudc-capf.el
index 92f0c80493..e2bbd5b28b 100644
--- a/lisp/net/eudc-capf.el
+++ b/lisp/net/eudc-capf.el
@@ -123,11 +123,12 @@ queried for email addresses, and the results delivered to
(match-end 0)))
(end (point))
(prefix (save-excursion (buffer-substring-no-properties beg
end))))
- (list beg end
- (completion-table-with-cache
- (lambda (_)
- (eudc-query-with-words (split-string prefix "[ \t]+") t))
- t))))))
+ (let ((result
+ (eudc-query-with-words (split-string prefix "[ \t]+") t)))
+ (when result
+ (list beg end
+ (completion-table-with-cache
+ (lambda (_) result) t))))))))
(provide 'eudc-capf)
;;; eudc-capf.el ends here
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index dea17f3424..450943a3f0 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,7 +51,7 @@ 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
"Directory servers to query.
@@ -343,9 +346,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..4a2dd9ad4a
--- /dev/null
+++ b/lisp/net/eudcb-mailabbrev.el
@@ -0,0 +1,130 @@
+;;; 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))
+ (soft (intern-soft value mail-abbrevs))
+ (raw-matches (and
+ (boundp soft)
+ (symbol-value soft))))
+ (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/rcirc.el b/lisp/net/rcirc.el
index b7eeab1735..29957a62d0 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1353,10 +1353,10 @@ inserting the new one."
(if (use-region-p)
(let ((beg (region-beginning)))
(goto-char (region-end))
- (insert "")
+ (insert "\^O")
(goto-char beg)
(insert pre))
- (insert pre "")))
+ (insert pre "\^O")))
(when (or (not (region-active-p)) (< (point) (mark)))
(forward-char (length pre))))
@@ -1364,11 +1364,11 @@ inserting the new one."
"Remove the closes formatting found closes to the current point."
(interactive)
(save-excursion
- (when (and (search-backward-regexp (rx (or "" " " " " " " ""))
+ (when (and (search-backward-regexp (rx (or "\^B" "\^]" "\^_" "\^^" "\^Q"))
rcirc-prompt-end-marker t)
- (looking-at (rx (group (or "" " " " " " " ""))
+ (looking-at (rx (group (or "\^B" "\^]" "\^_" "\^^" "\^Q"))
(*? nonl)
- (group ""))))
+ (group "\^O"))))
(replace-match "" nil nil nil 2)
(replace-match "" nil nil nil 1))))
@@ -1378,7 +1378,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the bold formatting is
inserted."
(interactive "P")
- (rcirc-format "" replace))
+ (rcirc-format "\^B" replace))
(defun rcirc-format-italic (replace)
"Insert italic formatting.
@@ -1386,7 +1386,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the italic formatting is
inserted."
(interactive "P")
- (rcirc-format " " replace))
+ (rcirc-format "\^]" replace))
(defun rcirc-format-underline (replace)
"Insert underlining formatting.
@@ -1394,7 +1394,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the underline formatting is
inserted."
(interactive "P")
- (rcirc-format " " replace))
+ (rcirc-format "\^_" replace))
(defun rcirc-format-strike-trough (replace)
"Insert strike-trough formatting.
@@ -1402,7 +1402,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the strike-trough formatting
is inserted."
(interactive "P")
- (rcirc-format " " replace))
+ (rcirc-format "\^^" replace))
(defun rcirc-format-fixed-width (replace)
"Insert fixed-width formatting.
@@ -1410,7 +1410,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the fixed width formatting is
inserted."
(interactive "P")
- (rcirc-format "" replace))
+ (rcirc-format "\^Q" replace))
(defvar-keymap rcirc-mode-map
:doc "Keymap for rcirc mode."
@@ -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-archive.el b/lisp/net/tramp-archive.el
index 646ae86452..5b2af7c6b2 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -183,18 +183,20 @@ It must be supported by libarchive(3).")
;; The definition of `tramp-archive-file-name-regexp' contains calls
;; to `regexp-opt', which cannot be autoloaded while loading
;; loaddefs.el. So we use a macro, which is evaluated only when needed.
+;; When tramp-archive.el is unloaded and reloaded, it gripes about
+;; missing `tramp-archive{-compression]-suffixes'. We protect this.
;;;###autoload
(progn (defmacro tramp-archive-autoload-file-name-regexp ()
"Regular expression matching archive file names."
- `(rx
+ `(tramp-compat-rx
bos
;; This group is used in `tramp-archive-file-name-archive'.
(group
(+ nonl)
;; Default suffixes ...
- "." ,(cons '| tramp-archive-suffixes)
+ "." ,(cons '| (bound-and-true-p tramp-archive-suffixes))
;; ... with compression.
- (? "." ,(cons '| tramp-archive-compression-suffixes)))
+ (? "." ,(cons '| (bound-and-true-p tramp-archive-compression-suffixes))))
;; This group is used in `tramp-archive-file-name-localname'.
(group "/" (* nonl))
eos)))
@@ -330,10 +332,6 @@ arguments to pass to the OPERATION."
(inhibit-file-name-operation operation))
(apply operation args))))
-;; Starting with Emacs 29, `tramp-archive-file-name-handler' is
-;; autoloaded. But it must still be in tramp-loaddefs.el for older
-;; versions of Emacs.
-;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archive")
;;;###tramp-autoload
(defun tramp-archive-file-name-handler (operation &rest args)
"Invoke the file archive related OPERATION.
@@ -396,30 +394,30 @@ arguments to pass to the OPERATION."
(put #'tramp-archive-autoload-file-name-handler 'tramp-autoload t)
;;;###autoload
-(progn (defun tramp-register-archive-file-name-handler ()
+(progn (defun tramp-register-archive-autoload-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
(when (and tramp-archive-enabled
(not
- (rassq #'tramp-archive-file-name-handler
file-name-handler-alist)))
+ (rassq 'tramp-archive-file-name-handler
file-name-handler-alist)))
(add-to-list 'file-name-handler-alist
(cons (tramp-archive-autoload-file-name-regexp)
#'tramp-archive-autoload-file-name-handler))
(put #'tramp-archive-autoload-file-name-handler 'safe-magic t))))
-(put #'tramp-register-archive-file-name-handler 'tramp-autoload t)
+(put #'tramp-register-archive-autoload-file-name-handler 'tramp-autoload t)
;;;###autoload
(progn
- (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
+ (add-hook 'after-init-hook
#'tramp-register-archive-autoload-file-name-handler)
(add-hook
'tramp-archive-unload-hook
(lambda ()
(remove-hook
- 'after-init-hook #'tramp-register-archive-file-name-handler))))
+ 'after-init-hook #'tramp-register-archive-autoload-file-name-handler))))
;; In older Emacsen (prior 27.1), the autoload above does not exist.
;; So we call it again; it doesn't hurt.
-(tramp-register-archive-file-name-handler)
+(tramp-register-archive-autoload-file-name-handler)
;; Mark `operations' the handler is responsible for.
(put #'tramp-archive-file-name-handler 'operations
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index a1d1d284ed..252eab0f3b 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -179,7 +179,7 @@ A nil value for either argument stands for the current
time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
-;; `ignore-error' is new in Emacs Emacs 27.1.
+;; `ignore-error' is new in Emacs 27.1.
(defmacro tramp-compat-ignore-error (condition &rest body)
"Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 16c4049a68..0973258157 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -455,7 +455,7 @@ Otherwise, return NAME."
(defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile)
"Encrypt / decrypt file INFILE to OUTFILE according to encrypted directory
ROOT.
Both files must be local files. OP must be `encrypt' or `decrypt'.
-If OP ist `decrypt', the basename of INFILE must be an encrypted file name.
+If OP is `decrypt', the basename of INFILE must be an encrypted file name.
Raise an error if this fails."
(when-let ((tramp-crypt-enabled t)
(dir (tramp-crypt-file-name-p root))
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/net/trampver.el b/lisp/net/trampver.el
index 2b39add20d..caf6750c26 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -83,7 +83,7 @@
(unless (string-equal "ok" x) (error "%s" x)))
(defun tramp-inside-emacs ()
- "Version string provided by INSIDE_EMACS enmvironment variable."
+ "Version string provided by INSIDE_EMACS environment variable."
(concat (or (getenv "INSIDE_EMACS") emacs-version)
",tramp:" tramp-version))
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 9cbab29504..fb8d5322c0 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -195,7 +195,7 @@ This is not used directly, but only via inheritance by
other faces."
(defface nxml-char-ref-number
'((t (:inherit nxml-ref)))
"Face used for the number in character references.
-This includes ths `x' in hex references."
+This includes the `x' in hex references."
:group 'nxml-faces)
(defface nxml-char-ref-delimiter
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/obsolete/vi.el b/lisp/obsolete/vi.el
index 91baa4d28e..afc6284b34 100644
--- a/lisp/obsolete/vi.el
+++ b/lisp/obsolete/vi.el
@@ -927,13 +927,13 @@ it is used instead of the saved one."
(vi-repeat-last-find-char count))
(defun vi-backward-upto-char (count char)
- "Find upto the COUNT'th CHAR backward on current line."
+ "Find up to the COUNT'th CHAR backward on current line."
(interactive "p\nc")
(setq vi-last-find-char (cons -1 (cons char t)))
(vi-repeat-last-find-char count))
(defun vi-forward-upto-char (count char)
- "Find upto the COUNT'th CHAR forward on current line."
+ "Find up to the COUNT'th CHAR forward on current line."
(interactive "p\nc")
(setq vi-last-find-char (cons 1 (cons char t)))
(vi-repeat-last-find-char count))
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index 836e1430df..1491a4645a 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
@@ -10556,7 +10556,7 @@
* org-element.el (org-element-paragraph-separate): Fix comments in
paragraph separator regexp. Optimize it.
- * org-element.el: Update code commets.
+ * org-element.el: Update code comments.
* org.el (org-mark-subtree): Fix bug when marking subtree with
point on an inlinetask. Refactor code.
@@ -13798,7 +13798,7 @@
2012-01-03 Dave Abrahams <dave@boostpro.com>
* org-agenda.el (org-agenda-follow-indirect): New option.
- (org-agenda-follow-mode): Call `org-agenda-do-context-action' fro
+ (org-agenda-follow-mode): Call `org-agenda-do-context-action' from
follow mode.
(org-agenda-do-context-action): Also do indirect follow mode
action.
@@ -17948,7 +17948,7 @@
* org.el (org-narrow-to-subtree): Ensure `org-back-to-heading'
will move point to a real heading and not an inline task by
- wraping function into a `org-with-limited-levels' macro.
+ wrapping function into a `org-with-limited-levels' macro.
2011-07-28 Bastien Guerry <bzg@gnu.org>
@@ -20112,10 +20112,10 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * org-agenda.el (org-agenda-entry-types): the the -> the
- * org-table.el (org-table-get-remote-range): or or -> or
- * org-wl.el (org-wl-folder-type): the the -> the
- * org.el (org-goto, org-inside-LaTeX-fragment-p): Likewise.
+ * org-agenda.el (org-agenda-entry-types):
+ * org-table.el (org-table-get-remote-range):
+ * org-wl.el (org-wl-folder-type):
+ * org.el (org-goto, org-inside-LaTeX-fragment-p): Fix typos.
2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -24341,7 +24341,7 @@
2010-07-19 Bernt Hansen <bernt@norang.ca>
* org.el (org-time-string-to-absolute): Ignore cyclic repeater
- when displaying items on todays agenda date.
+ when displaying items on today's agenda date.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
@@ -28477,7 +28477,7 @@
(outline-end-of-subtree): Make `outline-end-of-subtree' use the
org-version of this function in Org-mode. We use advice to
implement this change, so that future changes to this function in
- outline.el wil be handled properly.
+ outline.el will be handled properly.
(org-forward-same-level, org-backward-same-level): New commands.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
@@ -28769,7 +28769,7 @@
attachments.
* org-latex.el (org-export-latex-quotation-marks): Fix export of
- quotation makrs in parenthesis.
+ quotation marks in parenthesis.
(org-remove-initial-hash): New function.
(org-export-latex-preprocess): Fix bug with infinite loop if
environment is not properly closed.
@@ -30559,7 +30559,7 @@
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
* org-archive.el (org-extract-archive-heading): Allow %s for file
- name also in achive location heading.
+ name also in archive location heading.
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
@@ -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/ob-tangle.el b/lisp/org/ob-tangle.el
index 525d27bc07..d9814a7aa6 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -433,7 +433,7 @@ non-nil, return the full association list to be used by
;; The created link is transient. Using ID is
;; not necessary, but could have side-effects if
;; used. An ID property may be added to
- ;; existing entries thus creatin unexpected file
+ ;; existing entries thus creating unexpected file
;; modifications.
(org-id-link-to-org-use-id nil)
(l (org-no-properties (org-store-link nil))))
@@ -525,7 +525,7 @@ by `org-babel-get-src-block-info'."
("link" . ,(let (;; The created link is transient.
Using ID is
;; not necessary, but could have
side-effects if
;; used. An ID property may be added
to
- ;; existing entries thus creatin
unexpected file
+ ;; existing entries thus creating
unexpected file
;; modifications.
(org-id-link-to-org-use-id nil))
(org-no-properties (org-store-link nil))))
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index 4ad1f6d345..108f031cde 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -339,7 +339,7 @@ another window."
(defcustom org-link-search-must-match-exact-headline 'query-to-create
"Non-nil means internal fuzzy links can only match headlines.
-When nil, the a fuzzy link may point to a target or a named
+When nil, the fuzzy link may point to a target or a named
construct in the document. When set to the special value
`query-to-create', offer to create a new headline when none
matched.
diff --git a/lisp/org/org-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-faces.el b/lisp/org/org-faces.el
index d96898372f..78148a1b6d 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -137,7 +137,7 @@ The following faces apply, with this priority.
Since column view works by putting overlays with a display property
over individual characters in the buffer, the face of the underlining
-character (this might for example be the a TODO keyword) might still
+character (this might for example be the TODO keyword) might still
shine through in some properties. So when your column view looks
funny, with \"random\" colors, weight, strike-through, try to explicitly
set the properties in the `org-column' face. For example, set
diff --git a/lisp/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..7d9e7e10d0 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -59,6 +59,18 @@ The recommended way to set this is with a `Local Variables:'
list
in the file it applies to.")
;;;###autoload(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
+(defvar outline-search-function nil
+ "Function to search the next outline heading.
+The function is called with four optional arguments: BOUND, MOVE, BACKWARD,
+LOOKING-AT. The first two arguments BOUND and MOVE are almost the same as
+the BOUND and NOERROR arguments of `re-search-forward', with the difference
+that MOVE accepts only a boolean, either nil or non-nil. When the argument
+BACKWARD is non-nil, the search should search backward like
+`re-search-backward' does. In case of a successful search, the
+function should return non-nil, move point, and set match-data
+appropriately. When the argument LOOKING-AT is non-nil, it should
+imitate the function `looking-at'.")
+
(defvar outline-mode-prefix-map
(let ((map (make-sparse-keymap)))
(define-key map "@" 'outline-mark-subtree)
@@ -233,7 +245,8 @@ This option is only in effect when
`outline-minor-mode-cycle' is non-nil."
(defvar outline-font-lock-keywords
'(
;; Highlight headings according to the level.
- (eval . (list (concat "^\\(?:" outline-regexp "\\).*")
+ (eval . (list (or outline-search-function
+ (concat "^\\(?:" outline-regexp "\\).*"))
0 '(if outline-minor-mode
(if outline-minor-mode-highlight
(list 'face (outline-font-lock-face)))
@@ -366,7 +379,9 @@ data reflects the `outline-regexp'.")
"Return one of `outline-font-lock-faces' for current level."
(save-excursion
(goto-char (match-beginning 0))
- (looking-at outline-regexp)
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp))
(aref outline-font-lock-faces
(% (1- (funcall outline-level))
(length outline-font-lock-faces)))))
@@ -454,7 +469,7 @@ bindings, per the current major mode."
(defcustom outline-minor-mode-highlight nil
"Whether to highlight headings in `outline-minor-mode' using font-lock
keywords.
-This option controles whether `outline-minor-mode' will use its font-lock
+This option controls whether `outline-minor-mode' will use its font-lock
keywords to highlight headings, which could potentially conflict with
font-lock faces defined by the major mode. Thus, a non-nil value will
work well only when there's no such conflict.
@@ -474,8 +489,11 @@ outline font-lock faces to those of major mode."
;; Fallback to overlays when font-lock is unsupported.
(save-excursion
(goto-char (point-min))
- (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$")))
- (while (re-search-forward regexp nil t)
+ (let ((regexp (unless outline-search-function
+ (concat "^\\(?:" outline-regexp "\\).*$"))))
+ (while (if outline-search-function
+ (funcall outline-search-function)
+ (re-search-forward regexp nil t))
(let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
(overlay-put overlay 'outline-highlight t)
;; FIXME: Is it possible to override all underlying face attributes?
@@ -507,7 +525,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 +562,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)))
@@ -588,26 +610,37 @@ or else the number of characters matched by
`outline-regexp'."
"Skip forward to just before the next heading line.
If there's no following heading line, stop before the newline
at the end of the buffer."
- (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
- nil 'move)
- (goto-char (match-beginning 0)))
- (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
- (forward-char -1)))
+ (when (if outline-search-function
+ (progn
+ ;; Emulate "\n" to force finding the next preface
+ (unless (eobp) (forward-char 1))
+ (funcall outline-search-function nil t))
+ (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
+ nil 'move))
+ (goto-char (match-beginning 0))
+ ;; Compensate "\n" from the beginning of regexp
+ (when (and outline-search-function (not (bobp))) (forward-char -1)))
+ (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
+ (forward-char -1)))
(defun outline-next-heading ()
"Move to the next (possibly invisible) heading line."
(interactive)
;; Make sure we don't match the heading we're at.
- (if (and (bolp) (not (eobp))) (forward-char 1))
- (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move)
- (goto-char (match-beginning 0))))
+ (when (and (bolp) (not (eobp))) (forward-char 1))
+ (when (if outline-search-function
+ (funcall outline-search-function nil t)
+ (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move))
+ (goto-char (match-beginning 0))))
(defun outline-previous-heading ()
"Move to the previous (possibly invisible) heading line."
(interactive)
- (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move))
+ (if outline-search-function
+ (funcall outline-search-function nil t t)
+ (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move)))
(defsubst outline-invisible-p (&optional pos)
"Non-nil if the character after POS has outline invisible property.
@@ -624,8 +657,10 @@ Only visible heading lines are considered, unless
INVISIBLE-OK is non-nil."
(let (found)
(save-excursion
(while (not found)
- (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
- nil t)
+ (or (if outline-search-function
+ (funcall outline-search-function nil nil t)
+ (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil t))
(signal 'outline-before-first-heading nil))
(setq found (and (or invisible-ok (not (outline-invisible-p)))
(point)))))
@@ -638,7 +673,9 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok
too."
(save-excursion
(beginning-of-line)
(and (bolp) (or invisible-ok (not (outline-invisible-p)))
- (looking-at outline-regexp))))
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp)))))
(defun outline-insert-heading ()
"Insert a new heading at same depth at point."
@@ -750,7 +787,9 @@ nil for WHICH, or do not pass any argument)."
(while (and (progn (outline-next-heading) (not (eobp)))
(<= (funcall outline-level) level))))
(unless (eobp)
- (looking-at outline-regexp)
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp))
(match-string-no-properties 0))))
;; Bummer!! There is no higher-level heading in the buffer.
(outline-invent-heading head nil))))
@@ -801,7 +840,9 @@ the match data is set appropriately."
(save-excursion
(setq end (copy-marker end))
(goto-char beg)
- (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)
+ (when (if outline-search-function
+ (funcall outline-search-function end)
+ (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t))
(goto-char (match-beginning 0))
(funcall fun)
(while (and (progn
@@ -869,21 +910,23 @@ A heading line is one that starts with a `*' (or that
(if (< arg 0)
(beginning-of-line)
(end-of-line))
- (let (found-heading-p)
+ (let ((regexp (unless outline-search-function
+ (concat "^\\(?:" outline-regexp "\\)")))
+ found-heading-p)
(while (and (not (bobp)) (< arg 0))
(while (and (not (bobp))
(setq found-heading-p
- (re-search-backward
- (concat "^\\(?:" outline-regexp "\\)")
- nil 'move))
+ (if outline-search-function
+ (funcall outline-search-function nil t t)
+ (re-search-backward regexp nil 'move)))
(outline-invisible-p)))
(setq arg (1+ arg)))
(while (and (not (eobp)) (> arg 0))
(while (and (not (eobp))
(setq found-heading-p
- (re-search-forward
- (concat "^\\(?:" outline-regexp "\\)")
- nil 'move))
+ (if outline-search-function
+ (funcall outline-search-function nil t)
+ (re-search-forward regexp nil 'move)))
(outline-invisible-p (match-beginning 0))))
(setq arg (1- arg)))
(if found-heading-p (beginning-of-line))))
@@ -1103,8 +1146,11 @@ of the current heading, or to 1 if the current line is
not a heading."
(interactive (list
(cond
(current-prefix-arg (prefix-numeric-value current-prefix-arg))
- ((save-excursion (beginning-of-line)
- (looking-at outline-regexp))
+ ((save-excursion
+ (beginning-of-line)
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp)))
(funcall outline-level))
(t 1))))
(if (< levels 1)
@@ -1251,7 +1297,9 @@ If INVISIBLE-OK is non-nil, also consider invisible
lines."
(setq level (funcall outline-level)))
(setq start-level level))
(setq arg (- arg 1))))
- (looking-at outline-regexp))
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp)))
(defun outline-forward-same-level (arg)
"Move forward to the ARG'th subheading at same level as this one.
@@ -1309,6 +1357,60 @@ If there is no such heading, return nil."
(if (< (funcall outline-level) level)
nil
(point)))))
+
+
+;;; Search text-property for outline headings
+
+;;;###autoload
+(defun outline-search-level (&optional bound move backward looking-at)
+ "Search for the next text property `outline-level'.
+The arguments are the same as in `outline-search-text-property',
+except the hard-coded property name `outline-level'.
+This function is intended to be used in `outline-search-function'."
+ (outline-search-text-property 'outline-level nil bound move backward
looking-at))
+
+(autoload 'text-property-search-forward "text-property-search")
+(autoload 'text-property-search-backward "text-property-search")
+
+(defun outline-search-text-property (property &optional value bound move
backward looking-at)
+ "Search for the next text property PROPERTY with VALUE.
+The rest of arguments are described in `outline-search-function'."
+ (if looking-at
+ (when (if value (eq (get-text-property (point) property) value)
+ (get-text-property (point) property))
+ (set-match-data (list (pos-bol) (pos-eol)))
+ t)
+ ;; Go to the end when in the middle of heading
+ (when (and (not backward)
+ (if value (eq (get-text-property (point) property) value)
+ (get-text-property (point) property))
+ (not (or (bobp)
+ (not (if value
+ (eq (get-text-property (1- (point)) property)
value)
+ (get-text-property (1- (point)) property))))))
+ (goto-char (1+ (pos-eol))))
+ (let ((prop-match (if backward
+ (text-property-search-backward property value (and
value t))
+ (text-property-search-forward property value (and
value t)))))
+ (if prop-match
+ (let ((beg (prop-match-beginning prop-match))
+ (end (prop-match-end prop-match)))
+ (if (or (null bound) (if backward (>= beg bound) (<= end bound)))
+ (cond (backward
+ (goto-char beg)
+ (goto-char (pos-bol))
+ (set-match-data (list (point) end))
+ t)
+ (t
+ (goto-char end)
+ (goto-char (if (bolp) (1- (point)) (pos-eol)))
+ (set-match-data (list beg (point)))
+ t))
+ (when move (goto-char bound))
+ nil))
+ (when move (goto-char (or bound (if backward (point-min)
(point-max)))))
+ nil))))
+
(defun outline-headers-as-kill (beg end)
"Save the visible outline headers between BEG and END to the kill ring.
diff --git a/lisp/proced.el b/lisp/proced.el
index a774f2dd1e..ac44ae1513 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -140,8 +140,8 @@ the external command (usually \"kill\")."
(nice "Ni" "%3d" 3 proced-< t (nice pid) (t t nil))
(thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t))
(start "Start" proced-format-start 6 proced-time-lessp nil (start pid)
(t t nil))
- (vsize "VSize" "%d" right proced-< t (vsize pid) (nil t t))
- (rss "RSS" "%d" right proced-< t (rss pid) (nil t t))
+ (vsize "VSize" proced-format-memory right proced-< t (vsize pid) (nil
t t))
+ (rss "RSS" proced-format-memory right proced-< t (rss pid) (nil t
t))
(etime "ETime" proced-format-time right proced-time-lessp t (etime
pid) (nil t t))
(pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t))
(pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t))
@@ -740,12 +740,18 @@ Proced buffers."
"Type \\<proced-mode-map>\\[quit-window] to quit, \\[proced-help] for
help")))))
(defun proced-auto-update-timer ()
- "Auto-update Proced buffers using `run-at-time'."
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (if (and (eq major-mode 'proced-mode)
- proced-auto-update-flag)
- (proced-update t t)))))
+ "Auto-update Proced buffers using `run-at-time'.
+
+If there are no proced buffers, cancel the timer."
+ (unless (seq-filter (lambda (buf)
+ (with-current-buffer buf
+ (when (eq major-mode 'proced-mode)
+ (if proced-auto-update-flag
+ (proced-update t t))
+ t)))
+ (buffer-list))
+ (cancel-timer proced-auto-update-timer)
+ (setq proced-auto-update-timer nil)))
(defun proced-toggle-auto-update (arg)
"Change whether this Proced buffer is updated automatically.
@@ -1425,6 +1431,10 @@ The return string is always 6 characters wide."
Replace newline characters by \"^J\" (two characters)."
(string-replace "\n" "^J" args))
+(defun proced-format-memory (kilobytes)
+ "Format KILOBYTES in a human readable format."
+ (funcall byte-count-to-string-function (* 1024 kilobytes)))
+
(defun proced-format (process-alist format)
"Display PROCESS-ALIST using FORMAT."
(if (symbolp format)
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-cmds.el b/lisp/progmodes/cc-cmds.el
index 38e9d6011d..7bfd6bdbd9 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1456,7 +1456,7 @@ keyword on the line, the keyword is not inserted inside a
literal, and
(defun c-align-cpp-indent-to-body ()
"Align a \"#pragma\" line under the previous line.
-This function is intented for use as a member of `c-special-indent-hook'."
+This function is intended for use as a member of `c-special-indent-hook'."
(when (assq 'cpp-macro c-syntactic-context)
(when
(save-excursion
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..7e6dd43175 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)))))
@@ -6962,7 +6963,7 @@ comment at the start of cc-engine.el for more info."
;; At each buffer change, the syntax-table properties are removed in a
;; before-change function and reapplied, when needed, in an
;; after-change function. It is far more important that the
-;; properties get removed when they they are spurious than that they
+;; properties get removed when they are spurious than that they
;; be present when wanted.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c-clear-<-pair-props (&optional pos)
@@ -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.
@@ -9035,7 +9036,8 @@ multi-line strings (but not C++, for example)."
;; o - 'found if it's a type that matches one in `c-found-types';
;; o - 'maybe if it's an identifier that might be a type;
;; o - 'decltype if it's a decltype(variable) declaration; - or
- ;; o - 'no-id if "auto" precluded parsing a type identifier.
+ ;; o - 'no-id if "auto" precluded parsing a type identifier (C++)
+ ;; or the type int was implicit (C).
;; o - nil if it can't be a type (the point isn't moved then).
;;
;; The point is assumed to be at the beginning of a token.
@@ -9059,10 +9061,11 @@ multi-line strings (but not C++, for example)."
;; Skip leading type modifiers. If any are found we know it's a
;; prefix of a type.
- (when c-opt-type-modifier-prefix-key ; e.g. "const" "volatile", but NOT
"typedef"
- (while (looking-at c-opt-type-modifier-prefix-key)
- (when (looking-at c-no-type-key)
- (setq res 'no-id))
+ (when c-maybe-typeless-specifier-re
+ (while (looking-at c-maybe-typeless-specifier-re)
+ (save-match-data
+ (when (looking-at c-no-type-key)
+ (setq res 'no-id)))
(goto-char (match-end 1))
(c-forward-syntactic-ws)
(or (eq res 'no-id)
@@ -9127,6 +9130,9 @@ multi-line strings (but not C++, for example)."
(not (eq res 'no-id))
(progn
(setq pos nil)
+ (while (and c-opt-cpp-prefix
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))
(if (looking-at c-identifier-start)
(save-excursion
(setq id-start (point)
@@ -9186,6 +9192,18 @@ multi-line strings (but not C++, for example)."
(goto-char (match-end 1))
(c-forward-syntactic-ws)))))
+ ((and (eq name-res t)
+ (eq res 'prefix)
+ (c-major-mode-is 'c-mode)
+ (save-excursion
+ (goto-char id-end)
+ (and (not (looking-at c-symbol-start))
+ (not (looking-at c-type-decl-prefix-key)))))
+ ;; A C specifier followed by an implicit int, e.g.
+ ;; "register count;"
+ (goto-char id-start)
+ (setq res 'no-id))
+
(name-res
(cond ((eq name-res t)
;; A normal identifier.
@@ -9223,7 +9241,11 @@ multi-line strings (but not C++, for example)."
(t
;; Otherwise it's an operator identifier, which is not a type.
(goto-char start)
- (setq res nil)))))
+ (setq res nil))))
+
+ ((eq res 'prefix)
+ ;; Deal with "extern "C" foo_t my_foo;"
+ (setq res nil)))
(when (not (memq res '(nil no-id)))
;; Skip trailing type modifiers. If any are found we know it's
@@ -10011,9 +10033,11 @@ This function might do hidden buffer changes."
got-suffix-after-parens id-start
paren-depth 0))
- (if (setq at-type (if (eq backup-at-type 'prefix)
- t
- backup-at-type))
+ (if (not (memq
+ (setq at-type (if (eq backup-at-type 'prefix)
+ t
+ backup-at-type))
+ '(nil no-id)))
(setq type-start backup-type-start
id-start backup-id-start)
(setq type-start start-pos
@@ -10207,7 +10231,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 +10796,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 +10939,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
@@ -11066,6 +11102,11 @@ This function might do hidden buffer changes."
;; `got-parens' or `got-suffix' is set it's "a()", "a[]", "a()[]",
;; or similar, which we accept only if the context rules out
;; expressions.
+ ;;
+ ;; If we've got at-type 'maybe, we cannot confidently promote the
+ ;; possible type to a found type.
+ (when (and (eq at-type 'maybe))
+ (setq unsafe-maybe t))
(throw 'at-decl-or-cast t)))
;; If we had a complete symbol table here (which rules out
@@ -11201,12 +11242,14 @@ This function might do hidden buffer changes."
;; Record the type's coordinates in `c-record-type-identifiers' for
;; later fontification.
- (when (and c-record-type-identifiers at-type ;; (not (eq at-type t))
+ (when (and c-record-type-identifiers
+ (not (memq at-type '(nil no-id)))
;; There seems no reason to exclude a token from
;; 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))))
@@ -12583,7 +12626,7 @@ comment at the start of cc-engine.el for more info."
(defun c-laomib-fix-elt (lwm elt paren-state)
;; Correct a c-laomib-cache entry ELT with respect to buffer changes, either
- ;; doing nothing, signalling it is to be deleted, or replacing its start
+ ;; doing nothing, signaling it is to be deleted, or replacing its start
;; point with one lower in the buffer than LWM. PAREN-STATE is the paren
;; state at LWM. Return the corrected entry, or nil (if it needs deleting).
;; Note that corrections are made by `setcar'ing the original structure,
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 291af038b7..561aa0f7e5 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -2713,7 +2713,7 @@ before the type, so such things are not necessary to
mention here.
Mentioning them here is necessary only if they can occur in other
places, or if they are followed by a construct that must be skipped
over (like the parens in the \"__attribute__\" and \"__declspec\"
-examples above). In the last case, they alse need to be present on
+examples above). In the last case, they also need to be present on
one of `c-type-list-kwds', `c-ref-list-kwds',
`c-colon-type-list-kwds', `c-paren-nontype-kwds', `c-paren-type-kwds',
`c-<>-type-kwds', or `c-<>-arglist-kwds'."
@@ -3869,6 +3869,14 @@ possible for good performance."
t)
"\\>")))
+(c-lang-defconst c-maybe-typeless-specifier-re
+ "Regexp matching keywords which might, but needn't, declare variables with
+no explicit type given, or nil in languages without such specifiers."
+ t (c-lang-const c-opt-type-modifier-prefix-key)
+ c (c-lang-const c-type-decl-prefix-keywords-key))
+(c-lang-defvar c-maybe-typeless-specifier-re
+ (c-lang-const c-maybe-typeless-specifier-re))
+
(c-lang-defconst c-type-decl-prefix-key
"Regexp matching any declarator operator that might precede the
identifier in a declaration, e.g. the \"*\" in \"char *argv\". This
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 2aa6b90dea..5a610253e0 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1235,7 +1235,7 @@ Note that the style variables are always made local to
the buffer."
(defun c-multiline-string-check-final-quote ()
;; Check that the final quote in the buffer is correctly marked or not with
- ;; a string-fence syntax-table text propery. The return value has no
+ ;; a string-fence syntax-table text property. The return value has no
;; significance.
(let (pos-ll pos-lt)
(save-excursion
@@ -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..36849492be 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)
@@ -4284,7 +4282,7 @@ end
(ebnf-eps-header-footer ebnf-eps-footer))
-;; hacked fom `ps-output-string-prim' (ps-print.el)
+;; hacked from `ps-output-string-prim' (ps-print.el)
(defun ebnf-eps-string (string)
(let* ((str string)
(len (length str))
@@ -4405,9 +4403,9 @@ end
(defvar ebnf-nprod 0)
-(defsubst ebnf-message-info (messag)
+(defsubst ebnf-message-info (msg)
(message "%s...%3d%%"
- messag
+ msg
(round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index c587061837..c1bda7081c 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -9,7 +9,7 @@
;; Keywords: convenience, languages
;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1")
(project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23"))
-;; This is is a GNU ELPA :core package. Avoid adding functionality
+;; This is a GNU ELPA :core package. Avoid adding functionality
;; that is not available in the version of Emacs recorded above or any
;; of the package dependencies.
@@ -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.
@@ -192,8 +192,9 @@ chosen (interactively or automatically)."
. ("typescript-language-server" "--stdio"))
(sh-mode . ("bash-language-server" "start"))
((php-mode phps-mode)
- . ("php" "vendor/felixfbecker/\
-language-server/bin/php-language-server.php"))
+ . ,(eglot-alternatives
+ '(("phpactor" "language-server")
+ ("php"
"vendor/felixfbecker/language-server/bin/php-language-server.php"))))
((c++-mode c-mode) . ,(eglot-alternatives
'("clangd" "ccls")))
(((caml-mode :language-id "ocaml")
@@ -206,7 +207,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 +218,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 +235,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 +299,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 +587,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 +614,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))))
@@ -817,9 +821,6 @@ treated as in `eglot--dbind'."
(project
:documentation "Project associated with server."
:accessor eglot--project)
- (spinner
- :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
- :initform `(nil nil t) :accessor eglot--spinner)
(inhibit-autoreconnect
:initform t
:documentation "Generalized boolean inhibiting auto-reconnection if true."
@@ -877,7 +878,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 +1202,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))
@@ -1232,7 +1235,7 @@ This docstring appeases checkdoc, that's all."
:request-dispatcher (funcall spread #'eglot-handle-request)
:on-shutdown #'eglot--on-shutdown
initargs))
- (cancelled nil)
+ (canceled nil)
(tag (make-symbol "connected-catch-tag")))
(when server-info
(jsonrpc--debug server "Running language server: %s"
@@ -1244,7 +1247,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
@@ -1271,7 +1274,7 @@ This docstring appeases checkdoc, that's all."
:workspaceFolders (eglot-workspace-folders server))
:success-fn
(eglot--lambda ((InitializeResult) capabilities
serverInfo)
- (unless cancelled
+ (unless canceled
(push server
(gethash project eglot--servers-by-project))
(setf (eglot--capabilities server) capabilities)
@@ -1309,13 +1312,13 @@ in project `%s'."
(when tag (throw tag t))))
:timeout eglot-connect-timeout
:error-fn (eglot--lambda ((ResponseError) code message)
- (unless cancelled
+ (unless canceled
(jsonrpc-shutdown server)
(let ((msg (format "%s: %s" code message)))
(if tag (throw tag `(error . ,msg))
(eglot--error msg)))))
:timeout-fn (lambda ()
- (unless cancelled
+ (unless canceled
(jsonrpc-shutdown server)
(let ((msg (format "Timed out after %s
seconds"
eglot-connect-timeout)))
@@ -1332,7 +1335,7 @@ in project `%s'."
(jsonrpc-name server))
nil)
(_ server)))
- (quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
+ (quit (jsonrpc-shutdown server) (setq canceled 'quit)))
(setq tag nil))))
(defun eglot--inferior-bootstrap (name contact &optional connect-args)
@@ -1425,7 +1428,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 +1499,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 +1674,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.
@@ -1670,7 +1686,7 @@ For example, to keep your Company customization, add the
symbol
`company' to this variable.")
(defun eglot--stay-out-of-p (symbol)
- "Tell if Eglot should stay of of SYMBOL."
+ "Tell if Eglot should stay out of SYMBOL."
(cl-find (symbol-name symbol) eglot-stay-out-of
:test (lambda (s thing)
(let ((re (if (symbolp thing) (symbol-name thing) thing)))
@@ -1823,13 +1839,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.
@@ -1905,12 +1921,11 @@ Uses THING, FACE, DEFS and PREPEND."
(defun eglot--mode-line-format ()
"Compose the Eglot's mode-line."
- (pcase-let* ((server (eglot-current-server))
- (nick (and server (eglot-project-nickname server)))
- (pending (and server (hash-table-count
- (jsonrpc--request-continuations server))))
- (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner
server)))
- (last-error (and server (jsonrpc-last-error server))))
+ (let* ((server (eglot-current-server))
+ (nick (and server (eglot-project-nickname server)))
+ (pending (and server (hash-table-count
+ (jsonrpc--request-continuations server))))
+ (last-error (and server (jsonrpc-last-error server))))
(append
`(,(propertize
eglot-menu-string
@@ -1936,14 +1951,11 @@ Uses THING, FACE, DEFS and PREPEND."
'((mouse-3 eglot-clear-status "Clear this status"))
(format "An error occurred: %s\n" (plist-get last-error
:message)))))
- ,@(when (and doing (not done-p))
- `("/" ,(eglot--mode-line-props doing
- 'compilation-mode-line-run '())))
- ,@(when (cl-plusp pending)
- `("/" ,(eglot--mode-line-props
- (format "%d" pending) 'warning
- '((mouse-3 eglot-forget-pending-continuations
- "Forget pending continuations"))
+ ,@(when (cl-plusp pending)
+ `("/" ,(eglot--mode-line-props
+ (format "%d" pending) 'warning
+ '((mouse-3 eglot-forget-pending-continuations
+ "Forget pending continuations"))
"Number of outgoing, \
still unanswered LSP requests to the server\n"))))))))
@@ -2280,8 +2292,7 @@ Instead of a plist, an alist ((SECTION . VALUE) ...) can
be used
instead, but this variant is less reliable and not recommended.
This variable should be set as a directory-local variable. See
-See info node `(emacs)Directory Variables' for various ways to to
-that.
+info node `(emacs)Directory Variables' for various ways to do that.
Here's an example value that establishes two sections relevant to
the Pylsp and Gopls LSP servers:
@@ -2350,10 +2361,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)
@@ -2395,7 +2407,6 @@ When called interactively, use the currently active
server"
vconcat `[,(list :range `(:start ,beg :end ,end)
:rangeLength len :text text)]))))
(setq eglot--recent-changes nil)
- (setf (eglot--spinner server) (list nil :textDocument/didChange t))
(jsonrpc--call-deferred server))))
(defun eglot--signal-textDocument/didOpen ()
@@ -2916,7 +2927,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 +3104,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 +3133,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)
@@ -3212,7 +3205,7 @@ at point. With prefix argument, prompt for ACTION-KIND."
actions)))
(defun eglot--read-execute-code-action (actions server &optional action-kind)
- "Helper for interactive calls to `eglot-code-actions'"
+ "Helper for interactive calls to `eglot-code-actions'."
(let* ((menu-items
(or (cl-loop for a in actions
collect (cons (plist-get a :title) a))
@@ -3265,8 +3258,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 +3272,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/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 537b9484bd..7c470de195 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -52,7 +52,7 @@ All commands in `lisp-mode-shared-map' are inherited by this
map."
:parent lisp-mode-shared-map
"M-TAB" #'completion-at-point
"C-M-x" #'eval-defun
- "C-c C-e" #'elisp-eval-buffer
+ "C-c C-e" #'elisp-eval-region-or-buffer
"C-c C-f" #'elisp-byte-compile-file
"C-c C-b" #'elisp-byte-compile-buffer
"C-M-q" #'indent-pp-sexp)
@@ -280,7 +280,9 @@ Comments in the form will be lost."
(remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
(defun elisp-enable-lexical-binding (&optional interactive)
- "Make the current buffer use `lexical-binding'."
+ "Make the current buffer use `lexical-binding'.
+INTERACTIVE non-nil means ask the user for confirmation; this
+happens in interactive invocations."
(interactive "p")
(if lexical-binding
(when interactive
@@ -360,7 +362,7 @@ be used instead.
;;; Completion at point for Elisp
(defun elisp--local-variables-1 (vars sexp)
- "Return the vars locally bound around the witness, or nil if not found."
+ "Return VARS locally bound around the witness, or nil if not found."
(let (res)
(while
(unless
@@ -463,7 +465,7 @@ be used instead.
lastvars)))))
(defun elisp--expect-function-p (pos)
- "Return non-nil if the symbol at point is expected to be a function."
+ "Return non-nil if the symbol at position POS is expected to be a function."
(or
(and (eq (char-before pos) ?')
(eq (char-before (1- pos)) ?#))
@@ -1232,7 +1234,7 @@ All commands in `lisp-mode-shared-map' are inherited by
this map."
:parent lisp-mode-shared-map
"C-M-x" #'eval-defun
"C-M-q" #'indent-pp-sexp
- "C-c C-e" #'elisp-eval-buffer
+ "C-c C-e" #'elisp-eval-region-or-buffer
"C-c C-b" #'elisp-byte-compile-buffer
"M-TAB" #'completion-at-point
"C-j" #'eval-print-last-sexp)
@@ -1331,12 +1333,12 @@ Semicolons start comments.
(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value into current buffer.
+Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix numeric argument.
Normally, this function truncates long output according to the value
of the variables `eval-expression-print-length' and
-`eval-expression-print-level'. With a prefix argument of zero,
-however, there is no such truncation. Such a prefix argument
-also causes integers to be printed in several additional formats
-\(octal, hexadecimal, and character).
+`eval-expression-print-level'. But if EVAL-LAST-SEXP-ARG-INTERNAL is zero,
+there is no such truncation, and integers are printed in several additional
+formats (octal, hexadecimal, and character).
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
@@ -1557,8 +1559,8 @@ POS specifies the starting position where EXP was found
and defaults to point."
(defun eval-last-sexp (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in the echo area.
-Interactively, with a non `-' prefix argument, print output into
-current buffer.
+Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix argument.
+With a non `-' prefix argument, print output into current buffer.
This commands handles `defvar', `defcustom' and `defface' the
same way that `eval-defun' does. See the doc string of that
@@ -1588,7 +1590,7 @@ this command arranges for all errors to enter the
debugger."
(car value))))
(defun elisp--eval-defun-1 (form)
- "Treat some expressions specially.
+ "Treat some expressions in FORM specially.
Reset the `defvar' and `defcustom' variables to the initial value.
\(For `defcustom', use the :set function if there is one.)
Reinitialize the face according to the `defface' specification."
@@ -1688,15 +1690,21 @@ Return the result of evaluation."
elisp--eval-defun-result))
(defun eval-defun (edebug-it)
- "Evaluate the top-level form containing point.
+ "Evaluate top-level form around point and instrument it if EDEBUG-IT is
non-nil.
+Interactively, EDEBUG-IT is the prefix argument.
+If `edebug-all-defs' is non-nil, that inverts the meaning of EDEBUG-IT
+and the prefix argument: this function will instrument the form
+unless EDEBUG-IT is non-nil. The command `edebug-all-defs' toggles
+the value of the variable `edebug-all-defs'.
+
If point isn't in a top-level form, evaluate the first top-level
form after point. If there is no top-level form after point,
-eval the first preceeding top-level form.
+evaluate the first preceding top-level form.
If the current defun is actually a call to `defvar' or `defcustom',
evaluating it this way resets the variable using its initial value
expression (using the defcustom's :set function if there is one), even
-if the variable already has some other value. \(Normally `defvar' and
+if the variable already has some other value. (Normally `defvar' and
`defcustom' do not alter the value if there already is one.) In an
analogous way, evaluating a `defface' overrides any customizations of
the face, so that it becomes defined exactly as the `defface' expression
@@ -1705,8 +1713,6 @@ says.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger.
-With a prefix argument, instrument the code for Edebug.
-
If acting on a `defun' for FUNCTION, and the function was
instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
instrumented, just FUNCTION is printed.
@@ -1734,7 +1740,8 @@ which see."
;;; ElDoc Support
(defvar elisp--eldoc-last-data (make-vector 3 nil)
- "Bookkeeping; elements are as follows:
+ "Bookkeeping.
+Elements are as follows:
0 - contains the last symbol read from the buffer.
1 - contains the string last displayed in the echo area for variables,
or argument string for functions.
@@ -1766,7 +1773,7 @@ it is preferable to use ElDoc's interfaces directly.")
"use ElDoc's interfaces instead." "28.1")
(defun elisp-eldoc-funcall (callback &rest _ignored)
- "Document function call at point.
+ "Document function call at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see)."
(let* ((sym-info (elisp--fnsym-in-current-sexp))
(fn-sym (car sym-info)))
@@ -1778,7 +1785,7 @@ Intended for `eldoc-documentation-functions' (which see)."
'font-lock-keyword-face)))))
(defun elisp-eldoc-var-docstring (callback &rest _ignored)
- "Document variable at point.
+ "Document variable at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see).
Also see `elisp-eldoc-var-docstring-with-value'."
(let* ((sym (elisp--current-symbol))
@@ -1789,7 +1796,7 @@ Also see `elisp-eldoc-var-docstring-with-value'."
:face 'font-lock-variable-name-face))))
(defun elisp-eldoc-var-docstring-with-value (callback &rest _)
- "Document variable at point.
+ "Document variable at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see).
Compared to `elisp-eldoc-var-docstring', this also includes the
current variable value and a bigger chunk of the docstring."
@@ -1817,6 +1824,7 @@ current variable value and a bigger chunk of the
docstring."
(defun elisp-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
+INDEX is the index of the parameter in the returned string to highlight.
If SYM is a subr and no arglist is obtainable from the docstring
or elsewhere, return a 1-line docstring."
(let ((argstring
@@ -1847,7 +1855,8 @@ or elsewhere, return a 1-line docstring."
sym argstring index))))
(defun elisp--highlight-function-argument (sym args index)
- "Highlight argument INDEX in ARGS list for function SYM."
+ "Highlight the argument of function SYM whose index is INDEX.
+ARGS is the argument list of function SYM."
;; FIXME: This should probably work on the list representation of `args'
;; rather than its string representation.
;; FIXME: This function is much too long, we need to split it up!
@@ -2203,11 +2212,17 @@ Runs in a batch-mode Emacs. Interactively use variable
(terpri)
(pp collected)))
-(defun elisp-eval-buffer ()
- "Evaluate the forms in the current buffer."
+(defun elisp-eval-region-or-buffer ()
+ "Evaluate the forms in the active region or the whole current buffer.
+In Transient Mark mode when the mark is active, call `eval-region'.
+Otherwise, call `eval-buffer'."
(interactive)
- (eval-buffer)
- (message "Evaluated the %s buffer" (buffer-name)))
+ (if (use-region-p)
+ (eval-region (region-beginning) (region-end))
+ (eval-buffer))
+ (message "Evaluated the %s%s buffer"
+ (if (use-region-p) "region in the " "")
+ (buffer-name)))
(defun elisp-byte-compile-file (&optional load)
"Byte compile the file the current buffer is visiting.
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 294cf47087..adb984c3e5 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1133,7 +1133,7 @@ special *Flymake log* buffer." :group 'flymake :lighter
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
(add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t)
- ;; If Flymake happened to be already already ON, we must cleanup
+ ;; If Flymake happened to be already ON, we must cleanup
;; existing diagnostic overlays, lest we forget them by blindly
;; reinitializing `flymake--state' in the next line.
;; See https://github.com/joaotavora/eglot/issues/223.
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 6de079f05a..655dd6a5d9 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
@@ -278,7 +276,7 @@ START, END and COMMENT-START are regular expressions. A
block is
defined as text surrounded by START and END.
As a special case, START may be a list of the form (COMPLEX-START
-MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and
+MDATA-SELECTOR), where COMPLEX-START is a regexp with multiple parts and
MDATA-SELECTOR an integer that specifies which sub-match is the proper
place to adjust point, before calling `hs-forward-sexp-func'. Point
is adjusted to the beginning of the specified match. For example,
@@ -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."
@@ -580,7 +576,7 @@ property of an overlay."
(save-match-data (not (nth 8 (syntax-ppss))))))
(defun hs-forward-sexp (match-data arg)
- "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG.
+ "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' with ARG.
Original match data is restored upon return."
(save-match-data
(set-match-data match-data)
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/prog-mode.el b/lisp/progmodes/prog-mode.el
index f87230bd2f..58cb48f182 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -155,7 +155,7 @@ which case it will be used to compose the new symbol as per
the
third argument of `compose-region'.")
(defun prettify-symbols-default-compose-p (start end _match)
- "Return non-nil iff the symbol MATCH should be composed.
+ "Return non-nil if the symbol MATCH should be composed.
The symbol starts at position START and ends at position END.
This is the default for `prettify-symbols-compose-predicate'
which is suitable for most programming languages such as C or Lisp."
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ac278edd40..63510e9050 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))
@@ -710,6 +712,7 @@ DIRS must contain directory names."
(define-key map "G" 'project-or-external-find-regexp)
(define-key map "r" 'project-query-replace-regexp)
(define-key map "x" 'project-execute-extended-command)
+ (define-key map "\C-b" 'project-list-buffers)
map)
"Keymap for project commands.")
@@ -1220,13 +1223,38 @@ displayed."
(interactive (list (project--read-project-buffer)))
(display-buffer-other-frame buffer-or-name))
+;;;###autoload
+(defun project-list-buffers (&optional arg)
+ "Display a list of project buffers.
+The list is displayed in a buffer named \"*Buffer List*\".
+
+By default, all project buffers are listed except those whose names
+start with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files."
+ (interactive "P")
+ (let ((pr (project-current t)))
+ (display-buffer
+ (if (version< emacs-version "29.0.50")
+ (let ((buf (list-buffers-noselect arg (project-buffers pr))))
+ (with-current-buffer buf
+ (setq-local revert-buffer-function
+ (lambda (&rest _ignored)
+ (list-buffers--refresh (project-buffers pr))
+ (tabulated-list-print t))))
+ buf)
+ (list-buffers-noselect
+ arg nil (lambda (buf) (memq buf (project-buffers pr))))))))
+
(defcustom project-kill-buffer-conditions
'(buffer-file-name ; All file-visiting buffers are included.
- ;; Most of 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 +1305,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 +1680,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/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/sh-script.el b/lisp/progmodes/sh-script.el
index 558b62b20a..4deb06bde4 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -522,7 +522,7 @@ This is buffer-local in every such buffer.")
(rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=")
(sh . "\\<\\([[:alnum:]_]+\\)="))
"Regexp for the variable name and what may follow in an assignment.
-First grouping matches the variable name. This is upto and including the `='
+First grouping matches the variable name. This is up to and including the `='
sign. See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
(choice regexp
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..e585799dc6 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -781,7 +781,7 @@ host key."
;; Perform search
(dolist (s (auth-source-search :max 1000))
(when (and
- ;; Is PRODUCT specified, in the enty, and they are equal
+ ;; Is PRODUCT specified, in the entry, and they are equal
(if product
(if (plist-member s :product)
(equal (plist-get s :product) product)
@@ -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/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 310a9be4f6..e5458e6a07 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -7719,7 +7719,7 @@ nil otherwise."
(setq match t)
(setq elm nil))
(setq elm (cdr elm)))))
- ;; If this is a test just for exact match, return nil ot t
+ ;; If this is a test just for exact match, return nil or t
(if (and (equal flag 'lambda) (not (equal match 't)))
nil
match))))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index bb36688ef8..89a090ae93 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1237,16 +1237,21 @@ local keymap that binds `RET' to
`xref-quit-and-goto-xref'."
(max-height (/ (window-height) 2))
(size-fun (lambda (window)
(fit-window-to-buffer window max-height)))
+ xref-alist
buf)
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
+ ;; Call it here because it can call (project-current), and that
+ ;; might depend on individual buffer, not just directory.
+ (setq xref-alist (xref--analyze xrefs))
+
(with-current-buffer (get-buffer-create xref-buffer-name)
(xref--ensure-default-directory dd (current-buffer))
(xref--transient-buffer-mode)
- (xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
+ (xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer)
`(display-buffer-in-direction . ((direction . below)
(window-height .
,size-fun))))
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 0ae68d6024..33e8d98ce3 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -582,28 +582,57 @@ Used in `repeat-mode'."
(push s (alist-get (get s 'repeat-map) keymaps)))))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (insert "A list of keymaps used by commands with the symbol property
`repeat-map'.\n\n")
+ (insert "A list of keymaps used by commands with the symbol property
`repeat-map'.\n")
(dolist (keymap (sort keymaps (lambda (a b)
(when (and (symbolp (car a))
(symbolp (car b)))
- (string-lessp (car a) (car b))))))
- (insert (format-message
- "`%s' keymap is repeatable by these commands:\n"
- (car keymap)))
- (dolist (command (sort (cdr keymap) #'string-lessp))
- (let* ((info (help-fns--analyze-function command))
- (map (list (if (symbolp (car keymap))
- (symbol-value (car keymap))
- (car keymap))))
- (desc (mapconcat (lambda (key)
- (propertize (key-description key)
- 'face 'help-key-binding))
- (or (where-is-internal command map)
- (where-is-internal (nth 3 info) map))
- ", ")))
- (insert (format-message " `%s' (bound to %s)\n" command
desc))))
- (insert "\n")))))))
+ (string< (car a) (car b))))))
+ (insert (format-message "\f\n* `%s'\n" (car keymap)))
+ (when (symbolp (car keymap))
+ (insert (substitute-command-keys (format-message "\\{%s}" (car
keymap)))))
+
+ (let* ((map (if (symbolp (car keymap))
+ (symbol-value (car keymap))
+ (car keymap)))
+ (repeat-commands (cdr keymap))
+ map-commands commands-enter commands-exit)
+ (map-keymap (lambda (_key cmd)
+ (when (symbolp cmd) (push cmd map-commands)))
+ map)
+ (setq map-commands (seq-uniq map-commands))
+ (setq commands-enter (seq-difference repeat-commands
map-commands))
+ (setq commands-exit (seq-difference map-commands
repeat-commands))
+
+ (when (or commands-enter commands-exit)
+ (when commands-enter
+ (insert "\n** Entered with:\n\n")
+ (fill-region-as-paragraph
+ (point)
+ (progn
+ (insert (mapconcat (lambda (cmd)
+ (format-message "`%s'" cmd))
+ (sort commands-enter #'string<)
+ ", "))
+ (point)))
+ (insert "\n"))
+ (when commands-exit
+ (insert "\n** Exited with:\n\n")
+ (fill-region-as-paragraph
+ (point)
+ (progn
+ (insert (mapconcat (lambda (cmd)
+ (format-message "`%s'" cmd))
+ (sort commands-exit #'string<)
+ ", "))
+ (point)))
+ (insert "\n")))))
+
+ ;; Hide ^Ls.
+ (goto-char (point-min))
+ (while (search-forward "\n\f\n" nil t)
+ (put-text-property (1+ (match-beginning 0)) (1- (match-end 0))
+ 'invisible t)))))))
(provide 'repeat)
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/scroll-bar.el b/lisp/scroll-bar.el
index 5786a21e88..dbe2b6241f 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -390,7 +390,7 @@ EVENT should be a scroll bar click."
(setq point-before-scroll before-scroll)))))
-;;; Tookit scroll bars.
+;;; Toolkit scroll bars.
(defun scroll-bar-toolkit-scroll (event)
"Handle event EVENT on vertical scroll bar."
diff --git a/lisp/server.el b/lisp/server.el
index 90d97c1538..2973b783e6 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -670,7 +670,6 @@ the `server-process' variable."
"/tmp/")
(ignore-errors
(delete-directory (file-name-directory server-file))))))
- (setq server-mode nil) ;; already set by the minor mode code
(display-warning
'server
(concat "Unable to start the Emacs server.\n"
@@ -688,7 +687,9 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
(if leave-dead
(progn
(unless (eq t leave-dead) (server-log (message "Server stopped")))
- (setq server-process nil))
+ (setq server-mode nil
+ global-minor-modes (delq 'server-mode global-minor-modes)
+ server-process nil))
;; Make sure there is a safe directory in which to place the socket.
(server-ensure-safe-dir server-dir)
(when server-process
@@ -716,7 +717,10 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
;; Those are decoded by server-process-filter according
;; to file-name-coding-system. Also don't get
;; confused by CRs since we don't quote them.
- :coding 'raw-text-unix
+ ;; For encoding, we must use the locale's encoding,
+ ;; since emacsclient shows that verbatim on the
+ ;; console.
+ :coding (cons 'raw-text-unix locale-coding-system)
;; The other args depend on the kind of socket used.
(if server-use-tcp
(list :family 'ipv4 ;; We're not ready for IPv6 yet
@@ -728,6 +732,8 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
:plist '(:authenticated t)))))
(unless server-process (error "Could not start server process"))
(process-put server-process :server-file server-file)
+ (setq server-mode t)
+ (push 'server-mode global-minor-modes)
(when server-use-tcp
(let ((auth-key (server-get-auth-key)))
(process-put server-process :auth-key auth-key)
@@ -796,6 +802,10 @@ by the current Emacs process, use the `server-process'
variable."
t)
(file-error nil)))
+;; This keymap is empty, but allows users to define keybindings to use
+;; when `server-mode' is active.
+(defvar-keymap server-mode-map)
+
;;;###autoload
(define-minor-mode server-mode
"Toggle Server mode.
@@ -805,6 +815,7 @@ Server mode runs a process that accepts commands from the
`server-start' for details."
:global t
:version "22.1"
+ :keymap server-mode-map
;; Fixme: Should this check for an existing server socket and do
;; nothing if there is one (for multiple Emacs sessions)?
(server-start (not server-mode)))
diff --git a/lisp/shell.el b/lisp/shell.el
index 641f274045..7c3c925ab8 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -393,6 +393,14 @@ Useful for shells like zsh that has this feature."
'complete-expand)
map))
+(defvar-keymap shell-repeat-map
+ :doc "Keymap to repeat shell key sequences. Used in `repeat-mode'."
+ "C-f" #'shell-forward-command
+ "C-b" #'shell-backward-command)
+
+(put #'shell-forward-command 'repeat-map 'shell-repeat-map)
+(put #'shell-backward-command 'repeat-map 'shell-repeat-map)
+
(defcustom shell-mode-hook '()
"Hook for customizing Shell mode."
:type 'hook
diff --git a/lisp/simple.el b/lisp/simple.el
index e804f717b0..0f44b14948 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2491,9 +2491,15 @@ 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
+ (propertize (cond (shorter (concat "M-x " shorter))
+ ((stringp binding) binding)
+ (t (key-description binding)))
+ 'face 'help-key-binding)))
+
(defun execute-extended-command (prefixarg &optional command-name typed)
- ;; 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 +2522,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 +2546,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 +2562,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 +2576,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 +2650,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/so-long.el b/lisp/so-long.el
index 75201fefca..661f5ee57a 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -839,7 +839,7 @@ was established."
)
;; It's not clear to me whether all of these would be problematic, but they
;; seemed like reasonable targets. Some are certainly excessive in smaller
- ;; buffers of minified code, but we should be aiming to maximise performance
+ ;; buffers of minified code, but we should be aiming to maximize performance
;; by default, so that Emacs is as responsive as we can manage in even very
;; large buffers of minified code.
"List of buffer-local minor modes to explicitly disable.
@@ -880,7 +880,7 @@ If `so-long-revert' is subsequently invoked, then the
variables are restored
to their original states.
The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled)
-is important for maximising responsiveness when moving vertically within an
+is important for maximizing responsiveness when moving vertically within an
extremely long line, as otherwise the full length of the line may need to be
scanned to find the next position.
diff --git a/lisp/startup.el b/lisp/startup.el
index 70267fc857..5e0a47d3f8 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1063,19 +1063,30 @@ init-file, or to a default value if loading is not
possible."
;; If we loaded a compiled file, set `user-init-file' to
;; the source version if that exists.
- (when (equal (file-name-extension user-init-file)
- "elc")
- (let* ((source (file-name-sans-extension user-init-file))
- (alt (concat source ".el")))
- (setq source (cond ((file-exists-p alt) alt)
- ((file-exists-p source) source)
- (t nil)))
- (when source
- (when (file-newer-than-file-p source user-init-file)
- (message "Warning: %s is newer than %s"
- source user-init-file)
- (sit-for 1))
- (setq user-init-file source))))
+ (if (equal (file-name-extension user-init-file) "elc")
+ (let* ((source (file-name-sans-extension user-init-file))
+ (alt (concat source ".el")))
+ (setq source (cond ((file-exists-p alt) alt)
+ ((file-exists-p source) source)
+ (t nil)))
+ (when source
+ (when (file-newer-than-file-p source user-init-file)
+ (message "Warning: %s is newer than %s"
+ source user-init-file)
+ (sit-for 1))
+ (setq user-init-file source)))
+ ;; Else, perhaps the user init file was compiled
+ (when (and (equal (file-name-extension user-init-file) "eln")
+ ;; The next test is for builds without native
+ ;; compilation support or builds with unexec.
+ (boundp 'comp-eln-to-el-h))
+ (if-let (source (gethash (file-name-nondirectory
user-init-file)
+ comp-eln-to-el-h))
+ ;; source exists or the .eln file would not load
+ (setq user-init-file source)
+ (message "Warning: unknown source file for init file %S"
+ user-init-file)
+ (sit-for 1))))
(when (and load-defaults
(not inhibit-default-init))
diff --git a/lisp/subr.el b/lisp/subr.el
index 86a3b7ae99..7dd8ff2081 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))
@@ -2582,7 +2584,7 @@ Uses the `derived-mode-parent' property of the symbol to
trace backwards."
(defun major-mode-restore (&optional avoided-modes)
"Restore major mode earlier suspended with `major-mode-suspend'.
If there was no earlier suspended major mode, then fallback to `normal-mode',
-tho trying to avoid AVOIDED-MODES."
+though trying to avoid AVOIDED-MODES."
(if major-mode--suspended
(funcall (prog1 major-mode--suspended
(kill-local-variable 'major-mode--suspended)))
@@ -6926,7 +6928,7 @@ string will be displayed only if BODY takes longer than
TIMEOUT seconds.
If FUNC is a function alias, return the function alias chain.
If the function alias chain contains loops, an error will be
-signalled. If NOERROR, the non-loop parts of the chain is returned."
+signaled. If NOERROR, the non-loop parts of the chain is returned."
(declare (side-effect-free t))
(let ((chain nil)
(orig-func func))
@@ -7076,7 +7078,7 @@ CONDITION is either:
(defun match-buffers (condition &optional buffers arg)
"Return a list of buffers that match CONDITION.
-See `buffer-match' for details on CONDITION. By default all
+See `buffer-match-p' for details on CONDITION. By default all
buffers are checked, this can be restricted by passing an
optional argument BUFFERS, set to a list of buffers to check.
ARG is passed to `buffer-match', for predicate conditions in
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 2032689c65..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.
@@ -2207,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.
@@ -2225,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)
@@ -2244,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))
@@ -2254,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/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index f3f95627af..41a5b52f99 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -96,7 +96,7 @@ Find the bof of the current file."
"Return list of bibfiles for current document.
When using the chapterbib or bibunits package you should either
use the same database files everywhere, or separate parts using
-different databases into different files (included into the mater file).
+different databases into different files (included into the master file).
Then this function will return the applicable database files."
;; Ensure access to scanning info
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 075ad666b3..38d6ebe7e6 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1807,7 +1807,7 @@ With optional arg ALLOW-NEWLINE, allow single newline
between words."
(defun reftex-index-phrases-find-dup-re (phrase &optional sub)
"Return a regexp which matches variations of PHRASE (with additional space).
When SUB ins non-nil, the regexp will also match when PHRASE is a subphrase
-of another phrase. The regexp works lonly in the phrase buffer."
+of another phrase. The regexp works only in the phrase buffer."
(concat (if sub "^\\S-?\t\\([^\t\n]*" "^\\S-?\t")
(mapconcat #'regexp-quote (split-string phrase) " +")
(if sub "[^\t\n]*\\)\\([\t\n]\\|$\\)" " *\\([\t\n]\\|$\\)")))
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/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index ca0312d8fb..a1914a8cc8 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -2238,7 +2238,7 @@ of the current buffer."
"&")))
(defun tex-uptodate-p (file)
- "Return non-nil if FILE is not uptodate w.r.t the document source files.
+ "Return non-nil if FILE is not up-to-date w.r.t the document source files.
FILE is typically the output DVI or PDF file."
;; We should check all the files included !!!
(and
@@ -2375,7 +2375,7 @@ Only applies the FSPEC to the args part of FORMAT."
(push cmd tmp)))
;; Only remove if there's something left.
(if tmp (setq cmds (nreverse tmp))))
- ;; Remove commands whose input is not uptodate either.
+ ;; Remove commands whose input is not up-to-date either.
(let ((outs (delq nil (mapcar (lambda (x) (nth 2 x)) cmds)))
(tmp nil))
(dolist (cmd cmds)
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/ChangeLog.1 b/lisp/url/ChangeLog.1
index 2f7813e64c..1b5ddc1e76 100644
--- a/lisp/url/ChangeLog.1
+++ b/lisp/url/ChangeLog.1
@@ -366,7 +366,7 @@
* url.el, url-queue.el, url-parse.el, url-http.el, url-future.el:
* url-dav.el, url-cookie.el: Use cl-lib.
* url-util.el, url-privacy.el, url-nfs.el, url-misc.el, url-methods.el:
- * url-gw.el, url-file.el, url-expand.el: Dont use CL.
+ * url-gw.el, url-file.el, url-expand.el: Don't use CL.
2012-06-30 Glenn Morris <rgm@gnu.org>
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 9161f7d13e..f97b6de6fe 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -38,11 +38,13 @@ The function should take the following arguments:
PORT - the port number of the IRC server to contact
CHANNEL - What channel on the server to visit right away (can be nil)
USER - What username to use
-PASSWORD - What password to use"
+PASSWORD - What password to use.
+ SCHEME - a URI scheme, such as \"irc\" or \"ircs\""
:type '(choice (const :tag "rcirc" :value url-irc-rcirc)
(const :tag "ERC" :value url-irc-erc)
(const :tag "ZEN IRC" :value url-irc-zenirc)
(function :tag "Other"))
+ :version "29.1" ; Added SCHEME
:group 'url)
;; External.
@@ -51,7 +53,7 @@ PASSWORD - What password to use"
(defvar zenirc-server-alist)
(defvar zenirc-buffer-name)
-(defun url-irc-zenirc (host port channel user password)
+(defun url-irc-zenirc (host port channel user password _)
(let ((zenirc-buffer-name (if (and user host port)
(format "%s@%s:%d" user host port)
(format "%s:%d" host port)))
@@ -65,14 +67,14 @@ PASSWORD - What password to use"
(insert "/join " channel)
(zenirc-send-line))))
-(defun url-irc-rcirc (host port channel user password)
+(defun url-irc-rcirc (host port channel user password _)
(let ((chan (when channel (concat "#" channel))))
(rcirc-connect host port user nil nil (when chan (list chan)) password)
(when chan
(switch-to-buffer (concat chan "@" host)))))
-(defun url-irc-erc (host port channel user password)
- (erc-handle-irc-url host port channel user password))
+(defun url-irc-erc (host port channel user password scheme)
+ (erc-handle-irc-url host port channel user password scheme))
;;;###autoload
(defun url-irc (url)
@@ -80,16 +82,32 @@ PASSWORD - What password to use"
(port (url-port url))
(pass (url-password url))
(user (url-user url))
- (chan (url-filename url)))
+ (chan (url-filename url))
+ (type (url-type url))
+ (compatp (eql 5 (cdr (func-arity url-irc-function)))))
(if (url-target url)
(setq chan (concat chan "#" (url-target url))))
(if (string-match "^/" chan)
(setq chan (substring chan 1 nil)))
(if (= (length chan) 0)
(setq chan nil))
- (funcall url-irc-function host port chan user pass)
+ (when compatp
+ (lwarn 'url :error "Obsolete value for `url-irc-function'"))
+ (apply url-irc-function
+ host port chan user pass (unless compatp (list type)))
nil))
+;;;; ircs://
+
+;; The function `url-scheme-get-property' tries and fails to load the
+;; nonexistent url-ircs.el but falls back to using the following:
+
+;;;###autoload
+(defconst url-ircs-default-port 6697 "Default port for IRCS connections.")
+
+;;;###autoload
+(defalias 'url-ircs 'url-irc)
+
(provide 'url-irc)
;;; url-irc.el ends here
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index e3c0e2ca06..a1d6152ee2 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -1188,7 +1188,7 @@ file were isearch was started."
((and wrap (null file))
(current-buffer))
;; When there is no next file, file-exists-p raises the error to be
- ;; catched by the search function that displays the error message.
+ ;; caught by the search function that displays the error message.
((file-exists-p file)
(find-file-noselect file))
(t
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index a9591c9d82..357ce001b3 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -306,7 +306,7 @@ well."
;; terminal supporting 24 bit colors) doesn't render well in terminal
;; supporting only 256 colors. Concretely, both #ffeeee
;; (diff-removed) and #eeffee (diff-added) are mapped to the same
-;; greyish color. "min-colors 257" ensures that those colors are not
+;; grayish color. "min-colors 257" ensures that those colors are not
;; used terminals supporting only 256 colors. However, any number
;; between 257 and 2^24 (16777216) would do.
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index 07b853817d..24647de576 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -942,6 +942,9 @@ one optional arguments, diff-number to refine.")
(c-prev-pt nil)
(anc-prev 1)
diff-list shift-A shift-B shift-C
+ (A-idx "1")
+ (B-idx (if three-way-comp "2" "3"))
+ (C-idx (if three-way-comp "3" "2"))
)
;; diff list contains word numbers or points, depending on word-mode
@@ -979,23 +982,23 @@ one optional arguments, diff-number to refine.")
(let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
;; if the files A and B are the same and not 3way-comparison,
;; ignore the difference
- (if (or three-way-comp (not (string-equal agreement "3")))
- (let* ((a-begin (car (ediff-get-diff3-group "1")))
- (a-end (nth 1 (ediff-get-diff3-group "1")))
- (b-begin (car (ediff-get-diff3-group "2")))
- (b-end (nth 1 (ediff-get-diff3-group "2")))
- (c-or-anc-begin (car (ediff-get-diff3-group "3")))
- (c-or-anc-end (nth 1 (ediff-get-diff3-group "3")))
+ (if (or three-way-comp (not (string-equal agreement C-idx)))
+ (let* ((a-begin (car (ediff-get-diff3-group A-idx)))
+ (a-end (nth 1 (ediff-get-diff3-group A-idx)))
+ (b-begin (car (ediff-get-diff3-group B-idx)))
+ (b-end (nth 1 (ediff-get-diff3-group B-idx)))
+ (c-or-anc-begin (car (ediff-get-diff3-group C-idx)))
+ (c-or-anc-end (nth 1 (ediff-get-diff3-group C-idx)))
(state-of-merge
- (cond ((string-equal agreement "1") 'prefer-A)
- ((string-equal agreement "2") 'prefer-B)
+ (cond ((string-equal agreement A-idx) 'prefer-A)
+ ((string-equal agreement B-idx) 'prefer-B)
(t ediff-default-variant)))
(state-of-diff-merge
(if (memq state-of-merge '(default-A prefer-A)) 'B 'A))
(state-of-diff-comparison
- (cond ((string-equal agreement "1") 'A)
- ((string-equal agreement "2") 'B)
- ((string-equal agreement "3") 'C)))
+ (cond ((string-equal agreement A-idx) 'A)
+ ((string-equal agreement B-idx) 'B)
+ ((string-equal agreement C-idx) 'C)))
state-of-ancestor
c-begin c-end
a-begin-pt a-end-pt
@@ -1108,8 +1111,12 @@ one optional arguments, diff-number to refine.")
(get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*"))))
(message "Computing differences ...")
- (ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize
- ediff-actual-diff3-options file-A file-B file-C)
+ (apply #'ediff-exec-process ediff-diff3-program ediff-diff-buffer
'synchronize
+ ediff-actual-diff3-options
+ (cons file-A (if ediff-merge-with-ancestor-job
+ ;; Ancestor must be the middle file
+ (list file-C file-B)
+ (list file-B file-C))))
(ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-diff-buffer)
;;(message "Computing differences ... done")
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 0d96a195ad..f406883221 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1748,7 +1748,7 @@ With a prefix argument ARG, go back that many
differences."
regexp-skip
;; skip clashes, if necessary
non-clash-skip
- ;; skipp changed regions
+ ;; skip changed regions
skip-changed
;; skip difference regions that differ in white space
(and ediff-ignore-similar-regions
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-dav.el b/lisp/vc/vc-dav.el
index 94621599e4..1cd91c9f54 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -93,7 +93,7 @@ If EDITABLE is non-nil URL should be writable by the user and
if
locking is used for URL, a lock should also be set.
If REV is non-nil, that is the revision to check out. If REV is the
-empty string, that means to check ou tht ehead of the trunk.
+empty string, that means to check out the head of the trunk.
If optional arg DESTFILE is given, it is an alternate filename to
write the contents to."
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-rcs.el b/lisp/vc/vc-rcs.el
index a4345c7d7e..c41835e19f 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -1192,7 +1192,7 @@ variable `vc-rcs-release' is set to the returned value."
(defun vc-rcs-parse (&optional buffer)
"Parse current buffer, presumed to be in RCS-style masterfile format.
Optional arg BUFFER specifies another buffer to parse. Return an alist
-of two elements, w/ keys `headers' and `revisions' and values in turn
+of two elements, with keys `headers' and `revisions' and values in turn
sub-alists. For `headers', the values unless otherwise specified are
strings and the keys are:
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..fa3d58f770 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)
@@ -3336,6 +3347,8 @@ immediately after this one."
(lambda (&rest args)
(apply #'vc-user-edit-command (apply old args))))))
+;; This is used in .dir-locals.el in the Emacs source tree.
+;;;###autoload (put 'vc-prepare-patches-separately 'safe-local-variable
'booleanp)
(defcustom vc-prepare-patches-separately t
"Whether `vc-prepare-patch' should generate a separate message for each
patch.
If nil, `vc-prepare-patch' creates a single email message by attaching
@@ -3373,25 +3386,43 @@ If nil, no default will be used. This option may be
set locally."
(vc-root-dir))))
:buffer (current-buffer)))))
+(defun vc-prepare-patch-prompt-revisions ()
+ "Prompt the user for a list revisions.
+Prepare a default value, depending on the current context. With
+a numerical prefix argument, use the last N revisions as the
+default value. If the current buffer is a log-view buffer, use
+the marked commits. Otherwise fall back to the working revision
+of the current file."
+ (vc-read-multiple-revisions
+ "Revisions: " nil nil nil
+ (or (and-let* ((arg current-prefix-arg)
+ (fs (vc-deduce-fileset t)))
+ (cl-loop with file = (caadr fs)
+ repeat (prefix-numeric-value arg)
+ for rev = (vc-working-revision file)
+ then (vc-call-backend
+ (car fs) 'previous-revision
+ file rev)
+ when rev collect it into revs
+ finally return (mapconcat #'identity revs ",")))
+ (and-let* ((revs (log-view-get-marked)))
+ (mapconcat #'identity revs ","))
+ (and-let* ((file (buffer-file-name)))
+ (vc-working-revision file)))))
+
;;;###autoload
(defun vc-prepare-patch (addressee subject revisions)
"Compose an Email sending patches for REVISIONS to ADDRESSEE.
-If `vc-prepare-patches-separately' is nil, SUBJECT will be used
-as the default subject for the message (and it will be prompted
-for when called interactively). Otherwise a separate message
-will be composed for each revision, with SUBJECT derived from the
-invidividual commits.
-
-When invoked interactively in a Log View buffer with marked
-revisions, those revisions will be used."
+If `vc-prepare-patches-separately' is nil, use SUBJECT as the
+default subject for the message, or prompt a subject when invoked
+interactively. Otherwise compose a separate message for each
+revision, with SUBJECT derived from each revision subject.
+When invoked with a numerical prefix argument, use the last N
+revisions.
+When invoked interactively in a Log View buffer with
+marked revisions, use those these."
(interactive
- (let ((revs (vc-read-multiple-revisions
- "Revisions: " nil nil nil
- (or (and-let* ((revs (log-view-get-marked)))
- (mapconcat #'identity revs ","))
- (and-let* ((file (buffer-file-name)))
- (vc-working-revision file)))))
- to)
+ (let ((revs (vc-prepare-patch-prompt-revisions)) to)
(require 'message)
(while (null (setq to (completing-read-multiple
(format-prompt
@@ -3554,6 +3585,41 @@ 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 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 annotate-extract-revision-at-line file)))
+ (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/window.el b/lisp/window.el
index 905803b19e..dd23ab1d39 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1,7 +1,6 @@
;;; window.el --- GNU Emacs window commands aside from those written in C -*-
lexical-binding:t -*-
-;; Copyright (C) 1985, 1989, 1992-1994, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -9173,7 +9172,7 @@ present. See also `fit-frame-to-buffer-sizes'."
This list specifies the total maximum and minimum numbers of
lines and the maximum and minimum numbers of columns of the body
of the root window of any frame that shall be fit to its buffer.
-Any value specified by ths variable will be overridden by the
+Any value specified by this variable will be overridden by the
corresponding argument of `fit-frame-to-buffer', if non-nil.
On window systems where the menubar can wrap, fitting a frame to
@@ -10562,27 +10561,25 @@ displaying that processes's buffer."
(define-key ctl-x-4-map "1" 'same-window-prefix)
(define-key ctl-x-4-map "4" 'other-window-prefix)
-(defvar other-window-repeat-map
- (let ((map (make-sparse-keymap)))
- (define-key map "o" 'other-window)
- (define-key map "O" (lambda ()
- (interactive)
- (setq repeat-map 'other-window-repeat-map)
- (other-window -1)))
- map)
- "Keymap to repeat `other-window' key sequences. Used in `repeat-mode'.")
+(defvar-keymap other-window-repeat-map
+ :doc "Keymap to repeat `other-window' key sequences.
+Used in `repeat-mode'."
+ "o" #'other-window
+ "O" (lambda ()
+ (interactive)
+ (setq repeat-map 'other-window-repeat-map)
+ (other-window -1)))
(put 'other-window 'repeat-map 'other-window-repeat-map)
-(defvar resize-window-repeat-map
- (let ((map (make-sparse-keymap)))
- ;; Standard keys:
- (define-key map "^" 'enlarge-window)
- (define-key map "}" 'enlarge-window-horizontally)
- (define-key map "{" 'shrink-window-horizontally)
- ;; Additional keys:
- (define-key map "v" 'shrink-window)
- map)
- "Keymap to repeat window resizing commands. Used in `repeat-mode'.")
+(defvar-keymap resize-window-repeat-map
+ :doc "Keymap to repeat window resizing commands.
+Used in `repeat-mode'."
+ ;; Standard keys:
+ "^" #'enlarge-window
+ "}" #'enlarge-window-horizontally
+ "{" #'shrink-window-horizontally
+ ;; Additional keys:
+ "v" #'shrink-window)
(put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
diff --git a/lisp/woman.el b/lisp/woman.el
index 7f494a3b68..2b456fed3c 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1751,21 +1751,17 @@ Leave point at end of new text. Return length of
inserted text."
;;; Major mode (Man) interface:
-(defvar woman-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map Man-mode-map)
-
- (define-key map "R" #'woman-reformat-last-file)
- (define-key map "w" #'woman)
- (define-key map "\en" #'WoMan-next-manpage)
- (define-key map "\ep" #'WoMan-previous-manpage)
- (define-key map [M-mouse-2] #'woman-follow-word)
-
- ;; We don't need to call `man' when we are in `woman-mode'.
- (define-key map [remap man] #'woman)
- (define-key map [remap man-follow] #'woman-follow)
- map)
- "Keymap for `woman-mode'.")
+(defvar-keymap woman-mode-map
+ :doc "Keymap for `woman-mode'."
+ :parent Man-mode-map
+ "R" #'woman-reformat-last-file
+ "w" #'woman
+ "M-n" #'WoMan-next-manpage
+ "M-p" #'WoMan-previous-manpage
+ "M-<mouse-2>" #'woman-follow-word
+ ;; We don't need to call `man' when we are in `woman-mode'.
+ "<remap> <man>" #'woman
+ "<remap> <man-follow>" #'woman-follow)
(defun woman-follow (topic)
"Get a Un*x manual page of the item under point and put it in a buffer."
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 058ab99f5c..b3465e757a 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -818,7 +818,7 @@ has been pressed."
(let ((inhibit-message t))
(funcall function amt))
;; Do not error at buffer limits. Show a message instead.
- ;; This is especially important here because signalling an
+ ;; This is especially important here because signaling an
;; error will mess up the drag-and-drop operation.
(beginning-of-buffer
(message (error-message-string '(beginning-of-buffer))))
@@ -1468,7 +1468,7 @@ instead of returning \"E\".")
(dnd-get-local-file-name local-file-uri))))
(if (not local-name)
'(STRING . "F")
- ;; We want errors to be signalled immediately during ERT
+ ;; We want errors to be signaled immediately during ERT
;; testing, instead of being silently handled. (bug#56712)
(if x-dnd-xds-testing
(prog1 '(STRING . "S")
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/msdos/autogen/config.in b/msdos/autogen/config.in
index 14782ab4bf..4b1cfb96e8 100644
--- a/msdos/autogen/config.in
+++ b/msdos/autogen/config.in
@@ -217,7 +217,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
whether the gnulib module scanf shall be considered present. */
#undef GNULIB_SCANF
-/* Define if ths system is compatible with GNU/Linux. */
+/* Define if this system is compatible with GNU/Linux. */
#undef GNU_LINUX
/* Define to 1 if you want to use the GNU memory allocator. */
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.10 b/src/ChangeLog.10
index ba1cea18d4..1b18ae5ec5 100644
--- a/src/ChangeLog.10
+++ b/src/ChangeLog.10
@@ -7899,7 +7899,7 @@
* buffer.c (scroll-up-aggressively, scroll-down-aggressively):
* keymap.c (Fminor_mode_key_binding):
* macterm.c (mac-emulate-three-button-mouse):
- Delete duplicate duplicate words.
+ Delete duplicate words.
2005-07-18 Ken Raeburn <raeburn@gnu.org>
diff --git a/src/ChangeLog.11 b/src/ChangeLog.11
index 15ab227171..a00ca453ca 100644
--- a/src/ChangeLog.11
+++ b/src/ChangeLog.11
@@ -7503,7 +7503,7 @@
2010-05-28 Kenichi Handa <handa@m17n.org>
* font.c (font_delete_unmatched): Check Vface_ignored_fonts.
- Don't sheck SPEC if it is nil.
+ Don't check SPEC if it is nil.
(font_list_entities): Call font_delete_unmatched if
Vface_ignored_fonts is non-nil. (Bug#6287)
@@ -8639,7 +8639,7 @@
* keyboard.c: QClabel is new.
(parse_tool_bar_item): Take out QClabel from tool bar items.
- Try to construct a label if ther is no QClabel.
+ Try to construct a label if there is no QClabel.
(syms_of_keyboard): Intern :label as QClabel.
* dispextern.h (tool_bar_item_idx): TOOL_BAR_ITEM_LABEL is new.
@@ -11988,7 +11988,7 @@
* cmds.c (nonundocount): New global variable.
(keys_of_cmds): Initialize it.
- (Fself_insert_command): Use it to combine upto 20 sequential chars
+ (Fself_insert_command): Use it to combine up to 20 sequential chars
into a single undo entry, just like the Qself_insert_command code in
keyboard.c does.
Call frame_make_pointer_invisible, also like the Qself_insert_command
diff --git a/src/ChangeLog.12 b/src/ChangeLog.12
index 18618bbfb2..7f77c0ca07 100644
--- a/src/ChangeLog.12
+++ b/src/ChangeLog.12
@@ -73,7 +73,7 @@
* lisp.h (adjust_after_replace): Extern it.
- * coding.c (detect_coding): Cound the heading ASCII bytes in the
+ * coding.c (detect_coding): Count the heading ASCII bytes in the
case of detection for coding_category_utf_8_auto.
(decode_coding_gap) [not CODING_DISABLE_ASCII_OPTIMIZATION]:
Skip decoding if all bytes are ASCII.
@@ -1809,7 +1809,7 @@
* nsfns.m (Fns_do_applescript): Run event loop until script has
been executed (Bug#12969).
- (ns_run_ascript): Chech as_script for nil, set to nil after
+ (ns_run_ascript): Check as_script for nil, set to nil after
executing script.
2012-12-22 Martin Rudalics <rudalics@gmx.at>
@@ -14132,7 +14132,7 @@
(coding_set_destination): Return how many bytes
coding->destination was relocated.
(CODING_DECODE_CHAR, CODING_ENCODE_CHAR, CODING_CHAR_CHARSET)
- (CODING_CHAR_CHARSET_P): Adjust for the avove changes.
+ (CODING_CHAR_CHARSET_P): Adjust for the above changes.
2011-12-05 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
@@ -19967,7 +19967,7 @@
2011-05-05 Eli Zaretskii <eliz@gnu.org>
* w32heap.c (allocate_heap) [USE_LISP_UNION_TYPE || USE_LSB_TAG]:
- New version that can reserve upto 2GB of heap space.
+ New version that can reserve up to 2GB of heap space.
2011-05-05 Chong Yidong <cyd@stupidchicken.com>
diff --git a/src/ChangeLog.13 b/src/ChangeLog.13
index 268a59219c..91f8005ac5 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -1459,11 +1459,11 @@
(frame_default_tool_bar_height): Extern.
* gtkutil.c (xg_frame_set_char_size): Pass Qxg_frame_set_char_size
to adjust_frame_size.
- * nsfns.m (Fx_create_frame): Pass Pass Qx_create_frame_1 and
+ * nsfns.m (Fx_create_frame): Pass Qx_create_frame_1 and
Qx_create_frame_2 to adjust_frame_size.
* w32fns.c (x_change_tool_bar_height): Call adjust_frame_size with
inhibit 1 when we have not redisplayed the tool bar yet.
- (Fx_create_frame): Pass Pass Qx_create_frame_1 and
+ (Fx_create_frame): Pass Qx_create_frame_1 and
Qx_create_frame_2 to adjust_frame_size.
* w32menu.c (set_frame_menubar): Simplify adjust_frame_size
call.
@@ -1476,7 +1476,7 @@
frame size accordingly.
* xfns.c (x_change_tool_bar_height): Call adjust_frame_size with
inhibit 1 when we have not redisplayed the tool bar yet.
- (Fx_create_frame): Pass Pass Qx_create_frame_1 and
+ (Fx_create_frame): Pass Qx_create_frame_1 and
Qx_create_frame_2 to adjust_frame_size.
2015-01-12 Paul Eggert <eggert@cs.ucla.edu>
@@ -7498,7 +7498,7 @@
2014-04-16 Eli Zaretskii <eliz@gnu.org>
* insdel.c (invalidate_buffer_caches): When deleting or replacing
- text, invalidate the bidi_paragraph_cache upto and including the
+ text, invalidate the bidi_paragraph_cache up to and including the
preceding newline.
2014-04-16 Paul Eggert <eggert@cs.ucla.edu>
@@ -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
@@ -10868,7 +10868,7 @@
* xdisp.c (syms_of_xdisp): New vars redisplay--all-windows-cause and
redisplay--mode-lines-cause.
- (redisplay_internal): Keep them uptodate. Remove redundant check of
+ (redisplay_internal): Keep them up-to-date. Remove redundant check of
buffer_shared_and_changed.
* *.[chm]: Number every assignment to update_mode_lines so we
can track why it is set.
@@ -12566,7 +12566,7 @@
2013-09-16 Dmitry Antipov <dmantipov@yandex.ru>
Do not copy X event in handle_one_xevent except KeyPress case.
- Wnen XEvent is processed, it is unlikely to be changed except
+ When XEvent is processed, it is unlikely to be changed except
KeyPress case, so we can avoid copying and use const pointer to
const data to make sure that an event is not changed elsewhere.
* xterm.c (handle_one_xevent): Change 2nd arg to 'const XEvent *
diff --git a/src/ChangeLog.5 b/src/ChangeLog.5
index c74e44d7a2..408a934ce2 100644
--- a/src/ChangeLog.5
+++ b/src/ChangeLog.5
@@ -2316,7 +2316,7 @@
1995-02-15 Paul Reilly <pmr@geech.gnu.ai.mit.edu>
- * s/dgux.h (LIB_MOTIF): Add -lgen to provide provide the symbols
+ * s/dgux.h (LIB_MOTIF): Add -lgen to provide the symbols
`regcmp' and `regex'.
1995-02-15 Richard Stallman <rms@pogo.gnu.ai.mit.edu>
diff --git a/src/ChangeLog.6 b/src/ChangeLog.6
index fc7cc5e4d4..f5653efd91 100644
--- a/src/ChangeLog.6
+++ b/src/ChangeLog.6
@@ -2225,7 +2225,7 @@
1996-02-08 Eli Zaretskii <eliz@is.elta.co.il>
- * fileio.c (Fmake_temp_name) [MS-DOS]: Allow upto 8 characters in
+ * fileio.c (Fmake_temp_name) [MS-DOS]: Allow up to 8 characters in
the prefix of the temporary file name.
1996-02-07 Richard Stallman <rms@mole.gnu.ai.mit.edu>
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/ChangeLog.8 b/src/ChangeLog.8
index ef2472a0f3..c0e3523c64 100644
--- a/src/ChangeLog.8
+++ b/src/ChangeLog.8
@@ -1272,7 +1272,7 @@
* xdisp.c (display_line): Set charpos of first glyph in blank
lines not corresponding to any text to -1, even if no glyphs are
- filled in in that line.
+ filled in on that line.
1999-11-01 Gerd Moellmann <gerd@gnu.org>
@@ -3155,7 +3155,7 @@
* xdisp.c (resize_mini_window): Don't resize if
Vmax_mini_window_height is nil. Otherwise, use a default if
- Vmax_mini_window_height is not ot a number.
+ Vmax_mini_window_height is not a number.
(syms_of_xdisp): Extend documentation of Vmax_mini_window_height.
1999-08-25 Alexandre Oliva <oliva@dcc.unicamp.br>
@@ -5704,7 +5704,7 @@
(x_scroll_bar_expose): Make no-op for toolkit scroll bars.
(x_scroll_bar_create): Create and show a scroll bar widget
if using toolkit scroll bars.
- (x_scroll_bar_move): Handle tookit scroll bars.
+ (x_scroll_bar_move): Handle toolkit scroll bars.
* Makefile.in (LIBW): Use Xaw3d if present.
diff --git a/src/alloc.c b/src/alloc.c
index f69c65dedc..d3f696d5ad 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6279,11 +6279,6 @@ garbage_collect (void)
image_prune_animation_caches (false);
#endif
- /* ELisp code run by `gc-post-hook' could result in itree iteration,
- which must not happen while the itree is already busy. See
- bug#58639. */
- eassert (!itree_iterator_busy_p ());
-
if (!NILP (Vpost_gc_hook))
{
specpdl_ref gc_count = inhibit_garbage_collection ();
@@ -6508,7 +6503,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);
@@ -7780,13 +7775,23 @@ allocated since the last garbage collection. All data
types count.
Garbage collection happens automatically only when `eval' is called.
By binding this temporarily to a large number, you can effectively
-prevent garbage collection during a part of the program.
+prevent garbage collection during a part of the program. But be
+sure to get back to the normal value soon enough, to avoid system-wide
+memory pressure, and never use a too-high value for prolonged periods
+of time.
See also `gc-cons-percentage'. */);
DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage,
doc: /* Portion of the heap used for allocation.
Garbage collection can happen automatically once this portion of the heap
has been allocated since the last garbage collection.
+
+By binding this temporarily to a large number, you can effectively
+prevent garbage collection during a part of the program. But be
+sure to get back to the normal value soon enough, to avoid system-wide
+memory pressure, and never use a too-high value for prolonged periods
+of time.
+
If this portion is smaller than `gc-cons-threshold', this is ignored. */);
Vgc_cons_percentage = make_float (0.1);
diff --git a/src/buffer.c b/src/buffer.c
index b67b989326..d948aaa266 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -937,19 +937,16 @@ delete_all_overlays (struct buffer *b)
if (! b->overlays)
return;
- /* FIXME: This loop sets the overlays' `buffer` field to NULL but
- doesn't set the itree_nodes' `parent`, `left` and `right`
- fields accordingly. I believe it's harmless, but a bit untidy since
- other parts of the code are careful to set those fields to NULL when
- the overlay is deleted.
- Of course, we can't set them to NULL from within the iteration
- because the iterator may need them (tho we could if we added
- an ITREE_POST_ORDER iteration order). */
- ITREE_FOREACH (node, b->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ /* The general rule is that the tree cannot be modified from within
+ ITREE_FOREACH, but here we bend this rule a little because we know
+ that the POST_ORDER iterator will not need to look at `node` again. */
+ ITREE_FOREACH (node, b->overlays, PTRDIFF_MIN, PTRDIFF_MAX, POST_ORDER)
{
modify_overlay (b, node->begin, node->end);
- /* Where are the nodes freed ? --ap */
XOVERLAY (node->data)->buffer = NULL;
+ node->parent = NULL;
+ node->left = NULL;
+ node->right = NULL;
}
itree_clear (b->overlays);
}
@@ -982,7 +979,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;
@@ -2985,17 +2982,13 @@ overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend,
if (node->begin > end)
{
next = min (next, node->begin);
- ITREE_FOREACH_ABORT ();
break;
}
else if (node->begin == end)
{
next = node->begin;
if ((! empty || end < ZV) && beg < end)
- {
- ITREE_FOREACH_ABORT ();
- break;
- }
+ break;
if (empty && node->begin != node->end)
continue;
}
@@ -3050,7 +3043,6 @@ next_overlay_change (ptrdiff_t pos)
of pos, because the search is limited to [pos,next) . */
eassert (node->begin < next);
next = node->begin;
- ITREE_FOREACH_ABORT ();
break;
}
else if (node->begin < node->end && node->end < next)
@@ -3155,10 +3147,7 @@ overlay_touches_p (ptrdiff_t pos)
pos. */
ITREE_FOREACH (node, current_buffer->overlays, pos - 1, pos + 1, DESCENDING)
if (node->begin == pos || node->end == pos)
- {
- ITREE_FOREACH_ABORT ();
- return true;
- }
+ return true;
return false;
}
@@ -3454,21 +3443,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 +3635,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 +3824,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 +4116,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/comp.c b/src/comp.c
index 14012634cc..b6072a866e 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -947,7 +947,7 @@ obj_to_reloc (Lisp_Object obj)
}
xsignal1 (Qnative_ice,
- build_string ("cant't find data in relocation containers"));
+ build_string ("can't find data in relocation containers"));
assume (false);
found:
@@ -5609,7 +5609,7 @@ file_in_eln_sys_dir (Lisp_Object filename)
/* Load related routines. */
DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
doc: /* Load native elisp code FILENAME.
-LATE_LOAD has to be non-nil when loading for deferred compilation. */)
+LATE-LOAD has to be non-nil when loading for deferred compilation. */)
(Lisp_Object filename, Lisp_Object late_load)
{
CHECK_STRING (filename);
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 1c74180f15..440142757e 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -422,7 +422,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
- /* We dont check the syntax of signature. This will be done by
+ /* We don't check the syntax of signature. This will be done by
libdbus. */
if (dtype == DBUS_TYPE_OBJECT_PATH)
XD_DBUS_VALIDATE_PATH (object)
@@ -748,7 +748,7 @@ xd_append_arg (int dtype, Lisp_Object object,
DBusMessageIter *iter)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
- /* We dont check the syntax of signature. This will be done
+ /* We don't check the syntax of signature. This will be done
by libdbus. */
if (dtype == DBUS_TYPE_OBJECT_PATH)
XD_DBUS_VALIDATE_PATH (object)
diff --git a/src/dispextern.h b/src/dispextern.h
index 2f5f4335fe..2afbdeabaa 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3495,7 +3495,8 @@ extern bool cursor_in_mouse_face_p (struct window *w);
extern void tty_draw_row_with_mouse_face (struct window *, struct glyph_row *,
int, int, enum draw_glyphs_face);
extern void display_tty_menu_item (const char *, int, int, int, int, bool);
-
+extern struct glyph *x_y_to_hpos_vpos (struct window *, int, int, int *, int *,
+ int *, int *, int *);
/* Flags passed to try_window. */
#define TRY_WINDOW_CHECK_MARGINS (1 << 0)
#define TRY_WINDOW_IGNORE_FONTS_CHANGE (1 << 1)
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 8ad70fecd4..85102acd28 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);
}
diff --git a/src/eval.c b/src/eval.c
index ea23829948..7327d681f9 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1329,7 +1329,7 @@ Then the value of the last BODY form is returned from the
`condition-case'
expression.
The special handler (:success BODY...) is invoked if BODYFORM terminated
-without signalling an error. BODY is then evaluated with VAR bound to
+without signaling an error. BODY is then evaluated with VAR bound to
the value returned by BODYFORM.
See also the function `signal' for more info.
@@ -1716,7 +1716,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
Lisp_Object clause = Qnil;
struct handler *h;
- eassert (!itree_iterator_busy_p ());
if (gc_in_progress || waiting_for_input)
emacs_abort ();
@@ -1810,7 +1809,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
unbind_to (count, Qnil);
}
- /* If an error is signalled during a Lisp hook in redisplay, write a
+ /* If an error is signaled during a Lisp hook in redisplay, write a
backtrace into the buffer *Redisplay-trace*. */
if (!debugger_called && !NILP (error_symbol)
&& backtrace_on_redisplay_error
diff --git a/src/font.h b/src/font.h
index 3475189206..d36c45a53c 100644
--- a/src/font.h
+++ b/src/font.h
@@ -220,13 +220,13 @@ enum font_property_index
#define FONT_WIDTH_FOR_FACE(font) \
font_style_symbolic (font, FONT_WIDTH_INDEX, true)
-/* Return the numeric weight value corresponding ot the symbol NAME. */
+/* Return the numeric weight value corresponding to the symbol NAME. */
#define FONT_WEIGHT_NAME_NUMERIC(name) \
(font_style_to_value (FONT_WEIGHT_INDEX, (name), false) >> 8)
-/* Return the numeric slant value corresponding ot the symbol NAME. */
+/* Return the numeric slant value corresponding to the symbol NAME. */
#define FONT_SLANT_NAME_NUMERIC(name) \
(font_style_to_value (FONT_SLANT_INDEX, (name), false) >> 8)
-/* Return the numeric width value corresponding ot the symbol NAME. */
+/* Return the numeric width value corresponding to the symbol NAME. */
#define FONT_WIDTH_NAME_NUMERIC(name) \
(font_style_to_value (FONT_WIDTH_INDEX, (name), false) >> 8)
diff --git a/src/fontset.c b/src/fontset.c
index 4b91eff2ef..b82737d005 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1663,7 +1663,17 @@ overwrites the previous settings. */)
{
update_auto_fontset_alist (font_object, fontset_obj);
AUTO_FRAME_ARG (arg, Qfont, Fcons (fontset, font_object));
- Fmodify_frame_parameters (fr, arg);
+
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f))
+ /* This is a window-system frame. Prevent changes of
+ the `font' parameter here from messing with the
+ `font-parameter' frame property, as the frame
+ parameter is not being changed by the user. */
+ gui_set_frame_parameters_1 (f, arg, true);
+ else
+#endif
+ Fmodify_frame_parameters (fr, arg);
}
}
}
diff --git a/src/frame.c b/src/frame.c
index f076a5ba54..b57b296be5 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -4119,10 +4119,17 @@ frame_float (struct frame *f, Lisp_Object val, enum
frame_float_type what,
If a parameter is not specially recognized, do nothing special;
otherwise call the `gui_set_...' function for that parameter.
Except for certain geometry properties, always call store_frame_param
- to store the new value in the parameter alist. */
+ to store the new value in the parameter alist.
+
+ DEFAULT_PARAMETER should be set if the alist was not specified by
+ the user, or by the face code to set the `font' parameter. In that
+ case, the `font-parameter' frame parameter should not be changed,
+ so dynamic-setting.el can restore the user's selected font
+ correctly. */
void
-gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
+gui_set_frame_parameters_1 (struct frame *f, Lisp_Object alist,
+ bool default_parameter)
{
Lisp_Object tail, frame;
@@ -4249,7 +4256,7 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object
alist)
}
else
{
- register Lisp_Object param_index, old_value;
+ Lisp_Object param_index, old_value;
old_value = get_frame_param (f, prop);
@@ -4260,6 +4267,12 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object
alist)
&& XFIXNAT (param_index) < ARRAYELTS (frame_parms)
&& FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])
(*(FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])) (f,
val, old_value);
+
+ if (!default_parameter && EQ (prop, Qfont))
+ /* The user manually specified the `font' frame parameter.
+ Save that parameter for future use by the
+ dynamic-setting code. */
+ store_frame_param (f, Qfont_parameter, val);
}
}
@@ -4410,6 +4423,11 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object
alist)
SAFE_FREE ();
}
+void
+gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
+{
+ gui_set_frame_parameters_1 (f, alist, false);
+}
/* Insert a description of internally-recorded parameters of frame F
into the parameter alist *ALISTPTR that is to be given to the user.
@@ -4586,9 +4604,6 @@ gui_set_font (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
Lisp_Object font_object;
int fontset = -1;
-#ifdef HAVE_X_WINDOWS
- Lisp_Object font_param = arg;
-#endif
/* Set the frame parameter back to the old value because we may
fail to use ARG as the new parameter value. */
@@ -4627,16 +4642,10 @@ gui_set_font (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
error ("Unknown fontset: %s", SDATA (XCAR (arg)));
font_object = XCDR (arg);
arg = AREF (font_object, FONT_NAME_INDEX);
-#ifdef HAVE_X_WINDOWS
- font_param = Ffont_get (font_object, QCname);
-#endif
}
else if (FONT_OBJECT_P (arg))
{
font_object = arg;
-#ifdef HAVE_X_WINDOWS
- font_param = Ffont_get (font_object, QCname);
-#endif
/* This is to store the XLFD font name in the frame parameter for
backward compatibility. We should store the font-object
itself in the future. */
@@ -4667,9 +4676,7 @@ gui_set_font (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
if (FRAME_TERMINAL (f)->set_new_font_hook)
FRAME_TERMINAL (f)->set_new_font_hook (f, font_object, fontset);
store_frame_param (f, Qfont, arg);
-#ifdef HAVE_X_WINDOWS
- store_frame_param (f, Qfont_parameter, font_param);
-#endif
+
/* Recalculate tabbar height. */
f->n_tab_bar_rows = 0;
/* Recalculate toolbar height. */
@@ -4749,7 +4756,7 @@ gui_set_font_backend (struct frame *f, Lisp_Object
new_value, Lisp_Object old_va
if (FRAME_FONT (f))
{
/* Reconsider default font after backend(s) change (Bug#23386). */
- FRAME_RIF(f)->default_font_parameter (f, Qnil);
+ FRAME_RIF (f)->default_font_parameter (f, Qnil);
face_change = true;
windows_or_buffers_changed = 18;
}
@@ -5451,12 +5458,20 @@ gui_default_parameter (struct frame *f, Lisp_Object
alist, Lisp_Object prop,
enum resource_types type)
{
Lisp_Object tem;
+ bool was_unbound;
tem = gui_frame_get_arg (f, alist, prop, xprop, xclass, type);
+
if (BASE_EQ (tem, Qunbound))
- tem = deflt;
+ {
+ tem = deflt;
+ was_unbound = true;
+ }
+ else
+ was_unbound = false;
+
AUTO_FRAME_ARG (arg, prop, tem);
- gui_set_frame_parameters (f, arg);
+ gui_set_frame_parameters_1 (f, arg, was_unbound);
return tem;
}
@@ -5946,6 +5961,67 @@ This function is for internal use only. */)
return f->was_invisible ? Qt : Qnil;
}
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+DEFUN ("reconsider-frame-fonts", Freconsider_frame_fonts,
+ Sreconsider_frame_fonts, 1, 1, 0,
+ doc: /* Recreate FRAME's default font using updated font parameters.
+Signal an error if FRAME is not a window system frame. This should be
+called after a `config-changed' event is received, signaling that the
+parameters (such as pixel density) used by the system to open fonts
+have changed. */)
+ (Lisp_Object frame)
+{
+ struct frame *f;
+ Lisp_Object params, font_parameter;
+
+ f = decode_window_system_frame (frame);
+
+ /* Kludge: if a `font' parameter was already specified,
+ create an alist containing just that parameter. (bug#59371)
+
+ This sounds so simple, right? Well, read on below: */
+ params = Qnil;
+
+ /* The difference between Qfont and Qfont_parameter is that the
+ latter is not set automatically by the likes of x_new_font, and
+ implicitly as the default face is realized. It is only set when
+ the user specifically specifies a `font' frame parameter, and is
+ cleared the moment the frame's font becomes defined by a face
+ attribute, instead of through the `font' frame parameter. */
+ font_parameter = get_frame_param (f, Qfont_parameter);
+
+ if (!NILP (font_parameter))
+ params = list1 (Fcons (Qfont, font_parameter));
+
+ /* First, call this to reinitialize any font backend specific
+ stuff. */
+
+ if (FRAME_RIF (f)->default_font_parameter)
+ FRAME_RIF (f)->default_font_parameter (f, params);
+
+ /* For a mysterious reason, x_default_font_parameter sets Qfont to
+ nil in the alist! */
+
+ if (!NILP (font_parameter))
+ params = list1 (Fcons (Qfont, font_parameter));
+
+ /* Now call this to apply the existing value(s) of the `default'
+ face. */
+ call2 (Qface_set_after_frame_default, frame, params);
+
+ /* Restore the value of the `font-parameter' parameter, as
+ `face-set-after-frame-default' will have changed it through its
+ calls to `set-face-attribute'. */
+ if (!NILP (font_parameter))
+ store_frame_param (f, Qfont_parameter, font_parameter);
+
+ return Qnil;
+}
+
+#endif
+
/***********************************************************************
Multimonitor data
@@ -6201,6 +6277,7 @@ syms_of_frame (void)
DEFSYM (Qiconify_top_level, "iconify-top-level");
DEFSYM (Qmake_invisible, "make-invisible");
DEFSYM (Quse_frame_synchronization, "use-frame-synchronization");
+ DEFSYM (Qfont_parameter, "font-parameter");
{
int i;
@@ -6634,6 +6711,6 @@ iconify the top level frame instead. */);
#ifdef HAVE_WINDOW_SYSTEM
defsubr (&Sx_get_resource);
defsubr (&Sx_parse_geometry);
+ defsubr (&Sreconsider_frame_fonts);
#endif
-
}
diff --git a/src/frame.h b/src/frame.h
index 458b6257e4..d6fd62b2ac 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1670,6 +1670,7 @@ IMAGE_OPT_FROM_ID (struct frame *f, int id)
/* The class of this X application. */
#define EMACS_CLASS "Emacs"
+extern void gui_set_frame_parameters_1 (struct frame *, Lisp_Object, bool);
extern void gui_set_frame_parameters (struct frame *, Lisp_Object);
extern void gui_set_fullscreen (struct frame *, Lisp_Object, Lisp_Object);
extern void gui_set_line_spacing (struct frame *, Lisp_Object, Lisp_Object);
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index dc765e5aee..ede8f1323c 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -737,7 +737,7 @@ struct font_driver const ftcrfont_driver =
.filter_properties = ftfont_filter_properties,
.combining_capability = ftfont_combining_capability,
#ifdef HAVE_PGTK
- .cached_font_ok = ftcrfont_cached_font_ok
+ .cached_font_ok = ftcrfont_cached_font_ok,
#endif
};
#ifdef HAVE_HARFBUZZ
@@ -755,6 +755,42 @@ syms_of_ftcrfont (void)
pdumper_do_now_and_after_load (syms_of_ftcrfont_for_pdumper);
}
+#ifdef HAVE_X_WINDOWS
+
+/* Place the default font options used by Cairo on the given display
+ in OPTIONS. */
+
+void
+ftcrfont_get_default_font_options (struct x_display_info *dpyinfo,
+ cairo_font_options_t *options)
+{
+ Pixmap drawable;
+ cairo_surface_t *surface;
+
+ /* Cairo doesn't allow fetching the default font options for a
+ display, so the only option is to create a drawable, and an Xlib
+ surface for that drawable, and to get the font options from there
+ instead. */
+
+ drawable = XCreatePixmap (dpyinfo->display, dpyinfo->root_window,
+ 1, 1, dpyinfo->n_planes);
+ surface = cairo_xlib_surface_create (dpyinfo->display, drawable,
+ dpyinfo->visual, 1, 1);
+
+ if (!surface)
+ {
+ XFreePixmap (dpyinfo->display, drawable);
+ return;
+ }
+
+ cairo_surface_get_font_options (surface, options);
+ XFreePixmap (dpyinfo->display, drawable);
+ cairo_surface_destroy (surface);
+ return;
+}
+
+#endif
+
static void
syms_of_ftcrfont_for_pdumper (void)
{
diff --git a/src/ftfont.h b/src/ftfont.h
index cfab8d3154..ee56e2d760 100644
--- a/src/ftfont.h
+++ b/src/ftfont.h
@@ -84,4 +84,11 @@ struct font_info
#endif
};
+#if defined USE_CAIRO && defined HAVE_X_WINDOWS
+
+extern void ftcrfont_get_default_font_options (struct x_display_info *,
+ cairo_font_options_t *);
+
+#endif /* USE_CAIRO && HAVE_X_WINDOWS */
+
#endif /* EMACS_FTFONT_H */
diff --git a/src/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/haiku_support.h b/src/haiku_support.h
index e940e69bf1..2605a75b40 100644
--- a/src/haiku_support.h
+++ b/src/haiku_support.h
@@ -383,7 +383,7 @@ struct haiku_font_pattern
/* The number of characters in `wanted_chars'. */
int want_chars_len;
- /* List of characters. The font must fullfill at least one of
+ /* List of characters. The font must fulfill at least one of
them for the match to succeed. */
int *need_one_of;
diff --git a/src/haikufns.c b/src/haikufns.c
index 711202c5df..5717d0354f 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -175,10 +175,19 @@ haiku_change_tool_bar_height (struct frame *f, int height)
void
haiku_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/haikuselect.c b/src/haikuselect.c
index bd004f4900..e8d3b5f0f7 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -1260,7 +1260,7 @@ syms_of_haikuselect (void)
{
DEFVAR_BOOL ("haiku-signal-invalid-refs", haiku_signal_invalid_refs,
doc: /* If nil, silently ignore invalid file names in system messages.
-Otherwise, an error will be signalled if adding a file reference to a
+Otherwise, an error will be signaled if adding a file reference to a
system message failed. */);
haiku_signal_invalid_refs = true;
diff --git a/src/haikuterm.c b/src/haikuterm.c
index 4e32b74716..496480cbc0 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -3007,9 +3007,11 @@ haiku_default_font_parameter (struct frame *f,
Lisp_Object parms)
font = font_open_by_spec (f, Ffont_get_system_font ());
if (NILP (font))
- font = !NILP (font_param) ? font_param
- : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font",
- RES_TYPE_STRING);
+ font = (!NILP (font_param)
+ ? font_param
+ : gui_display_get_arg (dpyinfo, parms, Qfont,
+ "font", "Font",
+ RES_TYPE_STRING));
if (! FONTP (font) && ! STRINGP (font))
{
@@ -3029,13 +3031,6 @@ haiku_default_font_parameter (struct frame *f,
Lisp_Object parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it
- after we've applied the `default' face settings. */
- AUTO_FRAME_ARG (arg, Qfont_parameter, font_param);
- gui_set_frame_parameters (f, arg);
- }
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
RES_TYPE_STRING);
diff --git a/src/image.c b/src/image.c
index 1e323ba66a..600c32571e 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1843,7 +1843,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 ();
}
@@ -2980,7 +2982,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. */
@@ -3238,12 +3241,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
@@ -6224,26 +6228,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 ();
@@ -12207,7 +12213,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..04fa9e827a 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
@@ -111,7 +111,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
In order to avoid this, we introduce yet another node attribute,
called OFFSET.
- The OFFSET of some some subtree, represented by its root, is the
+ The OFFSET of some subtree, represented by its root, is the
amount of shift that needs to be applied to its BEGIN, END and
LIMIT values, in order to get to the actual buffer positions.
Coming back to the example, all we would need to do in this case,
@@ -131,43 +131,20 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
* | Stack
* +=======================================================================+ */
-typedef uintptr_t nodeptr_and_flag;
-
-static inline nodeptr_and_flag
-make_nav (struct itree_node *ptr, bool flag)
-{
- uintptr_t v = (uintptr_t) ptr;
- /* We assume alignment imposes the LSB is clear for us to use it. */
- eassert (!(v & 1));
- return v | !!flag;
-}
-
-static inline struct itree_node *
-nav_nodeptr (nodeptr_and_flag nav)
-{
- return (struct itree_node *) (nav & (~(uintptr_t)1));
-}
-
-static inline bool
-nav_flag (nodeptr_and_flag nav)
-{
- return (bool) (nav & 1);
-}
-
/* Simple dynamic array. */
-struct interval_stack
+struct itree_stack
{
- nodeptr_and_flag *nodes;
+ struct itree_node **nodes;
size_t size;
size_t length;
};
/* This is just a simple dynamic array with stack semantics. */
-static struct interval_stack*
-interval_stack_create (intmax_t initial_size)
+static struct itree_stack*
+itree_stack_create (intmax_t initial_size)
{
- struct interval_stack *stack = xmalloc (sizeof (struct interval_stack));
+ struct itree_stack *stack = xmalloc (sizeof (struct itree_stack));
stack->size = max (0, initial_size);
stack->nodes = xmalloc (stack->size * sizeof (struct itree_node*));
stack->length = 0;
@@ -175,7 +152,7 @@ interval_stack_create (intmax_t initial_size)
}
static void
-interval_stack_destroy (struct interval_stack *stack)
+itree_stack_destroy (struct itree_stack *stack)
{
if (! stack)
return;
@@ -184,14 +161,8 @@ interval_stack_destroy (struct interval_stack *stack)
xfree (stack);
}
-static void
-interval_stack_clear (struct interval_stack *stack)
-{
- stack->length = 0;
-}
-
static inline void
-interval_stack_ensure_space (struct interval_stack *stack, intmax_t nelements)
+itree_stack_ensure_space (struct itree_stack *stack, uintmax_t nelements)
{
if (nelements > stack->size)
{
@@ -204,95 +175,32 @@ interval_stack_ensure_space (struct interval_stack
*stack, intmax_t nelements)
/* Push NODE on the STACK, while settings its visited flag to FLAG. */
static inline void
-interval_stack_push_flagged (struct interval_stack *stack,
- struct itree_node *node, bool flag)
+itree_stack_push (struct itree_stack *stack, struct itree_node *node)
{
- eassert (node && node != NULL);
-
- /* FIXME: While the stack used in the iterator is bounded by the tree
- depth and could be easily pre-allocated to a large enough size to avoid
- this "ensure" check, `interval_stack_push` is also used elsewhere to
- simply collect some subset of the overlays, where it's only bounded by
- the total number of overlays in the buffer (which can be large and thus
- preferably not pre-allocated needlessly). */
- interval_stack_ensure_space (stack, stack->length + 1);
+ eassert (node);
+ itree_stack_ensure_space (stack, stack->length + 1);
- stack->nodes[stack->length] = make_nav (node, flag);
+ stack->nodes[stack->length] = node;
stack->length++;
}
-static inline void
-interval_stack_push (struct interval_stack *stack, struct itree_node *node)
-{
- interval_stack_push_flagged (stack, node, false);
-}
-
-static inline nodeptr_and_flag
-interval_stack_pop (struct interval_stack *stack)
+static inline struct itree_node *
+itree_stack_pop (struct itree_stack *stack)
{
if (stack->length == 0)
- return make_nav (NULL, false);
+ return NULL;
return stack->nodes[--stack->length];
}
/* +-----------------------------------------------------------------------+ */
-/* State used when iterating interval. */
-struct itree_iterator
-{
- struct interval_stack *stack;
- ptrdiff_t begin;
- ptrdiff_t end;
-
- /* A copy of the tree's `otick`. */
- uintmax_t otick;
- enum itree_order order;
- bool running;
- const char *file;
- int line;
-};
-
-/* Ideally, every iteration would use its own `iter` object, so we could
- have several iterations active at the same time. In practice, iterations
- 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 int
-interval_tree_max_height (const struct itree_tree *tree)
+itree_max_height (const struct itree_tree *tree)
{
return 2 * log (tree->size + 1) / log (2) + 0.5;
}
-/* Allocate a new iterator for TREE. */
-
-static struct itree_iterator *
-itree_iterator_create (struct itree_tree *tree)
-{
- struct itree_iterator *g = xmalloc (sizeof *g);
- /* 19 here just avoids starting with a silly-small stack.
- FIXME: Since this stack only needs to be about 2*max_depth
- in the worst case, we could completely pre-allocate it to something
- like word-bit-size * 2 and then never worry about growing it. */
- const int size = (tree ? interval_tree_max_height (tree) : 19) + 1;
-
- g->stack = interval_stack_create (size);
- g->running = false;
- g->begin = 0;
- g->end = 0;
- g->file = NULL;
- g->line = 0;
- return g;
-}
-
-static void
-itree_init (void)
-{
- iter = itree_iterator_create (NULL);
-}
-
struct check_subtree_result
{
/* Node count of the tree. */
@@ -325,7 +233,7 @@ check_subtree (struct itree_node *node,
and <= to its parent's otick.
Note: we cannot assert that (NODE.otick == NODE.parent.otick)
- implies (NODE.offset == 0) because interval_tree_inherit_offset()
+ implies (NODE.offset == 0) because itree_inherit_offset()
doesn't always update otick. It could, but it is not clear there
is a need. */
eassert (node->otick <= tree_otick);
@@ -429,7 +337,7 @@ itree_newlimit (struct itree_node *node)
/* Update NODE's limit attribute according to its children. */
static void
-interval_tree_update_limit (struct itree_node *node)
+itree_update_limit (struct itree_node *node)
{
if (node == NULL)
return;
@@ -444,7 +352,7 @@ interval_tree_update_limit (struct itree_node *node)
*/
static void
-interval_tree_inherit_offset (uintmax_t otick, struct itree_node *node)
+itree_inherit_offset (uintmax_t otick, struct itree_node *node)
{
eassert (node->parent == NULL || node->parent->otick >= node->otick);
if (node->otick == otick)
@@ -481,7 +389,7 @@ interval_tree_inherit_offset (uintmax_t otick, struct
itree_node *node)
stable, i.e. new_limit = old_limit. */
static void
-interval_tree_propagate_limit (struct itree_node *node)
+itree_propagate_limit (struct itree_node *node)
{
ptrdiff_t newlimit;
@@ -502,15 +410,15 @@ interval_tree_propagate_limit (struct itree_node *node)
}
static struct itree_node*
-interval_tree_validate (struct itree_tree *tree, struct itree_node *node)
+itree_validate (struct itree_tree *tree, struct itree_node *node)
{
if (tree->otick == node->otick || node == NULL)
return node;
if (node != tree->root)
- interval_tree_validate (tree, node->parent);
+ itree_validate (tree, node->parent);
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
return node;
}
@@ -541,7 +449,7 @@ ptrdiff_t
itree_node_begin (struct itree_tree *tree,
struct itree_node *node)
{
- interval_tree_validate (tree, node);
+ itree_validate (tree, node);
return node->begin;
}
@@ -551,20 +459,15 @@ ptrdiff_t
itree_node_end (struct itree_tree *tree,
struct itree_node *node)
{
- interval_tree_validate (tree, node);
+ itree_validate (tree, node);
return node->end;
}
-/* 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 +487,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)
+itree_init (struct itree_tree *tree)
{
- interval_tree_clear (tree);
- /* tree->iter = itree_iterator_create (tree); */
+ itree_clear (tree);
}
#endif
@@ -596,8 +498,6 @@ void
itree_destroy (struct itree_tree *tree)
{
eassert (tree->root == NULL);
- /* if (tree->iter)
- * itree_iterator_destroy (tree->iter); */
xfree (tree);
}
@@ -612,15 +512,15 @@ itree_size (struct itree_tree *tree)
/* Perform the familiar left-rotation on node NODE. */
static void
-interval_tree_rotate_left (struct itree_tree *tree,
+itree_rotate_left (struct itree_tree *tree,
struct itree_node *node)
{
eassert (node->right != NULL);
struct itree_node *right = node->right;
- interval_tree_inherit_offset (tree->otick, node);
- interval_tree_inherit_offset (tree->otick, right);
+ itree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, right);
/* Turn right's left subtree into node's right subtree. */
node->right = right->left;
@@ -648,22 +548,22 @@ interval_tree_rotate_left (struct itree_tree *tree,
node->parent = right;
/* Order matters here. */
- interval_tree_update_limit (node);
- interval_tree_update_limit (right);
+ itree_update_limit (node);
+ itree_update_limit (right);
}
/* Perform the familiar right-rotation on node NODE. */
static void
-interval_tree_rotate_right (struct itree_tree *tree,
+itree_rotate_right (struct itree_tree *tree,
struct itree_node *node)
{
eassert (tree && node && node->left != NULL);
struct itree_node *left = node->left;
- interval_tree_inherit_offset (tree->otick, node);
- interval_tree_inherit_offset (tree->otick, left);
+ itree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, left);
node->left = left->right;
if (left->right != NULL)
@@ -685,8 +585,8 @@ interval_tree_rotate_right (struct itree_tree *tree,
if (node != NULL)
node->parent = left;
- interval_tree_update_limit (left);
- interval_tree_update_limit (node);
+ itree_update_limit (left);
+ itree_update_limit (node);
}
/* Repair the tree after an insertion.
@@ -694,7 +594,7 @@ interval_tree_rotate_right (struct itree_tree *tree,
Rebalance the parents as needed to re-establish the RB invariants. */
static void
-interval_tree_insert_fix (struct itree_tree *tree,
+itree_insert_fix (struct itree_tree *tree,
struct itree_node *node)
{
eassert (tree->root->red == false);
@@ -728,12 +628,12 @@ interval_tree_insert_fix (struct itree_tree *tree,
if (node == node->parent->right) /* case 2.a */
{
node = node->parent;
- interval_tree_rotate_left (tree, node);
+ itree_rotate_left (tree, node);
}
/* case 3.a */
node->parent->red = false;
node->parent->parent->red = true;
- interval_tree_rotate_right (tree, node->parent->parent);
+ itree_rotate_right (tree, node->parent->parent);
}
}
else
@@ -753,12 +653,12 @@ interval_tree_insert_fix (struct itree_tree *tree,
if (node == node->parent->left) /* case 2.b */
{
node = node->parent;
- interval_tree_rotate_right (tree, node);
+ itree_rotate_right (tree, node);
}
/* case 3.b */
node->parent->red = false;
node->parent->parent->red = true;
- interval_tree_rotate_left (tree, node->parent->parent);
+ itree_rotate_left (tree, node->parent->parent);
}
}
}
@@ -770,22 +670,20 @@ 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)
+itree_insert_node (struct itree_tree *tree, struct itree_node *node)
{
- eassert (node->begin <= node->end && node != NULL);
- /* FIXME: The assertion below fails because `delete_all_overlays`
- doesn't set left/right/parent to NULL. */
- /* eassert (node->left == NULL && node->right == NULL
- && node->parent == NULL) */;
+ eassert (node && node->begin <= node->end);
+ eassert (node->left == NULL && node->right == NULL
+ && node->parent == NULL);
eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
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);
@@ -793,7 +691,7 @@ interval_tree_insert (struct itree_tree *tree, struct
itree_node *node)
ancestors limit values. */
while (child != NULL)
{
- interval_tree_inherit_offset (otick, child);
+ itree_inherit_offset (otick, child);
parent = child;
eassert (child->offset == 0);
child->limit = max (child->limit, node->end);
@@ -826,7 +724,7 @@ interval_tree_insert (struct itree_tree *tree, struct
itree_node *node)
{
node->red = true;
eassert (check_tree (tree, false)); /* FIXME: Too expensive. */
- interval_tree_insert_fix (tree, node);
+ itree_insert_fix (tree, node);
}
}
@@ -837,7 +735,7 @@ itree_insert (struct itree_tree *tree, struct itree_node
*node,
node->begin = begin;
node->end = end;
node->otick = tree->otick;
- interval_tree_insert (tree, node);
+ itree_insert_node (tree, node);
}
/* Safely modify a node's interval. */
@@ -847,35 +745,32 @@ itree_node_set_region (struct itree_tree *tree,
struct itree_node *node,
ptrdiff_t begin, ptrdiff_t end)
{
- interval_tree_validate (tree, node);
+ itree_validate (tree, node);
if (begin != node->begin)
{
itree_remove (tree, node);
node->begin = min (begin, PTRDIFF_MAX - 1);
node->end = max (node->begin, end);
- interval_tree_insert (tree, node);
+ itree_insert_node (tree, node);
}
else if (end != node->end)
{
node->end = max (node->begin, end);
eassert (node != NULL);
- interval_tree_propagate_limit (node);
+ itree_propagate_limit (node);
}
}
/* Return true, if NODE is a member of TREE. */
static bool
-interval_tree_contains (struct itree_tree *tree, struct itree_node *node)
+itree_contains (struct itree_tree *tree, struct itree_node *node)
{
eassert (node);
struct itree_node *other;
ITREE_FOREACH (other, tree, node->begin, PTRDIFF_MAX, ASCENDING)
if (other == node)
- {
- ITREE_FOREACH_ABORT ();
- return true;
- }
+ return true;
return false;
}
@@ -890,11 +785,11 @@ itree_limit_is_stable (struct itree_node *node)
}
static struct itree_node*
-interval_tree_subtree_min (uintmax_t otick, struct itree_node *node)
+itree_subtree_min (uintmax_t otick, struct itree_node *node)
{
if (node == NULL)
return node;
- while ((interval_tree_inherit_offset (otick, node),
+ while ((itree_inherit_offset (otick, node),
node->left != NULL))
node = node->left;
return node;
@@ -905,14 +800,14 @@ interval_tree_subtree_min (uintmax_t otick, struct
itree_node *node)
so re-balance the parents to re-establish the RB invariants. */
static void
-interval_tree_remove_fix (struct itree_tree *tree,
+itree_remove_fix (struct itree_tree *tree,
struct itree_node *node,
struct itree_node *parent)
{
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))
{
@@ -926,7 +821,7 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->red = false;
parent->red = true;
- interval_tree_rotate_left (tree, parent);
+ itree_rotate_left (tree, parent);
other = parent->right;
}
eassume (other != NULL);
@@ -945,13 +840,13 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->left->red = false;
other->red = true;
- interval_tree_rotate_right (tree, other);
+ itree_rotate_right (tree, other);
other = parent->right;
}
other->red = parent->red; /* 4.a */
parent->red = false;
other->right->red = false;
- interval_tree_rotate_left (tree, parent);
+ itree_rotate_left (tree, parent);
node = tree->root;
parent = NULL;
}
@@ -964,7 +859,7 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->red = false;
parent->red = true;
- interval_tree_rotate_right (tree, parent);
+ itree_rotate_right (tree, parent);
other = parent->left;
}
eassume (other != NULL);
@@ -983,14 +878,14 @@ interval_tree_remove_fix (struct itree_tree *tree,
{
other->right->red = false;
other->red = true;
- interval_tree_rotate_left (tree, other);
+ itree_rotate_left (tree, other);
other = parent->left;
}
other->red = parent->red; /* 4.b */
parent->red = false;
other->left->red = false;
- interval_tree_rotate_right (tree, parent);
+ itree_rotate_right (tree, parent);
node = tree->root;
parent = NULL;
}
@@ -1023,7 +918,7 @@ itree_total_offset (struct itree_node *node)
unchanged. Caller is responsible for recalculation of `limit`.
Requires both nodes to be using the same effective `offset`. */
static void
-interval_tree_replace_child (struct itree_tree *tree,
+itree_replace_child (struct itree_tree *tree,
struct itree_node *source,
struct itree_node *dest)
{
@@ -1049,11 +944,11 @@ interval_tree_replace_child (struct itree_tree *tree,
recalculation of `limit`. Requires both nodes to be using the same
effective `offset`. */
static void
-interval_tree_transplant (struct itree_tree *tree,
+itree_transplant (struct itree_tree *tree,
struct itree_node *source,
struct itree_node *dest)
{
- interval_tree_replace_child (tree, source, dest);
+ itree_replace_child (tree, source, dest);
source->left = dest->left;
if (source->left != NULL)
source->left->parent = source;
@@ -1068,17 +963,17 @@ interval_tree_transplant (struct itree_tree *tree,
struct itree_node*
itree_remove (struct itree_tree *tree, struct itree_node *node)
{
- eassert (interval_tree_contains (tree, node));
+ eassert (itree_contains (tree, node));
eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
/* Find `splice`, the leaf node to splice out of the tree. When
`node` has at most one child this is `node` itself. Otherwise,
it is the in order successor of `node`. */
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
struct itree_node *splice
= (node->left == NULL || node->right == NULL)
? node
- : interval_tree_subtree_min (tree->otick, node->right);
+ : itree_subtree_min (tree->otick, node->right);
/* Find `subtree`, the only child of `splice` (may be NULL). Note:
`subtree` will not be modified other than changing its parent to
@@ -1099,7 +994,7 @@ itree_remove (struct itree_tree *tree, struct itree_node
*node)
`splice` is black, this creates a red-red violation, so remember
this now as the field can be overwritten when splice is
transplanted below. */
- interval_tree_replace_child (tree, subtree, splice);
+ itree_replace_child (tree, subtree, splice);
bool removed_black = !splice->red;
/* Replace `node` with `splice` in the tree and propagate limit
@@ -1108,18 +1003,18 @@ itree_remove (struct itree_tree *tree, struct
itree_node *node)
has a new child. */
if (splice != node)
{
- interval_tree_transplant (tree, splice, node);
- interval_tree_propagate_limit (subtree_parent);
+ itree_transplant (tree, splice, node);
+ itree_propagate_limit (subtree_parent);
if (splice != subtree_parent)
- interval_tree_update_limit (splice);
+ itree_update_limit (splice);
}
- interval_tree_propagate_limit (splice->parent);
+ itree_propagate_limit (splice->parent);
--tree->size;
/* Fix any black height violation caused by removing a black node. */
if (removed_black)
- interval_tree_remove_fix (tree, subtree, subtree_parent);
+ itree_remove_fix (tree, subtree, subtree_parent);
eassert ((tree->size == 0) == (tree->root == NULL));
eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
@@ -1137,52 +1032,6 @@ itree_remove (struct itree_tree *tree, struct itree_node
*node)
return node;
}
-bool
-itree_iterator_busy_p (void)
-{
- return (iter && iter->running);
-}
-
-/* Start a iterator enumerating all intervals in [BEGIN,END) in the
- given ORDER. Only one iterator per tree can be running at any time. */
-
-struct itree_iterator *
-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; */
- if (iter->running)
- {
- fprintf (stderr,
- "Detected nested iteration!\nOuter: %s:%d\nInner: %s:%d\n",
- iter->file, iter->line, file, line);
- emacs_abort ();
- }
- iter->begin = begin;
- iter->end = end;
- iter->otick = tree->otick;
- iter->order = order;
- interval_stack_clear (iter->stack);
- if (begin <= end && tree->root != NULL)
- interval_stack_push_flagged (iter->stack, tree->root, false);
- iter->file = file;
- iter->line = line;
- iter->running = true;
- /* interval_stack_ensure_space (iter->stack,
- 2 * interval_tree_max_height (tree)); */
- return iter;
-}
-
-/* Stop using the iterator. */
-
-void
-itree_iterator_finish (struct itree_iterator *iter)
-{
- eassert (iter->running);
- iter->running = false;
-}
-
/* +=======================================================================+
* | Insert/Delete Gaps
@@ -1190,113 +1039,125 @@ 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. */
- struct interval_stack *saved = interval_stack_create (0);
+ 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 itree_stack *saved = itree_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);
+ /* Actually any order would do. */
+ 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))
+ itree_stack_push (saved, node);
+ }
}
- for (int i = 0; i < saved->length; ++i)
- itree_remove (tree, nav_nodeptr (saved->nodes[i]));
+ for (size_t i = 0; i < saved->length; ++i)
+ itree_remove (tree, 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;
- struct interval_stack *stack = interval_stack_create (size);
- interval_stack_push (stack, tree->root);
- nodeptr_and_flag nav;
- while ((nav = interval_stack_pop (stack),
- node = nav_nodeptr (nav)))
+ const int size = itree_max_height (tree) + 1;
+ struct itree_stack *stack = itree_stack_create (size);
+ itree_stack_push (stack, tree->root);
+ while ((node = itree_stack_pop (stack)))
{
/* Process in pre-order. */
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
+ if (pos > node->limit)
+ continue;
if (node->right != NULL)
{
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);
+ itree_stack_push (stack, node->right);
}
- if (node->left != NULL
- && pos <= node->left->limit + node->left->offset)
- interval_stack_push (stack, node->left);
+ if (node->left != NULL)
+ itree_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);
- interval_tree_propagate_limit (node);
+ itree_propagate_limit (node);
}
}
- interval_stack_destroy (stack);
+ itree_stack_destroy (stack);
}
- /* Reinsert nodes starting at POS having front-advance. */
+ /* 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)))
+ while ((node = itree_stack_pop (saved)))
{
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);
+ itree_insert_node (tree, node);
}
- interval_stack_destroy (saved);
+ itree_stack_destroy (saved);
}
/* 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. */
- const int size = interval_tree_max_height (tree) + 1;
- struct interval_stack *stack = interval_stack_create (size);
+ might unintentionally bring shifted nodes back into our search space. */
+ const int size = itree_max_height (tree) + 1;
+ struct itree_stack *stack = itree_stack_create (size);
struct itree_node *node;
- interval_stack_push (stack, tree->root);
- nodeptr_and_flag nav;
- while ((nav = interval_stack_pop (stack)))
+ itree_stack_push (stack, tree->root);
+ while ((node = itree_stack_pop (stack)))
{
- node = nav_nodeptr (nav);
- interval_tree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, node);
+ if (pos > node->limit)
+ continue;
if (node->right != NULL)
{
if (node->begin > pos + length)
@@ -1306,11 +1167,10 @@ itree_delete_gap (struct itree_tree *tree,
++tree->otick;
}
else
- interval_stack_push (stack, node->right);
+ itree_stack_push (stack, node->right);
}
- if (node->left != NULL
- && pos <= node->left->limit + node->left->offset)
- interval_stack_push (stack, node->left);
+ if (node->left != NULL)
+ itree_stack_push (stack, node->left);
if (pos < node->begin)
node->begin = max (pos, node->begin - length);
@@ -1318,10 +1178,10 @@ itree_delete_gap (struct itree_tree *tree,
{
node->end = max (pos , node->end - length);
eassert (node != NULL);
- interval_tree_propagate_limit (node);
+ itree_propagate_limit (node);
}
}
- interval_stack_destroy (stack);
+ itree_stack_destroy (stack);
}
@@ -1339,81 +1199,217 @@ itree_delete_gap (struct itree_tree *tree,
a NODE2 strictly bigger than NODE1 should also be included). */
static inline bool
-interval_node_intersects (const struct itree_node *node,
- ptrdiff_t begin, ptrdiff_t end)
+itree_node_intersects (const struct itree_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
{
return (begin < node->end && node->begin < end)
|| (node->begin == node->end && begin == node->begin);
}
-/* Return the next node of the iterator in the order given when it was
- started; or NULL if there are no more nodes. */
+/* Return the "next" node in the current traversal order.
-struct itree_node *
-itree_iterator_next (struct itree_iterator *g)
-{
- eassert (g->running);
+ Note that this should return all the nodes that we need to traverse
+ in order to traverse the nodes selected by the current narrowing (i.e.
+ `ITER->begin..ITER->end`) so it will also return some nodes which aren't in
+ that narrowing simply because they may have children which are.
- struct itree_node *const null = NULL;
- struct itree_node *node;
+ The code itself is very unsatifactory because the code of each one
+ of the supported traversals seems completely different from the others.
+ If someone knows how to make it more uniform and "obviously correct",
+ please make yourself heard. */
- /* The `visited` flag stored in each node is used here (and only here):
- We keep a "workstack" of nodes we need to consider. This stack
- consist of nodes of two types: nodes that we have decided
- should be returned by the iterator, and nodes which we may
- need to consider (including checking their children).
- We start an iteration with a stack containing just the root
- node marked as "not visited" which means that it (and its children)
- needs to be considered but we haven't yet decided whether it's included
- in the iterator's output. */
-
- do
+static struct itree_node *
+itree_iter_next_in_subtree (struct itree_node *node,
+ struct itree_iterator *iter)
+{
+ /* FIXME: Like in the previous version of the iterator, we
+ prune based on `limit` only when moving to a left child,
+ but `limit` can also get smaller when moving to a right child
+ It's actually fairly common, so maybe it would be worthwhile
+ to prune a bit more aggressively here. */
+ struct itree_node *next;
+ switch (iter->order)
{
- nodeptr_and_flag nav;
- bool visited;
- while ((nav = interval_stack_pop (g->stack),
- node = nav_nodeptr (nav),
- visited = nav_flag (nav),
- node && !visited))
- {
- struct itree_node *const left = node->left;
- struct itree_node *const right = node->right;
+ case ITREE_ASCENDING:
+ next = node->right;
+ if (!next)
+ {
+ while ((next = node->parent)
+ && next->right == node)
+ node = next;
+ if (!next)
+ return NULL; /* No more nodes to visit. */
+ node = next;
+ }
+ else
+ {
+ node = next;
+ itree_inherit_offset (iter->otick, node);
+ while ((next = node->left)
+ && (itree_inherit_offset (iter->otick, next),
+ iter->begin <= next->limit))
+ node = next;
+ }
+ if (node->begin > iter->end)
+ return NULL; /* No more nodes within begin..end. */
+ return node;
+
+ case ITREE_DESCENDING:
+ next = node->left;
+ if (!next
+ || (itree_inherit_offset (iter->otick, next),
+ next->limit < iter->begin))
+ {
+ while ((next = node->parent)
+ && next->left == node)
+ node = next;
+ if (!next)
+ return NULL; /* No more nodes to visit. */
+ node = next;
+ }
+ else
+ {
+ node = next;
+ while (node->begin <= iter->end
+ && (next = node->right))
+ {
+ itree_inherit_offset (iter->otick, next),
+ node = next;
+ }
+ }
+ return node;
+
+ case ITREE_PRE_ORDER:
+ next = node->left;
+ if (next
+ && (itree_inherit_offset (iter->otick, next),
+ !(next->limit < iter->begin)))
+ return next;
+ next = node->right;
+ if (node->begin <= iter->end && next)
+ {
+ itree_inherit_offset (iter->otick, next);
+ return next;
+ }
+ while ((next = node->parent))
+ {
+ if (next->right == node)
+ node = next;
+ else
+ {
+ eassert (next->left == node);
+ node = next;
+ next = node->right;
+ if (node->begin <= iter->end && next)
+ {
+ itree_inherit_offset (iter->otick, next);
+ return next;
+ }
+ }
+ }
+ return NULL;
+
+ case ITREE_POST_ORDER:
+ next = node->parent;
+ if (!next || next->right == node)
+ return next;
+ eassert (next->left == node);
+ node = next;
+ next = node->right;
+ if (!(node->begin <= iter->end && next))
+ return node;
+ node = next;
+ itree_inherit_offset (iter->otick, node);
+ while (((next = node->left)
+ && (itree_inherit_offset (iter->otick, next),
+ iter->begin <= next->limit))
+ || (node->begin <= iter->end
+ && (next = node->right)
+ && (itree_inherit_offset (iter->otick, next), true)))
+ node = next;
+ return node;
+
+ default:
+ emacs_abort ();
+ }
+}
- interval_tree_inherit_offset (g->otick, node);
- eassert (itree_limit_is_stable (node));
- switch (g->order)
- {
- case ITREE_ASCENDING:
- if (right != null && node->begin <= g->end)
- interval_stack_push_flagged (g->stack, right, false);
- if (interval_node_intersects (node, g->begin, g->end))
- interval_stack_push_flagged (g->stack, node, true);
- /* Node's children may still be off-set and we need to add it. */
- if (left != null && g->begin <= left->limit + left->offset)
- interval_stack_push_flagged (g->stack, left, false);
- break;
- case ITREE_DESCENDING:
- if (left != null && g->begin <= left->limit + left->offset)
- interval_stack_push_flagged (g->stack, left, false);
- if (interval_node_intersects (node, g->begin, g->end))
- interval_stack_push_flagged (g->stack, node, true);
- if (right != null && node->begin <= g->end)
- interval_stack_push_flagged (g->stack, right, false);
- break;
- case ITREE_PRE_ORDER:
- if (right != null && node->begin <= g->end)
- interval_stack_push_flagged (g->stack, right, false);
- if (left != null && g->begin <= left->limit + left->offset)
- interval_stack_push_flagged (g->stack, left, false);
- if (interval_node_intersects (node, g->begin, g->end))
- interval_stack_push_flagged (g->stack, node, true);
- break;
- }
- }
- /* Node may have been invalidated by itree_iterator_narrow
- after it was pushed: Check if it still intersects. */
- } while (node && ! interval_node_intersects (node, g->begin, g->end));
+static struct itree_node *
+itree_iterator_first_node (struct itree_tree *tree,
+ struct itree_iterator *iter)
+{
+ struct itree_node *node = tree->root;
+ if (node)
+ {
+ struct itree_node dummy;
+ dummy.left = NULL;
+ dummy.parent = NULL;
+ dummy.right = NULL;
+ itree_inherit_offset (iter->otick, node);
+ switch (iter->order)
+ {
+ case ITREE_ASCENDING:
+ dummy.right = node;
+ dummy.begin = PTRDIFF_MIN;
+ node = itree_iter_next_in_subtree (&dummy, iter);
+ break;
+
+ case ITREE_DESCENDING:
+ dummy.left = node;
+ node = itree_iter_next_in_subtree (&dummy, iter);
+ break;
+
+ case ITREE_PRE_ORDER:
+ break;
+
+ case ITREE_POST_ORDER:
+ dummy.parent = &dummy;
+ dummy.left = &dummy;
+ dummy.right = node;
+ dummy.begin = PTRDIFF_MIN;
+ node = itree_iter_next_in_subtree (&dummy, iter);
+ break;
+ default:
+ emacs_abort ();
+ }
+ }
+ return node;
+}
+
+/* Start a iterator enumerating all intervals in [BEGIN,END) in the
+ given ORDER. */
+
+struct itree_iterator *
+itree_iterator_start (struct itree_iterator *iter,
+ struct itree_tree *tree,
+ ptrdiff_t begin, ptrdiff_t end, enum itree_order order)
+{
+ eassert (iter);
+ iter->begin = begin;
+ iter->end = end;
+ iter->otick = tree->otick;
+ iter->order = order;
+ /* Beware: the `node` field always holds "the next" node to consider.
+ so it's always "one node ahead" of what the iterator loop sees.
+ In most respects this makes no difference, but we depend on this
+ detail in `delete_all_overlays` where this allows us to modify
+ the current node knowing that the iterator will not need it to
+ find the next. */
+ iter->node = itree_iterator_first_node (tree, iter);
+ return iter;
+}
+struct itree_node *
+itree_iterator_next (struct itree_iterator *iter)
+{
+ struct itree_node *node = iter->node;
+ while (node
+ && !itree_node_intersects (node, iter->begin, iter->end))
+ {
+ node = itree_iter_next_in_subtree (node, iter);
+ eassert (itree_limit_is_stable (node));
+ }
+ iter->node = node ? itree_iter_next_in_subtree (node, iter) : NULL;
return node;
}
@@ -1424,9 +1420,9 @@ void
itree_iterator_narrow (struct itree_iterator *g,
ptrdiff_t begin, ptrdiff_t end)
{
- eassert (g->running);
+ eassert (g);
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..291fa53fd3 100644
--- a/src/itree.h
+++ b/src/itree.h
@@ -104,6 +104,7 @@ enum itree_order
ITREE_ASCENDING,
ITREE_DESCENDING,
ITREE_PRE_ORDER,
+ ITREE_POST_ORDER,
};
extern void itree_node_init (struct itree_node *, bool, bool, Lisp_Object);
@@ -119,25 +120,33 @@ 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
instead. */
-extern bool itree_iterator_busy_p (void);
-extern struct itree_iterator *itree_iterator_start (struct itree_tree *,
+extern struct itree_iterator *itree_iterator_start (struct itree_iterator *,
+ struct itree_tree *,
ptrdiff_t,
ptrdiff_t,
- enum itree_order,
- const char *, int);
+ enum itree_order);
extern void itree_iterator_narrow (struct itree_iterator *, ptrdiff_t,
ptrdiff_t);
-extern void itree_iterator_finish (struct itree_iterator *);
extern struct itree_node *itree_iterator_next (struct itree_iterator *);
+/* State used when iterating interval. */
+struct itree_iterator
+ {
+ struct itree_node *node;
+ ptrdiff_t begin;
+ ptrdiff_t end;
+ uintmax_t otick; /* A copy of the tree's `otick`. */
+ enum itree_order order;
+ };
+
/* Iterate over the intervals between BEG and END in the tree T.
N will hold successive nodes. ORDER can be one of : `ASCENDING`,
- `DESCENDING`, or `PRE_ORDER`.
+ `DESCENDING`, `POST_ORDER`, or `PRE_ORDER`.
It should be used as:
ITREE_FOREACH (n, t, beg, end, order)
@@ -147,34 +156,24 @@ 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.
- - 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
- of `post-gc-hook`.
- - If you need to exit the loop early, you *have* to call `ITREE_ABORT`
- just before exiting (e.g. with `break` or `return`).
- - Non-local exits are not supported within the body of the loop.
+ it is cheap and pure.
- Don't modify the tree during the iteration.
*/
#define ITREE_FOREACH(n, t, beg, end, order) \
- /* FIXME: We'd want to declare `x` right here, but I can't figure out
+ /* FIXME: We'd want to declare `n` right here, but I can't figure out
how to make that work here: the `for` syntax only allows a single
clause for the var declarations where we need 2 different types.
We could use the `struct {foo x; bar y; } p;` trick to declare two
vars `p.x` and `p.y` of unrelated types, but then none of the names
- of the vars matches the `n` we receive :-(. */ \
- if (!t) \
- { } \
- else \
- for (struct itree_iterator *itree_iter_ \
- = itree_iterator_start (t, beg, end, ITREE_##order, \
- __FILE__, __LINE__); \
- ((n = itree_iterator_next (itree_iter_)) \
- || (itree_iterator_finish (itree_iter_), false));)
-
-#define ITREE_FOREACH_ABORT() \
- itree_iterator_finish (itree_iter_)
+ of the vars matches the `n` we receive :-(. */ \
+ if (!t) \
+ { } \
+ else \
+ for (struct itree_iterator itree_local_iter_, \
+ *itree_iter_ \
+ = itree_iterator_start (&itree_local_iter_, \
+ t, beg, end, ITREE_##order); \
+ ((n = itree_iterator_next (itree_iter_)));)
#define ITREE_FOREACH_NARROW(beg, end) \
itree_iterator_narrow (itree_iter_, beg, end)
diff --git a/src/keyboard.c b/src/keyboard.c
index d8796569cd..4b35a044eb 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);
}
@@ -5718,6 +5720,29 @@ make_scroll_bar_position (struct input_event *ev,
Lisp_Object type)
builtin_lisp_symbol (scroll_bar_parts[ev->part]));
}
+#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR
+
+/* Return whether or not the coordinates X and Y are inside the
+ box of the menu-bar window of frame F. */
+
+static bool
+coords_in_menu_bar_window (struct frame *f, int x, int y)
+{
+ struct window *window;
+
+ if (!WINDOWP (f->menu_bar_window))
+ return false;
+
+ window = XWINDOW (f->menu_bar_window);
+
+ return (y >= WINDOW_TOP_EDGE_Y (window)
+ && x >= WINDOW_LEFT_EDGE_X (window)
+ && y <= WINDOW_BOTTOM_EDGE_Y (window)
+ && x <= WINDOW_RIGHT_EDGE_X (window));
+}
+
+#endif
+
/* Given a struct input_event, build the lisp event which represents
it. If EVENT is 0, build a mouse movement event from the mouse
movement buffer, which should have a movement event in it.
@@ -5970,10 +5995,32 @@ make_lispy_event (struct input_event *event)
and ROW are set to frame relative glyph coordinates
which are then used to determine whether this click is
in a menu (non-toolkit version). */
- if (!toolkit_menubar_in_use (f))
+ if (!toolkit_menubar_in_use (f)
+#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR
+ /* Don't process events for menu bars if they are not
+ in the menu bar window. */
+ && (!FRAME_WINDOW_P (f)
+ || coords_in_menu_bar_window (f, XFIXNUM (event->x),
+ XFIXNUM (event->y)))
+#endif
+ )
{
- pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM
(event->y),
- &column, &row, NULL, 1);
+#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR
+ if (FRAME_WINDOW_P (f))
+ {
+ struct window *menu_w = XWINDOW (f->menu_bar_window);
+ int x, y, dummy;
+
+ x = FRAME_TO_WINDOW_PIXEL_X (menu_w, XFIXNUM (event->x));
+ y = FRAME_TO_WINDOW_PIXEL_Y (menu_w, XFIXNUM (event->y));
+
+ x_y_to_hpos_vpos (XWINDOW (f->menu_bar_window), x, y,
&column, &row,
+ NULL, NULL, &dummy);
+ }
+ else
+#endif
+ pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM
(event->y),
+ &column, &row, NULL, 1);
/* In the non-toolkit version, clicks on the menu bar
are ordinary button events in the event buffer.
@@ -5983,7 +6030,7 @@ make_lispy_event (struct input_event *event)
menu bar and Emacs doesn't know about it until
after the user makes a selection.) */
if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
- && (event->modifiers & down_modifier))
+ && (event->modifiers & down_modifier))
{
Lisp_Object items, item;
diff --git a/src/lisp.h b/src/lisp.h
index 6416785683..8a5b8dad83 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4690,7 +4690,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,
@@ -4915,6 +4915,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 dfa4d9afb5..2a57f72194 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1236,7 +1236,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
@@ -1740,12 +1741,15 @@ maybe_swap_for_eln (bool no_native, Lisp_Object
*filename, int *fd,
Vload_path,
Qnil, Qnil)))
return;
- call2 (intern_c_string ("display-warning"),
- Qcomp,
- CALLN (Fformat,
- build_string ("Cannot look up eln file as "
- "no source file was found for %s"),
- *filename));
+ Vdelayed_warnings_list
+ = Fcons (list2
+ (Qcomp,
+ CALLN (Fformat,
+ build_string ("Cannot look up eln "
+ "file as no source file "
+ "was found for %s"),
+ *filename)),
+ Vdelayed_warnings_list);
return;
}
}
@@ -5619,7 +5623,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/nsfns.m b/src/nsfns.m
index 2699cf37a5..d793bcf13f 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -632,10 +632,19 @@ ns_set_menu_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
ns_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/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 d6ae57afb2..0a5d96dbb7 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);
@@ -2748,7 +2748,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/pgtkfns.c b/src/pgtkfns.c
index 9473e14f5c..a32067af81 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -473,10 +473,19 @@ pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
pgtk_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -1112,13 +1121,6 @@ pgtk_default_font_parameter (struct frame *f,
Lisp_Object parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it after
- we've applied the `default' face settings. */
- AUTO_FRAME_ARG (arg, Qfont_parameter, font_param);
- gui_set_frame_parameters (f, arg);
- }
/* This call will make X resources override any system font setting. */
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index 491ba33882..13f6c6c3c4 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -511,16 +511,16 @@ pgtk_free_frame_resources (struct frame *f)
if (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider != NULL)
{
- GtkCssProvider *old =
- FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider;
+ GtkCssProvider *old
+ = FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider;
g_object_unref (old);
FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider = NULL;
}
if (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider != NULL)
{
- GtkCssProvider *old =
- FRAME_X_OUTPUT (f)->scrollbar_background_css_provider;
+ GtkCssProvider *old
+ = FRAME_X_OUTPUT (f)->scrollbar_background_css_provider;
g_object_unref (old);
FRAME_X_OUTPUT (f)->scrollbar_background_css_provider = NULL;
}
@@ -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
@@ -1331,8 +1333,8 @@ fill_background_by_face (struct frame *f, struct face
*face, int x, int y,
if (face->stipple != 0)
{
- cairo_pattern_t *mask =
- FRAME_DISPLAY_INFO (f)->bitmaps[face->stipple - 1].pattern;
+ cairo_pattern_t *mask
+ = FRAME_DISPLAY_INFO (f)->bitmaps[face->stipple - 1].pattern;
double r = ((face->foreground >> 16) & 0xff) / 255.0;
double g = ((face->foreground >> 8) & 0xff) / 255.0;
@@ -1604,8 +1606,8 @@ pgtk_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
/* It is assured that all LEN characters in STR is ASCII. */
for (j = 0; j < len; j++)
- char2b[j] =
- s->font->driver->encode_char (s->font, str[j]) & 0xFFFF;
+ char2b[j]
+ = s->font->driver->encode_char (s->font, str[j]) & 0xFFFF;
s->font->driver->draw (s, 0, upper_len,
x + glyph->slice.glyphless.upper_xoff,
s->ybase + glyph->slice.glyphless.upper_yoff,
@@ -2956,8 +2958,8 @@ pgtk_draw_window_cursor (struct window *w, struct
glyph_row *glyph_row, int x,
if (w == XWINDOW (f->selected_window))
{
- int frame_x =
- WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
+ int frame_x = (WINDOW_TO_FRAME_PIXEL_X (w, x)
+ + WINDOW_LEFT_FRINGE_WIDTH (w));
int frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, y);
pgtk_im_set_cursor_location (f, frame_x, frame_y,
w->phys_cursor_width,
@@ -4516,16 +4518,29 @@ pgtk_free_pixmap (struct frame *f, Emacs_Pixmap pixmap)
void
pgtk_focus_frame (struct frame *f, bool noactivate)
{
- struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
+ struct pgtk_display_info *dpyinfo;
+ GtkWidget *widget;
+ GtkWindow *window;
- GtkWidget *wid = FRAME_WIDGET (f);
+ dpyinfo = FRAME_DISPLAY_INFO (f);
- if (dpyinfo->x_focus_frame != f && wid != NULL)
+ if (FRAME_GTK_OUTER_WIDGET (f) && !noactivate)
{
- block_input ();
- gtk_widget_grab_focus (wid);
- unblock_input ();
+ /* The user says it is okay to activate the frame. Call
+ gtk_window_present_with_time. If the timestamp specified
+ (actually a display serial on Wayland) is new enough, then
+ any Wayland compositor supporting gtk_surface1_present will
+ cause the frame to be activated. */
+
+ window = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f));
+ gtk_window_present_with_time (window, dpyinfo->last_user_time);
+ return;
}
+
+ widget = FRAME_WIDGET (f);
+
+ if (widget)
+ gtk_widget_grab_focus (widget);
}
static void
@@ -5142,13 +5157,15 @@ static gboolean
key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data)
{
union buffered_input_event inev;
- ptrdiff_t nbytes = 0;
+ ptrdiff_t nbytes;
Mouse_HLInfo *hlinfo;
struct frame *f;
+ struct pgtk_display_info *dpyinfo;
f = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
EVENT_INIT (inev.ie);
hlinfo = MOUSE_HL_INFO (f);
+ nbytes = 0;
/* If mouse-highlight is an integer, input clears out
mouse highlighting. */
@@ -5179,6 +5196,12 @@ key_press_event (GtkWidget *widget, GdkEvent *event,
gpointer *user_data)
Lisp_Object c;
guint state;
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+
+ /* Set the last user time for pgtk_focus_frame to work
+ correctly. */
+ dpyinfo->last_user_time = event->key.time;
+
state = event->key.state;
/* While super is pressed, the input method will always always
@@ -5212,8 +5235,8 @@ key_press_event (GtkWidget *widget, GdkEvent *event,
gpointer *user_data)
/* Common for all keysym input events. */
XSETFRAME (inev.ie.frame_or_window, f);
- inev.ie.modifiers =
- pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers);
+ inev.ie.modifiers
+ = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers);
inev.ie.timestamp = event->key.time;
/* First deal with keysyms which have defined
@@ -5361,11 +5384,37 @@ done:
return TRUE;
}
+static struct pgtk_display_info *
+pgtk_display_info_for_display (GdkDisplay *dpy)
+{
+ struct pgtk_display_info *dpyinfo;
+
+ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+ {
+ if (dpyinfo->display == dpy)
+ return dpyinfo;
+ }
+
+ return NULL;
+}
+
static gboolean
key_release_event (GtkWidget *widget,
GdkEvent *event,
gpointer *user_data)
{
+ GdkDisplay *display;
+ struct pgtk_display_info *dpyinfo;
+
+ display = gtk_widget_get_display (widget);
+ dpyinfo = pgtk_display_info_for_display (display);
+
+ if (dpyinfo)
+ /* This is needed on Wayland because of some brain dead
+ compositors. Without them, we would not have to keep track of
+ the serial of key release events. */
+ dpyinfo->last_user_time = event->key.time;
+
return TRUE;
}
@@ -5420,9 +5469,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 +5512,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 +5529,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)
@@ -5899,9 +5951,10 @@ construct_mouse_click (struct input_event *result,
result->kind = MOUSE_CLICK_EVENT;
result->code = event->button - 1;
result->timestamp = event->time;
- result->modifiers =
- (pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->state) |
- (event->type == GDK_BUTTON_RELEASE ? up_modifier : down_modifier));
+ result->modifiers = (pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f),
+ event->state)
+ | (event->type == GDK_BUTTON_RELEASE
+ ? up_modifier : down_modifier));
XSETINT (result->x, event->x);
XSETINT (result->y, event->y);
@@ -5966,6 +6019,10 @@ button_event (GtkWidget *widget, GdkEvent *event,
}
}
+ /* Set the last user time, used to activate the frame in
+ pgtk_focus_frame. */
+ dpyinfo->last_user_time = event->button.time;
+
if (f)
{
/* Is this in the tab-bar? */
@@ -5984,10 +6041,7 @@ button_event (GtkWidget *widget, GdkEvent *event,
(f, x, y, event->type == GDK_BUTTON_PRESS,
pgtk_gtk_to_emacs_modifiers (dpyinfo, event->button.state));
}
- }
- if (f)
- {
if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p)
{
if (ignore_next_mouse_click_timeout)
@@ -6055,8 +6109,8 @@ scroll_event (GtkWidget *widget, GdkEvent *event,
gpointer *user_data)
inev.ie.kind = NO_EVENT;
inev.ie.timestamp = event->scroll.time;
- inev.ie.modifiers =
- pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->scroll.state);
+ inev.ie.modifiers
+ = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f),
event->scroll.state);
XSETINT (inev.ie.x, event->scroll.x);
XSETINT (inev.ie.y, event->scroll.y);
XSETFRAME (inev.ie.frame_or_window, f);
@@ -6594,6 +6648,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 +6789,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);
@@ -6940,10 +7035,9 @@ pgtk_parse_color (struct frame *f, const char
*color_name,
color->red = rgba.red * 65535;
color->green = rgba.green * 65535;
color->blue = rgba.blue * 65535;
- color->pixel =
- (color->red >> 8) << 16 |
- (color->green >> 8) << 8 |
- (color->blue >> 8) << 0;
+ color->pixel = ((color->red >> 8) << 16
+ | (color->green >> 8) << 8
+ | (color->blue >> 8) << 0);
return 1;
}
return 0;
@@ -7072,10 +7166,9 @@ If set to a non-float value, there will be no wait at
all. */);
Vpgtk_wait_for_event_timeout = make_float (0.1);
DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table,
- doc: /* Hash table of character codes indexed by X keysym codes.
*/);
- Vpgtk_keysym_table =
- make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD, Qnil, false);
+ doc: /* Hash table of character codes indexed by X keysym codes. */);
+ Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false);
window_being_scrolled = Qnil;
staticpro (&window_being_scrolled);
@@ -7113,13 +7206,13 @@ pgtk_begin_cr_clip (struct frame *f)
if (!cr)
{
- cairo_surface_t *surface =
- gdk_window_create_similar_surface (gtk_widget_get_window
- (FRAME_GTK_WIDGET (f)),
- CAIRO_CONTENT_COLOR_ALPHA,
- FRAME_CR_SURFACE_DESIRED_WIDTH (f),
- FRAME_CR_SURFACE_DESIRED_HEIGHT
- (f));
+ cairo_surface_t *surface
+ = gdk_window_create_similar_surface (gtk_widget_get_window
+ (FRAME_GTK_WIDGET (f)),
+ CAIRO_CONTENT_COLOR_ALPHA,
+ FRAME_CR_SURFACE_DESIRED_WIDTH (f),
+ FRAME_CR_SURFACE_DESIRED_HEIGHT
+ (f));
cr = FRAME_CR_CONTEXT (f) = cairo_create (surface);
cairo_surface_destroy (surface);
diff --git a/src/pgtkterm.h b/src/pgtkterm.h
index fcc6c5310e..b6bd10dcb4 100644
--- a/src/pgtkterm.h
+++ b/src/pgtkterm.h
@@ -262,6 +262,13 @@ struct pgtk_output
unsigned long background_color;
void *toolbar;
+ /* The "time" of the last user interaction on this display. Set
+ upon button and key press and release events.
+
+ Under the GDK Wayland backend, this is actually an event
+ serial. */
+ guint32 last_user_time;
+
/* Cursors */
Emacs_Cursor current_cursor;
Emacs_Cursor text_cursor;
@@ -357,8 +364,8 @@ struct pgtk_output
/* The tool bar in this frame */
GtkWidget *toolbar_widget;
/* True if tool bar is packed into the hbox widget (i.e. vertical). */
- bool_bf toolbar_in_hbox:1;
- bool_bf toolbar_is_packed:1;
+ bool_bf toolbar_in_hbox : 1;
+ bool_bf toolbar_is_packed : 1;
GtkTooltip *ttip_widget;
GtkWidget *ttip_lbl;
diff --git a/src/print.c b/src/print.c
index 65218084a4..07560518c4 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2017,8 +2017,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 358899cded..5144c5d6c9 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 08bf696b8c..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,
diff --git a/src/w32fns.c b/src/w32fns.c
index 93b7f80f26..887e5a1f7b 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1717,10 +1717,19 @@ w32_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
w32_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -5785,13 +5794,7 @@ w32_default_font_parameter (struct frame *f, Lisp_Object
parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it after
- we've applied the `default' face settings. */
- gui_set_frame_parameters (f, Fcons (Fcons (Qfont_parameter, font_param),
- Qnil));
- }
+
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
RES_TYPE_STRING);
}
@@ -8417,7 +8420,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/w32inevt.c b/src/w32inevt.c
index 6a1d9afacf..d13b0521c9 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -648,7 +648,7 @@ handle_file_notifications (struct input_event *hold_quit)
ns = NULL;
/* Find out if there is a record available in the linked list of
- notifications sets. If so, unlink te set from the linked list.
+ notifications sets. If so, unlink the set from the linked list.
Use the critical section. */
enter_crit ();
if (notifications_set_head->next != notifications_set_head)
diff --git a/src/xdisp.c b/src/xdisp.c
index 3b330f315b..fa5ce84b1c 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2330,7 +2330,7 @@ pixel_to_glyph_coords (struct frame *f, int pix_x, int
pix_y, int *x, int *y,
text, or we can't tell because W's current matrix is not up to
date. */
-static struct glyph *
+struct glyph *
x_y_to_hpos_vpos (struct window *w, int x, int y, int *hpos, int *vpos,
int *dx, int *dy, int *area)
{
@@ -3342,7 +3342,8 @@ init_iterator (struct it *it, struct window *w,
{
/* Mode lines, menu bar in terminal frames. */
it->first_visible_x = 0;
- it->last_visible_x = body_width = WINDOW_PIXEL_WIDTH (w);
+ it->last_visible_x =
+ WINDOW_PIXEL_WIDTH (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w);
}
else
{
@@ -3410,8 +3411,13 @@ init_iterator (struct it *it, struct window *w,
face = FACE_FROM_ID_OR_NULL (it->f, remapped_base_face_id);
if (face && face->box != FACE_NO_BOX)
{
+ int box_thickness = face->box_vertical_line_width;
it->face_box_p = true;
it->start_of_box_run_p = true;
+ /* Make sure we will have enough horizontal space to add the
+ right box line at the end. */
+ if (box_thickness > 0)
+ it->last_visible_x -= box_thickness;
}
}
@@ -5324,6 +5330,8 @@ display_min_width (struct it *it, ptrdiff_t bufpos,
/* Insert the stretch glyph. */
it->object = list3 (Qspace, QCwidth, w);
produce_stretch_glyph (it);
+ if (it->area == TEXT_AREA)
+ it->current_x += it->pixel_width;
it->min_width_property = Qnil;
}
}
@@ -7036,17 +7044,11 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t
endpos, struct window *w)
str = Foverlay_get (overlay, Qbefore_string);
if (STRINGP (str) && SCHARS (str)
&& memchr (SDATA (str), '\n', SBYTES (str)))
- {
- ITREE_FOREACH_ABORT ();
- return true;
- }
+ return true;
str = Foverlay_get (overlay, Qafter_string);
if (STRINGP (str) && SCHARS (str)
&& memchr (SDATA (str), '\n', SBYTES (str)))
- {
- ITREE_FOREACH_ABORT ();
- return true;
- }
+ return true;
}
/* Check for 'display' properties whose values include strings. */
@@ -23188,10 +23190,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
@@ -23228,14 +23238,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,
@@ -26751,7 +26755,17 @@ display_mode_line (struct window *w, enum face_id
face_id, Lisp_Object format)
{
struct glyph *last = (it.glyph_row->glyphs[TEXT_AREA]
+ it.glyph_row->used[TEXT_AREA] - 1);
+ int box_thickness = face->box_vertical_line_width;
last->right_box_line_p = true;
+ /* Add back the space for the right box line we subtracted in
+ init_iterator, since the right_box_line_p flag will make the
+ glyph wider. We actually add only as much space as is
+ available for the last glyph of the modeline and whatever
+ space is left beyond it, since that glyph could be only
+ partially visible */
+ if (box_thickness > 0)
+ last->pixel_width += max (0, (box_thickness
+ - (it.current_x - it.last_visible_x)));
}
return it.glyph_row->height;
@@ -33597,8 +33611,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/xfaces.c b/src/xfaces.c
index ed76db9adb..df078227c8 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3809,8 +3809,12 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object
lface)
ASET (lface, LFACE_FONT_INDEX, font);
}
f->default_face_done_p = false;
- AUTO_FRAME_ARG (arg, Qfont, font);
- Fmodify_frame_parameters (frame, arg);
+ AUTO_LIST2 (arg, AUTO_CONS_EXPR (Qfont, font),
+ /* Clear the `font-parameter' frame property, as the
+ font is now being specified by a face, not a
+ frame property. */
+ AUTO_CONS_EXPR (Qfont_parameter, Qnil));
+ gui_set_frame_parameters_1 (f, arg, true);
}
}
@@ -4208,7 +4212,17 @@ Default face attributes override any local face
attributes. */)
{
Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
AUTO_FRAME_ARG (arg, Qfont, name);
- Fmodify_frame_parameters (frame, arg);
+
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f))
+ /* This is a window-system frame. Prevent changes of
+ the `font' parameter here from messing with the
+ `font-parameter' frame property, as the frame
+ parameter is not being changed by the user. */
+ gui_set_frame_parameters_1 (f, arg, true);
+ else
+#endif
+ Fmodify_frame_parameters (frame, arg);
}
if (STRINGP (gvec[LFACE_FOREGROUND_INDEX]))
diff --git a/src/xfns.c b/src/xfns.c
index 3ff7a8c286..95092ce05f 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1362,13 +1362,21 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
char *xmessage = alloca (1 + message_length);
memcpy (xmessage, cursor_data.error_string, message_length);
- x_uncatch_errors ();
+ x_uncatch_errors_after_check ();
+
+ /* XFreeCursor can generate BadCursor errors, because
+ XCreateFontCursor is not a request that waits for a reply,
+ and as such can return IDs that will not actually be used by
+ the server. */
+ x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f));
/* Free any successfully created cursors. */
for (i = 0; i < mouse_cursor_max; i++)
if (cursor_data.cursor[i] != 0)
XFreeCursor (dpy, cursor_data.cursor[i]);
+ x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f));
+
/* This should only be able to fail if the server's serial
number tracking is broken. */
if (cursor_data.error_cursor >= 0)
@@ -1750,10 +1758,19 @@ x_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
x_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -4506,9 +4523,11 @@ x_default_font_parameter (struct frame *f, Lisp_Object
parms)
}
if (NILP (font))
- font = !NILP (font_param) ? font_param
- : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font",
- RES_TYPE_STRING);
+ font = (!NILP (font_param)
+ ? font_param
+ : gui_display_get_arg (dpyinfo, parms,
+ Qfont, "font", "Font",
+ RES_TYPE_STRING));
if (! FONTP (font) && ! STRINGP (font))
{
@@ -4540,13 +4559,6 @@ x_default_font_parameter (struct frame *f, Lisp_Object
parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it after
- we've applied the `default' face settings. */
- AUTO_FRAME_ARG (arg, Qfont_parameter, font_param);
- gui_set_frame_parameters (f, arg);
- }
/* This call will make X resources override any system font setting. */
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
RES_TYPE_STRING);
diff --git a/src/xselect.c b/src/xselect.c
index db5c7853e7..a381fa2352 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);
@@ -960,7 +967,7 @@ x_handle_selection_request (struct selection_input_event
*event)
x_reply_selection_request. If FOR_MULTIPLE, write out
the data even if conversion fails, using conversion_fail_tag.
- Return true iff successful. */
+ Return true if successful. */
static bool
x_convert_selection (Lisp_Object selection_symbol,
diff --git a/src/xsettings.c b/src/xsettings.c
index 15e7ff5499..00b67539d4 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -56,6 +56,7 @@ typedef unsigned int CARD32;
#ifdef USE_CAIRO
#include <fontconfig/fontconfig.h>
+#include "ftfont.h"
#elif defined HAVE_XFT
#include <X11/Xft/Xft.h>
#endif
@@ -765,7 +766,7 @@ parse_settings (unsigned char *prop,
#ifndef HAVE_PGTK
/* Read settings from the XSettings property window on display for DPYINFO.
Store settings read in SETTINGS.
- Return true iff successful. */
+ Return true if successful. */
static bool
read_settings (Display_Info *dpyinfo, struct xsettings *settings)
@@ -826,6 +827,7 @@ apply_xft_settings (Display_Info *dpyinfo,
#else
FcConfigSubstitute (NULL, pat, FcMatchPattern);
options = cairo_font_options_create ();
+ ftcrfont_get_default_font_options (dpyinfo, options);
cairo_ft_font_options_substitute (options, pat);
cairo_font_options_destroy (options);
FcDefaultSubstitute (pat);
@@ -884,6 +886,14 @@ apply_xft_settings (Display_Info *dpyinfo,
}
#endif
+#ifdef USE_CAIRO
+ /* When Cairo is being used, set oldsettings.dpi to dpyinfo->resx.
+ This is a gross hack, but seeing as Cairo fails to report
+ anything reasonable, just use it to avoid config-changed events
+ being sent at startup. */
+ oldsettings.dpi = dpyinfo->resx;
+#endif
+
if ((settings->seen & SEEN_DPI) != 0
&& settings->dpi > 0
/* The following conjunct avoids setting `changed' to true when
diff --git a/src/xterm.c b/src/xterm.c
index 7dd969b821..af652a0d85 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. */
@@ -1139,6 +1134,7 @@ static void x_clean_failable_requests (struct
x_display_info *);
static struct frame *x_tooltip_window_to_frame (struct x_display_info *,
Window, bool *);
static Window x_get_window_below (Display *, Window, int, int, int *, int *);
+static void x_set_input_focus (struct x_display_info *, Window, Time);
#ifndef USE_TOOLKIT_SCROLL_BARS
static void x_scroll_bar_redraw (struct scroll_bar *);
@@ -5245,7 +5241,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 +5261,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 +5310,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 +5322,60 @@ struct xi_known_valuator
/* The next valuator whose value we already know. */
struct xi_known_valuator *next;
};
+
+/* Populate the scroll valuator at INDEX in DEVICE with the scroll
+ valuator information provided in INFO.
+
+ The information consists of:
+
+ - whether or not the valuator is horizontal.
+
+ - whether or not the valuator's value is currently unknown,
+ until the next XI_Motion event is received or the valuator's
+ value is restored by the caller upon encountering valuator
+ class data.
+
+ - what the current value of the valuator is. This is set to
+ DBL_MIN for debugging purposes, but can be any value, as
+ invalid_p is currently true.
+
+ - the increment, which defines the amount of movement equal to a
+ single unit of scrolling. For example, if the increment is
+ 2.0, then a WHEEL_DOWN or WHEEL_UP event will be sent every
+ time the valuator value changes by 2.0, unless
+ mwheel-coalesce-scroll-events is nil.
+
+ - the number used in XI_Motion events and elsewhere to identify
+ the valuator. */
+
+static void
+xi_populate_scroll_valuator (struct xi_device_t *device,
+ int index, XIScrollClassInfo *info)
+{
+ struct xi_scroll_valuator_t *valuator;
+
+ valuator = &device->valuators[index];
+ valuator->horizontal
+ = (info->scroll_type == XIScrollTypeHorizontal);
+ valuator->invalid_p = true;
+ valuator->emacs_value = DBL_MIN;
+ valuator->increment = info->increment;
+ valuator->number = info->number;
+}
+
#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,58 +5384,121 @@ 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];
-
- valuator = &xi_device->valuators[actual_valuator_count++];
- valuator->horizontal
- = (info->scroll_type == XIScrollTypeHorizontal);
- valuator->invalid_p = true;
- valuator->emacs_value = DBL_MIN;
- valuator->increment = info->increment;
- valuator->number = info->number;
-
+ xi_populate_scroll_valuator (xi_device, actual_valuator_count++,
+ info);
break;
}
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 +5512,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 +5525,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 +5589,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 +5725,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 +5737,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 +11532,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 +11614,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 +11642,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 +11650,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 +13141,181 @@ 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];
+
+ xi_populate_scroll_valuator (device,
+ device->scroll_valuator_count++,
+ scroll);
+ 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 +13567,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;
@@ -14079,6 +14263,136 @@ x_get_window_below (Display *dpy, Window window,
return value;
}
+/* Like XTmouse_position, but much faster. */
+
+static void
+x_fast_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
+ enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object
*y,
+ Time *timestamp)
+{
+ int root_x, root_y, win_x, win_y;
+ unsigned int mask;
+ Window dummy;
+ struct scroll_bar *bar;
+ struct x_display_info *dpyinfo;
+ Lisp_Object tail, frame;
+ struct frame *f1;
+
+ dpyinfo = FRAME_DISPLAY_INFO (*fp);
+
+ if (dpyinfo->last_mouse_scroll_bar && !insist)
+ {
+ bar = dpyinfo->last_mouse_scroll_bar;
+
+ if (bar->horizontal)
+ x_horizontal_scroll_bar_report_motion (fp, bar_window, part,
+ x, y, timestamp);
+ else
+ x_scroll_bar_report_motion (fp, bar_window, part,
+ x, y, timestamp);
+
+ return;
+ }
+
+ if (!EQ (Vx_use_fast_mouse_position, Qreally_fast))
+ {
+ /* This means that Emacs should select a frame and report the
+ mouse position relative to it. The approach used here avoids
+ making multiple roundtrips to the X server querying for the
+ window beneath the pointer, and was borrowed from
+ haiku_mouse_position in haikuterm.c. */
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (FRAME_X_P (XFRAME (frame))
+ && (FRAME_DISPLAY_INFO (XFRAME (frame))
+ == dpyinfo))
+ XFRAME (frame)->mouse_moved = false;
+ }
+
+ if (gui_mouse_grabbed (dpyinfo)
+ && !EQ (track_mouse, Qdropping)
+ && !EQ (track_mouse, Qdrag_source))
+ /* Pick the last mouse frame if dropping. */
+ f1 = dpyinfo->last_mouse_frame;
+ else
+ /* Otherwise, pick the last mouse motion frame. */
+ f1 = dpyinfo->last_mouse_motion_frame;
+
+ if (!f1 && (FRAME_X_P (SELECTED_FRAME ())
+ && (FRAME_DISPLAY_INFO (SELECTED_FRAME ())
+ == dpyinfo)))
+ f1 = SELECTED_FRAME ();
+
+ if (!f1 || (!FRAME_X_P (f1) && (insist > 0)))
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_X_P (XFRAME (frame))
+ && (FRAME_DISPLAY_INFO (XFRAME (frame))
+ == dpyinfo)
+ && !FRAME_TOOLTIP_P (XFRAME (frame)))
+ f1 = XFRAME (frame);
+
+ if (f1 && FRAME_TOOLTIP_P (f1))
+ f1 = NULL;
+
+ if (f1 && FRAME_X_P (f1) && FRAME_X_WINDOW (f1))
+ {
+ if (!x_query_pointer (dpyinfo->display, FRAME_X_WINDOW (f1),
+ &dummy, &dummy, &root_x, &root_y,
+ &win_x, &win_y, &mask))
+ /* The pointer is out of the screen. */
+ return;
+
+ remember_mouse_glyph (f1, win_x, win_y,
+ &dpyinfo->last_mouse_glyph);
+ dpyinfo->last_mouse_glyph_frame = f1;
+
+ *bar_window = Qnil;
+ *part = scroll_bar_nowhere;
+
+ /* If track-mouse is `drag-source' and the mouse pointer is
+ certain to not be actually under the chosen frame, return
+ NULL in FP. */
+ if (EQ (track_mouse, Qdrag_source)
+ && (win_x < 0 || win_y < 0
+ || win_x >= FRAME_PIXEL_WIDTH (f1)
+ || win_y >= FRAME_PIXEL_HEIGHT (f1)))
+ *fp = NULL;
+ else
+ *fp = f1;
+
+ *timestamp = dpyinfo->last_mouse_movement_time;
+ XSETINT (*x, win_x);
+ XSETINT (*y, win_y);
+ }
+ }
+ else
+ {
+ /* This means Emacs should only report the coordinates of the
+ last mouse motion. */
+
+ if (dpyinfo->last_mouse_motion_frame)
+ {
+ *fp = dpyinfo->last_mouse_motion_frame;
+ *timestamp = dpyinfo->last_mouse_movement_time;
+ *x = make_fixnum (dpyinfo->last_mouse_motion_x);
+ *y = make_fixnum (dpyinfo->last_mouse_motion_y);
+ *bar_window = Qnil;
+ *part = scroll_bar_nowhere;
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (FRAME_X_P (XFRAME (frame))
+ && (FRAME_DISPLAY_INFO (XFRAME (frame))
+ == dpyinfo))
+ XFRAME (frame)->mouse_moved = false;
+ }
+
+ dpyinfo->last_mouse_motion_frame->mouse_moved = false;
+ }
+ }
+}
+
/* Return the current position of the mouse.
*FP should be a frame which indicates which display to ask about.
@@ -14105,9 +14419,27 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
Time *timestamp)
{
struct frame *f1, *maybe_tooltip;
- struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (*fp);
+ struct x_display_info *dpyinfo;
bool unrelated_tooltip;
+ dpyinfo = FRAME_DISPLAY_INFO (*fp);
+
+ if (!NILP (Vx_use_fast_mouse_position))
+ {
+ /* The user says that Emacs is running over the network, and a
+ fast approximation of `mouse-position' should be used.
+
+ Depending on what the value of `x-use-fast-mouse-position'
+ is, do one of two things: only perform the XQueryPointer to
+ obtain the coordinates from the last mouse frame, or only
+ return the last mouse motion frame and the
+ last_mouse_motion_x and Y. */
+
+ x_fast_mouse_position (fp, insist, bar_window, part, x,
+ y, timestamp);
+ return;
+ }
+
block_input ();
if (dpyinfo->last_mouse_scroll_bar && insist == 0)
@@ -14229,7 +14561,7 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
break;
}
#ifdef USE_GTK
- /* We don't wan't to know the innermost window. We
+ /* We don't want to know the innermost window. We
want the edit window. For non-Gtk+ the innermost
window is the edit window. For Gtk+ it might not
be. It might be the tool bar for example. */
@@ -14260,7 +14592,7 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
never use them in that case.) */
#ifdef USE_GTK
- /* We don't wan't to know the innermost window. We
+ /* We don't want to know the innermost window. We
want the edit window. */
f1 = x_window_to_frame (dpyinfo, win);
#else
@@ -18620,7 +18952,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 +21312,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 +21728,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 +21858,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 +21904,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 +23018,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 +23279,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 +23305,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 +23361,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 +23425,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 +23780,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 +23882,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 +25263,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 +25314,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 +25418,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 +25440,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 +25523,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
@@ -27347,11 +27712,10 @@ x_ewmh_activate_frame (struct frame *f)
{
time = x_get_server_time (f);
- x_ignore_errors_for_next_request (dpyinfo);
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- RevertToParent, time);
+ x_set_input_focus (FRAME_DISPLAY_INFO (f),
+ FRAME_OUTER_WINDOW (f),
+ time);
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
- x_stop_ignoring_errors (dpyinfo);
return;
}
@@ -27377,6 +27741,76 @@ 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;
+}
+
+static void
+x_set_input_focus (struct x_display_info *dpyinfo, Window window,
+ Time time)
+{
+#ifdef HAVE_XINPUT2
+ struct xi_device_t *device;
+#endif
+
+ /* Do the equivalent of XSetInputFocus with the specified window and
+ time, but use the attachment to the device that Emacs has
+ designated the client pointer on X Input Extension builds.
+ Asynchronously trap errors around the generated XI_SetFocus or
+ SetInputFocus request, in case the device has been destroyed or
+ the window obscured.
+
+ The revert_to will be set to RevertToParent for generated
+ SetInputFocus requests. */
+
+#ifdef HAVE_XINPUT2
+ if (dpyinfo->supports_xi2
+ && dpyinfo->client_pointer_device != -1)
+ {
+ device = xi_device_from_id (dpyinfo, dpyinfo->client_pointer_device);
+
+ /* The device is a master pointer. Use its attachment, which
+ should be the master keyboard. */
+
+ if (device)
+ {
+ eassert (device->use == XIMasterPointer);
+
+ x_ignore_errors_for_next_request (dpyinfo);
+ XISetFocus (dpyinfo->display, device->attachment,
+ /* Note that the input extension
+ only supports RevertToParent-type
+ behavior. */
+ window, time);
+ x_stop_ignoring_errors (dpyinfo);
+
+ return;
+ }
+ }
+#endif
+
+ /* Otherwise, use the pointer device that the X server says is the
+ client pointer. */
+ x_ignore_errors_for_next_request (dpyinfo);
+ XSetInputFocus (dpyinfo->display, window, RevertToParent, time);
+ x_stop_ignoring_errors (dpyinfo);
+}
+
/* In certain situations, when the window manager follows a
click-to-focus policy, there seems to be no way around calling
XSetInputFocus to give another frame the input focus.
@@ -27402,6 +27836,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
@@ -27413,8 +27859,6 @@ x_focus_frame (struct frame *f, bool noactivate)
return;
}
- /* Ignore any BadMatch error this request might result in. */
- x_ignore_errors_for_next_request (dpyinfo);
if (NILP (Vx_no_window_manager))
{
/* Use the last user time. It is invalid to use CurrentTime
@@ -27432,15 +27876,19 @@ x_focus_frame (struct frame *f, bool noactivate)
&& !dpyinfo->x_focus_frame)
time = x_get_server_time (f);
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- RevertToParent, time);
+ /* Ignore any BadMatch error this request might result in.
+ A BadMatch error can occur if the window was obscured
+ after the time of the last user interaction without
+ changing the last-focus-change-time. */
+ x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f),
+ time);
}
else
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- /* But when no window manager is in use, we
- don't care. */
- RevertToParent, CurrentTime);
- x_stop_ignoring_errors (dpyinfo);
+ x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f),
+ /* But when no window manager is in use,
+ respecting the ICCCM doesn't really
+ matter. */
+ CurrentTime);
}
}
@@ -28912,10 +29360,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 +29516,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 +29538,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 +30010,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 +30228,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 X protocol errors at
+ XtCloseDisplay. Just free the font info structure.
+ (Bug#18403) */
+ XFreeFontInfo (NULL, query_result, 1);
x_uncatch_errors ();
}
#endif
@@ -29966,7 +30425,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;
}
@@ -30846,6 +31307,7 @@ With MS Windows, Haiku windowing or Nextstep, the value
is t. */);
DEFSYM (Qimitate_pager, "imitate-pager");
DEFSYM (Qnewer_time, "newer-time");
DEFSYM (Qraise_and_focus, "raise-and-focus");
+ DEFSYM (Qreally_fast, "really-fast");
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
doc: /* Which keys Emacs uses for the ctrl modifier.
@@ -31125,4 +31587,19 @@ not bypass window manager focus stealing prevention):
- The symbol `raise-and-focus', which means to raise the window and
focus it manually. */);
Vx_allow_focus_stealing = Qnewer_time;
+
+ DEFVAR_LISP ("x-use-fast-mouse-position", Vx_use_fast_mouse_position,
+ doc: /* How to make `mouse-position' faster.
+
+`mouse-position' and `mouse-pixel-position' default to querying the X
+server for the window under the mouse pointer. This results in
+accurate results, but is also very slow when the X connection has
+moderate to high latency. Setting this variable to a non-nil value
+makes Emacs query only for the position of the pointer, which is
+usually faster. Doing so improves the performance of dragging to
+select text over slow X connections.
+
+If that is still too slow, setting this variable to the symbol
+`really-fast' will make Emacs return only cached values. */);
+ Vx_use_fast_mouse_position = Qnil;
}
diff --git a/src/xterm.h b/src/xterm.h
index 1124dcceb4..c36920081d 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -580,7 +580,9 @@ struct x_display_info
Time last_user_time;
/* Position where the mouse was last time we reported a motion.
- This is a position on last_mouse_motion_frame. */
+ This is a position on last_mouse_motion_frame. It is used in
+ some situations to report the mouse position as well: see
+ XTmouse_position. */
int last_mouse_motion_x;
int last_mouse_motion_y;
@@ -1605,22 +1607,15 @@ SELECTION_EVENT_DISPLAY (struct selection_input_event
*ev)
extern void x_free_gcs (struct frame *);
extern void x_relative_mouse_position (struct frame *, int *, int *);
-extern void x_real_pos_and_offsets (struct frame *f,
- int *left_offset_x,
- int *right_offset_x,
- int *top_offset_y,
- int *bottom_offset_y,
- int *x_pixels_diff,
- int *y_pixels_diff,
- int *xptr,
- int *yptr,
- int *outer_border);
-extern void x_default_font_parameter (struct frame* f, Lisp_Object parms);
+extern void x_real_pos_and_offsets (struct frame *, int *, int *, int *,
+ int *, int *, int *, int *, int *,
+ int *);
+extern void x_default_font_parameter (struct frame *, Lisp_Object);
/* From xrdb.c. */
-XrmDatabase x_load_resources (Display *, const char *, const char *,
- const char *);
+extern XrmDatabase x_load_resources (Display *, const char *, const char *,
+ const char *);
extern const char *x_get_string_resource (void *, const char *, const char *);
/* Defined in xterm.c */
diff --git a/test/lisp/auth-source-pass-tests.el
b/test/lisp/auth-source-pass-tests.el
index f5147a7ce0..6e6671efca 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -25,7 +25,7 @@
;;; Code:
-(require 'ert)
+(require 'ert-x)
(require 'auth-source-pass)
@@ -59,7 +59,7 @@
"Contains a list of all messages passed to `auth-source-do-debug'.")
(defun auth-source-pass--have-message-matching (regexp)
- "Return non-nil iff at least one `auth-source-do-debug' match REGEXP."
+ "Return non-nil if at least one `auth-source-do-debug' match REGEXP."
(seq-find (lambda (message)
(string-match regexp message))
auth-source-pass--debug-log))
@@ -109,7 +109,7 @@ ENTRY, HOSTNAME, USER and PORT are the same as in
(put 'auth-source-pass-match-entry-p 'ert-explainer
#'auth-source-pass--explain-match-entry-p)
(defun auth-source-pass--includes-sorted-entries (entries hostname &optional
user port)
- "Return non-nil iff ENTRIES matching the parameters are found in store.
+ "Return non-nil if ENTRIES matching the parameters are found in store.
ENTRIES should be sorted from most specific to least specific.
HOSTNAME, USER and PORT are passed unchanged to
@@ -157,7 +157,7 @@ result is ordered the same way as the suffixes."
(auth-source-pass--generate-entry-suffixes hostname user port))))
(defun auth-source-pass-match-entry-p (entry hostname &optional user port)
- "Return non-nil iff an ENTRY matching the parameters is found in store.
+ "Return non-nil if an ENTRY matching the parameters is found in store.
HOSTNAME, USER and PORT are passed unchanged to
`auth-source-pass--matching-entries'."
@@ -166,7 +166,7 @@ HOSTNAME, USER and PORT are passed unchanged to
(auth-source-pass--matching-entries hostname user port)))
(defun auth-source-pass-match-any-entry-p (hostname &optional user port)
- "Return non-nil iff there is at least one entry matching the parameters.
+ "Return non-nil if there is at least one entry matching the parameters.
HOSTNAME, USER and PORT are passed unchanged to
`auth-source-pass--matching-entries'."
@@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to
(ert-deftest auth-source-pass-can-start-from-auth-source-search ()
(auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
(auth-source-pass-enable)
- (let ((result (car (auth-source-search :host "gitlab.com"))))
+ ;; This also asserts an aspect of traditional search behavior
+ ;; relative to `auth-source-pass-extra-query-keywords'.
+ (let* ((auth-source-pass-extra-query-keywords nil)
+ (result (car (auth-source-search :host "gitlab.com"))))
(should (equal (plist-get result :user) "someone"))
(should (equal (plist-get result :host) "gitlab.com")))))
@@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to
(should (auth-source-pass--have-message-matching
"found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\"
\"b/gitlab.com\")"))))
+
+;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985)
+
+;; No entry has the requested port, but a result is still returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "x.com" :port 22 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "x.com" :port 22 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")))))))
+
+;; One of two entries has the requested port, both returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "x.com" :port 42 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")
+ (:host "x.com" :port "42" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "x.com" :port 42 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :secret "a")
+ (:host "x.com" :port 42 :secret "b")))))))
+
+;; No entry has the requested port, but :port is required, so search fails.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search
+ :host "x.com" :port 22 :require '(:port) :max 2)))
+ (should-not results))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search
+ :host "x.com" :port 22 :require '(:port) :max 2)))))
+
+;; Specifying a :host without a :user finds a lone entry and does not
+;; include extra fields (i.e., :port nil) in the result.
+;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine disroot.org user akib password b
+machine z.com password c
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "disroot.org" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--akib ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("akib@disroot.org" (secret . "b"))
+ ("z.com" (secret . "c")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "disroot.org" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+;; Searches for :host are case-sensitive, and a returned host isn't
+;; normalized.
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-host ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine libera.chat password a
+machine Libera.Chat password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "Libera.Chat" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "Libera.Chat" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--host ()
+ (auth-source-pass--with-store '(("libera.chat" (secret . "a"))
+ ("Libera.Chat" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "Libera.Chat" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "Libera.Chat" :secret "b")))))))
+
+
+;; A retrieved store entry mustn't be nil regardless of whether its
+;; path contains port or user components.
+
+(ert-deftest auth-source-pass-extra-query-keywords--baseline ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("x.com"))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search :host "x.com")))))
+
+;; Output port type (int or string) matches that of input parameter.
+
+(ert-deftest auth-source-pass-extra-query-keywords--port-type ()
+ (let ((auth-source-pass-extra-query-keywords t)
+ (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r)))
+ (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+ (auth-source-pass-enable)
+ (should (equal (mapcar f (auth-source-search :host "x.com" :port 42))
+ '((:host "x.com" :port 42 :secret "a")))))
+ (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+ (auth-source-pass-enable)
+ (should (equal (mapcar f (auth-source-search :host "x.com" :port "42"))
+ '((:host "x.com" :port "42" :secret "a")))))))
+
+;; Match precision sometimes takes a back seat to the traversal
+;; ordering. Specifically, the :host (h1, ...) args hold greater sway
+;; over the output because they determine the first coordinate in the
+;; sequence of (host, user, port) combinations visited. (Taking a
+;; tree-wise view, these become the depth-1 nodes in a DFS.)
+
+;; Note that all trailing /user forms are demoted for the sake of
+;; predictability (see tests further below for details). This means
+;; that, in the following test, /bar is held in limbo, followed by
+;; /foo, but they both retain priority over "gnu.org", as noted above.
+
+(ert-deftest auth-source-pass-extra-query-keywords--hosts-first ()
+ (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
+ ("gnu.org" (secret . "b"))
+ ("x.com" (secret . "c"))
+ ("fake.com" (secret . "d"))
+ ("x.com/foo" (secret . "e")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "gnu.org") :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ ;; Notice gnu.org is never considered ^
+ '((:host "x.com" :secret "c")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "x.com" :user "foo" :secret "e")))))))
+
+;; This is another example given in the bug thread.
+
+(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host ()
+ (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a"))
+ ("foo.com" (secret . "b"))
+ ("bar.org" (secret . "c"))
+ ("fake.com" (secret . "d")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "bar.org" :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "bar.org" :secret "c")))))))
+
+;; This conveys the same idea as `user-priorities', just below, but
+;; with slightly more realistic and less legible values.
+
+(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
+ (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a"))
+ ("bar@x.com" (secret . "b"))
+ ("x.com" (secret . "?"))
+ ("bar@y.org" (secret . "c"))
+ ("fake.com" (secret . "?"))
+ ("fake.com/bar" (secret . "d"))
+ ("y.org/bar" (secret . "?"))
+ ("bar@fake.com" (secret . "e"))))
+ (lambda (&rest _) (zerop (random 2))))))
+ (auth-source-pass--with-store store
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "fake.com" "y.org")
+ :user "bar"
+ :require '(:user) :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :user "bar" :secret "b")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "fake.com" :user "bar" :secret "e")
+ (:host "fake.com" :user "bar" :secret "d")
+ (:host "y.org" :user "bar" :secret "c"))))))))
+
+;; This is a more distilled version of `suffixed-user', above. It
+;; better illustrates that search order takes precedence over "/user"
+;; demotion because otherwise * and ** would be swapped, below. It
+;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u,
+;; h:2/u, u@g:1}.
+
+(ert-deftest auth-source-pass-extra-query-keywords--user-priorities ()
+ (let ((store (sort (copy-sequence '(("h:1/u" (secret . "/"))
+ ("h:2/u" (secret . "/"))
+ ("u@h:1" (secret . "@"))
+ ("u@h:2" (secret . "@"))
+ ("g:1/u" (secret . "/"))
+ ("g:2/u" (secret . "/"))
+ ("u@g:1" (secret . "@"))
+ ("u@g:2" (secret . "@"))))
+ (lambda (&rest _) (zerop (random 2))))))
+ (auth-source-pass--with-store store
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("h" "g")
+ :port 2
+ :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "h" :user "u" :port 2 :secret "@")
+ (:host "h" :user "u" :port 2 :secret "/") ; *
+ (:host "g" :user "u" :port 2 :secret "@") ; **
+ (:host "g" :user "u" :port 2 :secret "/"))))))))
+
(provide 'auth-source-pass-tests)
;;; auth-source-pass-tests.el ends here
diff --git a/test/lisp/cedet/srecode/fields-tests.el
b/test/lisp/cedet/srecode/fields-tests.el
index 292ac4e3b5..c9e0d4601b 100644
--- a/test/lisp/cedet/srecode/fields-tests.el
+++ b/test/lisp/cedet/srecode/fields-tests.el
@@ -66,7 +66,7 @@ It is filled with some text."
(when (and (overlayp (oref f overlay))
(not (overlay-get (oref f overlay) 'srecode-init-only)))
- (error "Field creation overlay is not tagged w/ init flag"))
+ (error "Field creation overlay is not tagged with init flag"))
(srecode-overlaid-activate f)
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/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index f742637ee3..160ac59113 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -803,4 +803,10 @@ See Bug#57915."
(macroexpand form)
(should (string-empty-p messages))))))))
+(ert-deftest cl-&key-arguments ()
+ (cl-flet ((fn (&key x) x))
+ (should-error (fn :x))
+ (should (eq (fn :x :a) :a))))
+
+
;;; cl-macs-tests.el ends here
diff --git a/test/lisp/emacs-lisp/package-resources/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git
a/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git a/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git
a/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig
b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig
new file mode 100644
index 0000000000..39202ca75e
Binary files /dev/null and
b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig differ
diff --git a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
index 30e74156c0..ddd96748ec 100755
--- a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
+++ b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
@@ -30,4 +30,5 @@ rm $KEYRING
#$GPG --export-secret-keys -armor > "../key.sec"
$GPG --import ../key.sec
$GPG --detach-sign --sign "./archive-contents"
+$GPG --detach-sign --sign "./elpa-packages.eld"
$GPG --detach-sign --sign "./signed-good-1.0.el"
diff --git
a/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git a/test/lisp/emacs-lisp/syntax-tests.el
b/test/lisp/emacs-lisp/syntax-tests.el
index f266db5c70..d8fc5c4fa8 100644
--- a/test/lisp/emacs-lisp/syntax-tests.el
+++ b/test/lisp/emacs-lisp/syntax-tests.el
@@ -56,7 +56,7 @@
"\\(?2:[abc]+\\)foo\\(\\2\\)" 2)
"\\(?4:[abc]+\\)foo\\(\\4\\)"))
;; Emacs supports only the back-references \1,...,\9, so when a
- ;; shift would result in \10 or more, an error must be signalled.
+ ;; shift would result in \10 or more, an error must be signaled.
(should-error
(syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7)))
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index a1dfbab9dc..74cbb7d947 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,121 @@
(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* ((inhibit-message noninteractive)
+ (proc (start-process "fake" (current-buffer) "sleep" "10"))
+ (elt (list :nick "tester!~tester@fake.irc"
+ :type 'GET
+ :peer nil
+ :parent proc
+ :ip "127.0.0.1"
+ :port "9899"
+ :file "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..fc12bf7ce3 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")))
@@ -1704,4 +1704,21 @@
(erc-networks-tests--clean-bufs))
+(ert-deftest erc-networks--determine ()
+ (should (eq (erc-networks--determine "irc.libera.chat") 'Libera.Chat))
+ (should (eq (erc-networks--determine "irc.oftc.net") 'OFTC))
+ (should (eq (erc-networks--determine "irc.dal.net") 'DALnet))
+
+ (let ((erc-server-announced-name "zirconium.libera.chat"))
+ (should (eq (erc-networks--determine) 'Libera.Chat)))
+ (let ((erc-server-announced-name "weber.oftc.net"))
+ (should (eq (erc-networks--determine) 'OFTC)))
+ (let ((erc-server-announced-name "redemption.ix.us.dal.net"))
+ (should (eq (erc-networks--determine) 'DALnet)))
+
+ ;; Failure
+ (let ((erc-server-announced-name "irc-us2.alphachat.net"))
+ (should (eq (erc-networks--determine)
+ erc-networks--name-missing-sentinel))))
+
;;; erc-networks-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el
b/test/lisp/erc/erc-scenarios-base-reconnect.el
index 49298dc594..8762f33b30 100644
--- a/test/lisp/erc/erc-scenarios-base-reconnect.el
+++ b/test/lisp/erc/erc-scenarios-base-reconnect.el
@@ -224,4 +224,50 @@
(with-current-buffer "#chan"
(funcall expect 10 "here comes the lady")))))
+
+(ert-deftest erc-scenarios-base-cancel-reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reconnect")
+ (dumb-server (erc-d-run "localhost" t 'timer 'timer 'timer-last))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter))
+ (erc-server-auto-reconnect t)
+ erc-autojoin-channels-alist
+ erc-server-buffer)
+
+ (ert-info ("Connect to foonet")
+ (setq erc-server-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "changeme"
+ :full-name "tester"))
+ (with-current-buffer erc-server-buffer
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+ (ert-info ("Two connection attempts, all stymied")
+ (with-current-buffer erc-server-buffer
+ (ert-info ("First two attempts behave normally")
+ (dotimes (n 2)
+ (ert-info ((format "Initial attempt %d" (1+ n)))
+ (funcall expect 3 "Opening connection")
+ (funcall expect 2 "Password incorrect")
+ (funcall expect 2 "Connection failed!")
+ (funcall expect 2 "Re-establishing connection"))))
+ (ert-info ("/RECONNECT cancels timer but still attempts to connect")
+ (erc-cmd-RECONNECT)
+ (funcall expect 2 "Canceled")
+ (funcall expect 3 "Opening connection")
+ (funcall expect 2 "Password incorrect")
+ (funcall expect 2 "Connection failed!")
+ (funcall expect 2 "Re-establishing connection"))
+ (ert-info ("Explicitly cancel timer")
+ (erc-cmd-RECONNECT "cancel")
+ (funcall expect 2 "Canceled")
+ (erc-d-t-absent-for 1 "Opening connection" (point)))))
+
+ (ert-info ("Server buffer is unique and temp name is absent")
+ (should (equal (list (get-buffer (format "127.0.0.1:%d" port)))
+ (erc-scenarios-common-buflist "127.0.0.1"))))))
+
;;; erc-scenarios-base-reconnect.el ends here
diff --git a/test/lisp/erc/erc-scenarios-misc.el
b/test/lisp/erc/erc-scenarios-misc.el
index ded620ccc1..8557a77906 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -177,4 +177,32 @@
(erc-scenarios-common-say "Hi")
(funcall expect 10 "Hola")))))
+(defvar url-irc-function)
+
+(ert-deftest erc-scenarios-handle-irc-url ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "join/legacy")
+ (dumb-server (erc-d-run "localhost" t 'foonet))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter))
+ (url-irc-function 'url-irc-erc)
+ (erc-url-connect-function
+ (lambda (scheme &rest r)
+ (ert-info ("Connect to foonet")
+ (should (equal scheme "irc"))
+ (with-current-buffer (apply #'erc `(:full-name "tester" ,@r))
+ (should (string= (buffer-name)
+ (format "127.0.0.1:%d" port)))
+ (current-buffer))))))
+
+ (with-temp-buffer
+ (insert (format ";; irc://tester:changeme@127.0.0.1:%d/#chan" port))
+ (goto-char 10)
+ (browse-url-at-point))
+
+ (ert-info ("Connected")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 10 "welcome")))))
+
;;; erc-scenarios-misc.el ends here
diff --git a/test/lisp/erc/erc-services-tests.el
b/test/lisp/erc/erc-services-tests.el
index 8e2b8d2927..7ff2e36e77 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -469,15 +469,11 @@
(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")
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
@@ -490,7 +486,6 @@
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-announced ()
- (ert-skip "Pass backend not yet supported")
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
@@ -503,19 +498,13 @@
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-overrides ()
- (ert-skip "Pass backend not yet supported")
(let ((store
`(,@erc-join-tests--auth-source-pass-entries
- ("GNU.chat:6697/#chan"
- ("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..ff5d802697 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
@@ -975,4 +953,229 @@
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
+(defvar erc-tests--ipv6-examples
+ '("1:2:3:4:5:6:7:8"
+ "::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0"
+ "1:2:3:4:5:6:77:88" "::ffff:255.255.255.255"
+ "fe08::7:8" "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
+ "1:2:3:4:5:6:7:8" "1::" "1:2:3:4:5:6:7::" "1::8"
+ "1:2:3:4:5:6::8" "1:2:3:4:5:6::8" "1::7:8" "1:2:3:4:5::7:8"
+ "1:2:3:4:5::8" "1::6:7:8" "1:2:3:4::6:7:8" "1:2:3:4::8"
+ "1::5:6:7:8" "1:2:3::5:6:7:8" "1:2:3::8" "1::4:5:6:7:8"
+ "1:2::4:5:6:7:8" "1:2::8" "1::3:4:5:6:7:8" "1::3:4:5:6:7:8"
+ "1::8" "::2:3:4:5:6:7:8" "::2:3:4:5:6:7:8" "::8"
+ "::" "fe08::7:8%eth0" "fe08::7:8%1" "::255.255.255.255"
+ "::ffff:255.255.255.255" "::ffff:0:255.255.255.255"
+ "2001:db8:3:4::192.0.2.33" "64:ff9b::192.0.2.33"))
+
+(ert-deftest erc--server-connect-dumb-ipv6-regexp ()
+ (dolist (a erc-tests--ipv6-examples)
+ (should-not (string-match erc--server-connect-dumb-ipv6-regexp a))
+ (should (string-match erc--server-connect-dumb-ipv6-regexp
+ (concat "[" a "]")))))
+
+(ert-deftest erc-select-read-args ()
+
+ (ert-info ("Defaults to TLS")
+ (should (equal (ert-simulate-keys "\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.libera.chat"
+ :port 6697
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("Override default TLS")
+ (should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.libera.chat"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("Address includes port")
+ (should (equal (ert-simulate-keys
+ "localhost:6667\rnick\r\r"
+ (erc-select-read-args))
+ (list :server "localhost"
+ :port 6667
+ :nick "nick"
+ :password nil))))
+
+ (ert-info ("Address includes nick, password skipped via option")
+ (should (equal (ert-simulate-keys "nick@localhost:6667\r"
+ (let (erc-prompt-for-password)
+ (erc-select-read-args)))
+ (list :server "localhost"
+ :port 6667
+ :nick "nick"
+ :password nil))))
+
+ (ert-info ("Address includes nick and password")
+ (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r"
+ (erc-select-read-args))
+ (list :server "localhost"
+ :port 6667
+ :nick "nick"
+ :password "sesame"))))
+
+ (ert-info ("IPv6 address plain")
+ (should (equal (ert-simulate-keys "::1\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "[::1]"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("IPv6 address with port")
+ (should (equal (ert-simulate-keys "[::1]:6667\r\r\r"
+ (erc-select-read-args))
+ (list :server "[::1]"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("IPv6 address includes nick")
+ (should (equal (ert-simulate-keys "nick@[::1]:6667\r\r"
+ (erc-select-read-args))
+ (list :server "[::1]"
+ :port 6667
+ :nick "nick"
+ :password nil)))))
+
+(ert-deftest erc-tls ()
+ (let (calls)
+ (cl-letf (((symbol-function 'user-login-name)
+ (lambda (&optional _) "tester"))
+ ((symbol-function 'erc-open)
+ (lambda (&rest r) (push r calls))))
+
+ (ert-info ("Defaults")
+ (erc-tls)
+ (should (equal (pop calls)
+ '("irc.libera.chat" 6697 "tester" "unknown" t
+ nil nil nil nil nil "user" nil))))
+
+ (ert-info ("Full")
+ (erc-tls :server "irc.gnu.org"
+ :port 7000
+ :user "bobo"
+ :nick "bob"
+ :full-name "Bob's Name"
+ :password "bob:changeme"
+ :client-certificate t
+ :id 'GNU.org)
+ (should (equal (pop calls)
+ '("irc.gnu.org" 7000 "bob" "Bob's Name" t
+ "bob:changeme" nil nil nil t "bobo" GNU.org))))
+
+ ;; Values are often nil when called by lisp code, which leads to
+ ;; null params. This is why `erc-open' recomputes almost
+ ;; everything.
+ (ert-info ("Fallback")
+ (let ((erc-nick "bob")
+ (erc-server "irc.gnu.org")
+ (erc-email-userid "bobo")
+ (erc-user-full-name "Bob's Name"))
+ (erc-tls :server nil
+ :port 7000
+ :nick nil
+ :password "bob:changeme"))
+ (should (equal (pop calls)
+ '(nil 7000 nil "Bob's Name" t
+ "bob:changeme" nil nil nil nil "bobo" nil)))))))
+
+(defun erc-tests--make-server-buf (name)
+ (with-current-buffer (get-buffer-create name)
+ (erc-mode)
+ (setq erc-server-process (start-process "sleep" (current-buffer)
+ "sleep" "1")
+ erc-session-server (concat "irc." name ".org")
+ erc-session-port 6667
+ erc-network (intern name))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (current-buffer)))
+
+(defun erc-tests--make-client-buf (server name)
+ (unless (bufferp server)
+ (setq server (get-buffer server)))
+ (with-current-buffer (get-buffer-create name)
+ (erc-mode)
+ (setq erc--target (erc--target-from-string name))
+ (dolist (v '(erc-server-process
+ erc-session-server
+ erc-session-port
+ erc-network))
+ (set v (buffer-local-value v server)))
+ (current-buffer)))
+
+(ert-deftest erc-handle-irc-url ()
+ (let* (calls
+ rvbuf
+ erc-networks-alist
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
+ (erc-url-connect-function
+ (lambda (&rest r)
+ (push r calls)
+ (if (functionp rvbuf) (funcall rvbuf) rvbuf))))
+
+ (cl-letf (((symbol-function 'erc-cmd-JOIN)
+ (lambda (&rest r) (push r calls))))
+
+ (with-current-buffer (erc-tests--make-server-buf "foonet")
+ (setq rvbuf (current-buffer)))
+ (erc-tests--make-server-buf "barnet")
+ (erc-tests--make-server-buf "baznet")
+
+ (ert-info ("Unknown network")
+ (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Unknown network, no port")
+ (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Known network, no port")
+ (setq erc-networks-alist '((foonet "irc.foonet.org")))
+ (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Known network, different port")
+ (erc-handle-irc-url "irc.foonet.org" 6697 "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Known network, existing chan with key")
+ (erc-tests--make-client-buf "foonet" "#chan")
+ (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc")
+ (should (equal '("#chan" "sec") (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Unknown network, connect, no chan")
+ (erc-handle-irc-url "irc.gnu.org" nil nil nil nil "irc")
+ (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Unknown network, connect, chan")
+ (with-current-buffer "foonet"
+ (should-not (local-variable-p 'erc-after-connect)))
+ (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu")))
+ (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc")
+ (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
+ (should-not calls)
+ (with-current-buffer "gnu"
+ (should (local-variable-p 'erc-after-connect))
+ (funcall (car erc-after-connect))
+ (should (equal '("#spam" nil) (pop calls)))
+ (should-not (local-variable-p 'erc-after-connect)))
+ (should-not calls))))
+
+ (when noninteractive
+ (kill-buffer "foonet")
+ (kill-buffer "barnet")
+ (kill-buffer "baznet")
+ (kill-buffer "#chan")))
+
;;; erc-tests.el ends here
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el
b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index a4befd96b5..8dd5cef7aa 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -562,6 +562,7 @@ DUMB-SERVER-VAR are bound accordingly in BODY."
;;
(erc-server-flood-penalty 0.05)
erc-autojoin-channels-alist
+ erc-after-connect
erc-server-auto-reconnect)
(should-not erc-d--slow-mo)
(with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index bc2cb68cd8..ef65125241 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -73,7 +73,7 @@
(require 'erc-d-t)
(require 'erc-d)))
-(require 'erc-backend)
+(require 'erc)
(eval-when-compile (require 'erc-join)
(require 'erc-services))
@@ -125,6 +125,7 @@
(erc-auth-source-parameters-join-function nil)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
+ (erc-after-connect nil)
(erc-d-linger-secs 10)
,@bindings)))
diff --git a/test/lisp/erc/resources/join/legacy/foonet.eld
b/test/lisp/erc/resources/join/legacy/foonet.eld
index 344ba7c1da..4025094a59 100644
--- a/test/lisp/erc/resources/join/legacy/foonet.eld
+++ b/test/lisp/erc/resources/join/legacy/foonet.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((pass 10 "PASS :changeme"))
((nick 1 "NICK tester"))
((user 1 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
diff --git a/test/lisp/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/browse-url-tests.el
b/test/lisp/net/browse-url-tests.el
index 1c993958b8..dc81976821 100644
--- a/test/lisp/net/browse-url-tests.el
+++ b/test/lisp/net/browse-url-tests.el
@@ -56,6 +56,15 @@
'browse-url--man))
(should-not (browse-url-select-handler "man:ls" 'external)))
+(ert-deftest browse-url-tests-select-handler-irc ()
+ (should (eq (browse-url-select-handler "irc://localhost" 'internal)
+ 'browse-url--irc))
+ (should-not (browse-url-select-handler "irc://localhost" 'external))
+ (should (eq (browse-url-select-handler "irc6://localhost")
+ 'browse-url--irc))
+ (should (eq (browse-url-select-handler "ircs://tester@irc.gnu.org/#chan")
+ 'browse-url--irc)))
+
(ert-deftest browse-url-tests-select-handler-file ()
(should (eq (browse-url-select-handler "file://foo.txt")
'browse-url-emacs))
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 7631842918..c808e6350e 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -407,7 +407,7 @@
:session dbus--test-service
'(:array (:dict-entry :string "string" :boolean t :boolean t)))
:type 'wrong-type-argument)
- ;; The first element ist not of a basic type.
+ ;; The first element is not of a basic type.
(should-error
(dbus-check-arguments
:session dbus--test-service
@@ -1093,7 +1093,7 @@ is in progress."
(dbus-unregister-service :session dbus--test-service)))
(ert-deftest dbus-test06-register-property-emits-signal ()
- "Check property registration for an own service, including signalling."
+ "Check property registration for an own service, including signaling."
(skip-unless dbus--test-enabled-session-bus)
(dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
@@ -1136,7 +1136,7 @@ is in progress."
dbus--test-interface property)
"foo"))
- ;; Set property. The new value shall be signalled.
+ ;; Set property. The new value shall be signaled.
(setq dbus--test-signal-received nil)
(should
(equal
diff --git a/test/lisp/net/eudc-resources/bbdb
b/test/lisp/net/eudc-resources/bbdb
new file mode 100644
index 0000000000..b730bb51cc
--- /dev/null
+++ b/test/lisp/net/eudc-resources/bbdb
@@ -0,0 +1,3 @@
+;; -*- mode: Emacs-Lisp; coding: utf-8; -*-
+;;; file-format: 9
+["Emacs" "ERT3" nil nil nil nil nil ("emacs-ert-test-3@bbdb.gnu.org") ((notes
. " ")) "c8bd3a63-3a83-48a7-a95b-be118a923e00" "2022-11-19 16:36:04 +0000"
"2022-11-19 16:36:04 +0000" nil]
diff --git a/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif
b/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif
new file mode 100644
index 0000000000..9db4be2028
--- /dev/null
+++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif
@@ -0,0 +1,15 @@
+# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify.
+# CRC32 12f0e8c3
+dn: dc=gnu
+objectClass: dcObject
+objectClass: organization
+dc: gnu
+o: The ldap.gnu.org organization
+description: An organization for the following person
+structuralObjectClass: organization
+entryUUID: 43dd74ec-fc0d-103c-8d5c-7dbac5615d14
+creatorsName:
+createTimestamp: 20221119042038Z
+entryCSN: 20221119042038.100000Z#000000#000#000000
+modifiersName:
+modifyTimestamp: 20221119042038Z
diff --git
a/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif
b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif
new file mode 100644
index 0000000000..7828f179df
--- /dev/null
+++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif
@@ -0,0 +1,17 @@
+# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify.
+# CRC32 a33c0168
+dn: cn=emacs-ert-test-1
+objectClass: OpenLDAPperson
+cn: emacs-ert-test-1
+description:: RW1hY3Mg
+uid: 1
+sn: ERT1
+givenName: Emacs
+mail: emacs-ert-test-1@ldap.gnu.org
+structuralObjectClass: OpenLDAPperson
+entryUUID: 43dd805e-fc0d-103c-8d5d-7dbac5615d14
+creatorsName:
+createTimestamp: 20221119042038Z
+entryCSN: 20221119042038.100350Z#000000#000#000000
+modifiersName:
+modifyTimestamp: 20221119042038Z
diff --git
a/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif
b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif
new file mode 100644
index 0000000000..d3de3d81c7
--- /dev/null
+++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif
@@ -0,0 +1,17 @@
+# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify.
+# CRC32 56119237
+dn: cn=emacs-ert-test-2
+objectClass: OpenLDAPperson
+cn: emacs-ert-test-2
+description:: RW1hY3Mg
+uid: 2
+sn: ERT2
+givenName: Emacs
+mail: emacs-ert-test-2@ldap.gnu.org
+structuralObjectClass: OpenLDAPperson
+entryUUID: 43dd92b0-fc0d-103c-8d5e-7dbac5615d14
+creatorsName:
+createTimestamp: 20221119042038Z
+entryCSN: 20221119042038.100819Z#000000#000#000000
+modifiersName:
+modifyTimestamp: 20221119042038Z
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-resources/slapd.conf
b/test/lisp/net/eudc-resources/slapd.conf
new file mode 100644
index 0000000000..9afafe7676
--- /dev/null
+++ b/test/lisp/net/eudc-resources/slapd.conf
@@ -0,0 +1,7 @@
+include /etc/ldap/schema/core.schema
+include /etc/ldap/schema/cosine.schema
+include /etc/ldap/schema/inetorgperson.schema
+include /etc/ldap/schema/openldap.schema
+database ldif
+directory eudc-resources
+suffix "dc=gnu,dc=org"
diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el
index 915006a97c..212db65cb2 100644
--- a/test/lisp/net/eudc-tests.el
+++ b/test/lisp/net/eudc-tests.el
@@ -152,4 +152,160 @@
(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")))))))))
+
+(require 'ldap)
+(ert-deftest eudcb-ldap ()
+ "Test the LDAP back-end."
+ (skip-unless (and (file-exists-p "/usr/sbin/slapd")
+ (file-exists-p "/usr/bin/ldapsearch")))
+ (cd (concat (ert-resource-directory) ".."))
+ (let ((ldap-process
+ (start-process "slapd" "*slapd*" "/usr/sbin/slapd"
+ "-h" "ldap://127.0.0.1:3899"; "-d" "0" "-4"
+ "-f" (ert-resource-file "slapd.conf")))
+ (ldap-host-parameters-alist '(("ldap://localhost:3899";
+ base "dc=gnu,dc=org" auth simple)))
+ (eudc-server-hotlist '(("ldap://localhost:3899"; . ldap)))
+ (eudc-ignore-options-file t))
+ (sleep-for 1) ; Wait for slapd to start.
+ (should (equal (with-temp-buffer
+ (insert "emacs-ert-test-1")
+ (eudc-expand-try-all)
+ (buffer-string))
+ "Emacs ERT1 <emacs-ert-test-1@ldap.gnu.org>"))
+ (kill-process ldap-process)))
+
+(eval-and-compile
+ (push (expand-file-name "../elpa/packages/bbdb/lisp" source-directory)
+ load-path)
+ (defvar bbdb-file)
+ (require 'bbdb nil t))
+
+(ert-deftest eudcb-bbdb ()
+ "Test the BBDB back-end."
+ (skip-unless (featurep 'bbdb))
+ (let ((bbdb-file (ert-resource-file "bbdb"))
+ (eudc-server-hotlist '(("" . bbdb)))
+ (eudc-ignore-options-file t))
+ (should (equal (with-temp-buffer
+ (insert "emacs-ert-test-3")
+ (eudc-expand-try-all)
+ (buffer-string))
+ "Emacs ERT3 <emacs-ert-test-3@bbdb.gnu.org>"))))
+
+(provide 'eudc-tests)
;;; eudc-tests.el ends here
diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el
index 9e60a243b3..04462dbc8b 100644
--- a/test/lisp/net/mailcap-tests.el
+++ b/test/lisp/net/mailcap-tests.el
@@ -125,7 +125,7 @@
(ert-deftest mailcap-view-file ()
(with-pristine-mailcap
- ;; Try using a lambda as viewer and check wether
+ ;; Try using a lambda as viewer and check whether
;; `mailcap-view-file' works correctly.
(let* ((mailcap-mime-extensions '((".test" . "test/test"))))
(mailcap-add "test/test" 'mailcap--test-viewer)
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/server-tests.el b/test/lisp/server-tests.el
new file mode 100644
index 0000000000..351b8ef8d1
--- /dev/null
+++ b/test/lisp/server-tests.el
@@ -0,0 +1,41 @@
+;;; server-tests.el --- Emacs server test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'server)
+
+;;; Tests:
+
+(ert-deftest server-test/server-start-sets-minor-mode ()
+ "Ensure that calling `server-start' also sets `server-mode' properly."
+ (server-start)
+ (unwind-protect
+ (progn
+ ;; Make sure starting the server activates the minor mode.
+ (should (eq server-mode t))
+ (should (memq 'server-mode global-minor-modes)))
+ ;; Always stop the server, even if the above checks fail.
+ (server-start t))
+ ;; Make sure stopping the server deactivates the minor mode.
+ (should (eq server-mode nil))
+ (should-not (memq 'server-mode global-minor-modes)))
+
+;;; server-tests.el ends here
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 97f425f6f4..6e48f11fc0 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -73,6 +73,30 @@
(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 ()
+ (let ((text-quoting-style 'grave))
+ (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/subr-tests.el b/test/lisp/subr-tests.el
index cc9610cd39..e22d1c7be0 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1106,7 +1106,7 @@ final or penultimate step during initialization."))
(ert-deftest test-keymap-parse-macros ()
(should (equal (key-parse "C-x ( C-d C-x )") [24 40 4 24 41]))
- (should (equal (kbd "C-x ( C-d C-x )") ""))
+ (should (equal (kbd "C-x ( C-d C-x )") "\^D"))
(should (equal (kbd "C-x ( C-x )") "")))
(defvar subr-test--global)
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/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index dc4d3af699..13248a3650 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -127,7 +127,7 @@ Don't set it globally, the functions should be let-bound.")
(defun vc-test--create-repo-function (backend)
"Run the `vc-create-repo' backend function.
-For backends which dont support it, it is emulated."
+For backends which don't support it, it is emulated."
(cond
((eq backend 'CVS)
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/manual/noverlay/overlay-perf.el
b/test/manual/noverlay/overlay-perf.el
index e84941c08f..4d79254a53 100644
--- a/test/manual/noverlay/overlay-perf.el
+++ b/test/manual/noverlay/overlay-perf.el
@@ -157,7 +157,7 @@ Return test-total elapsed time."
(cond ((string-match-p "\\`-[cn]\\'" (car args))
(unless (and (cdr args)
(string-match-p "\\`[0-9]+\\'" (cadr args)))
- (error "%s expectes a natnum argument" (car args)))
+ (error "%s expects a natnum argument" (car args)))
(if (equal (car args) "-c")
(setq k (string-to-number (cadr args)))
(setq n (string-to-number (cadr args))))
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index e020732524..0e6d717cbb 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -42,7 +42,6 @@ recorded calls conveniently."
overlay
hooks-property
(list (lambda (ov &rest args)
- (message " %S called on %S with args %S" hooks-property ov args)
(should inhibit-modification-hooks)
(should (eq ov overlay))
(push (list hooks-property args)
@@ -175,47 +174,41 @@ properties."
(t 1 2 0))
(insert-behind-hooks
(t 1 2 0)))))))
- (message "BEGIN overlay-modification-hooks test-case %S" test-case)
-
- ;; All three hooks ignore the overlay's `front-advance' and
- ;; `rear-advance' option, so test both ways while expecting the same
- ;; result.
- (dolist (advance '(nil t))
- (message " advance is %S" advance)
- (let-alist test-case
- (with-temp-buffer
- ;; Set up the temporary buffer and overlay as specified by
- ;; the test case.
- (insert (or .buffer-text "1234"))
- (let ((overlay (make-overlay
- (or .overlay-beg 2)
- (or .overlay-end 4)
- nil
- advance advance)))
- (message " (buffer-string) is %S" (buffer-string))
- (message " overlay is %S" overlay)
- (overlay-tests-start-recording-modification-hooks overlay)
-
- ;; Modify the buffer, possibly inducing calls to the
- ;; overlay's modification hooks.
- (should (or .insert-at .replace))
- (when .insert-at
- (goto-char .insert-at)
- (insert "x")
- (message " inserted \"x\" at %S, buffer-string now %S"
- .insert-at (buffer-string)))
- (when .replace
- (goto-char (point-min))
- (search-forward .replace)
- (replace-match "x")
- (message " replaced %S with \"x\"" .replace))
-
- ;; Verify that the expected and actual modification hook
- ;; calls match.
- (should (equal
- .expected-calls
- (overlay-tests-get-recorded-modification-hooks
- overlay)))))))))
+ (ert-info ((format "test-case: %S" test-case))
+ ;; All three hooks ignore the overlay's `front-advance' and
+ ;; `rear-advance' option, so test both ways while expecting the same
+ ;; result.
+ (dolist (advance '(nil t))
+ (ert-info ((format "advance is %S" advance))
+ (let-alist test-case
+ (with-temp-buffer
+ ;; Set up the temporary buffer and overlay as specified by
+ ;; the test case.
+ (insert (or .buffer-text "1234"))
+ (let ((overlay (make-overlay
+ (or .overlay-beg 2)
+ (or .overlay-end 4)
+ nil
+ advance advance)))
+ (overlay-tests-start-recording-modification-hooks overlay)
+
+ ;; Modify the buffer, possibly inducing calls to the
+ ;; overlay's modification hooks.
+ (should (or .insert-at .replace))
+ (when .insert-at
+ (goto-char .insert-at)
+ (insert "x"))
+ (when .replace
+ (goto-char (point-min))
+ (search-forward .replace)
+ (replace-match "x"))
+
+ ;; Verify that the expected and actual modification hook
+ ;; calls match.
+ (should (equal
+ .expected-calls
+ (overlay-tests-get-recorded-modification-hooks
+ overlay)))))))))))
(ert-deftest overlay-modification-hooks-message-other-buf ()
"Test for bug#21824.
@@ -275,6 +268,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 +1321,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 +1717,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 +8373,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 t)
+ (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 t)
+ (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 t)
+ (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
@@ -8348,7 +8468,7 @@ dicta sunt, explicabo. "))
(insert "foo")
(should (buffer-modified-p))
(should-not (eq (buffer-modified-p) 'autosaved))
- (do-auto-save nil t)
+ (do-auto-save t t)
(should (eq (buffer-modified-p) 'autosaved))
(with-silent-modifications
(put-text-property 1 3 'face 'bold))
@@ -8372,7 +8492,7 @@ dicta sunt, explicabo. "))
(restore-buffer-modified-p nil)
(should-not (buffer-modified-p))
(insert "bar")
- (do-auto-save nil t)
+ (do-auto-save t t)
(should (eq (buffer-modified-p) 'autosaved))
(insert "zot")
(restore-buffer-modified-p 'autosaved)
diff --git a/test/src/comp-resources/comp-test-funcs.el
b/test/src/comp-resources/comp-test-funcs.el
index 9092f040c8..03925d4d2e 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -211,10 +211,10 @@
(comp-tests-err-arith-f)
(arith-error (concat "arith-error "
(error-message-string err)
- " catched"))
+ " caught"))
(error (concat "error "
(error-message-string err)
- " catched"))))
+ " caught"))))
(defun comp-tests-condition-case-1-f ()
;; Bpushhandler Bpophandler
(condition-case
@@ -222,10 +222,10 @@
(comp-tests-err-foo-f)
(arith-error (concat "arith-error "
(error-message-string err)
- " catched"))
+ " caught"))
(error (concat "error "
(error-message-string err)
- " catched"))))
+ " caught"))))
(defun comp-tests-catch-f (f)
(catch 'foo
(funcall f)))
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 734b4a0d22..4e512098a3 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -298,9 +298,9 @@ Check that the resulting binaries do not differ."
(comp-deftest non-locals ()
"Test non locals."
(should (string= (comp-tests-condition-case-0-f)
- "arith-error Arithmetic error catched"))
+ "arith-error Arithmetic error caught"))
(should (string= (comp-tests-condition-case-1-f)
- "error Foo catched"))
+ "error Foo caught"))
(should (= (comp-tests-catch-f
(lambda () (throw 'foo 3)))
3))
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index bb2f04e8ee..0e12e4dbd8 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -222,7 +222,7 @@ expressions works for identifiers starting with period."
(ert-deftest eval-tests/funcall-with-delayed-message ()
;; Check that `funcall-with-delayed-message' displays its message before
- ;; its function terminates iff the timeout is short enough.
+ ;; its function terminates if the timeout is short enough.
;; This also serves as regression test for bug#55628 where a short
;; timeout was rounded up to the next whole second.
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index 7e9669c651..683d331d75 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -115,7 +115,7 @@ expected font properties from parsing NAME.")
(defun test-font-parse ()
"Test font name parsing."
(interactive)
- (switch-to-buffer (generate-new-buffer "*Font Pase Test*"))
+ (switch-to-buffer (generate-new-buffer "*Font Parse Test*"))
(setq show-trailing-whitespace nil)
(let ((pass-face '((t :foreground "green")))
(fail-face '((t :foreground "red"))))
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 75d67140a9..731fa893c1 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -217,7 +217,7 @@
(while (not threads-mutex-key)
(thread-yield))
(thread-signal thr 'quit nil)
- ;; `quit' is not catched by `should-error'. We must indicate it.
+ ;; `quit' is not caught by `should-error'. We must indicate it.
(condition-case nil
(thread-join thr)
(quit (signal 'error nil)))))))