[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/package+vc 1823349e6a: Merge remote-tracking branch 'origin/mast
|
From: |
Philip Kaludercic |
|
Subject: |
feature/package+vc 1823349e6a: Merge remote-tracking branch 'origin/master' into feature/package+vc |
|
Date: |
Fri, 12 Aug 2022 10:05:19 -0400 (EDT) |
branch: feature/package+vc
commit 1823349e6a61b2997b27cdb1ff42c69739693455
Merge: faa7f03b0c 829b131e5b
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Merge remote-tracking branch 'origin/master' into feature/package+vc
---
ChangeLog.3 | 51 +-
Makefile.in | 9 +-
admin/MAINTAINERS | 1 +
admin/check-doc-strings | 8 +-
admin/emake | 1 +
admin/make-tarball.txt | 13 +-
admin/update_autogen | 14 +-
configure.ac | 4 +
doc/emacs/custom.texi | 3 +
doc/emacs/search.texi | 5 +-
doc/lispref/commands.texi | 2 +-
doc/lispref/debugging.texi | 44 +
doc/lispref/display.texi | 6 +-
doc/lispref/frames.texi | 12 +-
doc/lispref/functions.texi | 4 +
doc/lispref/keymaps.texi | 6 +-
doc/lispref/loading.texi | 27 +-
doc/lispref/modes.texi | 9 +-
doc/lispref/os.texi | 11 +-
doc/lispref/positions.texi | 19 +-
doc/lispref/processes.texi | 49 +-
doc/misc/calc.texi | 2 +-
doc/misc/ediff.texi | 11 +-
doc/misc/htmlfontify.texi | 10 +-
doc/misc/idlwave.texi | 38 +-
doc/misc/mh-e.texi | 47 +-
doc/misc/modus-themes.org | 449 +++++--
doc/misc/reftex.texi | 8 +-
doc/misc/tramp.texi | 4 +-
doc/misc/transient.texi | 802 ++++++------
doc/misc/viper.texi | 2 +-
doc/misc/vtable.texi | 6 +-
etc/AUTHORS | 2 +-
etc/NEWS | 167 ++-
etc/PROBLEMS | 34 +-
etc/TODO | 29 +-
etc/emacs_lldb.py | 2 +-
etc/publicsuffix.txt | 8 +-
etc/themes/modus-operandi-theme.el | 4 +-
etc/themes/modus-themes.el | 411 +++---
etc/themes/modus-vivendi-theme.el | 4 +-
lib-src/etags.c | 8 -
lib-src/make-docfile.c | 360 +----
lisp/ChangeLog.12 | 2 +-
lisp/Makefile.in | 70 +-
lisp/allout.el | 18 +-
lisp/apropos.el | 31 +-
lisp/array.el | 87 +-
lisp/auth-source.el | 60 +-
lisp/battery.el | 16 +-
lisp/bookmark.el | 4 +-
lisp/calendar/time-date.el | 14 +-
lisp/calendar/timeclock.el | 2 +-
lisp/cedet/cedet.el | 6 +-
lisp/cedet/ede/base.el | 4 +-
lisp/cedet/ede/config.el | 4 +-
lisp/cedet/ede/custom.el | 10 +-
lisp/cedet/ede/files.el | 5 +-
lisp/cedet/ede/speedbar.el | 4 +-
lisp/cedet/ede/system.el | 2 +-
lisp/cedet/semantic/complete.el | 78 +-
lisp/cedet/semantic/db-typecache.el | 2 +-
lisp/cedet/semantic/db.el | 11 +-
lisp/cedet/semantic/tag-file.el | 102 +-
lisp/cedet/semantic/util.el | 3 -
lisp/cedet/semantic/wisent/comp.el | 16 +-
lisp/cedet/semantic/wisent/python.el | 6 +-
lisp/cedet/srecode/compile.el | 10 +-
lisp/cedet/srecode/insert.el | 4 +
lisp/cedet/srecode/table.el | 10 +-
lisp/cus-dep.el | 2 +-
lisp/cus-edit.el | 36 +-
lisp/custom.el | 1 +
lisp/descr-text.el | 4 +-
lisp/desktop.el | 2 +-
lisp/dired-aux.el | 9 +-
lisp/dired.el | 3 +-
lisp/edmacro.el | 9 +-
lisp/electric.el | 19 +-
lisp/emacs-lisp/advice.el | 5 +-
lisp/emacs-lisp/byte-opt.el | 17 +-
lisp/emacs-lisp/byte-run.el | 17 +-
lisp/emacs-lisp/bytecomp.el | 34 +-
lisp/emacs-lisp/checkdoc.el | 25 +-
lisp/emacs-lisp/cl-lib.el | 4 +-
lisp/emacs-lisp/cl-macs.el | 30 +-
lisp/emacs-lisp/comp.el | 5 +-
lisp/emacs-lisp/edebug.el | 2 +-
lisp/emacs-lisp/eldoc.el | 1 -
lisp/emacs-lisp/ert.el | 2 +-
lisp/emacs-lisp/helper.el | 1 -
lisp/emacs-lisp/lisp-mode.el | 68 +-
lisp/emacs-lisp/lisp.el | 9 +-
lisp/emacs-lisp/loaddefs-gen.el | 124 +-
lisp/emacs-lisp/package.el | 11 +-
lisp/emacs-lisp/seq.el | 27 +
lisp/emacs-lisp/shortdoc.el | 2 +-
lisp/emacs-lisp/subr-x.el | 11 +-
lisp/emacs-lisp/timer.el | 70 +-
lisp/emacs-lisp/warnings.el | 2 +-
lisp/emulation/viper-ex.el | 2 +-
lisp/emulation/viper-init.el | 2 +-
lisp/emulation/viper-util.el | 53 +-
lisp/emulation/viper.el | 25 +-
lisp/env.el | 2 +-
lisp/epa-ks.el | 6 +-
lisp/epg.el | 4 +-
lisp/erc/erc-networks.el | 3 -
lisp/eshell/em-extpipe.el | 4 +-
lisp/eshell/em-hist.el | 1 -
lisp/eshell/em-unix.el | 6 +-
lisp/eshell/esh-arg.el | 2 +-
lisp/eshell/esh-io.el | 27 +-
lisp/eshell/esh-proc.el | 55 +-
lisp/eshell/esh-util.el | 2 +-
lisp/ezimage.el | 5 -
lisp/faces.el | 39 +-
lisp/files.el | 11 +-
lisp/filesets.el | 57 +-
lisp/find-dired.el | 23 +-
lisp/find-lisp.el | 2 +-
lisp/finder.el | 16 +-
lisp/gnus/gnus-art.el | 4 +-
lisp/gnus/gnus-demon.el | 2 +-
lisp/gnus/gnus-srvr.el | 1 -
lisp/gnus/gnus-sum.el | 2 -
lisp/gnus/gnus-util.el | 33 +-
lisp/gnus/gnus.el | 13 +-
lisp/gnus/mm-util.el | 1 -
lisp/gnus/nneething.el | 3 +-
lisp/gnus/nnfolder.el | 3 +-
lisp/gnus/nnheader.el | 6 +-
lisp/gnus/nnimap.el | 3 +-
lisp/gnus/nnmaildir.el | 21 +-
lisp/gnus/nnmh.el | 11 +-
lisp/gnus/nnrss.el | 6 +-
lisp/gnus/nntp.el | 46 +-
lisp/gnus/spam-stat.el | 3 +-
lisp/gnus/spam.el | 6 +-
lisp/help-fns.el | 2 +-
lisp/help.el | 31 +-
lisp/hex-util.el | 8 +-
lisp/ibuf-ext.el | 82 +-
lisp/ibuf-macs.el | 9 +-
lisp/ibuffer.el | 30 +-
lisp/image.el | 3 +-
lisp/international/characters.el | 23 +-
lisp/international/ja-dic-utl.el | 8 +-
lisp/international/mule-diag.el | 62 +-
lisp/international/quail.el | 8 +-
lisp/international/titdic-cnv.el | 7 +-
lisp/isearch.el | 8 +-
lisp/keymap.el | 18 +-
lisp/language/misc-lang.el | 9 +-
lisp/ldefs-boot.el | 510 ++++----
lisp/leim/quail/hangul.el | 33 +-
lisp/leim/quail/indian.el | 2 +-
lisp/loadup.el | 18 +-
lisp/mail/binhex.el | 4 +
lisp/mail/footnote.el | 30 +-
lisp/mail/mailabbrev.el | 2 +-
lisp/mail/mspools.el | 18 +-
lisp/mail/rfc2047.el | 3 +
lisp/mail/rmailedit.el | 11 +-
lisp/mail/rmailsum.el | 14 +-
lisp/mail/sendmail.el | 6 +-
lisp/mail/supercite.el | 130 +-
lisp/mh-e/mh-acros.el | 18 +-
lisp/mh-e/mh-alias.el | 5 -
lisp/mh-e/mh-buffers.el | 1 -
lisp/mh-e/mh-comp.el | 1 -
lisp/mh-e/mh-e.el | 2 -
lisp/mh-e/mh-folder.el | 3 +-
lisp/mh-e/mh-funcs.el | 1 -
lisp/mh-e/mh-gnus.el | 12 +-
lisp/mh-e/mh-identity.el | 1 -
lisp/mh-e/mh-inc.el | 1 -
lisp/mh-e/mh-junk.el | 1 -
lisp/mh-e/mh-letter.el | 22 +-
lisp/mh-e/mh-limit.el | 1 -
lisp/mh-e/mh-mime.el | 1 -
lisp/mh-e/mh-print.el | 1 -
lisp/mh-e/mh-scan.el | 1 -
lisp/mh-e/mh-search.el | 3 +-
lisp/mh-e/mh-seq.el | 1 -
lisp/mh-e/mh-show.el | 1 -
lisp/mh-e/mh-speed.el | 1 -
lisp/mh-e/mh-thread.el | 1 -
lisp/mh-e/mh-tool-bar.el | 1 -
lisp/mh-e/mh-utils.el | 8 +-
lisp/mh-e/mh-xface.el | 1 -
lisp/mouse.el | 4 +-
lisp/mpc.el | 7 +-
lisp/net/ange-ftp.el | 6 +-
lisp/net/dictionary.el | 2 +-
lisp/net/dig.el | 33 +-
lisp/net/eudc-hotlist.el | 15 +-
lisp/net/eudc.el | 1 -
lisp/net/eww.el | 6 +-
lisp/net/net-utils.el | 9 -
lisp/net/newst-backend.el | 8 +-
lisp/net/newst-treeview.el | 11 +-
lisp/net/tramp-adb.el | 269 ++--
lisp/net/tramp-archive.el | 12 +-
lisp/net/tramp-cache.el | 164 ++-
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-compat.el | 10 +
lisp/net/tramp-crypt.el | 9 +-
lisp/net/tramp-gvfs.el | 47 +-
lisp/net/tramp-sh.el | 716 +++++-----
lisp/net/tramp-smb.el | 346 ++---
lisp/net/tramp-sshfs.el | 13 +-
lisp/net/tramp-sudoedit.el | 24 +-
lisp/net/tramp.el | 144 +-
lisp/nxml/rng-dt.el | 2 +-
lisp/nxml/rng-loc.el | 8 +-
lisp/nxml/rng-match.el | 2 +-
lisp/nxml/rng-parse.el | 2 +-
lisp/nxml/rng-util.el | 15 +-
lisp/nxml/rng-valid.el | 4 +-
lisp/{emacs-lisp => obsolete}/autoload.el | 10 +-
lisp/obsolete/gs.el | 2 +-
lisp/{ => obsolete}/makesum.el | 8 +-
lisp/{mh-e => obsolete}/mh-compat.el | 21 +-
lisp/{net => obsolete}/netrc.el | 15 +-
lisp/obsolete/ps-def.el | 54 +
lisp/{url => obsolete}/url-about.el | 5 +-
lisp/{url => obsolete}/url-dired.el | 3 +-
lisp/org/ob-core.el | 12 +-
lisp/org/ob-lilypond.el | 1 +
lisp/org/org-plot.el | 2 +-
lisp/org/org.el | 8 +-
lisp/org/ox.el | 2 +-
lisp/outline.el | 71 +-
lisp/pixel-scroll.el | 3 +-
lisp/play/5x5.el | 12 +-
lisp/play/cookie1.el | 3 +-
lisp/play/doctor.el | 9 +-
lisp/play/fortune.el | 56 +-
lisp/play/hanoi.el | 44 +-
lisp/printing.el | 66 +-
lisp/progmodes/antlr-mode.el | 9 +-
lisp/progmodes/cc-fonts.el | 77 +-
lisp/progmodes/cc-langs.el | 2 +-
lisp/progmodes/cc-mode.el | 15 +-
lisp/progmodes/cperl-mode.el | 9 +-
lisp/progmodes/ebnf2ps.el | 42 +-
lisp/progmodes/fortran.el | 12 +-
lisp/progmodes/gdb-mi.el | 27 +-
lisp/progmodes/hideif.el | 3 +-
lisp/progmodes/idlwave.el | 15 +-
lisp/progmodes/js.el | 42 +-
lisp/progmodes/meta-mode.el | 24 +-
lisp/progmodes/perl-mode.el | 5 +-
lisp/progmodes/prolog.el | 8 -
lisp/progmodes/python.el | 81 +-
lisp/progmodes/which-func.el | 3 +
lisp/progmodes/xscheme.el | 23 +-
lisp/ps-def.el | 134 --
lisp/ps-print.el | 100 +-
lisp/rect.el | 4 +-
lisp/replace.el | 12 +-
lisp/saveplace.el | 11 +-
lisp/select.el | 3 -
lisp/simple.el | 19 +-
lisp/subr.el | 108 +-
lisp/tar-mode.el | 2 +-
lisp/term.el | 2 +-
lisp/textmodes/emacs-news-mode.el | 15 +-
lisp/textmodes/flyspell.el | 3 +
lisp/textmodes/ispell.el | 7 -
lisp/textmodes/picture.el | 1 -
lisp/textmodes/reftex-cite.el | 52 +-
lisp/textmodes/reftex-index.el | 6 +-
lisp/textmodes/reftex-ref.el | 6 +-
lisp/textmodes/reftex-sel.el | 12 +-
lisp/textmodes/reftex-toc.el | 6 +-
lisp/textmodes/remember.el | 2 +-
lisp/textmodes/sgml-mode.el | 2 +-
lisp/textmodes/texinfo.el | 3 -
lisp/textmodes/text-mode.el | 16 +-
lisp/thingatpt.el | 13 +-
lisp/transient.el | 999 +++++++++-----
lisp/type-break.el | 30 +-
lisp/uniquify.el | 4 +-
lisp/url/url-file.el | 3 +-
lisp/url/url-http.el | 21 +-
lisp/url/url-privacy.el | 11 +-
lisp/url/url-util.el | 41 +-
lisp/vc/add-log.el | 14 +-
lisp/vc/diff-mode.el | 4 +-
lisp/vc/ediff-help.el | 4 -
lisp/vc/ediff-hook.el | 8 -
lisp/vc/ediff-init.el | 138 +-
lisp/vc/ediff-mult.el | 36 +-
lisp/vc/ediff-ptch.el | 4 +-
lisp/vc/ediff-util.el | 100 +-
lisp/vc/ediff-wind.el | 38 +-
lisp/vc/ediff.el | 5 +-
lisp/vc/emerge.el | 2 +
lisp/vc/pcvs-util.el | 8 +-
lisp/vc/vc-annotate.el | 30 +-
lisp/vc/vc-bzr.el | 24 +-
lisp/vc/vc-cvs.el | 2 +-
lisp/vc/vc-dir.el | 16 +-
lisp/vc/vc-git.el | 57 +-
lisp/vc/vc-hg.el | 15 +-
lisp/vc/vc-hooks.el | 62 +-
lisp/vc/vc.el | 2 +-
lisp/wdired.el | 1 -
lisp/wid-edit.el | 8 +-
lisp/woman.el | 12 +-
lisp/x-dnd.el | 2 +-
nextstep/Makefile.in | 3 +-
src/Makefile.in | 19 +-
src/buffer.c | 5 +-
src/bytecode.c | 4 +-
src/callint.c | 118 +-
src/callproc.c | 39 +-
src/composite.c | 71 +-
src/dispextern.h | 2 +
src/editfns.c | 54 +-
src/eval.c | 71 +-
src/frame.c | 6 +-
src/ftcrfont.c | 8 +-
src/haiku_support.cc | 33 +-
src/haiku_support.h | 1 +
src/haikufns.c | 18 +-
src/haikuterm.c | 88 +-
src/haikuterm.h | 5 +-
src/indent.c | 10 +-
src/keyboard.c | 82 +-
src/lisp.h | 11 +-
src/lread.c | 160 ++-
src/marker.c | 5 +-
src/nsfns.m | 1 +
src/pgtkfns.c | 1 +
src/print.c | 324 ++---
src/process.c | 156 ++-
src/process.h | 5 +-
src/puresize.h | 2 +-
src/sysdep.c | 5 +-
src/timefns.c | 97 +-
src/w32fns.c | 1 +
src/xdisp.c | 88 +-
src/xfns.c | 87 +-
src/xmenu.c | 26 +
src/xsettings.c | 7 +-
src/xsettings.h | 2 +-
src/xterm.c | 1377 ++++++++++++++------
src/xterm.h | 99 +-
.../authinfo | 0
.../netrc-folding | 0
test/lisp/auth-source-tests.el | 26 +-
test/lisp/calc/calc-tests.el | 4 -
test/lisp/comint-tests.el | 4 -
test/lisp/emacs-lisp/lisp-mode-tests.el | 23 +
test/lisp/emacs-lisp/package-tests.el | 15 +
test/lisp/emacs-lisp/seq-tests.el | 18 +
test/lisp/emacs-lisp/syntax-tests.el | 4 -
test/lisp/env-tests.el | 40 +
test/lisp/erc/resources/erc-scenarios-common.el | 4 +-
test/lisp/eshell/em-pred-tests.el | 2 +-
test/lisp/eshell/esh-proc-tests.el | 43 +
test/lisp/help-tests.el | 4 +-
test/lisp/ibuffer-tests.el | 2 +-
test/lisp/net/netrc-resources/services | 6 -
test/lisp/net/netrc-tests.el | 60 -
test/lisp/net/tramp-tests.el | 66 +-
test/lisp/{ => obsolete}/makesum-tests.el | 0
test/lisp/progmodes/python-tests.el | 182 ++-
test/lisp/saveplace-tests.el | 2 +-
test/lisp/textmodes/reftex-tests.el | 135 +-
test/lisp/url/url-util-tests.el | 20 +
test/lisp/xml-tests.el | 4 -
test/src/callint-tests.el | 13 +
test/src/coding-tests.el | 25 +-
test/src/font-tests.el | 7 +-
test/src/keymap-tests.el | 12 +
test/src/lread-resources/lazydoc.el | Bin 0 -> 171 bytes
test/src/lread-tests.el | 17 +
test/src/process-tests.el | 124 +-
382 files changed, 8195 insertions(+), 6221 deletions(-)
diff --git a/ChangeLog.3 b/ChangeLog.3
index a75c7963b6..700a210f35 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,52 @@
+2022-07-31 Eli Zaretskii <eliz@gnu.org>
+
+ * src/lisp.h (CHECK_INTEGER): Fix the predicate. (Bug#56856)
+
+2022-07-30 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of column-related functions
+
+ * doc/lispref/text.texi (Primitive Indent, Columns):
+ * src/indent.c (Fcurrent_indentation, Fmove_to_column): Document
+ that column counting ignores invisible text. (Bug#56837)
+
+2022-07-30 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * src/macfont.m (macfont_open): Initialize font->space_width.
(Bug#56808)
+
+2022-07-30 Eli Zaretskii <eliz@gnu.org>
+
+ Improve indexing of keymap variables
+
+ * doc/lispref/maps.texi (Standard Keymaps):
+ * doc/lispref/display.texi (Button Buffer Commands)
+ (Button Properties):
+ * doc/lispref/keymaps.texi (Translation Keymaps): Improve indexing
+ of keymaps. (Bug#56816)
+
+2022-07-29 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: fontify variables/functions after line comments ending in
spaces
+
+ * lisp/progmodes/cc-engine.el (c-forward-comment-minus-1): Take account
of
+ spaces preceding a linefeed when scanning a putative line comment end.
+
+2022-07-28 Stefan Kangas <stefan@marxist.se>
+
+ Bump Emacs version to 28.1.91
+
+ * README:
+ * configure.ac:
+ * msdos/sed2v2.inp:
+ * nt/README.W32: Bump Emacs version to 28.1.91.
+
+2022-07-28 Stefan Kangas <stefan@marxist.se>
+
+ Update ChangeLog and AUTHORS for 28.1.91 pretest
+
+ * ChangeLog.3:
+ * etc/AUTHORS: Update.
+
2022-07-28 Lars Ingebrigtsen <larsi@gnus.org>
Revert the `...' documentation back to actual usage
@@ -236558,7 +236607,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
-commit 05df70e755f72b7a4c7b7d94ca2349f1c5c67968 (inclusive).
+commit 78759ddcb0fc7dd75a7a8edfb2c19dc2f1d86ee2 (inclusive).
See ChangeLog.2 for earlier changes.
;; Local Variables:
diff --git a/Makefile.in b/Makefile.in
index 4b74963665..bf0f52b514 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -455,18 +455,11 @@ lisp: src
lib lib-src lisp nt: Makefile
$(MAKE) -C $@ all
-# Ideally, VCSWITNESS should be a file that is modified whenever the
-# repository registers a commit from either a local checkin or a
-# repository pull. In git there is no single file that guarantees
-# this, but the local log for the current head should be close enough.
-#
# Pass an unexpanded $srcdir to src's Makefile, which then
# expands it using its own value of srcdir (which points to the
# source directory of src/).
-dirstate = .git/logs/HEAD
-VCSWITNESS = $(if $(wildcard $(srcdir)/$(dirstate)),$$(srcdir)/../$(dirstate))
src: Makefile
- $(MAKE) -C $@ VCSWITNESS='$(VCSWITNESS)' BIN_DESTDIR='$(BIN_DESTDIR)' \
+ $(MAKE) -C $@ BIN_DESTDIR='$(BIN_DESTDIR)' \
ELN_DESTDIR='$(ELN_DESTDIR)' all
blessmail: Makefile src
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index f0239db008..6e080d1f5b 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -137,6 +137,7 @@ Andrea Corallo
Stefan Kangas
admin/automerge
+ admin/update_autogen
Po Lu
The Haiku port:
diff --git a/admin/check-doc-strings b/admin/check-doc-strings
index 135090b34c..b119b50885 100755
--- a/admin/check-doc-strings
+++ b/admin/check-doc-strings
@@ -290,13 +290,7 @@ while (my $file = <FIND>) {
}
}
-my @pkgs;
-if (-d "../xemacs-packages") {
- @pkgs = qw (libs/edebug libs/xemacs-base comm/eudc oa/edit-utils);
-} else {
- @pkgs = ();
-}
-for (@pkgs) { s@^@../xemacs-packages/@; }
+my @pkgs = ();
open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
while (my $file = <FIND>) {
my $contents = FileContents $file;
diff --git a/admin/emake b/admin/emake
index 6c778c85d4..9bebd34067 100755
--- a/admin/emake
+++ b/admin/emake
@@ -36,6 +36,7 @@ SCRAPE|\
INFO.*Scraping.*[.] ?\$|\
INFO.*Scraping.*done\$|\
GEN.*etc/DOC|\
+GEN.*autoloads|\
^Waiting for git|\
^Finding pointers|\
^Using load-path|\
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 6990f27bfa..a60fead267 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -183,9 +183,10 @@ General steps (for each step, check for possible errors):
yourself, find it at <https://alpha.gnu.org/gnu/emacs/pretest>.
Releases are of course at <https://ftp.gnu.org/pub/gnu/emacs/>.
- ./admin/diff-tar-files emacs-OLD.tar.gz emacs-NEW.tar.gz
+ ./admin/diff-tar-files emacs-OLD.tar emacs-NEW.tar
- Alternatively:
+ Alternatively, if you want to use the compressed tarballs (which
+ diff-tar-files doesn't understand):
tar tJf emacs-OLD.tar.xz | sed -e 's,^[^/]*,,' | sort > old_tmp
tar tJf emacs-NEW.tar.xz | sed -e 's,^[^/]*,,' | sort > new_tmp
@@ -203,7 +204,7 @@ General steps (for each step, check for possible errors):
The output of this command might be easier to compare to the
tarball than the one you get from find.
-7. tar -xf emacs-NEW.tar; cd emacs-NEW
+7. tar xf emacs-NEW.tar; cd emacs-NEW
./configure --prefix=/tmp/emacs && make check && make install
Use 'script' or M-x compile to save the compilation log in
@@ -288,7 +289,7 @@ General steps (for each step, check for possible errors):
https://ftp.gnu.org/gnu/emacs/ for a release.
Download them and check the signatures and SHA1/SHA256 checksums.
- Check they build.
+ Check they build (./configure --with-native-compilation).
11. Send an announcement to: emacs-devel, and bcc: info-gnu-emacs@gnu.org.
For a pretest, also bcc: platform-testers@gnu.org.
@@ -309,8 +310,8 @@ General steps (for each step, check for possible errors):
sha1sum emacs-NEW.tar.xz
sha256sum emacs-NEW.tar.xz
- You can optionally sign the announcement email, probably using the
- same PGP key that you used for signing the tarball.
+ You can optionally sign the announcement email, preferably using
+ the same PGP key that you used for signing the tarball.
(Use e.g. `M-x mml-secure-message-sign' in `message-mode' to sign
an email.)
diff --git a/admin/update_autogen b/admin/update_autogen
index bfbf9d15c2..d02da74af9 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -4,7 +4,7 @@
## Copyright (C) 2011-2022 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
-## Maintainer: emacs-devel@gnu.org
+## Maintainer: Stefan Kangas <stefan@marxist.se>
## This file is part of GNU Emacs.
@@ -81,7 +81,6 @@ ldefs_flag=1
lboot_flag=
## Parameters.
-ldefs_in=lisp/loaddefs.el
ldefs_out=lisp/ldefs-boot.el
sources="configure.ac lib/Makefile.am"
## Files to copy into autogendir.
@@ -177,8 +176,6 @@ modified=$(status ${autogendir:+$sources}
${ldefs_flag:+lisp}) || die
echo "Running 'make maintainer-clean'..."
make maintainer-clean #|| die "Cleaning error"
-
- rm -f $ldefs_in
}
@@ -289,18 +286,13 @@ make -C src "$@" bootstrap-emacs || die "make src error"
echo "Running lisp/ make..."
-make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src
error"
-
+make -C lisp "$@" ldefs-boot.el EMACS=../src/bootstrap-emacs || die "make src
error"
-## Ignore comment differences.
-[ ! "$lboot_flag" ] || \
- diff -q -I '^;' $ldefs_in $ldefs_out || \
- cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
# Refresh the prebuilt grammar-wy.el
grammar_in=lisp/cedet/semantic/grammar-wy.el
grammar_out=lisp/cedet/semantic/grm-wy-boot.el
-make -C admin/grammars/ ../../$grammar_in
+make -C admin/grammars/ ../../$grammar_in EMACS=../../src/bootstrap-emacs
cp $grammar_in $grammar_out || die "cp grm_wy_boot error"
diff --git a/configure.ac b/configure.ac
index 87c126ecbb..1a264275bd 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4675,6 +4675,10 @@ if test "${HAVE_X11}" = "yes"; then
AC_DEFINE([HAVE_XSYNC], [1],
[Define to 1 if the X Synchronization Extension is available.])
XSYNC_LIBS="-lXext"
+ OLDLIBS="$LIBS"
+ LIBS="-lXext $LIBS" # Set this temporarily for AC_CHECK_FUNC
+ AC_CHECK_FUNCS([XSyncTriggerFence]) # Check for version 3.1
+ LIBS="$OLDLIBS"
fi
fi
AC_SUBST([XSYNC_LIBS])
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 6ed43bcb79..efaf0dfd38 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2452,6 +2452,9 @@ keys which send non-@acronym{ASCII} characters.
Write a single-quote (@code{'}) followed by the Lisp object you want.
@end table
+ For more information on the Emacs Lisp syntax, @pxref{Introduction,,,
+elisp, The Emacs Lisp Reference Manual}.
+
@node Init Examples
@subsection Init File Examples
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 27d4db8541..582e764c55 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -228,8 +228,9 @@ customizing the @code{isearch-wrap-pause} user option. If
it is
@code{t} (the default), signal an error. (Repeating the search will
wrap around.) If @code{no}, issue a @code{ding} and wrap immediately
after reaching the last match. If @code{no-ding}, wrap immediately,
-but don't @code{ding}. Finally, if @code{nil}, never wrap, but just
-stop at the last match.
+but don't @code{ding}. With the values @code{no} and @code{no-ding}
+the search will try to wrap around also on typing a character.
+Finally, if @code{nil}, never wrap, but just stop at the last match.
@cindex search ring
@findex isearch-ring-advance
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index a8ce294ad9..26739bf5b8 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2704,7 +2704,7 @@ Return the timestamp in @var{position}. This is the time
at which the
event occurred, in milliseconds. Such a timestamp is reported
relative to an arbitrary starting time that varies according to the
window system in use. On the X Window System, for example, it is the
-number of miliseconds since the X server was started.
+number of milliseconds since the X server was started.
@end defun
These functions compute a position list given particular buffer
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 058c931954..9ae40949d1 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -77,6 +77,7 @@ debugger recursively. @xref{Recursive Editing}.
@menu
* Error Debugging:: Entering the debugger when an error happens.
+* Debugging Redisplay:: Getting backtraces from redisplay errors.
* Infinite Loops:: Stopping and debugging a program that doesn't exit.
* Function Debugging:: Entering it when a certain function is called.
* Variable Debugging:: Entering it when a variable is modified.
@@ -105,6 +106,10 @@ debugger, set the variable @code{debug-on-error} to
non-@code{nil}.
(The command @code{toggle-debug-on-error} provides an easy way to do
this.)
+Note that, for technical reasons, you cannot use the facilities
+defined in this subsection to debug errors in Lisp that the redisplay
+code has invoked. @xref{Debugging Redisplay}, for help with these.
+
@defopt debug-on-error
This variable determines whether the debugger is called when an error
is signaled and not handled. If @code{debug-on-error} is @code{t},
@@ -213,6 +218,45 @@ file, use the option @samp{--debug-init}. This binds
bypasses the @code{condition-case} which normally catches errors in the
init file.
+@node Debugging Redisplay
+@subsection Debugging Redisplay Errors
+@cindex redisplay errors
+@cindex debugging redisplay errors
+
+When an error occurs in Lisp code which redisplay has invoked, Emacs's
+usual debugging mechanisms are unusable, for technical reasons. This
+subsection describes how to get a backtrace from such an error, which
+should be helpful in debugging it.
+
+These directions apply to Lisp forms used, for example, in
+@code{:eval} mode line constructs (@pxref{Mode Line Data}), and in all
+hooks invoked from redisplay, such as:
+
+@itemize
+@item
+@code{fontification-functions} (@pxref{Auto Faces}).
+@item
+@code{window-scroll-functions} (@pxref{Window Hooks}).
+@end itemize
+
+Note that if you have had an error in a hook function called from
+redisplay, the error handling might have removed this function from
+the hook. You will thus need to reinitialize that hook somehow,
+perhaps with @code{add-hook}, to be able to replay the bug.
+
+To generate a backtrace in these circumstances, set the variable
+@code{backtrace-on-redisplay-error} to non-@code{nil}. When the error
+occurs, Emacs will dump the backtrace to the buffer
+@file{*Redisplay-trace*}, but won't automatically display it in a
+window. This is to avoid needlessly corrupting the redisplay you are
+debugging. You will thus need to display the buffer yourself, with a
+command such as @code{switch-to-buffer-other-frame} @key{C-x 5 b}.
+
+@defvar backtrace-on-redisplay-error
+Set this variable to non-@code{nil} to enable the generation of a
+backtrace when an error occurs in any Lisp called from redisplay.
+@end defvar
+
@node Infinite Loops
@subsection Debugging Infinite Loops
@cindex infinite loops
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index ace67fbedb..96079dc106 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -8596,9 +8596,9 @@ Characters of Unicode General Category [Cf], such as
U+200E
images, such as U+00AD @sc{soft hyphen}.
@item variation-selectors
-Unicode VS-1 through VS-16 (U+FE00 through U+FE0F), which are used to
-select between different glyphs for the same codepoints (typically
-emojis).
+Unicode VS-1 through VS-256 (U+FE00 through U+FE0F and U+E0100 through
+U+E01EF), which are used to select between different glyphs for the same
+codepoints (typically emojis).
@item no-font
Characters for which there is no suitable font, or which cannot be
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index ed56fa777d..262b86672d 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -2180,10 +2180,20 @@ If non-@code{nil}, the frame is visible on all virtual
desktops on systems
with virtual desktops.
@vindex shaded@r{, a frame parameter}
-@item sticky
+@item shaded
If non-@code{nil}, tell the window manager to display the frame in a
way that its contents are hidden, leaving only the title bar.
+@vindex use-frame-synchronization@r{, a frame parameter}
+@item use-frame-synchronization
+If non-@code{nil}, synchronize the frame redisplay with the refresh
+rate of the monitor to avoid graphics tearing. At present, this is
+only implemented on Haiku and the X window system inside no-toolkit
+and X toolkit builds, does not work correctly with toolkit scroll
+bars, and requires a compositing manager supporting the relevant
+display synchronization protocols. The @code{synchronizeResize} X
+resource must also be set to the string @code{"extended"}.
+
@vindex inhibit-double-buffering@r{, a frame parameter}
@item inhibit-double-buffering
If non-@code{nil}, the frame is drawn to the screen without double
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 8e8cc5fd9c..8265e58210 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -2498,6 +2498,10 @@ the current buffer.
Specify that this command is meant to be applicable for @var{modes}
only.
+@item (interactive-args @var{arg} ...)
+Specify the arguments that should be stored for @code{repeat-command}.
+Each @var{arg} is on the form @code{@var{argument-name} @var{form}}.
+
@item (pure @var{val})
If @var{val} is non-@code{nil}, this function is @dfn{pure}
(@pxref{What Is a Function}). This is the same as the @code{pure}
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 5cb5367bc0..2be31d63a6 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -374,7 +374,8 @@ number of keys. Here's a very basic example:
@end lisp
This function creates a new sparse keymap, defines the keystrokes in
-@var{pairs}, and returns the new keymap.
+@var{pairs}, and returns the new keymap. It signals an error if there
+are duplicate key bindings in @var{pairs}.
@var{pairs} is a list of alternating key bindings and key definitions,
as accepted by @code{keymap-set}. In addition, the key can be the
@@ -438,7 +439,8 @@ variable. This is what virtually all modes do---a mode
called
This macro defines @var{name} as a variable, passes @var{options}
and @var{pairs} to @code{define-keymap}, and uses the result as the
-default value for the variable.
+default value for the variable. It signals an error if there are
+duplicate key bindings in @var{pairs}.
@var{options} is like the keywords in @code{define-keymap}, but
there's an additional @code{:doc} keyword that provides the doc
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 54fc16ec9f..0972a7a123 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -698,14 +698,13 @@ Switch to *doctor* buffer and start giving psychotherapy.
@noindent
@cindex @code{fn} in function's documentation string
-The backslash and newline immediately following the double-quote are a
-convention used only in the preloaded uncompiled Lisp files such as
-@file{loaddefs.el}; they tell @code{make-docfile} to put the
-documentation string in the @file{etc/DOC} file. @xref{Building Emacs}.
-See also the commentary in @file{lib-src/make-docfile.c}. @samp{(fn)}
-in the usage part of the documentation string is replaced with the
-function's name when the various help functions (@pxref{Help
-Functions}) display it.
+While the @file{loaddefs.el} isn't for editing, we try to keep it
+somewhat readable for people. For instance, control characters in
+@code{defvar} values are escaped, and we insert a backslash and
+newline immediately following the double-quote of the doc string to
+keep the line length down. @samp{(fn)} in the usage part of the
+documentation string is replaced with the function's name when the
+various help functions (@pxref{Help Functions}) display it.
If you write a function definition with an unusual macro that is not
one of the known and recognized function definition methods, use of an
@@ -767,7 +766,7 @@ the corresponding list of files to load for it. Entries to
this
mapping are added by calls to @code{register-definition-prefixes}
which are generated by @code{loaddefs-generate}
(@pxref{Autoload}). Files which don't contain any definitions worth
-loading (test files, for examples), should set
+loading (test files, for example), should set
@code{autoload-compute-prefixes} to @code{nil} as a file-local
variable.
@@ -1032,7 +1031,7 @@ with a call to @code{provide}. The order of the elements
in the
@cindex symbol, where defined
@cindex where was a symbol defined
-@defun symbol-file symbol &optional type
+@defun symbol-file symbol &optional type native-p
This function returns the name of the file that defined @var{symbol}.
If @var{type} is @code{nil}, then any kind of definition is acceptable.
If @var{type} is @code{defun}, @code{defvar}, or @code{defface}, that
@@ -1043,6 +1042,14 @@ The value is normally an absolute file name. It can
also be @code{nil},
if the definition is not associated with any file. If @var{symbol}
specifies an autoloaded function, the value can be a relative file name
without extension.
+
+If the optional third argument @var{native-p} is non-@code{nil}, and
+Emacs was built with native compilation support (@pxref{Native
+Compilation}), this function will try to find the @file{.eln} file
+that defined @var{symbol}, instead of the @file{.elc} or @file{.el}
+file. If such a @file{.eln} file is found and is not outdated, the
+function will return its absolute file name; otherwise it will report
+the name of either the source or the byte-compiled file.
@end defun
The basis for @code{symbol-file} is the data in the variable
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index e94093318f..75eb21522f 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1356,11 +1356,10 @@ the conventions listed above:
;; @r{Create the keymap for this mode.}
@group
(defvar-keymap text-mode-map
- "C-M-i" #'ispell-complete-word
- @dots{})
- "Keymap for `text-mode'.
-Many other modes, such as `mail-mode', `outline-mode' and
-`indented-text-mode', inherit all the commands defined in this map.")
+ :doc "Keymap for `text-mode'.
+Many other modes, such as `mail-mode' and `outline-mode', inherit all
+the commands defined in this map."
+ "C-M-i" #'ispell-complete-word)
@end group
@end smallexample
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 2b49818ed3..d591b219cd 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1541,7 +1541,7 @@ Year numbers count since the year 1 BCE, and do not skip
zero
as traditional Gregorian years do; for example, the year number
@minus{}37 represents the Gregorian year 38 BCE@.
-@defun time-convert time &optional form
+@defun time-convert time form
This function converts a time value into a Lisp timestamp.
The optional @var{form} argument specifies the timestamp form to be
@@ -1554,7 +1554,7 @@ representing the timestamp; for example, it is treated as
1000000000
if @var{time} is @code{nil} and the platform timestamp has nanosecond
resolution. If @var{form} is @code{list}, this function returns an
integer list @code{(@var{high} @var{low} @var{micro} @var{pico})}.
-Although an omitted or @code{nil} @var{form} currently acts like
+Although a @code{nil} @var{form} currently acts like
@code{list}, this is planned to change in a future Emacs version, so
callers requiring list timestamps should pass @code{list} explicitly.
@@ -2067,7 +2067,12 @@ This returns @code{t} if the time value @var{t1} is less
than the time value
@defun time-equal-p t1 t2
This returns @code{t} if the two time values @var{t1} and @var{t2} are
-equal.
+equal. The result is @code{nil} if either argument is a NaN.
+For the purpose of comparison, a @code{nil} argument represents the
+current time with infinite resolution, so this function returns
+@code{nil} if one argument is @code{nil} and the other is not, and
+callers can therefore use @code{nil} to represent an unknown time
+value that does not equal any timestamp.
@end defun
@defun time-subtract t1 t2
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index 3a9a152f8d..333c8e19a0 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -995,7 +995,7 @@ the entire buffer regardless of any narrowing.
types of text, consider using an alternative facility described in
@ref{Swapping Text}.
-@deffn Command narrow-to-region start end &optional lock
+@deffn Command narrow-to-region start end
This function sets the accessible portion of the current buffer to start
at @var{start} and end at @var{end}. Both arguments should be character
positions.
@@ -1003,10 +1003,11 @@ positions.
In an interactive call, @var{start} and @var{end} are set to the bounds
of the current region (point and the mark, with the smallest first).
-When @var{lock} is non-@code{nil}, calls to @code{widen}, or to
-@code{narrow-to-region} with an optional argument @var{lock}
-@code{nil}, do not produce any effect until the end of the current
-body form.
+Note that, in rare circumstances, Emacs may decide to leave, for
+performance reasons, the accessible portion of the buffer unchanged
+after a call to @code{narrow-to-region}. This can happen when a Lisp
+program is called via low-level hooks, such as
+@code{jit-lock-functions}, @code{post-command-hook}, etc.
@end deffn
@deffn Command narrow-to-page &optional move-count
@@ -1032,9 +1033,11 @@ It is equivalent to the following expression:
@end example
@end deffn
-However, when @code{widen} is called inside a body form in which
-@code{narrow-to-region} was called with an optional argument
-@code{lock} non-@code{nil}, it does not produce any effect.
+Note that, in rare circumstances, Emacs may decide to leave, for
+performance reasons, the accessible portion of the buffer unchanged
+after a call to @code{widen}. This can happen when a Lisp program is
+called via low-level hooks, such as @code{jit-lock-functions},
+@code{post-command-hook}, etc.
@defun buffer-narrowed-p
This function returns non-@code{nil} if the buffer is narrowed, and
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 1ef8fc3d03..382053ab24 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -705,12 +705,13 @@ coding system will apply. @xref{Default Coding Systems}.
Initialize the type of device used to communicate with the subprocess.
Possible values are @code{pty} to use a pty, @code{pipe} to use a
pipe, or @code{nil} to use the default derived from the value of the
-@code{process-connection-type} variable. This parameter and the value
-of @code{process-connection-type} are ignored if a non-@code{nil}
-value is specified for the @code{:stderr} parameter; in that case, the
-type will always be @code{pipe}. On systems where ptys are not
-available (MS-Windows), this parameter is likewise ignored, and pipes
-are used unconditionally.
+@code{process-connection-type} variable. If @var{type} is a cons cell
+@w{@code{(@var{input} . @var{output})}}, then @var{input} will be used
+for standard input and @var{output} for standard output (and standard
+error if @code{:stderr} is @code{nil}).
+
+On systems where ptys are not available (MS-Windows), this parameter
+is ignored, and pipes are used unconditionally.
@item :noquery @var{query-flag}
Initialize the process query flag to @var{query-flag}.
@@ -1242,15 +1243,24 @@ that are already closed, the value is either 0 or 256,
depending on
whether the connection was closed normally or abnormally.
@end defun
-@defun process-tty-name process
+@defun process-tty-name process &optional stream
This function returns the terminal name that @var{process} is using for
its communication with Emacs---or @code{nil} if it is using pipes
instead of a pty (see @code{process-connection-type} in
-@ref{Asynchronous Processes}). If @var{process} represents a program
-running on a remote host, the terminal name used by that program on
-the remote host is provided as process property @code{remote-tty}. If
-@var{process} represents a network, serial, or pipe connection, the
-value is @code{nil}.
+@ref{Asynchronous Processes}). By default, this function returns the
+terminal name if any of @var{process}'s standard streams use a
+terminal. If @var{stream} is one of @code{stdin}, @code{stdout}, or
+@code{stderr}, this function returns the terminal name (or @code{nil},
+as above) that @var{process} uses for that stream specifically. You
+can use this to determine whether a particular stream uses a pipe or a
+pty.
+
+If @var{process} represents a program running on a remote host, this
+function returns the @emph{local} terminal name that communicates with
+@var{process}; you can get the terminal name used by that program on
+the remote host with the process property @code{remote-tty}. If
+@var{process} represents a network, serial, or pipe connection, this
+function always returns @code{nil}.
@end defun
@defun process-coding-system process
@@ -1530,20 +1540,11 @@ a buffer, which is called the associated buffer of the
process
default filter discards the output.
If the subprocess writes to its standard error stream, by default
-the error output is also passed to the process filter function. If
-Emacs uses a pseudo-TTY (pty) for communication with the subprocess,
-then it is impossible to separate the standard output and standard
-error streams of the subprocess, because a pseudo-TTY has only one
-output channel. In that case, if you want to keep the output to those
-streams separate, you should redirect one of them to a file---for
-example, by using an appropriate shell command via
-@code{start-process-shell-command} or a similar function.
-
- Alternatively, you could use the @code{:stderr} parameter with a
+the error output is also passed to the process filter function.
+Alternatively, you could use the @code{:stderr} parameter with a
non-@code{nil} value in a call to @code{make-process}
(@pxref{Asynchronous Processes, make-process}) to make the destination
-of the error output separate from the standard output; in that case,
-Emacs will use pipes for communicating with the subprocess.
+of the error output separate from the standard output.
When a subprocess terminates, Emacs reads any pending output,
then stops reading output from that subprocess. Therefore, if the
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 9bda6af1c5..98f59b89c0 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -1,7 +1,7 @@
\input texinfo @c -*- mode: texinfo; coding: utf-8 -*-
+@setfilename ../../info/calc.info
@comment %**start of header (This is for running Texinfo on a region.)
@c smallbook
-@setfilename ../../info/calc.info
@c [title]
@settitle GNU Emacs Calc Manual
@include docstyle.texi
diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi
index 39b09b29b3..cbc7556aa8 100644
--- a/doc/misc/ediff.texi
+++ b/doc/misc/ediff.texi
@@ -947,12 +947,14 @@ This function can also be invoked from the Menubar.
However, in some
cases, the change will take place only after you execute one of the Ediff
commands, such as going to the next difference or redisplaying.
+@c --> The below can be revisited once the toolbar has been ported to Emacs:
+@ignore
@item ediff-toggle-use-toolbar
@findex ediff-toggle-use-toolbar
-Available in XEmacs only. The Ediff toolbar provides quick access to some
-of the common Ediff functions. This function toggles the display of the
-toolbar. If invoked from the menubar, the function may take sometimes
-effect only after you execute an Ediff command, such as going to the next
+The Ediff toolbar provides quick access to some of the common Ediff
+functions. This function toggles the display of the toolbar. If
+invoked from the menubar, the function may take sometimes effect only
+after you execute an Ediff command, such as going to the next
difference.
@item ediff-use-toolbar-p
@@ -961,6 +963,7 @@ The use of the toolbar can also be specified via the
variable
@code{ediff-use-toolbar-p} (default is @code{t}). This variable can be set
only in @file{.emacs}: do @strong{not} change it interactively. Use the
function @code{ediff-toggle-use-toolbar} instead.
+@end ignore
@item ediff-revert-buffers-then-recompute-diffs
@findex ediff-revert-buffers-then-recompute-diffs
diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi
index 0ab000b70f..fadc6a5cbe 100644
--- a/doc/misc/htmlfontify.texi
+++ b/doc/misc/htmlfontify.texi
@@ -10,8 +10,7 @@
This manual documents Htmlfontify, a source code -> crosslinked +
formatted + syntax colorized html transformer.
-Copyright @copyright{} 2002--2003, 2013--2022 Free Software Foundation,
-Inc.
+Copyright @copyright{} 2002--2022 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -1539,13 +1538,6 @@ Htmlfontify has a couple of external requirements:
@itemize @bullet
-@item
-GNU Emacs 20.7+ or 21.1+
-
-Other versions may work---these have been used successfully by the
-author. If you intend to use Htmlfontify in batch mode, 21.1+ is
-pretty much required.
-
@item
A copy of etags (exuberant-ctags or GNU etags). Htmlfontify attempts
to autodetect the version you have and customize itself accordingly,
diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi
index 26a6e6c7a3..6aaa4309a1 100644
--- a/doc/misc/idlwave.texi
+++ b/doc/misc/idlwave.texi
@@ -217,7 +217,7 @@ Integrity checks and auto-termination of logical blocks.
@item
Routine name space conflict search with likelihood-of-use ranking.
@item
-Support for @file{imenu} (Emacs) and @file{func-menu} (XEmacs).
+Support for @file{imenu}.
@item
Documentation support.
@item
@@ -392,7 +392,7 @@ that IDLWAVE has many more capabilities than covered here,
which can
be discovered by reading the entire manual, or hovering over the
shoulder of your nearest IDLWAVE guru for a few days.
-It is assumed that you have access to Emacs or XEmacs with the full
+It is assumed that you have access to Emacs with the full
IDLWAVE package including online help. We also assume that you are
familiar with Emacs and can read the nomenclature of key presses in
Emacs (in particular, @kbd{C} stands for @key{CONTROL} and @kbd{M} for
@@ -1011,9 +1011,9 @@ Non-@code{nil} means use last match on line for
@cindex Font lock
Highlighting of keywords, comments, strings etc.@: can be accomplished
-with @code{font-lock}. If you are using @code{global-font-lock-mode}
-(in Emacs), or have @code{font-lock} turned on in any other buffer in
-XEmacs, it should also automatically work in IDLWAVE buffers. If you'd
+with @code{font-lock}. If you are using @code{global-font-lock-mode},
+or have @code{font-lock-mode} turned on in any other buffer,
+it should also automatically work in IDLWAVE buffers. If you'd
prefer invoking font-lock individually by mode, you can enforce it in
@code{idlwave-mode} with the following line in your @file{.emacs}:
@@ -2298,12 +2298,11 @@ Regexp matching the start of a document library header.
@cindex Motion commands
@cindex Program structure, moving through
@cindex Code structure, moving through
-@cindex @file{Func-menu}, XEmacs package
-@cindex @file{Imenu}, Emacs package
+@cindex @file{Imenu}
@cindex Function definitions, jumping to
@cindex Procedure definitions, jumping to
-IDLWAVE supports both @file{Imenu} and @file{Func-menu}, two packages
+IDLWAVE supports @file{Imenu}, a package
which make it easy to jump to the definitions of functions and
procedures in the current file with a pop-up selection. To bind
@file{Imenu} to a mouse-press, use in your @file{.emacs}:
@@ -4022,7 +4021,7 @@ user is King!
IDLWAVE was developed on a UNIX system. However, thanks to the
portability of Emacs, much of IDLWAVE does also work under different
-operating systems like Windows (with NTEmacs or NTXEmacs).
+operating systems like Windows (with NTEmacs).
The only real problem is that there is no command-line version of IDL
for Windows with which IDLWAVE can interact. As a
@@ -4117,13 +4116,6 @@ configuration files (e.g., @file{.cshrc}), but from the
file
@file{~/.MacOSX/environment.plist}. Either include your path settings
there, or start Emacs and IDLWAVE from the shell.
-@item @strong{I get errors like @samp{Symbol's function is void:
-overlayp}}
-
-You don't have the @samp{fsf-compat} package installed, which IDLWAVE
-needs to run under XEmacs. Install it, or find an XEmacs distribution
-which includes it by default.
-
@item @strong{I'm getting errors like @samp{Symbol's value as variable is void:
cl-builtin-gethash} on completion or routine info.}
@@ -4262,20 +4254,6 @@ is updated).
Starting with IDL 6.2, the HTML help and its catalog are
distributed with IDL, and so should never be inconsistent.
-@item @strong{I get errors such as @samp{void-variable
-browse-url-browser-function} or similar when attempting to load IDLWAVE
-under XEmacs.}
-
-You don't have the @samp{browse-url} (or other required) XEmacs package.
-Unlike Emacs, XEmacs distributes many packages separately from the
-main program. IDLWAVE is actually among these, but is not always the
-most up to date. When installing IDLWAVE as an XEmacs package, it
-should prompt you for required additional packages. When installing it
-from source, it won't and you'll get this error. The easiest solution
-is to install all the packages when you install XEmacs (the so-called
-@samp{sumo} bundle). The minimum set of XEmacs packages required by
-IDLWAVE is @samp{fsf-compat, xemacs-base, mail-lib}.
-
@end enumerate
@node GNU Free Documentation License
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index c1cf44a027..12841860d9 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -214,9 +214,7 @@ them.
The MH-E package is distributed with Emacs@footnote{Version
@value{VERSION} of MH-E appeared in Emacs 24.4. It is supported in GNU
-Emacs 23 and higher, as well as XEmacs 21.4.22 and 21.5.31. MH-E is
-known not to work with GNU Emacs versions 20 and below, and XEmacs
-version 21.5.9--21.5.16. It is compatible with MH versions 6.8.4 and
+Emacs 23 and higher. It is compatible with MH versions 6.8.4 and
higher, all versions of nmh, and GNU mailutils 1.0 and higher}, so you
shouldn't have to do anything special to use it. Gnus is also
required; version 5.10 or higher is recommended. This manual covers
@@ -1501,9 +1499,6 @@ box ~/mail/mh-e
command emacsclient --eval '(mh-inc-spool-mh-e)'
@end smallexample
-In XEmacs, the command @command{gnuclient} is used in a similar
-fashion.
-
@findex mh-inc-folder
@kindex i
@vindex mh-inc-folder-hook
@@ -2090,8 +2085,7 @@ and @samp{X-Image-URL:} will be used. The option
This feature will be turned on by default if your system supports it.
The first header field used, if present, is the Gnus-specific
-@samp{Face:} field@footnote{The @samp{Face:} field appeared in GNU
-Emacs 21 and XEmacs. For more information, see
+@samp{Face:} field@footnote{For more information, see
@uref{https://quimby.gnus.org/circus/face/}.}.
@cindex @command{uncompface}
@@ -2104,12 +2098,9 @@ Emacs 21 and XEmacs. For more information, see
Next is the traditional @samp{X-Face:} header field@footnote{The
display of this field requires the
@uref{ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z,
-@command{uncompface} program}. Recent versions of XEmacs have internal
-support for @samp{X-Face:} images. If your version of XEmacs does not,
-then you'll need both @command{uncompface} and the
-@uref{http://www.jpl.org/ftp/pub/elisp/, @samp{x-face} package}.}. MH-E
-renders the foreground and background of the image using the
-associated attributes of the face @code{mh-show-xface}.
+@command{uncompface} program}.} MH-E renders the foreground and
+background of the image using the associated attributes of the face
+@code{mh-show-xface}.
@cindex @command{convert}
@cindex @command{wget}
@@ -6448,17 +6439,9 @@ too long to list here).
@item mh-tool-bar-search-function
Function called by the tool bar search button (default:
@code{mh-search}).
-@c -------------------------
-@item mh-xemacs-tool-bar-position
-Tool bar location (default: @samp{Same As Default Tool Bar}).
-@c -------------------------
-@item mh-xemacs-use-tool-bar-flag
-If @samp{on}, use tool bar (default: @samp{on}, if supported).
@end vtable
-In GNU Emacs, icons for some of MH-E's functions are added to the tool
-bar. In XEmacs, you have the opportunity to create a separate tool bar for
-the MH-E icons.
+Icons for some of MH-E's functions are added to the tool bar.
@vindex mh-tool-bar-folder-buttons
@vindex mh-tool-bar-letter-buttons
@@ -6480,24 +6463,6 @@ option @code{mh-tool-bar-search-function}. By default,
this is set to
Function} from the @samp{Value Menu} and enter a function of your own
choosing.
-@vindex mh-xemacs-use-tool-bar-flag
-
-XEmacs provides a couple of extra options. The first,
-@code{mh-xemacs-use-tool-bar-flag}, controls whether to show the MH-E
-icons at all. By default, this option is turned on if the window
-system supports tool bars. If your system doesn't support tool bars,
-then you won't be able to turn on this option.
-
-@vindex mh-xemacs-tool-bar-position
-
-The second extra option is @code{mh-xemacs-tool-bar-position} which
-controls the placement of the tool bar along the four edges of the
-frame. You can choose from one of @samp{Same As Default Tool Bar},
-@samp{Top}, @samp{Bottom}, @samp{Left}, or @samp{Right}. If this
-variable is set to anything other than @samp{Same As Default Tool Bar}
-and the default tool bar is in a different location, then two tool
-bars will be displayed: the MH-E tool bar and the default tool bar.
-
@node Searching
@chapter Searching Through Messages
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 943294b626..ddd9595fc8 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -1,25 +1,23 @@
-#+title: Modus themes for GNU Emacs
-#+author: Protesilaos Stavrou
-#+email: info@protesilaos.com
-#+language: en
-#+options: ':t toc:nil author:t email:t num:t
-#+startup: content
-
-#+macro: stable-version 2.4.0
-#+macro: release-date 2022-06-01
-#+macro: development-version 2.5.0-dev
-#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
-#+macro: space @@texinfo:@: @@
-#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
-
-#+texinfo_filename: modus-themes.info
-#+texinfo_dir_category: Emacs misc features
-#+texinfo_dir_title: Modus Themes: (modus-themes)
-#+texinfo_dir_desc: Elegant, highly legible and customizable themes
-#+texinfo_header: @set MAINTAINERSITE @uref{https://protesilaos.com,maintainer
webpage}
-#+texinfo_header: @set MAINTAINER Protesilaos Stavrou
-#+texinfo_header: @set MAINTAINEREMAIL @email{info@protesilaos.com}
-#+texinfo_header: @set MAINTAINERCONTACT
@uref{mailto:info@protesilaos.com,contact the maintainer}
+#+title: Modus themes for GNU Emacs
+#+author: Protesilaos Stavrou
+#+email: info@protesilaos.com
+#+language: en
+#+options: ':t toc:nil author:t email:t num:t
+#+startup: content
+#+macro: stable-version 2.5.0
+#+macro: release-date 2022-08-03
+#+macro: development-version 2.6.0-dev
+#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
+#+macro: space @@texinfo:@: @@
+#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
+#+texinfo_filename: modus-themes.info
+#+texinfo_dir_category: Emacs misc features
+#+texinfo_dir_title: Modus Themes: (modus-themes)
+#+texinfo_dir_desc: Elegant, highly legible and customizable themes
+#+texinfo_header: @set MAINTAINERSITE
@uref{https://protesilaos.com,maintainer webpage}
+#+texinfo_header: @set MAINTAINER Protesilaos Stavrou
+#+texinfo_header: @set MAINTAINEREMAIL @email{info@protesilaos.com}
+#+texinfo_header: @set MAINTAINERCONTACT
@uref{mailto:info@protesilaos.com,contact the maintainer}
#+texinfo: @insertcopying
@@ -198,6 +196,9 @@ sudo apt install elpa-modus-themes
They are now ready to be used:
[[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]].
+NOTE that Debian's package is severely out-of-date as of this writing
+2022-07-24 09:57 +0300.
+
*** GNU Guix
:properties:
:custom_id: h:a4ca52cd-869f-46a5-9e16-4d9665f5b88e
@@ -618,7 +619,7 @@ By default, customizing a theme-related user option through
the Custom
interfaces or with {{{kbd(M-x customize-set-variable)}}} will not reload the
currently active Modus theme.
-Enable this behavior by setting this variable to ~nil~.
+Enable this behaviour by setting this variable to ~nil~.
Regardless of this option, the active theme must be reloaded for changes
to user options to take effect
([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]).
@@ -1199,7 +1200,7 @@ Brief: Set the overall style of completion framework
interfaces.
Symbol: ~modus-themes-completions~ (=alist= type properties)
-This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy, Mct,
+This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy,
Orderless, Selectrum, Vertico. The value is an alist that takes the
form of a =(key . properties)= combination. Here is a sample, followed
by a description of the particularities:
@@ -1476,6 +1477,9 @@ with underlines.
This style affects several packages that enable ~hl-line-mode~, such as
=elfeed=, =notmuch=, and =mu4e=.
+[ Also check the =lin= package on GNU ELPA (by the author of the
+ modus-themes) for a stylistic enhancement to ~hl-line-mode~. ]
+
** Option for line numbers
:properties:
:alt_title: Line numbers
@@ -2000,16 +2004,21 @@ Putting it all together, the alist can look like this:
:end:
#+vindex: modus-themes-headings
-Brief: Control the style of headings. This can be particularised for
-each level of heading (e.g. Org has eight levels).
+Brief: Heading styles with optional list of values for levels 0-8.
Symbol: ~modus-themes-headings~ (=alist= type, multiple properties)
-This is an alist that accepts a =(key . list-of-values)= combination. The
-key is either a number, representing the heading's level or ~t~, which
-pertains to the fallback style. The list of values covers symbols that
-refer to properties, as described below. Here is a sample, followed by
-a presentation of all available properties:
+This is an alist that accepts a =(key . list-of-values)= combination.
+The key is either a number, representing the heading's level (0-8) or t,
+which pertains to the fallback style.
+
+Level 0 is a special heading: it is used for what counts as a document
+title or equivalent, such as the =#+title= construct we find in Org
+files. Levels 1-8 are regular headings.
+
+The list of values covers symbols that refer to properties, as described
+below. Here is a complete sample, followed by a presentation of all
+available properties:
#+begin_src emacs-lisp
(setq modus-themes-headings
@@ -2162,7 +2171,7 @@ things with precision
([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization
This section is of interest only to users who are prepared to maintain
their own local tweaks and who are willing to deal with any possible
incompatibilities between versioned releases of the themes. As such,
-they are labeled as "do-it-yourself" or "DIY".
+they are labelled as "do-it-yourself" or "DIY".
** More accurate colors in terminal emulators
:PROPERTIES:
@@ -2605,7 +2614,7 @@ this example:
Whenever we enter a ~diff-mode~ buffer, we now get a magenta-colored
region.
-Perhaps you may wish to generalize those findings in to a set of
+Perhaps you may wish to generalise those findings in to a set of
functions that also accept an arbitrary face. We shall leave the
experimentation up to you.
@@ -2624,7 +2633,7 @@ contrast on an on-demand basis.
One way to achieve this is to design a command that cycles through three
distinct levels of intensity, though the following can be adapted to any
-kind of cyclic behavior, such as to switch between red, green, and
+kind of cyclic behaviour, such as to switch between red, green, and
blue.
In the following example, we employ the ~modus-themes-color~ function
@@ -2848,7 +2857,6 @@ both themes and expands to some more assosiations in the
palette:
(bg-inactive . "#f6ece5")
(bg-region . "#c6bab1")
(bg-header . "#ede3e0")
- (bg-tab-bar . "#dcd3d3")
(bg-tab-active . "#fdf6eb")
(bg-tab-inactive . "#c8bab8"))
modus-themes-vivendi-color-overrides
@@ -2860,7 +2868,6 @@ both themes and expands to some more assosiations in the
palette:
(bg-inactive . "#1a1e39")
(bg-region . "#393a53")
(bg-header . "#202037")
- (bg-tab-bar . "#262b41")
(bg-tab-active . "#120f18")
(bg-tab-inactive . "#3a3a5a")))
(setq modus-themes-operandi-color-overrides nil
@@ -2879,7 +2886,6 @@ look like this:
(bg-inactive . "#e6e6e6")
(bg-region . "#b5b5b5")
(bg-header . "#e4e4e4")
- (bg-tab-bar . "#d1d1d4")
(bg-tab-active . "#f5f5f5")
(bg-tab-inactive . "#c0c0c0"))
#+end_src
@@ -2897,6 +2903,9 @@ fall below the minimum 7:1 contrast ratio that governs
the design of the
themes (the WCAG AAA legibility standard). Alternatively, this can also
be done programmatically ([[#h:4589acdc-2505-41fc-9f5e-699cfc45ab00][Override
color saturation]]).
+The above are expanded into a fully fledged derivative elsewhere in this
+document ([[#h:736c0ff5-8c9c-4565-82cf-989e57d07d4a][Override colors
completely]]).
+
For manual interventions it is advised to inspect the source code of
~modus-themes-operandi-colors~ and ~modus-themes-vivendi-colors~ for the
inline commentary: it explains what the intended use of each palette
@@ -3092,6 +3101,286 @@ Blend background colors with BG-BLEND and foreground
colors with FG-BLEND."
(modus-themes-tinted-mode 1)
#+end_src
+** Override colors completely
+:PROPERTIES:
+:CUSTOM_ID: h:736c0ff5-8c9c-4565-82cf-989e57d07d4a
+:END:
+
+Based on the ideas we have already covered in these sections, the
+following code block provides a complete, bespoke pair of color palettes
+which override the defaults. They are implemented as a minor mode, as
+explained before ([[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override
colors]]). We call them "Summertime" for
+convenience.
+
+#+begin_src emacs-lisp
+;; Read the relevant blog post:
+;;
<https://protesilaos.com/codelog/2022-07-26-modus-themes-color-override-demo/>
+(define-minor-mode modus-themes-summertime
+ "Refashion the Modus themes by overriding their colors.
+
+This is a complete technology demonstration to show how to
+manually override the colors of the Modus themes. I have taken
+good care of those overrides to make them work as a fully fledged
+color scheme that is compatible with all user options of the
+Modus themes.
+
+These overrides are usable by those who (i) like something more
+fancy than the comparatively austere looks of the Modus themes,
+and (ii) can cope with a lower contrast ratio.
+
+The overrides are set up as a minor mode, so that the user can
+activate the effect on demand. Those who want to load the
+overrides at all times can either add them directly to their
+configuration or enable `modus-themes-summertime' BEFORE loading
+either of the Modus themes (if the overrides are evaluated after
+the theme, the theme must be reloaded).
+
+Remember that all changes to theme-related variables require a
+reload of the theme to take effect (the Modus themes have lots of
+user options, apart from those overrides).
+
+The `modus-themes-summertime' IS NOT an official extension to the
+Modus themes and DOES NOT comply with its lofty accessibility
+standards. It is included in the official manual as guidance for
+those who want to make use of the color overriding facility we
+provide."
+ :init-value nil
+ :global t
+ (if modus-themes-summertime
+ (setq modus-themes-operandi-color-overrides
+ '((bg-main . "#fff0f2")
+ (bg-dim . "#fbe6ef")
+ (bg-alt . "#f5dae6")
+ (bg-hl-line . "#fad8e3")
+ (bg-active . "#efcadf")
+ (bg-inactive . "#f3ddef")
+ (bg-active-accent . "#ffbbef")
+ (bg-region . "#dfc5d1")
+ (bg-region-accent . "#efbfef")
+ (bg-region-accent-subtle . "#ffd6ef")
+ (bg-header . "#edd3e0")
+ (bg-tab-active . "#ffeff2")
+ (bg-tab-inactive . "#f8d3ef")
+ (bg-tab-inactive-accent . "#ffd9f5")
+ (bg-tab-inactive-alt . "#e5c0d5")
+ (bg-tab-inactive-alt-accent . "#f3cce0")
+ (fg-main . "#543f78")
+ (fg-dim . "#5f476f")
+ (fg-alt . "#7f6f99")
+ (fg-unfocused . "#8f6f9f")
+ (fg-active . "#563068")
+ (fg-inactive . "#8a5698")
+ (fg-docstring . "#5f5fa7")
+ (fg-comment-yellow . "#a9534f")
+ (fg-escape-char-construct . "#8b207f")
+ (fg-escape-char-backslash . "#a06d00")
+ (bg-special-cold . "#d3e0f4")
+ (bg-special-faint-cold . "#e0efff")
+ (bg-special-mild . "#c4ede0")
+ (bg-special-faint-mild . "#e0f0ea")
+ (bg-special-warm . "#efd0c4")
+ (bg-special-faint-warm . "#ffe4da")
+ (bg-special-calm . "#f0d3ea")
+ (bg-special-faint-calm . "#fadff9")
+ (fg-special-cold . "#405fb8")
+ (fg-special-mild . "#407f74")
+ (fg-special-warm . "#9d6f4f")
+ (fg-special-calm . "#af509f")
+ (bg-completion . "#ffc5e5")
+ (bg-completion-subtle . "#f7cfef")
+ (red . "#ed2f44")
+ (red-alt . "#e0403d")
+ (red-alt-other . "#e04059")
+ (red-faint . "#ed4f44")
+ (red-alt-faint . "#e0603d")
+ (red-alt-other-faint . "#e06059")
+ (green . "#217a3c")
+ (green-alt . "#417a1c")
+ (green-alt-other . "#006f3c")
+ (green-faint . "#318a4c")
+ (green-alt-faint . "#518a2c")
+ (green-alt-other-faint . "#20885c")
+ (yellow . "#b06202")
+ (yellow-alt . "#a95642")
+ (yellow-alt-other . "#a06f42")
+ (yellow-faint . "#b07232")
+ (yellow-alt-faint . "#a96642")
+ (yellow-alt-other-faint . "#a08042")
+ (blue . "#275ccf")
+ (blue-alt . "#475cc0")
+ (blue-alt-other . "#3340ef")
+ (blue-faint . "#476ce0")
+ (blue-alt-faint . "#575ccf")
+ (blue-alt-other-faint . "#3f60d7")
+ (magenta . "#bf317f")
+ (magenta-alt . "#d033c0")
+ (magenta-alt-other . "#844fe4")
+ (magenta-faint . "#bf517f")
+ (magenta-alt-faint . "#d053c0")
+ (magenta-alt-other-faint . "#846fe4")
+ (cyan . "#007a9f")
+ (cyan-alt . "#3f709f")
+ (cyan-alt-other . "#107f7f")
+ (cyan-faint . "#108aaf")
+ (cyan-alt-faint . "#3f80af")
+ (cyan-alt-other-faint . "#3088af")
+ (red-active . "#cd2f44")
+ (green-active . "#116a6c")
+ (yellow-active . "#993602")
+ (blue-active . "#475ccf")
+ (magenta-active . "#7f2ccf")
+ (cyan-active . "#007a8f")
+ (red-nuanced-bg . "#ffdbd0")
+ (red-nuanced-fg . "#ed6f74")
+ (green-nuanced-bg . "#dcf0dd")
+ (green-nuanced-fg . "#3f9a4c")
+ (yellow-nuanced-bg . "#fff3aa")
+ (yellow-nuanced-fg . "#b47232")
+ (blue-nuanced-bg . "#e3e3ff")
+ (blue-nuanced-fg . "#201f6f")
+ (magenta-nuanced-bg . "#fdd0ff")
+ (magenta-nuanced-fg . "#c0527f")
+ (cyan-nuanced-bg . "#dbefff")
+ (cyan-nuanced-fg . "#0f3f60")
+ (bg-diff-heading . "#b7cfe0")
+ (fg-diff-heading . "#041645")
+ (bg-diff-added . "#d6f0d6")
+ (fg-diff-added . "#004520")
+ (bg-diff-changed . "#fcefcf")
+ (fg-diff-changed . "#524200")
+ (bg-diff-removed . "#ffe0ef")
+ (fg-diff-removed . "#891626")
+ (bg-diff-refine-added . "#84cfa4")
+ (fg-diff-refine-added . "#002a00")
+ (bg-diff-refine-changed . "#cccf8f")
+ (fg-diff-refine-changed . "#302010")
+ (bg-diff-refine-removed . "#da92b0")
+ (fg-diff-refine-removed . "#500010")
+ (bg-diff-focus-added . "#a6e5c6")
+ (fg-diff-focus-added . "#002c00")
+ (bg-diff-focus-changed . "#ecdfbf")
+ (fg-diff-focus-changed . "#392900")
+ (bg-diff-focus-removed . "#efbbcf")
+ (fg-diff-focus-removed . "#5a0010"))
+ modus-themes-vivendi-color-overrides
+ '((bg-main . "#25152a")
+ (bg-dim . "#2a1930")
+ (bg-alt . "#382443")
+ (bg-hl-line . "#332650")
+ (bg-active . "#463358")
+ (bg-inactive . "#2d1f3a")
+ (bg-active-accent . "#50308f")
+ (bg-region . "#5d4a67")
+ (bg-region-accent . "#60509f")
+ (bg-region-accent-subtle . "#3f285f")
+ (bg-header . "#3a2543")
+ (bg-tab-active . "#26162f")
+ (bg-tab-inactive . "#362647")
+ (bg-tab-inactive-accent . "#36265a")
+ (bg-tab-inactive-alt . "#3e2f5a")
+ (bg-tab-inactive-alt-accent . "#3e2f6f")
+ (fg-main . "#debfe0")
+ (fg-dim . "#d0b0da")
+ (fg-alt . "#ae85af")
+ (fg-unfocused . "#8e7f9f")
+ (fg-active . "#cfbfef")
+ (fg-inactive . "#b0a0c0")
+ (fg-docstring . "#c8d9f7")
+ (fg-comment-yellow . "#cf9a70")
+ (fg-escape-char-construct . "#ff75aa")
+ (fg-escape-char-backslash . "#dbab40")
+ (bg-special-cold . "#2a3f58")
+ (bg-special-faint-cold . "#1e283f")
+ (bg-special-mild . "#0f3f31")
+ (bg-special-faint-mild . "#0f281f")
+ (bg-special-warm . "#44331f")
+ (bg-special-faint-warm . "#372213")
+ (bg-special-calm . "#4a314f")
+ (bg-special-faint-calm . "#3a223f")
+ (fg-special-cold . "#c0b0ff")
+ (fg-special-mild . "#bfe0cf")
+ (fg-special-warm . "#edc0a6")
+ (fg-special-calm . "#ff9fdf")
+ (bg-completion . "#502d70")
+ (bg-completion-subtle . "#451d65")
+ (red . "#ff5f6f")
+ (red-alt . "#ff8f6d")
+ (red-alt-other . "#ff6f9d")
+ (red-faint . "#ffa0a0")
+ (red-alt-faint . "#f5aa80")
+ (red-alt-other-faint . "#ff9fbf")
+ (green . "#51ca5c")
+ (green-alt . "#71ca3c")
+ (green-alt-other . "#51ca9c")
+ (green-faint . "#78bf78")
+ (green-alt-faint . "#99b56f")
+ (green-alt-other-faint . "#88bf99")
+ (yellow . "#f0b262")
+ (yellow-alt . "#f0e242")
+ (yellow-alt-other . "#d0a272")
+ (yellow-faint . "#d2b580")
+ (yellow-alt-faint . "#cabf77")
+ (yellow-alt-other-faint . "#d0ba95")
+ (blue . "#778cff")
+ (blue-alt . "#8f90ff")
+ (blue-alt-other . "#8380ff")
+ (blue-faint . "#82b0ec")
+ (blue-alt-faint . "#a0acef")
+ (blue-alt-other-faint . "#80b2f0")
+ (magenta . "#ff70cf")
+ (magenta-alt . "#ff77f0")
+ (magenta-alt-other . "#ca7fff")
+ (magenta-faint . "#e0b2d6")
+ (magenta-alt-faint . "#ef9fe4")
+ (magenta-alt-other-faint . "#cfa6ff")
+ (cyan . "#30cacf")
+ (cyan-alt . "#60caff")
+ (cyan-alt-other . "#40b79f")
+ (cyan-faint . "#90c4ed")
+ (cyan-alt-faint . "#a0bfdf")
+ (cyan-alt-other-faint . "#a4d0bb")
+ (red-active . "#ff6059")
+ (green-active . "#64dc64")
+ (yellow-active . "#ffac80")
+ (blue-active . "#4fafff")
+ (magenta-active . "#cf88ff")
+ (cyan-active . "#50d3d0")
+ (red-nuanced-bg . "#440a1f")
+ (red-nuanced-fg . "#ffcccc")
+ (green-nuanced-bg . "#002904")
+ (green-nuanced-fg . "#b8e2b8")
+ (yellow-nuanced-bg . "#422000")
+ (yellow-nuanced-fg . "#dfdfb0")
+ (blue-nuanced-bg . "#1f1f5f")
+ (blue-nuanced-fg . "#bfd9ff")
+ (magenta-nuanced-bg . "#431641")
+ (magenta-nuanced-fg . "#e5cfef")
+ (cyan-nuanced-bg . "#042f49")
+ (cyan-nuanced-fg . "#a8e5e5")
+ (bg-diff-heading . "#304466")
+ (fg-diff-heading . "#dae7ff")
+ (bg-diff-added . "#0a383a")
+ (fg-diff-added . "#94ba94")
+ (bg-diff-changed . "#2a2000")
+ (fg-diff-changed . "#b0ba9f")
+ (bg-diff-removed . "#50163f")
+ (fg-diff-removed . "#c6adaa")
+ (bg-diff-refine-added . "#006a46")
+ (fg-diff-refine-added . "#e0f6e0")
+ (bg-diff-refine-changed . "#585800")
+ (fg-diff-refine-changed . "#ffffcc")
+ (bg-diff-refine-removed . "#952838")
+ (fg-diff-refine-removed . "#ffd9eb")
+ (bg-diff-focus-added . "#1d4c3f")
+ (fg-diff-focus-added . "#b4dfb4")
+ (bg-diff-focus-changed . "#424200")
+ (fg-diff-focus-changed . "#d0daaf")
+ (bg-diff-focus-removed . "#6f0f39")
+ (fg-diff-focus-removed . "#eebdba")))
+ (setq modus-themes-operandi-color-overrides nil
+ modus-themes-vivendi-color-overrides nil)))
+#+end_src
+
** Font configurations for Org and others
:properties:
:custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929
@@ -3117,6 +3406,9 @@ the ~variable-pitch~ (proportional spacing) and
~fixed-pitch~ (monospaced)
faces respectively. It may also be convenient to set your main typeface
by configuring the ~default~ face the same way.
+[ The =fontaine= package on GNU ELPA (by the author of the modus-themes)
+ is designed to handle this case. ]
+
Put something like this in your initialization file (also consider
reading the doc string of ~set-face-attribute~):
@@ -4165,9 +4457,9 @@ have lots of extensions, so the "full support" may not be
100% true…
+ calendar and diary
+ calfw
+ calibredb
-+ centaur-tabs
+ cfrs
+ change-log and log-view (such as ~vc-print-log~, ~vc-print-root-log~)
++ chart
+ cider
+ circe
+ citar
@@ -4187,13 +4479,12 @@ have lots of extensions, so the "full support" may not
be 100% true…
+ css-mode
+ csv-mode
+ ctrlf
-+ cursor-flash
+ custom (what you get with {{{kbd(M-x customize)}}})
+ dap-mode
-+ dashboard (emacs-dashboard)
+ deadgrep
+ debbugs
+ deft
++ denote
+ devdocs
+ dictionary
+ diff-hl
@@ -4210,7 +4501,6 @@ have lots of extensions, so the "full support" may not be
100% true…
+ diredp (dired+)
+ display-fill-column-indicator-mode
+ doom-modeline
-+ dynamic-ruler
+ easy-jekyll
+ ebdb
+ ediff
@@ -4251,7 +4541,6 @@ have lots of extensions, so the "full support" may not be
100% true…
+ flyspell
+ flx
+ freeze-it
-+ frog-menu
+ focus
+ fold-this
+ font-lock (generic syntax highlighting)
@@ -4289,6 +4578,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ imenu-list
+ indium
+ info
++ info+ (info-plus)
+ info-colors
+ interaction-log
+ ioccur
@@ -4303,6 +4593,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ kaocha-runner
+ keycast
+ ledger-mode
++ leerzeichen
+ line numbers (~display-line-numbers-mode~ and global variant)
+ lsp-mode
+ lsp-ui
@@ -4314,7 +4605,6 @@ have lots of extensions, so the "full support" may not be
100% true…
+ marginalia
+ markdown-mode
+ markup-faces (~adoc-mode~)
-+ mct
+ mentor
+ messages
+ mini-modeline
@@ -4341,14 +4631,12 @@ have lots of extensions, so the "full support" may not
be 100% true…
+ org-superstar
+ org-table-sticky-header
+ org-tree-slide
-+ org-treescope
+ origami
+ outline-mode
+ outline-minor-faces
+ package (what you get with {{{kbd(M-x list-packages)}}})
+ page-break-lines
+ pandoc-mode
-+ paradox
+ paren-face
+ pass
+ pdf-tools
@@ -4420,7 +4708,6 @@ have lots of extensions, so the "full support" may not be
100% true…
+ typescript
+ undo-tree
+ vc (vc-dir.el, vc-hooks.el)
-+ vc-annotate (the output of {{{kbd(C-x v g)}}})
+ vertico
+ vertico-quick
+ vimish-fold
@@ -4464,9 +4751,11 @@ supported by the themes.
+ bufler
+ counsel-notmuch
+ counsel-org-capture-string
++ dashboard (emacs-dashboard)
+ define-word
+ disk-usage
+ dtache
++ dynamic-ruler
+ easy-kill
+ edit-indirect
+ egerrit
@@ -4542,7 +4831,7 @@ The =git-gutter= and =git-gutter-fr= packages default to
drawing bitmaps
for the indicators they display (e.g. bitmap of a plus sign for added
lines). In Doom Emacs, these bitmaps are replaced with contiguous lines
which may look nicer, but require a change to the foreground of the
-relevant faces to yield the desired color combinations.
+relevant faces to yield the desired colour combinations.
Since this is Doom-specific, we urge users to apply changes in their
local setup. Below is some sample code, based on what we cover at
@@ -5181,24 +5470,6 @@ candidates. That style still meets the contrast ratio
target of >= 7:1
ANSI color number 1 (red) from the already-supported array of
~ansi-color-names-vector~.
-** Note on vc-annotate-background-mode
-:properties:
-:custom_id: h:5095cbd1-e17a-419c-93e8-951c186362a3
-:end:
-
-Due to the unique way ~vc-annotate~ ({{{kbd(C-x v g)}}}) applies colors,
support
-for its background mode (~vc-annotate-background-mode~) is disabled at the
-theme level.
-
-Normally, such a drastic measure should not belong in a theme: assuming
-the user's preferences is bad practice. However, it has been deemed
-necessary in the interest of preserving color contrast accessibility
-while still supporting a useful built-in tool.
-
-If there actually is a way to avoid such a course of action, without
-prejudice to the accessibility standard of this project, then please
-report as much or send patches
([[#h:9c3cd842-14b7-44d7-84b2-a5c8bc3fc3b1][Contributing]]).
-
** Note on pdf-tools link hints
:properties:
:custom_id: h:2659d13e-b1a5-416c-9a89-7c3ce3a76574
@@ -5519,7 +5790,7 @@ interface virtually unusable.
[[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]].
-Again, one must exercise judgment in order to avoid discrimination,
+Again, one must exercise judgement in order to avoid discrimination,
where "discrimination" refers to:
+ The treatment of substantially different magnitudes as if they were of
@@ -5535,11 +5806,11 @@ usability beyond matters of color---they would be
making a
not-so-obvious error of treating different cases as if they were the
same.
-The Modus themes prioritize "thematic consistency" over abstract harmony
+The Modus themes prioritise "thematic consistency" over abstract harmony
or regularity among their applicable colors. In concrete terms, we do
not claim that, say, our yellows are the best complements for our blues
because we generally avoid using complementary colors side-by-side, so
-it is wrong to optimize for a decontextualised blue+yellow combination.
+it is wrong to optimise for a decontextualised blue+yellow combination.
Not to imply that our colors do not work well together because they do,
just to clarify that consistency of context is what themes must strive
for, and that requires widening the scope of the design beyond the
@@ -5758,22 +6029,22 @@ The Modus themes are a collective effort. Every bit of
work matters.
Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia, Gonçalo Marrafa,
Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Iris
Garcia, Ivan Popovych, Jeremy Friesen, Jerry Zhang, Johannes Grødem,
- John Haman, Jorge Morais, Joshua O'Connor, Julio C. Villasante, Kenta
- Usami, Kevin Fleming, Kévin Le Gouguec, Kostadin Ninev, Len Trigg,
- Lennart C. Karssen, Magne Hov, Manuel Uberti, Mark Bestley, Mark
- Burton, Markus Beppler, Mauro Aranda, Maxime Tréca, Michael
- Goldenberg, Morgan Smith, Morgan Willcock, Murilo Pereira, Nicky van
- Foreest, Nicolas De Jaeghere, Paul Poloskov, Pengji Zhang, Pete
- Kazmier, Peter Wu, Philip Kaludercic, Pierre Téchoueyres, Przemysław
- Kryger, Robert Hepple, Roman Rudakov, Ryan Phillips, Rytis Paškauskas,
- Rudolf Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška,
- Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut Verron, Thomas
- Heartman, Togan Muftuoglu, Tony Zorman, Trey Merkley, Tomasz
- Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh, Vincent Foley. As
- well as users: Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux,
- Fredrik, Moesasji, Nick, TheBlob42, Trey, bepolymathe, bit9tream,
- derek-upham, doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn,
- pRot0ta1p.
+ John Haman, Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio
+ C. Villasante, Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kostadin
+ Ninev, Len Trigg, Lennart C. Karssen, Magne Hov, Manuel Uberti, Mark
+ Bestley, Mark Burton, Markus Beppler, Matt Armstrong, Mauro Aranda,
+ Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan Willcock,
+ Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Paul Poloskov,
+ Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic, Pierre
+ Téchoueyres, Przemysław Kryger, Robert Hepple, Roman Rudakov, Ryan
+ Phillips, Rytis Paškauskas, Rudolf Adamkovič, Sam Kleinman, Samuel
+ Culpepper, Saša Janiška, Shreyas Ragavan, Simon Pugnet, Tassilo Horn,
+ Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman, Trey
+ Merkley, Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh,
+ Vincent Foley. As well as users: Ben, CsBigDataHub1, Emacs Contrib,
+ Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer Emacs, TheBlob42,
+ Trey, bepolymathe, bit9tream, derek-upham, doolio, fleimgruber,
+ gitrj95, iSeeU, jixiuf, okamsn, pRot0ta1p.
+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii,
Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core
@@ -5784,10 +6055,12 @@ The Modus themes are a collective effort. Every bit of
work matters.
+ Inspiration for certain features :: Bozhidar Batsov (zenburn-theme),
Fabrice Niessen (leuven-theme).
-Special thanks (from A-Z) to Gustavo Barros, Manuel Uberti, Nicolas De
-Jaeghere, and Omar Antolín Camarena for their long time contributions
-and insightful commentary on key aspects of the themes' design and/or
-aspects of their functionality.
+Special thanks (from A-Z) to Daniel Mendler, Gustavo Barros, Manuel
+Uberti, Nicolas De Jaeghere, and Omar Antolín Camarena for their long
+time contributions and insightful commentary on key aspects of the
+themes' design and/or aspects of their functionality.
+
+All errors are my own.
* Other notes about the project
:properties:
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index c3b7b0b0f6..0c95b388cb 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -38,7 +38,6 @@ Con@TeX{}t
@set SUPPORTADDRESS @AUCTeX{} user mailing list (@email{auctex@@gnu.org})
@set DEVELADDRESS @AUCTeX{} developer mailing list
(@email{auctex-devel@@gnu.org})
@set BUGADDRESS @AUCTeX{} bug mailing list (@email{bug-auctex@@gnu.org})
-@set XEMACSFTP @uref{ftp://ftp.xemacs.org/pub/xemacs/packages/,XEmacs FTP site}
@c %**end of header
@copying
@@ -249,10 +248,7 @@ reports or suggestions.
@cindex Installation
@RefTeX{} has been bundled and pre-installed with Emacs since
-version 20.2. It has also been bundled and pre-installed with XEmacs
-19.16--20.x. XEmacs 21.x users want to install the corresponding
-plug-in package which is available from the @value{XEMACSFTP}. See the
-XEmacs 21.x documentation on package installation for details.
+version 20.2.
@findex turn-on-reftex
@findex reftex-mode
@@ -3584,7 +3580,7 @@ the @value{BUGADDRESS}.
There are also several Usenet groups which have competent readers who
might be able to help: @code{comp.emacs}, @code{gnu.emacs.help},
-@code{comp.emacs.xemacs}, and @code{comp.text.tex}.
+and @code{comp.text.tex}.
Thanks to the people on the Net who have used @RefTeX{} and helped
developing it with their reports. In particular thanks to @i{Ralf
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index cfbc96f469..924aa66d44 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3383,7 +3383,7 @@ names. Beside the @code{default} value, @var{syntax} can
be
@item @code{simplified}
@cindex simplified syntax
-The remote file name syntax is similar to the syntax used by Ange FTP@.
+This remote file name syntax is similar to the syntax used by Ange FTP@.
A remote file name has the form
@code{@value{prefix}user@@host@value{postfix}path/to/file}. The
@code{user@@} part is optional, and the method is determined by
@@ -3395,7 +3395,7 @@ A remote file name has the form
@clear unified
@set separate
@include trampver.texi
-The remote file name syntax is similar to the syntax used by XEmacs.
+This remote file name syntax originated in the XEmacs text editor.
A remote file name has the form
@code{@trampfn{method,user@@host,path/to/file}}. The @code{method}
and @code{user@@} parts are optional.
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index d634ad5197..24c3090ef7 100644
--- a/doc/misc/transient.texi
+++ b/doc/misc/transient.texi
@@ -47,9 +47,9 @@ General Public License for more details.
Taking inspiration from prefix keys and prefix arguments, Transient
implements a similar abstraction involving a prefix command, infix
arguments and suffix commands. We could call this abstraction a
-``transient command'', but because it always involves at least two
+“transient command”, but because it always involves at least two
commands (a prefix and a suffix) we prefer to call it just a
-``transient''.
+“transient”.
When the user calls a transient prefix command, a transient
(temporary) keymap is activated, which binds the transient's infix
@@ -97,7 +97,7 @@ Usage
* Getting Help for Suffix Commands::
* Enabling and Disabling Suffixes::
* Other Commands::
-* Other Options::
+* Configuration::
Defining New Commands
@@ -144,20 +144,20 @@ Related Abstractions and Packages
Taking inspiration from prefix keys and prefix arguments, Transient
implements a similar abstraction involving a prefix command, infix
arguments and suffix commands. We could call this abstraction a
-``transient command'', but because it always involves at least two
+“transient command”, but because it always involves at least two
commands (a prefix and a suffix) we prefer to call it just a
-``transient''.
+“transient”.
+@cindex transient prefix command
@quotation
Transient keymaps are a feature provided by Emacs. Transients as
implemented by this package involve the use of transient keymaps.
-@cindex transient prefix command
Emacs provides a feature that it calls @dfn{prefix commands}. When we
-talk about ``prefix commands'' in this manual, then we mean our own kind
-of ``prefix commands'', unless specified otherwise. To avoid ambiguity
+talk about “prefix commands” in this manual, then we mean our own kind
+of “prefix commands”, unless specified otherwise. To avoid ambiguity
we sometimes use the terms @dfn{transient prefix command} for our kind and
-``regular prefix command'' for the Emacs' kind.
+“regular prefix command” for Emacs' kind.
@end quotation
@@ -208,7 +208,7 @@ looks a bit like this:
@quotation
This is a simplified version of @code{magit-tag}. Info manuals do not
-support images or colored text, so the above ``screenshot'' lacks some
+support images or colored text, so the above “screenshot” lacks some
information; in practice you would be able to tell whether the
arguments @code{--force} and @code{--annotate} are enabled or not based on
their
color.
@@ -216,11 +216,11 @@ color.
@end quotation
@cindex command dispatchers
-Transient can be used to implement simple ``command dispatchers''. The
+Transient can be used to implement simple “command dispatchers”. The
main benefit then is that the user can see all the available commands
in a popup buffer. That is useful by itself because it frees the user
from having to remember all the keys that are valid after a certain
-prefix key or command. Magit's @code{magit-dispatch} (on @code{C-x M-g})
command is
+prefix key or command. Magit's @code{magit-dispatch} (on @kbd{C-x M-g})
command is
an example of using Transient to merely implement a command
dispatcher.
@@ -235,22 +235,22 @@ argument means to a certain command.
Transient suffix commands, on the other hand, can accept dozens of
different arguments without the user having to remember anything.
-When using Transient, one can call a command with arguments that
-are just as complex as when calling the same function non-interactively
+When using Transient, one can call a command with arguments that are
+just as complex as when calling the same function non-interactively
from Lisp.
Invoking a transient command with arguments is similar to invoking a
command in a shell with command-line completion and history enabled.
One benefit of the Transient interface is that it remembers history
-not only on a global level (``this command was invoked using these
-arguments, and previously it was invoked using those other arguments''),
+not only on a global level (“this command was invoked using these
+arguments, and previously it was invoked using those other arguments”),
but also remembers the values of individual arguments independently.
@xref{Using History}.
-After a transient prefix command is invoked, @kbd{C-h @var{key}} can be used to
-show the documentation for the infix or suffix command that @kbd{@var{key}} is
+After a transient prefix command is invoked, @kbd{C-h @var{KEY}} can be used to
+show the documentation for the infix or suffix command that @kbd{@var{KEY}} is
bound to (@pxref{Getting Help for Suffix Commands}), and infixes and
-suffixes can be removed from the transient using @kbd{C-x l @var{key}}.
Infixes
+suffixes can be removed from the transient using @kbd{C-x l @var{KEY}}.
Infixes
and suffixes that are disabled by default can be enabled the same way.
@xref{Enabling and Disabling Suffixes}.
@@ -273,11 +273,12 @@ to implementing yet).
* Getting Help for Suffix Commands::
* Enabling and Disabling Suffixes::
* Other Commands::
-* Other Options::
+* Configuration::
@end menu
@node Invoking Transients
@section Invoking Transients
+
@cindex invoking transients
A transient prefix command is invoked like any other command by
@@ -290,9 +291,9 @@ disabled while the transient state is in effect.
There are two kinds of commands that are available after invoking a
transient prefix command; infix and suffix commands. Infix commands
set some value (which is then shown in a popup buffer), without
-leaving the transient. Suffix commands, on the other hand, usually quit
-the transient and they may use the values set by the infix commands,
-i.e.@: the infix @strong{arguments}.
+leaving the transient. Suffix commands, on the other hand, usually
+quit the transient and they may use the values set by the infix
+commands, i.e., the infix @strong{arguments}.
Instead of setting arguments to be used by a suffix command, infix
commands may also set some value by side-effect, e.g., by setting the
@@ -300,11 +301,12 @@ value of some variable.
@node Aborting and Resuming Transients
@section Aborting and Resuming Transients
+
@cindex aborting transients
@cindex resuming transients
@cindex quit transient
-To quit the transient without invoking a suffix command press @code{C-g}.
+To quit the transient without invoking a suffix command press @kbd{C-g}.
Key bindings in transient keymaps may be longer than a single event.
After pressing a valid prefix key, all commands whose bindings do not
@@ -314,7 +316,7 @@ prefix key, but not the complete transient).
A transient prefix command can be bound as a suffix of another
transient. Invoking such a suffix replaces the current transient
-state with a new transient state, i.e.@: the available bindings change
+state with a new transient state, i.e., the available bindings change
and the information displayed in the popup buffer is updated
accordingly. Pressing @kbd{C-g} while a nested transient is active only
quits the innermost transient, causing a return to the previous
@@ -325,13 +327,12 @@ the latter, then you can later resume the stack of
transients using
@kbd{M-x transient-resume}.
@table @asis
+@item @kbd{C-g} (@code{transient-quit-seq})
+@itemx @kbd{C-g} (@code{transient-quit-one})
@kindex C-g
-@findex transient-quit-seq
-@item @kbd{C-g} @tie{}@tie{}@tie{}@tie{}(@code{transient-quit-seq})
@kindex C-g
+@findex transient-quit-seq
@findex transient-quit-one
-@item @kbd{C-g} @tie{}@tie{}@tie{}@tie{}(@code{transient-quit-one})
-
This key quits the currently active incomplete key sequence, if any,
or else the current transient. When quitting the current transient,
it returns to the previous transient, if any.
@@ -342,22 +343,20 @@ To learn how to get that binding back see
@code{transient-bind-q-to-quit}'s
doc string.
@table @asis
+@item @kbd{C-q} (@code{transient-quit-all})
@kindex C-q
@findex transient-quit-all
-@item @kbd{C-q} @tie{}@tie{}@tie{}@tie{}(@code{transient-quit-all})
-
This command quits the currently active incomplete key sequence, if
any, and all transients, including the active transient and all
suspended transients, if any.
+@item @kbd{C-z} (@code{transient-suspend})
@kindex C-z
@findex transient-suspend
-@item @kbd{C-z} @tie{}@tie{}@tie{}@tie{}(@code{transient-suspend})
-
Like @code{transient-quit-all}, this command quits an incomplete key
sequence, if any, and all transients. Additionally, it saves the
stack of transients so that it can easily be resumed (which is
-particularly useful if you quickly need to do ``something else'', and
+particularly useful if you quickly need to do “something else” and
the stack is deeper than a single transient, and/or you have already
changed the values of some infix arguments).
@@ -365,43 +364,39 @@ Note that only a single stack of transients can be saved
at a time.
If another stack is already saved, then saving a new stack discards
the previous stack.
-@kindex M-x transient-resume
+@item @kbd{M-x transient-resume}
@findex transient-resume
-@item @kbd{M-x transient-resume}
@tie{}@tie{}@tie{}@tie{}(@code{transient-resume})
-
This command resumes the previously suspended stack of transients,
if any.
@end table
@node Common Suffix Commands
@section Common Suffix Commands
+
@cindex common suffix commands
A few shared suffix commands are available in all transients. These
suffix commands are not shown in the popup buffer by default.
-This includes the aborting commands mentioned in the previous section, as
-well as some other commands that are all bound to @kbd{C-x @var{key}}. After
+This includes the aborting commands mentioned in the previous section,
+as well as some other commands that are all bound to @kbd{C-x @var{KEY}}.
After
@kbd{C-x} is pressed, a section featuring all these common commands is
temporarily shown in the popup buffer. After invoking one of them,
-the section disappears again. Note, however, that one of these commands
-is described as ``Show common permanently''; invoke that if you want the
-common commands to always be shown for all transients.
+the section disappears again. Note, however, that one of these
+commands is described as “Show common permanently”; invoke that if you
+want the common commands to always be shown for all transients.
@table @asis
+@item @kbd{C-x t} (@code{transient-toggle-common})
@kindex C-x t
@findex transient-toggle-common
-@item @kbd{C-x t} @tie{}@tie{}@tie{}@tie{}(@code{transient-toggle-common})
-
This command toggles whether the generic commands that are common to
all transients are always displayed or only after typing the
incomplete prefix key sequence @kbd{C-x}. This only affects the current
Emacs session.
-
@end table
@defopt transient-show-common-commands
-
This option controls whether shared suffix commands are shown
alongside the transient-specific infix and suffix commands. By
default, the shared commands are not shown to avoid overwhelming
@@ -412,14 +407,15 @@ commands. The value of this option can be changed for
the current
Emacs session by typing @kbd{C-x t} while a transient is active.
@end defopt
-The other common commands are described in either the previous or
-in one of the following sections.
+The other common commands are described in either the previous or in
+one of the following sections.
Some of Transient's key bindings differ from the respective bindings
of Magit-Popup; see @ref{FAQ} for more information.
@node Saving Values
@section Saving Values
+
@cindex saving values of arguments
After setting the infix arguments in a transient, the user can save
@@ -429,8 +425,7 @@ Most transients will start out with the saved arguments
when they are
invoked. There are a few exceptions, though. Some transients are
designed so that the value that they use is stored externally as the
buffer-local value of some variable. Invoking such a transient again
-uses the buffer-local value.@footnote{
-@code{magit-diff} and @code{magit-log} are two prominent examples, and their
+uses the buffer-local value. @footnote{@code{magit-diff} and @code{magit-log}
are two prominent examples, and their
handling of buffer-local values is actually a bit more complicated
than outlined above and even customizable.}
@@ -440,30 +435,32 @@ history. That value won't be used when the transient is
next invoked,
but it is easily accessible (@pxref{Using History}).
@table @asis
+@item @kbd{C-x s} (@code{transient-set})
@kindex C-x s
@findex transient-set
-@item @kbd{C-x s} @tie{}@tie{}@tie{}@tie{}(@code{transient-set})
-
This command saves the value of the active transient for this Emacs
session.
+@item @kbd{C-x C-s} (@code{transient-save})
@kindex C-x C-s
@findex transient-save
-@item @kbd{C-x C-s} @tie{}@tie{}@tie{}@tie{}(@code{transient-save})
-
Save the value of the active transient persistently across Emacs
sessions.
+@item @kbd{C-x C-k} (@code{transient-save})
+@kindex C-x C-k
+@findex transient-save
+Clear the set and saved value of the active transient.
@end table
@defopt transient-values-file
-
This option names the file that is used to persist the values of
transients between Emacs sessions.
@end defopt
@node Using History
@section Using History
+
@cindex value history
Every time the user invokes a suffix command the transient's current
@@ -472,32 +469,28 @@ same way one can cycle through the history of commands
that read
user-input in the minibuffer.
@table @asis
+@item @kbd{C-M-p} (@code{transient-history-prev})
+@itemx @kbd{C-x p}
@kindex C-M-p
-@findex transient-history-prev
-@item @kbd{C-M-p} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-prev})
@kindex C-x p
@findex transient-history-prev
-@item @kbd{C-x p} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-prev})
-
This command switches to the previous value used for the active
transient.
+@item @kbd{C-M-n} (@code{transient-history-next})
+@itemx @kbd{C-x n}
@kindex C-M-n
-@findex transient-history-next
-@item @kbd{C-M-n} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-next})
@kindex C-x n
@findex transient-history-next
-@item @kbd{C-x n} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-next})
-
This command switches to the next value used for the active
transient.
@end table
In addition to the transient-wide history, Transient of course
supports per-infix history. When an infix reads user-input using the
-minibuffer, the user can use the regular minibuffer history
-commands to cycle through previously used values. Usually the same
-keys as those mentioned above are bound to those commands.
+minibuffer, the user can use the regular minibuffer history commands
+to cycle through previously used values. Usually the same keys as
+those mentioned above are bound to those commands.
Authors of transients should arrange for different infix commands that
read the same kind of value to also use the same history key
@@ -506,19 +499,18 @@ read the same kind of value to also use the same history
key
Both kinds of history are saved to a file when Emacs is exited.
@defopt transient-history-file
-
This option names the file that is used to persist the history of
transients and their infixes between Emacs sessions.
@end defopt
@defopt transient-history-limit
-
This option controls how many history elements are kept at the time
the history is saved in @code{transient-history-file}.
@end defopt
@node Getting Help for Suffix Commands
@section Getting Help for Suffix Commands
+
@cindex getting help
Transients can have many suffixes and infixes that the user might not
@@ -527,14 +519,13 @@ provides access to the documentation directly from the
active
transient.
@table @asis
+@item @kbd{C-h} (@code{transient-help})
@kindex C-h
@findex transient-help
-@item @kbd{C-h} @tie{}@tie{}@tie{}@tie{}(@code{transient-help})
-
-This command enters help mode. When help mode is active,
-typing a key shows information about the suffix command that the key
-is normally bound to (instead of invoking it). Pressing @kbd{C-h} a
-second time shows information about the @emph{prefix} command.
+This command enters help mode. When help mode is active, typing a
+key shows information about the suffix command that the key normally
+is bound to (instead of invoking it). Pressing @kbd{C-h} a second time
+shows information about the @emph{prefix} command.
After typing a key, the stack of transient states is suspended and
information about the suffix command is shown instead. Typing @kbd{q} in
@@ -550,6 +541,7 @@ non-infix suffixes this is usually appropriate.
@node Enabling and Disabling Suffixes
@section Enabling and Disabling Suffixes
+
@cindex enabling suffixes
@cindex disabling suffixes
@@ -571,7 +563,7 @@ displayed at any level.
The levels of individual transients and/or their individual suffixes
can be changed interactively, by invoking the transient and then
-pressing @kbd{C-x l} to enter the ``edit'' mode, see below.
+pressing @kbd{C-x l} to enter the “edit” mode, see below.
The default level for both transients and their suffixes is 4. The
@code{transient-default-level} option only controls the default for
@@ -582,23 +574,20 @@ very important suffixes on a lower level, so that they
remain
available even if the user lowers the transient level.
@defopt transient-default-level
-
This option controls which suffix levels are made available by
default. It sets the transient-level for transients for which the
user has not set that individually.
@end defopt
@defopt transient-levels-file
-
This option names the file that is used to persist the levels of
transients and their suffixes between Emacs sessions.
@end defopt
@table @asis
+@item @kbd{C-x l} (@code{transient-set-level})
@kindex C-x l
@findex transient-set-level
-@item @kbd{C-x l} @tie{}@tie{}@tie{}@tie{}(@code{transient-set-level})
-
This command enters edit mode. When edit mode is active, then all
infixes and suffixes that are currently usable are displayed along
with their levels. The colors of the levels indicate whether they
@@ -616,9 +605,9 @@ To change the transient level press @kbd{C-x l} again.
To exit edit mode press @kbd{C-g}.
Note that edit mode does not display any suffixes that are not
-currently usable. @code{magit-rebase}, for example, shows different suffixes
-depending on whether a rebase is already in progress or not. The
-predicates also apply in edit mode.
+currently usable. @code{magit-rebase}, for example, shows different
+suffixes depending on whether a rebase is already in progress or
+not. The predicates also apply in edit mode.
Therefore, to control which suffixes are available given a certain
state, you have to make sure that that state is currently active.
@@ -633,27 +622,29 @@ following commands. These commands are never shown in
the transient
window, and the key bindings are the same as for @code{scroll-up-command} and
@code{scroll-down-command} in other buffers.
-@findex transient-scroll-up arg
@deffn Command transient-scroll-up arg
-
-This command scrolls text of transient popup window upward @var{arg}
-lines. If @var{arg} is @code{nil}, then it scrolls near full screen. This
+This command scrolls text of transient popup window upward @var{ARG}
+lines. If @var{ARG} is @code{nil}, then it scrolls near full screen. This
is a wrapper around @code{scroll-up-command} (which see).
@end deffn
-@findex transient-scroll-down arg
@deffn Command transient-scroll-down arg
-
-This command scrolls text of transient popup window down @var{arg}
-lines. If @var{arg} is @code{nil}, then it scrolls near full screen. This
+This command scrolls text of transient popup window down @var{ARG}
+lines. If @var{ARG} is @code{nil}, then it scrolls near full screen. This
is a wrapper around @code{scroll-down-command} (which see).
@end deffn
-@node Other Options
-@section Other Options
+@node Configuration
+@section Configuration
-@defopt transient-show-popup
+More options are described in @ref{Common Suffix Commands}, in @ref{Saving
Values}, in @ref{Using History} and in @ref{Enabling and Disabling Suffixes}.
+
+@anchor{Essential Options}
+@subheading Essential Options
+
+Also see @ref{Common Suffix Commands}.
+@defopt transient-show-popup
This option controls whether the current transient's infix and
suffix commands are shown in the popup buffer.
@@ -662,13 +653,11 @@ suffix commands are shown in the popup buffer.
If @code{t} (the default) then the popup buffer is shown as soon as a
transient prefix command is invoked.
-
@item
If @code{nil}, then the popup buffer is not shown unless the user
explicitly requests it, by pressing an incomplete prefix key
sequence.
-
@item
If a number, then the a brief one-line summary is shown instead of
the popup buffer. If zero or negative, then not even that summary
@@ -676,45 +665,43 @@ is shown; only the pressed key itself is shown.
The popup is shown when the user explicitly requests it by
pressing an incomplete prefix key sequence. Unless this is zero,
-the popup is shown after that many seconds of inactivity
-(using the absolute value).
+the popup is shown after that many seconds of inactivity (using
+the absolute value).
@end itemize
@end defopt
@defopt transient-enable-popup-navigation
-
This option controls whether navigation commands are enabled in the
transient popup buffer.
While a transient is active the transient popup buffer is not the
current buffer, making it necessary to use dedicated commands to act
on that buffer itself. This is disabled by default. If this option
-is non-nil, then the following features are available:
+is non-@code{nil}, then the following features are available:
@itemize
@item
-@key{UP} moves the cursor to the previous suffix.
-@key{DOWN} moves the cursor to the next suffix.
-@key{RET} invokes the suffix the cursor is on.
-
+@kbd{@key{UP}} moves the cursor to the previous suffix.
@item
-@key{mouse-1} invokes the clicked on suffix.
-
+@kbd{@key{DOWN}} moves the cursor to the next suffix.
+@item
+@kbd{@key{RET}} invokes the suffix the cursor is on.
+@item
+@kbd{mouse-1} invokes the clicked on suffix.
@item
@kbd{C-s} and @kbd{C-r} start isearch in the popup buffer.
@end itemize
@end defopt
@defopt transient-display-buffer-action
-
This option specifies the action used to display the transient popup
buffer. The transient popup buffer is displayed in a window using
-@code{(display-buffer @var{buffer} transient-display-buffer-action)}.
+@code{(display-buffer @var{BUFFER} transient-display-buffer-action)}.
-The value of this option has the form @code{(@var{function} . @var{alist})},
-where @var{function} is a function or a list of functions. Each such
+The value of this option has the form @code{(@var{FUNCTION} . @var{ALIST})},
+where @var{FUNCTION} is a function or a list of functions. Each such
function should accept two arguments: a buffer to display and an
-alist of the same form as @var{alist}. @xref{Choosing Window,,,elisp,},
+alist of the same form as @var{ALIST}. @xref{Choosing Window,,,elisp,},
for details.
The default is:
@@ -727,7 +714,7 @@ The default is:
@end lisp
This displays the window at the bottom of the selected frame.
-Another useful @var{function} is @code{display-buffer-below-selected}, which
+Another useful @var{FUNCTION} is @code{display-buffer-below-selected}, which
is what @code{magit-popup} used by default. For more alternatives see
@ref{Buffer Display Action Functions,,,elisp,}, and see @ref{Buffer Display
Action Alists,,,elisp,}.
@@ -748,8 +735,20 @@ If you change the value of this option, then you might also
want to change the value of @code{transient-mode-line-format}.
@end defopt
-@defopt transient-mode-line-format
+@anchor{Accessibility Options}
+@subheading Accessibility Options
+
+@defopt transient-force-single-column
+This option controls whether the use of a single column to display
+suffixes is enforced. This might be useful for users with low
+vision who use large text and might otherwise have to scroll in two
+dimensions.
+@end defopt
+
+@anchor{Auxiliary Options}
+@subheading Auxiliary Options
+@defopt transient-mode-line-format
This option controls whether the transient popup buffer has a
mode-line, separator line, or neither.
@@ -759,23 +758,28 @@ good value.
If @code{line} (the default), then the buffer also has no mode-line, but a
thin line is drawn instead, using the background color of the face
-@code{transient-separator}. Text-mode frames cannot display thin lines, and
-therefore fall back to treating @code{line} like @code{nil}.
+@code{transient-separator}. Text-mode frames cannot display thin lines,
+and therefore fall back to treating @code{line} like @code{nil}.
Otherwise this can be any mode-line format. @xref{Mode Line
Format,,,elisp,}, for details.
@end defopt
-@defopt transient-read-with-initial-input
+@defopt transient-semantic-coloring
+This option controls whether prefixes and suffixes are colored in
+a Hydra-like fashion.
-This option controls whether the last history element is used as the
-initial minibuffer input when reading the value of an infix argument
-from the user. If @code{nil}, there is no initial input and the first
-element has to be accessed the same way as the older elements.
+If non-@code{nil}, then the key binding of each suffix is colorized to
+indicate whether it exits the transient state or not. The color of
+the prefix is indicated using the line that is drawn when the value
+of @code{transient-mode-line-format} is @code{line}.
+
+For more information about how Hydra uses colors see
+@uref{https://github.com/abo-abo/hydra#color} and
+@uref{https://oremacs.com/2015/02/19/hydra-colors-reloaded}.
@end defopt
@defopt transient-highlight-mismatched-keys
-
This option controls whether key bindings of infix commands that do
not match the respective command-line argument should be highlighted.
For other infix commands this option has no effect.
@@ -795,7 +799,6 @@ The highlighting is done using one of the faces
@end defopt
@defopt transient-substitute-key-function
-
This function is used to modify key bindings. If the value of this
option is @code{nil} (the default), then no substitution is performed.
@@ -819,14 +822,52 @@ optimized for lisp.
@end lisp
@end defopt
-@defopt transient-detect-key-conflicts
+@defopt transient-read-with-initial-input
+This option controls whether the last history element is used as the
+initial minibuffer input when reading the value of an infix argument
+from the user. If @code{nil}, there is no initial input and the first
+element has to be accessed the same way as the older elements.
+@end defopt
+
+@defopt transient-hide-during-minibuffer-read
+This option controls whether the transient buffer is hidden while
+user input is being read in the minibuffer.
+@end defopt
+
+@defopt transient-align-variable-pitch
+This option controls whether columns are aligned pixel-wise in the
+popup buffer.
+
+If this is non-@code{nil}, then columns are aligned pixel-wise to support
+variable-pitch fonts. Keys are not aligned, so you should use a
+fixed-pitch font for the @code{transient-key} face. Other key faces
+inherit from that face unless a theme is used that breaks that
+relationship.
+
+This option is intended for users who use a variable-pitch font for
+the @code{default} face.
+@end defopt
+
+@defopt transient-force-fixed-pitch
+This option controls whether to force the use of a monospaced font
+in popup buffer. Even if you use a proportional font for the
+@code{default} face, you might still want to use a monospaced font in
+transient's popup buffer. Setting this option to @code{t} causes
@code{default}
+to be remapped to @code{fixed-pitch} in that buffer.
+@end defopt
+
+@anchor{Developer Options}
+@subheading Developer Options
+These options are mainly intended for developers.
+
+@defopt transient-detect-key-conflicts
This option controls whether key binding conflicts should be
-detected at the time the transient is invoked. If so, this
-results in an error, which prevents the transient from being used.
-Because of that, conflicts are ignored by default.
+detected at the time the transient is invoked. If so, this results
+in an error, which prevents the transient from being used. Because
+of that, conflicts are ignored by default.
-Conflicts cannot be determined earlier, i.e.@: when the transient is
+Conflicts cannot be determined earlier, i.e., when the transient is
being defined and when new suffixes are being added, because at that
time there can be false-positives. It is actually valid for
multiple suffixes to share a common key binding, provided the
@@ -834,48 +875,51 @@ predicates of those suffixes prevent that more than one
of them is
enabled at a time.
@end defopt
-@defopt transient-force-fixed-pitch
+@defopt transient-highlight-higher-levels
+This option controls whether suffixes that would not be available by
+default are highlighted.
-This option controls whether to force the use of a monospaced font
-in popup buffer. Even if you use a proportional font for the
-@code{default} face, you might still want to use a monospaced font in
-transient's popup buffer. Setting this option to @code{t} causes
@code{default}
-to be remapped to @code{fixed-pitch} in that buffer.
+When non-@code{nil} then the descriptions of suffixes are highlighted if
+their level is above 4, the default of @code{transient-default-level}.
+Assuming you have set that variable to 7, this highlights all
+suffixes that won't be available to users without them making the
+same customization.
@end defopt
@node Modifying Existing Transients
@chapter Modifying Existing Transients
+
@cindex modifying existing transients
-To an extent, transients can be customized interactively, see @ref{Enabling
and Disabling Suffixes}. This section explains how existing transients
-can be further modified non-interactively.
+To an extent, transients can be customized interactively, see
+@ref{Enabling and Disabling Suffixes}. This section explains how existing
+transients can be further modified non-interactively.
The following functions share a few arguments:
@itemize
@item
-@var{prefix} is a transient prefix command, a symbol.
-
+@var{PREFIX} is a transient prefix command, a symbol.
@item
-@var{suffix} is a transient infix or suffix specification in the same form
+@var{SUFFIX} is a transient infix or suffix specification in the same form
as expected by @code{transient-define-prefix}. Note that an infix is a
-special kind of suffix. Depending on context ``suffixes'' means
-``suffixes (including infixes)'' or ``non-infix suffixes''. Here it
+special kind of suffix. Depending on context “suffixes” means
+“suffixes (including infixes)” or “non-infix suffixes”. Here it
means the former. @xref{Suffix Specifications}.
-@var{suffix} may also be a group in the same form as expected by
+@var{SUFFIX} may also be a group in the same form as expected by
@code{transient-define-prefix}. @xref{Group Specifications}.
@item
-@var{loc} is a command, a key vector, a key description (a string as
+@var{LOC} is a command, a key vector, a key description (a string as
returned by @code{key-description}), or a list specifying coordinates (the
last element may also be a command or key). For example @code{(1 0 -1)}
identifies the last suffix (@code{-1}) of the first subgroup (@code{0}) of the
second group (@code{1}).
-If @var{loc} is a list of coordinates, then it can be used to identify a
+If @var{LOC} is a list of coordinates, then it can be used to identify a
group, not just an individual suffix command.
The function @code{transient-get-suffix} can be useful to determine whether
@@ -885,55 +929,53 @@ at the definition of the transient prefix command.
@end itemize
These functions operate on the information stored in the
-@code{transient--layout} property of the @var{prefix} symbol. Suffix entries
in
-that tree are not objects but have the form @code{(@var{level}
-@var{class} @var{plist})}, where
-@var{plist} should set at least @code{:key}, @code{:description} and
-@code{:command}.
-
-@defun transient-insert-suffix prefix loc suffix
+@code{transient--layout} property of the @var{PREFIX} symbol. Suffix entries
in
+that tree are not objects but have the form @code{(@var{LEVEL} @var{CLASS}
@var{PLIST})}, where
+@var{PLIST} should set at least @code{:key}, @code{:description} and
@code{:command}.
-This function inserts suffix or group @var{suffix} into @var{prefix}
-before @var{loc}.
+@defun transient-insert-suffix prefix loc suffix &optional keep-other
@end defun
-
-@defun transient-append-suffix prefix loc suffix
-
-This function inserts suffix or group @var{suffix} into @var{prefix}
-after @var{loc}.
+@defun transient-append-suffix prefix loc suffix &optional keep-other
+These functions insert the suffix or group @var{SUFFIX} into @var{PREFIX}
before
+or after @var{LOC}.
+
+Conceptually adding a binding to a transient prefix is similar to
+adding a binding to a keymap, but this is complicated by the fact
+that multiple suffix commands can be bound to the same key, provided
+they are never active at the same time, see @ref{Predicate Slots}.
+
+Unfortunately both false-positives and false-negatives are possible.
+To deal with the former use non-nil @var{KEEP-OTHER@.} To deal with the
+latter remove the conflicting binding explicitly.
@end defun
@defun transient-replace-suffix prefix loc suffix
-
-This function replaces the suffix or group at @var{loc} in @var{prefix} with
-suffix or group @var{suffix}.
+This function replaces the suffix or group at @var{LOC} in @var{PREFIX} with
+suffix or group @var{SUFFIX}.
@end defun
@defun transient-remove-suffix prefix loc
-
-This function removes the suffix or group at @var{loc} in @var{prefix}.
+This function removes the suffix or group at @var{LOC} in @var{PREFIX}.
@end defun
@defun transient-get-suffix prefix loc
-
-This function returns the suffix or group at @var{loc} in @var{prefix}. The
+This function returns the suffix or group at @var{LOC} in @var{PREFIX}. The
returned value has the form mentioned above.
@end defun
@defun transient-suffix-put prefix loc prop value
-
-This function edits the suffix or group at @var{loc} in @var{prefix},
-by setting the @var{prop} of its plist to @var{value}.
+This function edits the suffix or group at @var{LOC} in @var{PREFIX}, by
setting
+the @var{PROP} of its plist to @var{VALUE}.
@end defun
Most of these functions do not signal an error if they cannot perform
the requested modification. The functions that insert new suffixes
-show a warning if @var{loc} cannot be found in @var{prefix}, without
-signaling an error. The reason for doing it like this is that
-establishing a key binding (and that is what we essentially are trying
-to do here) should not prevent the rest of the configuration from
-loading. Among these functions only @code{transient-get-suffix} and
-@code{transient-suffix-put} may signal an error.
+show a warning if @var{LOC} cannot be found in @var{PREFIX} without signaling
an
+error. The reason for doing it like this is that establishing a key
+binding (and that is what we essentially are trying to do here) should
+not prevent the rest of the configuration from loading. Among these
+functions only @code{transient-get-suffix} and @code{transient-suffix-put} may
+signal an error.
@node Defining New Commands
@chapter Defining New Commands
@@ -957,12 +999,11 @@ defines the complete transient, not just the transient
prefix command
that is used to invoke that transient.
@defmac transient-define-prefix name arglist [docstring] [keyword
value]@dots{} group@dots{} [body@dots{}]
-
-This macro defines @var{name} as a transient prefix command and binds the
+This macro defines @var{NAME} as a transient prefix command and binds the
transient's infix and suffix commands.
-@var{arglist} are the arguments that the prefix command takes.
-@var{docstring} is the documentation string and is optional.
+@var{ARGLIST} are the arguments that the prefix command takes.
+@var{DOCSTRING} is the documentation string and is optional.
These arguments can optionally be followed by keyword-value pairs.
Each key has to be a keyword symbol, either @code{:class} or a keyword
@@ -970,11 +1011,11 @@ argument supported by the constructor of that class. The
@code{transient-prefix} class is used if the class is not specified
explicitly.
-@var{group}s add key bindings for infix and suffix commands and specify
+@var{GROUP}s add key bindings for infix and suffix commands and specify
how these bindings are presented in the popup buffer. At least one
-@var{group} has to be specified. @xref{Binding Suffix and Infix Commands}.
+@var{GROUP} has to be specified. @xref{Binding Suffix and Infix Commands}.
-The @var{body} is optional. If it is omitted, then @var{arglist} is ignored
and
+The @var{BODY} is optional. If it is omitted, then @var{ARGLIST} is ignored
and
the function definition becomes:
@lisp
@@ -983,15 +1024,15 @@ the function definition becomes:
(transient-setup 'NAME))
@end lisp
-If @var{body} is specified, then it must begin with an @code{interactive} form
-that matches @var{arglist}, and it must call @code{transient-setup}. It may,
+If @var{BODY} is specified, then it must begin with an @code{interactive} form
+that matches @var{ARGLIST}, and it must call @code{transient-setup}. It may,
however, call that function only when some condition is satisfied.
@cindex scope of a transient
All transients have a (possibly @code{nil}) value, which is exported when
suffix commands are called, so that they can consume that value.
For some transients it might be necessary to have a sort of
-secondary value, called a ``scope''. Such a scope would usually be
+secondary value, called a “scope”. Such a scope would usually be
set in the command's @code{interactive} form and has to be passed to the
setup function:
@@ -1013,8 +1054,8 @@ described below.
Users and third-party packages can add additional bindings using
functions such as @code{transient-insert-suffix} (@pxref{Modifying
-Existing Transients}). These functions take a ``suffix
-specification'' as one of their arguments, which has the same form as
+Existing Transients}). These functions take a “suffix
+specification” as one of their arguments, which has the same form as
the specifications used in @code{transient-define-prefix}.
@menu
@@ -1024,6 +1065,7 @@ the specifications used in @code{transient-define-prefix}.
@node Group Specifications
@subsection Group Specifications
+
@cindex group specifications
The suffix and infix commands of a transient are organized in groups.
@@ -1043,39 +1085,39 @@ brackets to do the latter.
Group specifications then have this form:
@lisp
-[@{@var{level}@} @{@var{description}@}
- @{@var{keyword} @var{value}@}...
- @var{element}...]
+[@{@var{LEVEL}@} @{@var{DESCRIPTION}@}
+ @{@var{KEYWORD} @var{VALUE}@}...
+ @var{ELEMENT}...]
@end lisp
-The @var{level} is optional and defaults to 4. @xref{Enabling and
+The @var{LEVEL} is optional and defaults to 4. @xref{Enabling and
Disabling Suffixes}.
-The @var{description} is optional. If present, it is used as the heading of
+The @var{DESCRIPTION} is optional. If present, it is used as the heading of
the group.
-The @var{keyword}-@var{value} pairs are optional. Each keyword has to be a
+The @var{KEYWORD}-@var{VALUE} pairs are optional. Each keyword has to be a
keyword symbol, either @code{:class} or a keyword argument supported by the
constructor of that class.
@itemize
@item
One of these keywords, @code{:description}, is equivalent to specifying
-@var{description} at the very beginning of the vector. The recommendation
+@var{DESCRIPTION} at the very beginning of the vector. The recommendation
is to use @code{:description} if some other keyword is also used, for
-consistency, or @var{description} otherwise, because it looks better.
+consistency, or @var{DESCRIPTION} otherwise, because it looks better.
@item
-Likewise @code{:level} is equivalent to @var{level}.
+Likewise @code{:level} is equivalent to @var{LEVEL}.
@item
Other important keywords include the @code{:if...} keywords. These
keywords control whether the group is available in a certain
situation.
-For example, one group of the @code{magit-rebase} transient uses
-@code{:if magit-rebase-in-progress-p}, which contains the suffixes
-that are useful while rebase is already in progress; and another that uses
+For example, one group of the @code{magit-rebase} transient uses @code{:if
+ magit-rebase-in-progress-p}, which contains the suffixes that are
+useful while rebase is already in progress; and another that uses
@code{:if-not magit-rebase-in-progress-p}, which contains the suffixes that
initiate a rebase.
@@ -1096,9 +1138,9 @@ suffixes, which assumes that a predicate like this is
used:
@end lisp
@item
-The value of @code{:setup-children}, if non-@code{nil}, is a function
-that takes two arguments the group object itself and a list of children.
-The children are given as a, potentially empty, list consisting
+The value of @code{:setup-children}, if non-@code{nil}, is a function that
takes
+two arguments the group object itself and a list of children.
+The children are given as a (potentially empty) list consisting
of either group or suffix specifications. It can make arbitrary
changes to the children including constructing new children from
scratch. Also see @code{transient-setup-children}.
@@ -1109,21 +1151,21 @@ contained in a group are right padded, effectively
aligning the
descriptions.
@end itemize
-The @var{element}s are either all subgroups (vectors), or all suffixes
+The @var{ELEMENT}s are either all subgroups (vectors), or all suffixes
(lists) and strings. (At least currently no group type exists that
would allow mixing subgroups with commands at the same level, though
in principle there is nothing that prevents that.)
-If the @var{element}s are not subgroups, then they can be a mixture of lists
+If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists
that specify commands and strings. Strings are inserted verbatim.
The empty string can be used to insert gaps between suffixes, which is
particularly useful if the suffixes are outlined as a table.
Variables are supported inside group specifications. For example in
place of a direct subgroup specification, a variable can be used whose
-value is a vector that qualifies as a group specification. Likewise, a
-variable can be used where a suffix specification is expected. Lists
-of group or suffix specifications are also supported. Indirect
+value is a vector that qualifies as a group specification. Likewise,
+a variable can be used where a suffix specification is expected.
+Lists of group or suffix specifications are also supported. Indirect
specifications are resolved when the transient prefix is being
defined.
@@ -1131,6 +1173,7 @@ The form of suffix specifications is documented in the
next node.
@node Suffix Specifications
@subsection Suffix Specifications
+
@cindex suffix specifications
A transient's suffix and infix commands are bound when the transient
@@ -1140,37 +1183,36 @@ prefix command is defined using
@code{transient-define-prefix}, see
individual suffix command.
The same form is also used when later binding additional commands
-using functions such as @code{transient-insert-suffix},
-see @ref{Modifying Existing Transients}.
+using functions such as @code{transient-insert-suffix}, see @ref{Modifying
Existing Transients}.
-Note that an infix is a special kind of suffix. Depending on context
-``suffixes'' means ``suffixes (including infixes)'' or ``non-infix
-suffixes''. Here it means the former.
+Note that an infix is a special kind of suffix. Depending on context
+“suffixes” means “suffixes (including infixes)” or “non-infix
+suffixes”. Here it means the former.
Suffix specifications have this form:
@lisp
-([@var{level}]
- [@var{key}] [@var{description}]
- @var{command}|@var{argument} [@var{keyword} @var{value}]...)
+([@var{LEVEL}]
+ [@var{KEY}] [@var{DESCRIPTION}]
+ @var{COMMAND}|@var{ARGUMENT} [@var{KEYWORD} @var{VALUE}]...)
@end lisp
-@var{level}, @var{key} and @var{description} can also be specified using the
@var{keyword}s
+@var{LEVEL}, @var{KEY} and @var{DESCRIPTION} can also be specified using the
@var{KEYWORD}s
@code{:level}, @code{:key} and @code{:description}. If the object that is
associated with
-@var{command} sets these properties, then they do not have to be specified
+@var{COMMAND} sets these properties, then they do not have to be specified
here. You can however specify them here anyway, possibly overriding
the object's values just for the binding inside this transient.
@itemize
@item
-@var{level} is the suffix level, an integer between 1 and 7.
+@var{LEVEL} is the suffix level, an integer between 1 and 7.
@xref{Enabling and Disabling Suffixes}.
@item
-@var{key} is the key binding, either a vector or key description string.
+@var{KEY} is the key binding, either a vector or key description string.
@item
-@var{description} is the description, either a string or a function that
+@var{DESCRIPTION} is the description, either a string or a function that
returns a string. The function should be a lambda expression to
avoid ambiguity. In some cases a symbol that is bound as a function
would also work but to be safe you should use @code{:description} in that
@@ -1182,7 +1224,7 @@ argument that is mandatory in all cases.
@itemize
@item
-Usually @var{command} is a symbol that is bound as a function, which has
+@var{COMMAND} should be a symbol that is bound as a function, which has
to be defined or at least autoloaded as a command by the time the
containing prefix command is invoked.
@@ -1190,15 +1232,13 @@ Any command will do; it does not need to have an object
associated
with it (as would be the case if @code{transient-define-suffix} or
@code{transient-define-infix} were used to define it).
-The command can also be a closure or lambda expression, but that
-should only be used for dynamic transients whose suffixes are
-defined when the prefix command is invoked. See information about
-the @code{:setup-children} function in @ref{Group Specifications}.
+Anonymous, dynamically defined suffix commands are also support.
+See information about the @code{:setup-children} function in @ref{Group
Specifications}.
As mentioned above, the object that is associated with a command can
be used to set the default for certain values that otherwise have to
be set in the suffix specification. Therefore if there is no object,
-then you have to make sure to specify the @var{key} and the @var{description}.
+then you have to make sure to specify the @var{KEY} and the @var{DESCRIPTION}.
As a special case, if you want to add a command that might be neither
defined nor autoloaded, you can use a workaround like:
@@ -1209,8 +1249,8 @@ defined nor autoloaded, you can use a workaround like:
:if (lambda () (featurep 'no-library))))
@end lisp
-Instead of @code{featurep} you could also use @code{require} with a
-non-nil value for @var{noerror}.
+Instead of @code{featurep} you could also use @code{require} with a
non-@code{nil} value
+for @var{NOERROR}.
@item
The mandatory argument can also be a command-line argument, a
@@ -1227,30 +1267,29 @@ used.
Unless the class is specified explicitly, the appropriate class is
guessed based on the long argument. If the argument ends with @samp{=}
-(e.g. @samp{--format=}) then @code{transient-option} is used, otherwise
+(e.g., @samp{--format=}) then @code{transient-option} is used, otherwise
@code{transient-switch}.
@end itemize
-Finally, details can be specified using optional
-@var{keyword}-@var{value} pairs.
+Finally, details can be specified using optional @var{KEYWORD}-@var{VALUE}
pairs.
Each keyword has to be a keyword symbol, either @code{:class} or a keyword
argument supported by the constructor of that class. See @ref{Suffix Slots}.
@node Defining Suffix and Infix Commands
@section Defining Suffix and Infix Commands
+
@cindex defining suffix commands
@cindex defining infix commands
-Note that an infix is a special kind of suffix. Depending on context
-``suffixes'' means ``suffixes (including infixes)'' or ``non-infix
-suffixes''.
+Note that an infix is a special kind of suffix. Depending on context
+“suffixes” means “suffixes (including infixes)” or “non-infix
+suffixes”.
@defmac transient-define-suffix name arglist [docstring] [keyword
value]@dots{} body@dots{}
+This macro defines @var{NAME} as a transient suffix command.
-This macro defines @var{name} as a transient suffix command.
-
-@var{arglist} are the arguments that the command takes.
-@var{docstring} is the documentation string and is optional.
+@var{ARGLIST} are the arguments that the command takes.
+@var{DOCSTRING} is the documentation string and is optional.
These arguments can optionally be followed by keyword-value pairs.
Each keyword has to be a keyword symbol, either @code{:class} or a keyword
@@ -1258,17 +1297,16 @@ argument supported by the constructor of that class.
The
@code{transient-suffix} class is used if the class is not specified
explicitly.
-The @var{body} must begin with an @code{interactive} form that matches
@var{arglist}.
+The @var{BODY} must begin with an @code{interactive} form that matches
@var{ARGLIST}.
The infix arguments are usually accessed by using @code{transient-args}
inside @code{interactive}.
@end defmac
@defmac transient-define-infix name arglist [docstring] [keyword value]@dots{}
+This macro defines @var{NAME} as a transient infix command.
-This macro defines @var{name} as a transient infix command.
-
-@var{arglist} is always ignored (but mandatory never-the-less) and
-reserved for future use. @var{docstring} is the documentation string and
+@var{ARGLIST} is always ignored (but mandatory never-the-less) and
+reserved for future use. @var{DOCSTRING} is the documentation string and
is optional.
The keyword-value pairs are mandatory. All transient infix commands
@@ -1297,13 +1335,12 @@ Different infix commands behave differently because the
concrete
methods are different for different infix command classes. In rare
cases the above command function might not be suitable, even if you
define your own infix command class. In that case you have to use
-@code{transient-suffix-command} to define the infix command and use @code{t} as
-the value of the @code{:transient} keyword.
+@code{transient-define-suffix} to define the infix command and use @code{t} as
the
+value of the @code{:transient} keyword.
@end defmac
@defmac transient-define-argument name arglist [docstring] [keyword
value]@dots{}
-
-This macro defines @var{name} as a transient infix command.
+This macro defines @var{NAME} as a transient infix command.
This is an alias for @code{transient-define-infix}. Only use this alias
to define an infix command that actually sets an infix argument.
@@ -1313,7 +1350,6 @@ To define an infix command that, for example, sets a
variable, use
@node Using Infix Arguments
@section Using Infix Arguments
-@cindex using infix arguments
The functions and the variables described below allow suffix commands
to access the value of the transient from which they were invoked;
@@ -1332,61 +1368,56 @@ function, which for infix arguments serves about the
same purpose as
@code{prefix-arg} serves for prefix arguments.
@defun transient-args prefix
-
This function returns the value of the transient prefix command
-@var{prefix}.
+@var{PREFIX}.
If the current command was invoked from the transient prefix command
-@var{prefix}, then it returns the active infix arguments. If the current
-command was not invoked from @var{prefix}, then it returns the set, saved
-or default value for @var{prefix}.
+@var{PREFIX}, then it returns the active infix arguments. If the current
+command was not invoked from @var{PREFIX}, then it returns the set, saved
+or default value for @var{PREFIX}.
@end defun
@defun transient-arg-value arg args
-
-This function return the value of @var{arg} as it appears in @var{args}.
+This function return the value of @var{ARG} as it appears in @var{ARGS}.
For a switch a boolean is returned. For an option the value is
returned as a string, using the empty string for the empty value,
-or @code{nil} if the option does not appear in @var{args}.
+or @code{nil} if the option does not appear in @var{ARGS}.
@end defun
@defun transient-suffixes prefix
-
This function returns the suffixes of the transient prefix command
-@var{prefix}. This is a list of objects. This function should only be
+@var{PREFIX}. This is a list of objects. This function should only be
used if you need the objects (as opposed to just their values) and
-if the current command is not being invoked from @var{prefix}.
+if the current command is not being invoked from @var{PREFIX}.
@end defun
@defvar transient-current-suffixes
-
The suffixes of the transient from which this suffix command was
invoked. This is a list of objects. Usually it is sufficient to
instead use the function @code{transient-args}, which returns a list of
values. In complex cases it might be necessary to use this variable
-instead, i.e.@: if you need access to information beside the value.
+instead, i.e., if you need access to information beside the value.
@end defvar
@defvar transient-current-prefix
-
The transient from which this suffix command was invoked. The
returned value is a @code{transient-prefix} object, which holds information
associated with the transient prefix command.
@end defvar
@defvar transient-current-command
-
The transient from which this suffix command was invoked. The
returned value is a symbol, the transient prefix command.
@end defvar
@node Transient State
@section Transient State
+
@cindex transient state
-Invoking a transient prefix command ``activates'' the respective
-transient, i.e.@: it puts a transient keymap into effect, which binds
+Invoking a transient prefix command “activates” the respective
+transient, i.e., it puts a transient keymap into effect, which binds
the transient's infix and suffix commands.
The default behavior while a transient is active is as follows:
@@ -1397,20 +1428,20 @@ Invoking an infix command does not affect the transient
state; the
transient remains active.
@item
-Invoking a (non-infix) suffix command ``deactivates'' the transient
+Invoking a (non-infix) suffix command “deactivates” the transient
state by removing the transient keymap and performing some
additional cleanup.
@item
Invoking a command that is bound in a keymap other than the
transient keymap is disallowed and trying to do so results in a
-warning. This does not ``deactivate'' the transient.
+warning. This does not “deactivate” the transient.
@end itemize
But these are just the defaults. Whether a certain command
-deactivates or ``exits'' the transient is configurable. There is more
-than one way in which a command can be ``transient'' or ``non-transient'';
-the exact behavior is implemented by calling a so-called ``pre-command''
+deactivates or “exits” the transient is configurable. There is more
+than one way in which a command can be “transient” or “non-transient”;
+the exact behavior is implemented by calling a so-called “pre-command”
function. Whether non-suffix commands are allowed to be called is
configurable per transient.
@@ -1426,10 +1457,8 @@ Valid values are booleans and the pre-commands described
below.
@itemize
@item
@code{t} is equivalent to @code{transient--do-stay}.
-
@item
@code{nil} is equivalent to @code{transient--do-exit}.
-
@item
If @code{transient} is unbound (and that is actually the default for
non-infix suffixes) then the value of the prefix's
@@ -1439,18 +1468,18 @@ essentially equivalent to it being @code{nil}.
@end itemize
@item
-A suffix command can be a prefix command itself, i.e. a
-``sub-prefix''. While a sub-prefix is active we nearly always want
-@kbd{C-g} to take the user back to the ``super-prefix''. However in rare
+A suffix command can be a prefix command itself, i.e., a
+“sub-prefix”. While a sub-prefix is active we nearly always want
+@kbd{C-g} to take the user back to the “super-prefix”. However in rare
cases this may not be desirable, and that makes the following
complication necessary:
For @code{transient-suffix} objects the @code{transient} slot is unbound. We
can
ignore that for the most part because, as stated above, @code{nil} and the
-slot being unbound are equivalent, and mean ``do exit''. That isn't
+slot being unbound are equivalent, and mean “do exit”. That isn't
actually true for suffixes that are sub-prefixes though. For such
-suffixes unbound means ``do exit but allow going back'', which is the
-default, while @code{nil} means ``do exit permanently'', which requires that
+suffixes unbound means “do exit but allow going back”, which is the
+default, while @code{nil} means “do exit permanently”, which requires that
slot to be explicitly set to that value.
@item
@@ -1465,7 +1494,7 @@ called by @code{transient--pre-command}, a function on
@code{pre-command-hook} a
the value that they return determines whether the transient is exited.
To do so the value of one of the constants @code{transient--exit} or
@code{transient--stay} is used (that way we don't have to remember if @code{t}
means
-``exit'' or ``stay'').
+“exit” or “stay”).
Additionally, these functions may change the value of @code{this-command}
(which explains why they have to be called using @code{pre-command-hook}),
@@ -1480,7 +1509,6 @@ The default for infixes is @code{transient--do-stay}.
This is also the only
function that makes sense for infixes.
@defun transient--do-stay
-
Call the command without exporting variables and stay transient.
@end defun
@@ -1490,27 +1518,55 @@ Call the command without exporting variables and stay
transient.
The default for suffixes is @code{transient--do-exit}.
@defun transient--do-exit
-
Call the command after exporting variables and exit the transient.
@end defun
-@defun transient--do-call
+@defun transient--do-return
+Call the command after exporting variables and return to parent
+prefix. If there is no parent prefix, then call @code{transient--do-exit}.
+@end defun
+@defun transient--do-call
Call the command after exporting variables and stay transient.
@end defun
-@defun transient--do-replace
+The following pre-commands are suitable for sub-prefixes. Only the
+first should ever explicitly be set as the value of the @code{transient}
+slot.
+
+@defun transient--do-recurse
+Call the transient prefix command, preparing for return to active
+transient.
+
+Whether we actually return to the parent transient is ultimately
+under the control of each invoked suffix. The difference between
+this pre-command and @code{transient--do-replace} is that it changes the
+value of the @code{transient-suffix} slot to @code{transient--do-return}.
+
+If there is no parent transient, then only call this command and
+skip the second step.
+@end defun
+@defun transient--do-replace
Call the transient prefix command, replacing the active transient.
-This is used for suffixes that are prefixes themselves, i.e.@: for
-sub-prefixes.
+Unless @code{transient--do-recurse} is explicitly used, this pre-command
+is automatically used for suffixes that are prefixes themselves,
+i.e., for sub-prefixes.
+@end defun
+
+@defun transient--do-suspend
+Suspend the active transient, saving the transient stack.
+
+This is used by the command @code{transient-suspend} and optionally also by
+“external events” such as @code{handle-switch-frame}. Such bindings should
+be added to @code{transient-predicate-map}.
@end defun
@anchor{Pre-commands for Non-Suffixes}
@subheading Pre-commands for Non-Suffixes
-The default for non-suffixes, i.e@: commands that are bound in other
+The default for non-suffixes, i.e., commands that are bound in other
keymaps beside the transient keymap, is @code{transient--do-warn}. Silently
ignoring the user-error is also an option, though probably not a good
one.
@@ -1520,12 +1576,10 @@ If you want to let the user invoke non-suffix commands,
then use
slot.
@defun transient--do-warn
-
Call @code{transient-undefined} and stay transient.
@end defun
@defun transient--do-noop
-
Call @code{transient-noop} and stay transient.
@end defun
@@ -1533,21 +1587,18 @@ Call @code{transient-noop} and stay transient.
@subheading Special Pre-Commands
@defun transient--do-quit-one
-
If active, quit help or edit mode, else exit the active transient.
This is used when the user pressed @kbd{C-g}.
@end defun
@defun transient--do-quit-all
-
Exit all transients without saving the transient stack.
This is used when the user pressed @kbd{C-q}.
@end defun
@defun transient--do-suspend
-
Suspend the active transient, saving the transient stack.
This is used when the user pressed @kbd{C-z}.
@@ -1555,6 +1606,7 @@ This is used when the user pressed @kbd{C-z}.
@node Classes and Methods
@chapter Classes and Methods
+
@cindex classes and methods
Transient uses classes and generic functions to make it possible to
@@ -1591,7 +1643,7 @@ holds a function that is used to read a new value for an
infix
command. The values of such slots are regular functions.
Generic functions are used when a function should do something
-different based on the type of the command, i.e. when all commands
+different based on the type of the command, i.e., when all commands
of a certain type should behave the same way but different from the
behavior for other types. Object slots that hold a regular function
as value are used when the task that they perform is likely to
@@ -1613,7 +1665,7 @@ differ even between different commands of the same type.
@section Group Classes
The type of a group can be specified using the @code{:class} property at the
-beginning of the class specification, e.g. @code{[:class transient-columns
+beginning of the class specification, e.g., @code{[:class transient-columns
...]} in a call to @code{transient-define-prefix}.
@itemize
@@ -1622,7 +1674,7 @@ The abstract @code{transient-child} class is the base
class of both
@code{transient-group} (and therefore all groups) as well as of
@code{transient-suffix} (and therefore all suffix and infix commands).
-This class exists because the elements (a.k.a.@: ``children'') of certain
+This class exists because the elements (or “children”) of certain
groups can be other groups instead of suffix and infix commands.
@item
@@ -1632,8 +1684,8 @@ group classes.
@item
The @code{transient-column} class is the simplest group.
-This is the default ``flat'' group. If the class is not specified
-explicitly and the first element is not a vector (i.e. not a group),
+This is the default “flat” group. If the class is not specified
+explicitly and the first element is not a vector (i.e., not a group),
then this class is used.
This class displays each element on a separate line.
@@ -1648,8 +1700,8 @@ Direct elements have to be groups whose elements have to
be commands
or strings. Each subgroup represents a column. This class takes
care of inserting the subgroups' elements.
-This is the default ``nested'' group. If the class is not specified
-explicitly and the first element is a vector (i.e.@: a group), then
+This is the default “nested” group. If the class is not specified
+explicitly and the first element is a vector (i.e., a group), then
this class is used.
@item
@@ -1665,12 +1717,11 @@ elements.
@section Group Methods
@defun transient-setup-children group children
-
This generic function can be used to setup the children or a group.
The default implementation usually just returns the children
-unchanged, but if the @code{setup-children} slot of @var{group} is non-nil,
then
-it calls that function with @var{children} as the only argument and
+unchanged, but if the @code{setup-children} slot of @var{GROUP} is
non-@code{nil}, then
+it calls that function with @var{CHILDREN} as the only argument and
returns the value.
The children are given as a (potentially empty) list consisting of
@@ -1680,7 +1731,6 @@ children from scratch.
@end defun
@defun transient--insert-group group
-
This generic function formats the group and its elements and inserts
the result into the current buffer, which is a temporary buffer.
The contents of that buffer are later inserted into the popup buffer.
@@ -1698,7 +1748,6 @@ commands and there is only a single generic function that
can be
specialized based on the class of a prefix command.
@defun transient--history-init obj
-
This generic function is called while setting up the transient and
is responsible for initializing the @code{history} slot. This is the
transient-wide history; many individual infixes also have a history
@@ -1784,8 +1833,7 @@ functions use @code{describe-function}.
@subsection Suffix Value Methods
@defun transient-init-value obj
-
-This generic function sets the initial value of the object @var{obj}.
+This generic function sets the initial value of the object @var{OBJ}.
This function is called for all suffix commands, but unless a
concrete method is implemented this falls through to the default
@@ -1797,9 +1845,8 @@ a method.
@end defun
@defun transient-infix-read obj
-
This generic function determines the new value of the infix object
-@var{obj}.
+@var{OBJ}.
This function merely determines the value; @code{transient-infix-set} is
used to actually store the new value in the object.
@@ -1809,40 +1856,36 @@ user using the reader specified by the @code{reader}
slot (using the
@code{transient-infix-value} method described below).
For some infix classes the value is changed without reading
-anything in the minibuffer, i.e.@: the mere act of invoking the
+anything in the minibuffer, i.e., the mere act of invoking the
infix command determines what the new value should be, based
on the previous value.
@end defun
@defun transient-prompt obj
-
This generic function returns the prompt to be used to read infix
-object @var{obj}'s value.
+object @var{OBJ}'s value.
@end defun
@defun transient-infix-set obj value
-
-This generic function sets the value of infix object @var{obj} to @var{value}.
+This generic function sets the value of infix object @var{OBJ} to @var{VALUE}.
@end defun
@defun transient-infix-value obj
-
-This generic function returns the value of the suffix object @var{obj}.
+This generic function returns the value of the suffix object @var{OBJ}.
This function is called by @code{transient-args} (which see), meaning this
function is how the value of a transient is determined so that the
invoked suffix command can use it.
Currently most values are strings, but that is not set in stone.
-@code{nil} is not a value, it means ``no value''.
+@code{nil} is not a value, it means “no value”.
Usually only infixes have a value, but see the method for
@code{transient-suffix}.
@end defun
@defun transient-init-scope obj
-
-This generic function sets the scope of the suffix object @var{obj}.
+This generic function sets the scope of the suffix object @var{OBJ}.
The scope is actually a property of the transient prefix, not of
individual suffixes. However it is possible to invoke a suffix
@@ -1859,8 +1902,7 @@ implementation, which is a noop.
@subsection Suffix Format Methods
@defun transient-format obj
-
-This generic function formats and returns @var{obj} for display.
+This generic function formats and returns @var{OBJ} for display.
When this function is called, then the current buffer is some
temporary buffer. If you need the buffer from which the prefix
@@ -1869,27 +1911,23 @@ making @code{transient--source-buffer} current.
@end defun
@defun transient-format-key obj
-
-This generic function formats @var{obj}'s @code{key} for display and returns
the
+This generic function formats @var{OBJ}'s @code{key} for display and returns
the
result.
@end defun
@defun transient-format-description obj
-
-This generic function formats @var{obj}'s @code{description} for display and
+This generic function formats @var{OBJ}'s @code{description} for display and
returns the result.
@end defun
@defun transient-format-value obj
-
-This generic function formats @var{obj}'s value for display and returns
+This generic function formats @var{OBJ}'s value for display and returns
the result.
@end defun
@defun transient-show-help obj
-
Show help for the prefix, infix or suffix command represented by
-@var{obj}.
+@var{OBJ}.
For prefixes, show the info manual, if that is specified using the
@code{info-manual} slot. Otherwise, show the manpage if that is specified
@@ -1906,10 +1944,10 @@ the command's doc string.
@itemize
@item
-@code{man-page} or @code{info-manual} can be used to specify the documentation
for
-the prefix and its suffixes. The command @code{transient-help} uses the
-method @code{transient-show-help} (which see) to lookup and use these
-values.
+@code{show-help}, @code{man-page} or @code{info-manual} can be used to specify
the
+documentation for the prefix and its suffixes. The command
+@code{transient-help} uses the method @code{transient-show-help} (which see) to
+lookup and use these values.
@item
@code{history-key} If multiple prefix commands should share a single value,
@@ -1930,7 +1968,7 @@ multiple sub-lists.
@item
@code{scope} For some transients it might be necessary to have a sort of
-secondary value, called a ``scope''. See @code{transient-define-prefix}.
+secondary value, called a “scope”. See @code{transient-define-prefix}.
@end itemize
@anchor{Internal Prefix Slots}
@@ -1995,10 +2033,8 @@ It must contain the following %-placeholders:
@itemize
@item
@code{%k} For the key.
-
@item
@code{%d} For the description.
-
@item
@code{%v} For the infix value. Non-infix suffixes don't have a value.
@end itemize
@@ -2006,6 +2042,11 @@ It must contain the following %-placeholders:
@item
@code{description} The description, either a string or a function that is
called with no argument and returns a string.
+
+@item
+@code{show-help} A function used to display help for the suffix. If
+unspecified, the prefix controls how hlep is displayed for its
+suffixes.
@end itemize
@anchor{Slots of @code{transient-infix}}
@@ -2016,10 +2057,10 @@ They are defined here anyway to allow sharing certain
methods.
@itemize
@item
-@code{argument} The long argument, e.g. @code{--verbose}.
+@code{argument} The long argument, e.g., @code{--verbose}.
@item
-@code{shortarg} The short argument, e.g. @code{-v}.
+@code{shortarg} The short argument, e.g., @code{-v}.
@item
@code{value} The value. Should not be accessed directly.
@@ -2036,7 +2077,34 @@ the prefixes.
@item
@code{multi-value} For options, whether the option can have multiple
-values. If non-nil, then default to use @code{completing-read-multiple}.
+values. If this is non-@code{nil}, then the values are read using
+@code{completing-read-multiple} by default and if you specify your own
+reader, then it should read the values using that function or
+similar.
+
+Supported non-@code{nil} values are:
+
+@itemize
+@item
+Use @code{rest} for an option that can have multiple values. This is
+useful e.g., for an @code{--} argument that indicates that all remaining
+arguments are files (such as @code{git log -- file1 file2}).
+
+In the list returned by @code{transient-args} such an option and its
+values are represented by a single list of the form @code{(ARGUMENT
+ . VALUES)}.
+
+@item
+Use @code{repeat} for an option that can be specified multiple times.
+
+In the list returned by @code{transient-args} each instance of the option
+and its value appears separately in the usual from, for example:
+@code{("--another-argument" "--option=first" "--option=second")}.
+@end itemize
+
+In both cases the option's values have to be specified in the
+default value of a prefix using the same format as returned by
+@code{transient-args}, e.g., @code{("--other" "--o=1" "--o=2" ("--" "f1"
"f2"))}.
@item
@code{always-read} For options, whether to read a value on every invocation.
@@ -2053,8 +2121,8 @@ same history because their values are of the same kind.
@item
@code{reader} The function used to read the value of an infix. Not used
-for switches. The function takes three arguments, @var{prompt},
-@var{initial-input} and @var{history}, and must return a string.
+for switches. The function takes three arguments, @var{PROMPT},
+@var{INITIAL-INPUT} and @var{HISTORY}, and must return a string.
@item
@code{prompt} The prompt used when reading the value, either a string or a
@@ -2098,25 +2166,18 @@ what happens if you use more than one.
@itemize
@item
@code{if} Enable if predicate returns non-@code{nil}.
-
@item
@code{if-not} Enable if predicate returns @code{nil}.
-
@item
@code{if-non-nil} Enable if variable's value is non-@code{nil}.
-
@item
@code{if-nil} Enable if variable's value is @code{nil}.
-
@item
@code{if-mode} Enable if major-mode matches value.
-
@item
@code{if-not-mode} Enable if major-mode does not match value.
-
@item
@code{if-derived} Enable if major-mode derives from value.
-
@item
@code{if-not-derived} Enable if major-mode does not derive from value.
@end itemize
@@ -2146,16 +2207,13 @@ The following diagrams illustrate some of the
differences.
@itemize
@item
-@code{(c)} represents a return to the command loop.
-
+@samp{(c)} represents a return to the command loop.
@item
-@code{(+)} represents the user's choice to press one key or another.
-
+@samp{(+)} represents the user's choice to press one key or another.
@item
-@code{@{@var{word}@}} are possible behaviors.
-
+@samp{@{WORD@}} are possible behaviors.
@item
-@code{@{@var{number}@}} is a footnote.
+@samp{@{NUMBER@}} is a footnote.
@end itemize
@anchor{Regular Prefix Commands}
@@ -2331,7 +2389,7 @@ and also takes external state into account.
@itemize
@item
-@code{@{1@}} Transients can be configured to be exited when a suffix command
+@samp{@{1@}} Transients can be configured to be exited when a suffix command
is invoked. The default is to do so for all suffixes except for
those that are common to all transients and which are used to
perform tasks such as providing help and saving the value of the
@@ -2340,7 +2398,7 @@ specified for individual suffix commands and may even
depend on
state.
@item
-@code{@{2@}} Transients can be configured to allow the user to invoke
+@samp{@{2@}} Transients can be configured to allow the user to invoke
non-suffix commands. The default is to not allow that and instead
warn the user.
@end itemize
@@ -2386,9 +2444,9 @@ Both packages use transient keymaps to make a set of
commands
temporarily available and show the available commands in a popup
buffer.
-A Hydra ``body'' is equivalent to a Transient ``prefix'' and a Hydra
-``head'' is equivalent to a Transient ``suffix''. Hydra has no equivalent
-of a Transient ``infix''.
+A Hydra “body” is equivalent to a Transient “prefix” and a Hydra
+“head” is equivalent to a Transient “suffix”. Hydra has no equivalent
+of a Transient “infix”.
Both hydras and transients can be used as simple command dispatchers.
Used like this they are similar to regular prefix commands and prefix
@@ -2406,7 +2464,7 @@ command dispatchers:
@item
Invoking a command from a hydra does not necessarily exit the hydra.
That makes it possible to invoke the same command again, but using a
-shorter key sequence (i.e. the key that was used to enter the hydra
+shorter key sequence (i.e., the key that was used to enter the hydra
does not have to be pressed again).
Transient supports that too, but for now this feature is not a focus
@@ -2421,7 +2479,6 @@ using the current interface:
("n" "next visible heading" outline-next-visible-heading)])
@end lisp
-
@item
Transient supports infix arguments; values that are set by infix
commands and then consumed by the invoked suffix command(s).
@@ -2465,13 +2522,13 @@ currently exist.
@anchor{Can I control how the popup buffer is displayed?}
@appendixsec Can I control how the popup buffer is displayed?
-Yes, see @code{transient-display-buffer-action} in @ref{Other Options}.
+Yes, see @code{transient-display-buffer-action} in @ref{Configuration}.
@anchor{Why did some of the key bindings change?}
@appendixsec Why did some of the key bindings change?
You may have noticed that the bindings for some of the common commands
-do @strong{not} have the prefix @code{C-x} and that furthermore some of these
commands
+do @strong{not} have the prefix @kbd{C-x} and that furthermore some of these
commands
are grayed out while others are not. That unfortunately is a bit
confusing if the section of common commands is not shown permanently,
making the following explanation necessary.
@@ -2486,42 +2543,41 @@ bindings. The bindings that do use a prefix do so to
avoid wasting
too many non-prefix bindings, keeping them available for use in
individual transients. The bindings that do not use a prefix and that
are @strong{not} grayed out are very important bindings that are
@strong{always}
-available, even when invoking the ``common command key prefix'' or @strong{any
+available, even when invoking the “common command key prefix” or @strong{any
other} transient-specific prefix. The non-prefix keys that @strong{are} grayed
out however, are not available when any incomplete prefix key sequence
-is active. They do not use the ``common command key prefix'' because it
+is active. They do not use the “common command key prefix” because it
is likely that users want to invoke them several times in a row and
-e.g. @kbd{M-p M-p M-p} is much more convenient than
-@kbd{C-x M-p C-x M-p C-x M-p}.
+e.g., @kbd{M-p M-p M-p} is much more convenient than @kbd{C-x M-p C-x M-p C-x
M-p}.
-You may also have noticed that the "Set" command is bound to @kbd{C-x s},
+You may also have noticed that the “Set” command is bound to @kbd{C-x s},
while Magit-Popup used to bind @kbd{C-c C-c} instead. I have seen several
users praise the latter binding (sic), so I did not change it
willy-nilly. The reason that I changed it is that using different
prefix keys for different common commands, would have made the
-temporary display of the common commands even more confusing,
-i.e. after pressing @kbd{C-c} all the @kbd{C-x ...} bindings would be grayed
out.
+temporary display of the common commands even more confusing, i.e.,
+after pressing @kbd{C-c} all the bindings that begin with the @kbd{C-x} prefix
+would be grayed out.
Using a single prefix for common commands key means that all other
potential prefix keys can be used for transient-specific commands
-@strong{without} the section of common commands also popping up. @code{C-c} in
+@strong{without} the section of common commands also popping up. @kbd{C-c} in
particular is a prefix that I want to (and already do) use for Magit, and
also using that for a common command would prevent me from doing so.
(Also see the next question.)
-@anchor{Why does @code{q} not quit popups anymore?}
-@appendixsec Why does @code{q} not quit popups anymore?
+@anchor{Why does @kbd{q} not quit popups anymore?}
+@appendixsec Why does @kbd{q} not quit popups anymore?
I agree that @kbd{q} is a good binding for commands that quit something.
This includes quitting whatever transient is currently active, but it
also includes quitting whatever it is that some specific transient is
-controlling. The transient @code{magit-blame} for example binds @code{q} to
the
+controlling. The transient @code{magit-blame} for example binds @kbd{q} to the
command that turns @code{magit-blame-mode} off.
So I had to decide if @kbd{q} should quit the active transient (like
-Magit-Popup used to) or whether @kbd{C-g} should do that instead, so
-that @kbd{q}
+Magit-Popup used to) or whether @kbd{C-g} should do that instead, so that
@kbd{q}
could be bound in individual transient to whatever commands make sense
for them. Because all other letters are already reserved for use by
individual transients, I have decided to no longer make an exception
@@ -2548,7 +2604,7 @@ necessary changes. See its doc string for more
information.
@printindex vr
@node Concept Index
-@appendix Concept and Feature Index
+@appendix Concept Index
@printindex cp
diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi
index b0deb31d10..0e2473ddf3 100644
--- a/doc/misc/viper.texi
+++ b/doc/misc/viper.texi
@@ -1842,7 +1842,7 @@ usually most effective:
(set-face-background viper-replace-overlay-face "yellow")
@end smallexample
For a complete list of colors available to you, evaluate the expression
-@code{(x-defined-colors)}. (Type it in the buffer @file{*scratch*} and then
+@code{(defined-colors)}. (Type it in the buffer @file{*scratch*} and then
hit the @kbd{C-j} key.
@item viper-replace-overlay-cursor-color "Red"
diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index 296dc520a1..59cd9d0f56 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -465,9 +465,9 @@ When point is placed on a vtable, the following keys are
bound:
Sort the table by the current column
(@code{vtable-sort-by-current-column}). Note that the table is sorted
according to the data returned by the getter function (@pxref{Making A
-Table}), not by how it's
-displayed in the buffer. Columns that have only numerical data is
-sorted as numbers, the rest are sorted as strings.
+Table}), not by how it's displayed in the buffer. Columns that have
+only numerical data are sorted as numbers, the rest are sorted as
+strings.
@findex vtable-narrow-current-column
@item @{
diff --git a/etc/AUTHORS b/etc/AUTHORS
index 8946800e0b..4ad8a54130 100644
--- a/etc/AUTHORS
+++ b/etc/AUTHORS
@@ -1573,7 +1573,7 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c]
and co-wrote help-tests.el
and changed xdisp.c display.texi w32.c msdos.c w32fns.c simple.el
files.el fileio.c emacs.c keyboard.c w32term.c text.texi dispnew.c
- w32proc.c files.texi frames.texi configure.ac dispextern.h lisp.h
+ w32proc.c files.texi frames.texi configure.ac lisp.h dispextern.h
process.c ms-w32.h and 1236 other files
Eliza Velasquez: changed server.el
diff --git a/etc/NEWS b/etc/NEWS
index ba05b49176..2747cec18c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -59,7 +59,7 @@ If a constant file name is required, the file can be renamed
to
"emacs.pdmp", and Emacs will find it during startup anyway.
---
-** Emacs now uses of XInput 2 for input events.
+** Emacs now uses XInput 2 for input events.
If your X server has support and you have the XInput 2 development
headers installed, Emacs will use the X Input Extension for handling
input. If this causes problems, you can configure Emacs with the
@@ -349,6 +349,21 @@ Use 'abbrev', 'skeleton' or 'tempo' instead.
** The rlogin.el library, and the 'rsh' command are now obsolete.
Use something like 'M-x shell RET ssh <host> RET' instead.
+---
+** The url-about.el library is now obsolete.
+
+---
+** The autoload.el library is now obsolete.
+It is superseded by the loaddefs-gen.el library.
+
+---
+** The netrc.el library is now obsolete.
+Use the 'auth-source-netrc-parse-all' function in auth-source.el
+instead.
+
+---
+** The url-dired.el library is now obsolete.
+
---
** The fast-lock.el and lazy-lock.el library have been removed.
They have been obsolete since Emacs 22.1.
@@ -360,6 +375,9 @@ option) and can be set to nil to disable Just-in-time Lock
mode.
* Changes in Emacs 29.1
+---
+** New user option 'electric-quote-replace-consecutive'.
+
---
** Emacs is now capable of editing files with very long lines.
The display of long lines has been optimized, and Emacs should no
@@ -620,6 +638,9 @@ requires an X compositing manager supporting the extended
frame
synchronization protocol (see
https://fishsoup.net/misc/wm-spec-synchronization.html).
+This behavior can be toggled on and off via the frame parameter
+'use-frame-synchronization'.
+
+++
** New frame parameter 'alpha-background' and X resource "alphaBackground".
This controls the opacity of the text background when running on a
@@ -869,6 +890,7 @@ specifiers can now use ':type webp'.
** Windows
++++
*** New user option 'display-buffer-avoid-small-windows'.
If non-nil, this should be a window height, a number. Windows smaller
than this will be avoided by 'display-buffer', if possible.
@@ -1080,31 +1102,31 @@ now has font-selection and character composition rules,
a language
environment, and an input method. The newly-added scripts and the
corresponding language environments are:
-**** Tai Tham script and the Northern Thai language environment
-**** Brahmi script and language environment
-**** Kaithi script and language environment
-**** Tirhuta script and language environment
-**** Sharada script and language environment
-**** Siddham script and language environment
-**** Syloti Nagri script and language environment
-**** Modi script and language environment
-**** Baybayin script and Tagalog language environment
-**** Hanunoo script and language environment
-**** Buhid script and language environment
-**** Tagbanwa script and language environment
-**** Limbu script and language environment
-**** Balinese script and language environment
-**** Javanese script and language environment
-**** Sundanese script and language environment
-**** Batak script and language environment
-**** Rejang script and language environment
-**** Makasar script and language environment
-**** Lontara script and language environment
-**** Hanifi Rohingya script and language environment
-**** Grantha script and language environment
-**** Kharoshthi script and language environment
-**** Lepcha script and language environment
-**** Meetei Mayek script and language environment
+Tai Tham script and the Northern Thai language environment
+Brahmi script and language environment
+Kaithi script and language environment
+Tirhuta script and language environment
+Sharada script and language environment
+Siddham script and language environment
+Syloti Nagri script and language environment
+Modi script and language environment
+Baybayin script and Tagalog language environment
+Hanunoo script and language environment
+Buhid script and language environment
+Tagbanwa script and language environment
+Limbu script and language environment
+Balinese script and language environment
+Javanese script and language environment
+Sundanese script and language environment
+Batak script and language environment
+Rejang script and language environment
+Makasar script and language environment
+Lontara script and language environment
+Hanifi Rohingya script and language environment
+Grantha script and language environment
+Kharoshthi script and language environment
+Lepcha script and language environment
+Meetei Mayek script and language environment
---
*** The "Oriya" language environment was renamed to "Odia".
@@ -1176,9 +1198,11 @@ 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 commands 'elisp-byte-compile-file' and 'elisp-byte-compile-buffer'.
These commands (bound to 'C-c C-f' and 'C-c C-b', respectively)
byte-compile the visited file and the current buffer, respectively.
@@ -1213,6 +1237,7 @@ This controls how statements like the following are
indented:
bar
** Cperl Mode
+
---
*** New user option 'cperl-file-style'.
This option determines the indentation style to be used. It can also
@@ -1314,6 +1339,13 @@ When invoked with a non-zero prefix argument, as in 'C-u
C-x C-e',
this command will pop up a new buffer and show the full pretty-printed
value there.
++++
+*** You can now generate a backtrace from Lisp errors in redisplay.
+To do this, set the new variable 'backtrace-on-redisplay-error' to a
+non-nil value. The backtrace will be written to buffer
+*Redisplay-trace*. This buffer will not be automatically displayed in
+a window.
+
** Compile
+++
@@ -1454,6 +1486,11 @@ outside the echo area, Emacs will, by default, end the
Isearch and
yank the text at mouse cursor. But if 'mouse-yank-at-point' is
non-nil, the text will now be added to the Isearch instead.
++++
+*** Changes for values 'no' and 'no-ding' of 'isearch-wrap-pause'.
+Now with these values the search will wrap around not only on repeating
+with 'C-s C-s', but also after typing a character.
+
+++
*** New user option 'char-fold-override'.
Non-nil means that the default definitions of equivalent characters
@@ -1616,6 +1653,7 @@ the common "utm_" trackers from URLs.
** Find-Dired
+---
*** New command 'find-dired-with-command'.
This enables users to run 'find-dired' with an arbitrary command,
enabling running commands previously unsupported and also enabling new
@@ -1633,6 +1671,12 @@ Message, referred to as 'gnus-summary-tool-bar-retro',
well as the icons used), and the "Gnome" tool bars are now the only
pre-defined toolbars.
+---
+*** 'gnus-summary-up-thread' and 'gnus-summary-down-thread' bindings removed.
+The 'gnus-summary-down-thread' binding to "M-C-d" was shadowed by
+'gnus-summary-read-document', and these commands are also available on
+"T-u" and "T-d" respectively.
+
---
*** Gnus now uses a variable-pitch font in the headers by default.
To get the monospace font back, you can put something like the
@@ -2205,6 +2249,10 @@ remote host are shown. Alternatively, the user option
'proced-show-remote-processes' can be set to non-nil.
'proced-signal-function' has been marked obsolete.
+---
+*** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'.
+The old name is still available as an obsolete function alias.
+
* New Modes and Packages in Emacs 29.1
@@ -2213,6 +2261,7 @@ remote host are shown. Alternatively, the user option
Allows the creation of "functions with slots" or "function objects"
via the macros 'oclosure-define' and 'oclosure-lambda'.
++++
*** New generic function 'oclosure-interactive-form'.
Used by 'interactive-form' when called on an OClosure.
This allows specific OClosure types to compute their interactive specs
@@ -2228,6 +2277,11 @@ This mode is used to edit files geared towards testing
actions in
Emacs buffers, like indentation and the like. The new ert function
'ert-test-erts-file' is used to parse these files.
+---
+** New mode 'js-json-mode'.
+This is a lightweight variant of 'js-mode' that is used by default
+when visiting JSON files.
+
* Incompatible Lisp Changes in Emacs 29.1
@@ -2303,6 +2357,12 @@ they will still be escaped, so the '.foo' symbol is
still printed as
and remapping parent of basic faces does not work reliably.
Instead of remapping 'mode-line', you have to remap 'mode-line-active'.
++++
+** 'make-process' has been extended to support ptys when ':stderr' is set.
+Previously, setting ':stderr' to a non-nil value would force the
+process's connection to use pipes. Now, Emacs will use a pty for
+stdin and stdout if requested no matter the value of ':stderr'.
+
---
** User option 'mail-source-ignore-errors' is now obsolete.
The whole mechanism for prompting users to continue in case of
@@ -2429,14 +2489,15 @@ but switching to `ash` is generally much preferable.
'meta-complete-symbol', 'meta-mode-map',
'minibuffer-completing-symbol',
'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350',
-'msb-after-load-hooks', 'nnimap-split-rule', 'ns-alternatives-map',
-'ns-store-cut-buffer-internal', 'package-menu-view-commentary',
-'pascal-last-completions', 'pascal-show-completions',
-'pascal-toggle-completions', 'prolog-char-quote-workaround',
-'read-filename-at-point', 'reftex-index-map',
-'reftex-index-phrases-map', 'reftex-select-bib-map',
-'reftex-select-label-map', 'reftex-toc-map', 'register-name-alist',
-'register-value', 'report-emacs-bug-pretest-address',
+'msb-after-load-hooks', 'nnimap-split-rule', 'nntp-authinfo-file',
+'ns-alternatives-map', 'ns-store-cut-buffer-internal',
+'package-menu-view-commentary', 'pascal-last-completions',
+'pascal-show-completions', 'pascal-toggle-completions',
+'prolog-char-quote-workaround', 'read-filename-at-point',
+'reftex-index-map', 'reftex-index-phrases-map',
+'reftex-select-bib-map', 'reftex-select-label-map', 'reftex-toc-map',
+'register-name-alist', 'register-value',
+'report-emacs-bug-pretest-address',
'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to',
'rmail-dont-reply-to-names', 'rst-block-face', 'rst-comment-face',
'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face',
@@ -2455,7 +2516,7 @@ but switching to `ash` is generally much preferable.
'find-emacs-lisp-shadows', 'newsticker-cache-filename',
'redisplay-end-trigger-functions', 'set-window-redisplay-end-trigger',
'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode',
-'vc-arch-command', 'window-redisplay-end-trigger'.
+'vc-arch-command', 'window-redisplay-end-trigger', 'x-selection'.
---
** Some functions and variables obsolete since Emacs 21 or 22 have been
removed:
@@ -2487,6 +2548,7 @@ functions.
** '?\' at the end of a line now signals an error.
Previously it produced a nonsense value, -1, that was never intended.
+---
** Some libraries obsolete since Emacs 24.1 and 24.3 have been removed:
abbrevlist.el, assoc.el, complete.el, cust-print.el,
erc-hecomplete.el, mailpost.el, mouse-sel.el, old-emacs-lock.el,
@@ -2495,6 +2557,16 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and
sregex.el.
* Lisp Changes in Emacs 29.1
++++
+** New 'declare' form 'interactive-args'.
+This can be used to specify what forms to put into 'command-history'
+when executing commands interactively.
+
++++
+** The FORM arg of 'time-convert' is mandatory.
+'time-convert' can still be called without it, as before, but the
+compiler now emits a warning about this deprecated usage.
+
+++
** Emacs now supports user-customizable and themable icons.
These can be used for buttons in buffers and the like. See
@@ -2548,21 +2620,22 @@ for each specific data type while the selection is
being converted.
This function includes the current value of the variable in eldoc display
and can be used as a more detailed alternative to 'elisp-eldoc-var-docstring'.
++++
** 'save-some-buffers' can now be extended to save other things.
Traditionally, 'save-some-buffers' saved buffers, and also saved
abbrevs. This has been generalized via the
'save-some-buffers-functions' variable, and packages can now register
things to be saved.
++++
** New function 'string-equal-ignore-case'.
This compares strings ignoring case differences.
-+++
-** New argument LOCK of 'narrow-to-region'.
-If 'narrow-to-region' is called from Lisp with the new optional
-argument LOCK non-nil, then calls to 'widen' and calls to
-'narrow-to-region' with the optional argument LOCK nil or omitted do
-not produce any effect until the end of the current body form.
+---
+** 'symbol-file' can now report natively-compiled .eln files.
+If Emacs was built with native-compilation enabled, Lisp programs can
+now call 'symbol-file' with the new optional 3rd argument non-nil to
+request the name of the .eln file which defined a given symbol.
** Themes
@@ -2825,10 +2898,12 @@ them towards or away from each other.
This hook is run before 'x-popup-menu' is about to display a
deck-of-cards menu on screen.
+---
** New hook 'post-select-region-hook'.
This hook is run immediately after 'select-active-regions' causes the
region to be set as the primary selection.
++++
** New function 'buffer-match-p'.
Check if a buffer satisfies some condition. Some examples for
conditions can be regular expressions that match a buffer name, a
@@ -2836,6 +2911,7 @@ cons-cell like '(major-mode . shell-mode)' that matches
any buffer
where 'major-mode' is 'shell-mode' or a combined with a condition like
'(and "\\`\\*.+\\*\\'" (major-mode . special-mode))'.
++++
** New function 'match-buffers'.
Use 'buffer-match-p' to gather a list of buffers that match a
condition.
@@ -3291,6 +3367,15 @@ translation.
This is useful when quoting shell arguments for a remote shell
invocation. Such shells are POSIX conformant by default.
++++
+** 'make-process' can set connection type independently for input and output.
+When calling 'make-process', communication via pty can be enabled
+selectively for just input or output by passing a cons cell for
+':connection-type', e.g. '(pipe . pty)'. When examining a process
+later, you can determine whether a particular stream for a process
+uses a pty by passing one of 'stdin', 'stdout', or 'stderr' as the
+second argument to 'process-tty-name'.
+
+++
** 'signal-process' now consults the list 'signal-process-functions'.
This is to determine which function has to be called in order to
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 98ddd192b4..98c8d0c302 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -770,14 +770,6 @@ cause files to be downloaded to the local computer when
they are
accessed (which could take some time, and Emacs functions accessing
the file will wait for that), avoiding the errors.
-*** ps-print commands fail to find prologue files ps-prin*.ps.
-
-This can happen if you use an old version of X-Symbol package: it
-defines compatibility functions which trick ps-print into thinking it
-runs in XEmacs, and look for the prologue files in a wrong directory.
-
-The solution is to upgrade X-Symbol to a later version.
-
*** On systems with shared libraries you might encounter run-time errors
from the dynamic linker telling you that it is unable to find some
shared libraries, for instance those for Xaw3d or image support.
@@ -2337,8 +2329,23 @@ terminals display them as 1-column glyphs. Again, this
causes cursor
addressing to get out of sync and eventually messes up the display.
One possible workaround for problems caused by character composition
-is to turn off 'auto-composition-mode' on Kitty terminals.
+is to turn off 'auto-composition-mode' on Kitty terminals, e.g. by
+customizing the 'auto-composition-mode' variable to have as value a
+string that the 'tty-type' function returns on those terminals.
+
+*** Display artifacts on the Alacritty text terminal
+
+This terminal is known to cause problems with Emoji sequences: when
+displaying them, the Emacs text-mode frame could show gaps and other
+visual artifacts.
+The solution is to disable 'auto-composition-mode' on these
+terminals, for example, like this:
+
+ (setq auto-composition-mode "alacritty")
+
+This disables 'auto-composition-mode' on frames that display on
+terminals of this type.
* Runtime problems specific to individual Unix variants
@@ -3554,15 +3561,6 @@ as a macro. If the definition (in both unex*.c and
malloc.c) is wrong,
it can cause problems like this. You might be able to find the correct
value in the man page for a.out(5).
-* 'make check' failures
-
-** emacs-module-tests fail on Ubuntu 16.04
-
-This is due to a bug in GCC that was fixed in 2015; see
-<https://lists.gnu.org/r/emacs-devel/2018-09/msg00548.html>.
-You can work around the problem by using a later version of GCC or of
-Ubuntu, or by configuring without modules.
-
* Problems on legacy systems
This section covers bugs reported on very old hardware or software.
diff --git a/etc/TODO b/etc/TODO
index 5c55a8b999..da4a8c1fab 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -130,11 +130,6 @@ See also ESR's proposal for a BROWSER environment variable
** In Custom buffers, put the option that turns a mode on or off first
This should use a heuristic of some kind?
-** Define recompute-arg and recompute-arg-if for fix_command to use
-See rms message of 11 Dec 05 in
-https://lists.gnu.org/r/emacs-pretest-bug/2005-12/msg00165.html,
-and the rest of that discussion.
-
** In Emacs Info, examples of using Customize should be clickable
They should create Custom buffers when clicked.
@@ -1713,17 +1708,8 @@ apparently loses under Solaris, at least. [fx has mostly
done this.]
(Obsolete, since gmalloc.c is nowadays only used on MS-DOS.)
-** Rewrite make-docfile to be clean and maintainable
-It might be better to replace with Lisp the part of make-docfile that
-produces the etc/DOC file by scanning *.el files, for example by
-reusing the code in the byte compiler or in autoload.el that already
-scans *.el files.
-https://lists.gnu.org/r/emacs-devel/2012-06/msg00037.html
-https://lists.gnu.org/r/emacs-devel/2021-05/msg00235.html
-
** Eliminate the etc/DOC file altogether
-As an alternative to the previous item, we could try and eliminate the
-DOC file altogether. See
+We could try and eliminate the DOC file altogether. See
https://lists.gnu.org/r/emacs-devel/2021-05/msg00237.html
** Add an inferior-comint-minor-mode
@@ -1755,6 +1741,19 @@ for vc-rcs-update-changelog.
A two-char comment-starter whose two chars are symbol constituents will
not be noticed if it appears within a word.
+** Multi-pointer X does not work very well
+Emacs is reasonably usable under a multi-pointer X (MPX) environment,
+if you turn off tooltips and mouse highlight, and don't use anything
+that calls `mouse-position'. Otherwise, tooltips are shown next to
+the wrong pointer, mouse highlight simply goes haywire, and
+`mouse-position' returns information for the wrong pointer.
+
+This could be easily fixed in principle, but I cannot find a stable
+enough environment under which the fix can be tested.
+
+The MPX code has not been tested under X toolkit or GTK+ 2.x builds
+and is not expected to work there.
+
This file is part of GNU Emacs.
diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py
index 64df137267..880a835341 100644
--- a/etc/emacs_lldb.py
+++ b/etc/emacs_lldb.py
@@ -202,7 +202,7 @@ def xdebug_print(debugger, command, result, internal_dict):
########################################################################
def type_summary_Lisp_Object(obj, internal_dict):
- return "-> " + Lisp_Object(obj).summary()
+ return Lisp_Object(obj).summary()
########################################################################
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index 18cb313a32..b5a89c65cc 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -7130,7 +7130,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-06-14T15:15:19Z
+// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-07-28T15:14:54Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -8020,7 +8020,7 @@ dvag
// dvr : 2016-05-26 DISH Technologies L.L.C.
dvr
-// earth : 2014-12-04 Interlink Co., Ltd.
+// earth : 2014-12-04 Interlink Systems Innovation Institute K.K.
earth
// eat : 2014-01-23 Charleston Road Registry Inc.
@@ -8779,7 +8779,7 @@ lanxess
// lasalle : 2015-04-02 Jones Lang LaSalle Incorporated
lasalle
-// lat : 2014-10-16 ECOM-LAC Federaciòn de Latinoamèrica y el Caribe para
Internet y el Comercio Electrònico
+// lat : 2014-10-16 XYZ.COM LLC
lat
// latino : 2015-07-30 Dish DBS Corporation
@@ -9034,7 +9034,7 @@ mobile
// moda : 2013-11-07 Dog Beach, LLC
moda
-// moe : 2013-11-13 Interlink Co., Ltd.
+// moe : 2013-11-13 Interlink Systems Innovation Institute K.K.
moe
// moi : 2014-12-18 Amazon Registry Services, Inc.
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index 646504636f..20af99df94 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -3,8 +3,10 @@
;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
+;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Version: 2.4.1
+;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Version: 2.5.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
index c543e7ec43..e64a11b74f 100644
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -3,9 +3,10 @@
;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
+;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing list: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 2.4.1
+;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Version: 2.5.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -108,7 +109,7 @@ cover the blue-cyan-magenta side of the spectrum."
:prefix "modus-themes-"
:tag "Modus Themes Faces")
-(defvar modus-themes--version "2.5.0-dev"
+(defvar modus-themes--version "2.5.0"
"Current version of the Modus themes.
The version either is the last tagged release, such as '2.4.0',
@@ -954,7 +955,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-special-cold nil
- "Combines the 'special cold' background and foreground values.
+ "Combines the special cold background and foreground values.
This is intended for cases when a neutral gray background is not
suitable and where a combination of more saturated colors would
not be appropriate.
@@ -963,7 +964,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-special-mild nil
- "Combines the 'special mild' background and foreground values.
+ "Combines the special mild background and foreground values.
This is intended for cases when a neutral gray background is not
suitable and where a combination of more saturated colors would
not be appropriate.
@@ -972,7 +973,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-special-warm nil
- "Combines the 'special warm' background and foreground values.
+ "Combines the special warm background and foreground values.
This is intended for cases when a neutral gray background is not
suitable and where a combination of more saturated colors would
not be appropriate.
@@ -981,7 +982,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-special-calm nil
- "Combines the 'special calm' background and foreground values.
+ "Combines the special calm background and foreground values.
This is intended for cases when a neutral gray background is not
suitable and where a combination of more saturated colors would
not be appropriate.
@@ -990,7 +991,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-added nil
- "Combines green colors for the 'added' state in diffs.
+ "Combines green colors for the added state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -998,7 +999,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-changed nil
- "Combines yellow colors for the 'changed' state in diffs.
+ "Combines yellow colors for the changed state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1006,7 +1007,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-removed nil
- "Combines red colors for the 'removed' state in diffs.
+ "Combines red colors for the removed state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1014,7 +1015,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-refine-added nil
- "Combines green colors for word-wise 'added' state in diffs.
+ "Combines green colors for word-wise added state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1022,7 +1023,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-refine-changed nil
- "Combines yellow colors for word-wise 'changed' state in diffs.
+ "Combines yellow colors for word-wise changed state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1030,7 +1031,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-refine-removed nil
- "Combines red colors for word-wise 'removed' state in diffs.
+ "Combines red colors for word-wise removed state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1038,7 +1039,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-focus-added nil
- "Combines green colors for the focused 'added' state in diffs.
+ "Combines green colors for the focused added state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1046,7 +1047,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-focus-changed nil
- "Combines yellow colors for the focused 'changed' state in.
+ "Combines yellow colors for the focused changed state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1054,7 +1055,7 @@ The actual styling of the face is done by
`modus-themes-faces'."
:group 'modus-themes-faces)
(defface modus-themes-diff-focus-removed nil
- "Combines red colors for the focused 'removed' state in diffs.
+ "Combines red colors for the focused removed state in diffs.
The applied colors are contingent on the value assigned to
`modus-themes-diffs'.
@@ -1099,6 +1100,14 @@ The actual styling of the face is done by
`modus-themes-faces'."
"Applies a blue color and other styles for mark indicators.
This is intended for use in modes such as Dired, Ibuffer, Proced.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-themes-faces)
+
+(defface modus-themes-heading-0 nil
+ "General purpose face for use as the document's title.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
The actual styling of the face is done by `modus-themes-faces'."
:group 'modus-themes-faces)
@@ -1426,7 +1435,7 @@ By default, customizing a theme-related user option
through the
Custom interfaces or with `customize-set-variable' will not
reload the currently active Modus theme.
-Enable this behavior by setting this variable to nil."
+Enable this behaviour by setting this variable to nil."
:group 'modus-themes
:package-version '(modus-themes . "1.5.0")
:version "28.1"
@@ -1459,7 +1468,7 @@ For form, see `modus-themes-operandi-colors'."
:type '(alist :key-type symbol :value-type color)
:set #'modus-themes--set-option
:initialize #'custom-initialize-default
- :link '(info-link "(modus-themes) Override colors (DIY)"))
+ :link '(info-link "(modus-themes) Override colors"))
(defcustom modus-themes-vivendi-color-overrides nil
"Override colors in the Modus Vivendi palette.
@@ -1471,7 +1480,7 @@ For form, see `modus-themes-vivendi-colors'."
:type '(alist :key-type symbol :value-type color)
:set #'modus-themes--set-option
:initialize #'custom-initialize-default
- :link '(info-link "(modus-themes) Override colors (DIY)"))
+ :link '(info-link "(modus-themes) Override colors"))
;; The byte compiler complains when a defcustom isn't a top level form
(let* ((names (mapcar (lambda (pair)
@@ -1576,14 +1585,19 @@ speaking, is not limited to mouse usage."
This is a helper variable intended for internal use.")
(defcustom modus-themes-headings nil
- "Heading styles with optional list of values for levels 1-8.
+ "Heading styles with optional list of values for levels 0-8.
This is an alist that accepts a (key . list-of-values)
combination. The key is either a number, representing the
-heading's level or t, which pertains to the fallback style. The
-list of values covers symbols that refer to properties, as
-described below. Here is a sample, followed by a presentation of
-all available properties:
+heading's level (0-8) or t, which pertains to the fallback style.
+
+Level 0 is a special heading: it is used for what counts as a
+document title or equivalent, such as the #+title construct we
+find in Org files. Levels 1-8 are regular headings.
+
+The list of values covers symbols that refer to properties, as
+described below. Here is a complete sample, followed by a
+presentation of all available properties:
(setq modus-themes-headings
(quote ((1 . (background overline variable-pitch 1.5))
@@ -1668,12 +1682,12 @@ For Org users, the extent of the heading depends on the
variable
and `background' properties. Depending on the version of Org,
there may be others, such as `org-fontify-done-headline'."
:group 'modus-themes
- :package-version '(modus-themes . "2.3.0")
+ :package-version '(modus-themes . "2.5.0")
:version "29.1"
:type `(alist
:options ,(mapcar (lambda (el)
(list el modus-themes--headings-choice))
- '(1 2 3 4 5 6 7 8 t))
+ '(0 1 2 3 4 5 6 7 8 t))
:key-type symbol
:value-type ,modus-themes--headings-choice)
:set #'modus-themes--set-option
@@ -1827,6 +1841,7 @@ value are passed as a symbol. Those are:
yellow, green, blue, in tinted and shaded versions. They cover
the full set of information provided by the `org-habit'
consistency graph.
+
- `simplified' is like the default except that it removes the
dichotomy between current and future variants by applying
uniform color-coded values. It applies a total of four colors:
@@ -1835,15 +1850,17 @@ value are passed as a symbol. Those are:
the default. The intent is to shift focus towards the
distinction between the four states of a habit task, rather
than each state's present/future outlook.
+
- `traffic-light' further reduces the available colors to red,
yellow, and green. As in `simplified', present and future
- variants appear uniformly, but differently from it, the 'clear'
+ variants appear uniformly, but differently from it, the CLEAR
state is rendered in a green hue, instead of the original blue.
This is meant to capture the use-case where a habit task being
- \"too early\" is less important than it being \"too late\".
- The difference between ready and clear states is attenuated by
+ too early is less important than it being too late. The
+ difference between READY and CLEAR states is attenuated by
painting both of them using shades of green. This option thus
highlights the alert and overdue states.
+
- When `modus-themes-deuteranopia' is non-nil the exact style of
the habit graph adapts to the needs of users with red-green
color deficiency by substituting every instance of green with
@@ -2060,7 +2077,7 @@ active mode line. The inactive mode lines remain
two-dimensional
and are toned down a bit, relative to the default style.
The `moody' property optimizes the mode line for use with the
-library of the same name (hereinafter referred to as 'Moody').
+library of the same name (hereinafter referred to as Moody).
In practice, it removes the box effect and replaces it with
underline and overline properties. It also tones down the
inactive mode lines. Despite its intended purpose, this option
@@ -2253,7 +2270,7 @@ follows (order is not significant):
The `popup' key takes the same values as `selection'.
-Apart from specfying each key separately, a fallback list is
+Apart from specifying each key separately, a fallback list is
accepted. This is only useful when the desired aesthetic is the
same across all keys that are not explicitly referenced. For
example, this:
@@ -3113,10 +3130,10 @@ theme's fallback text color."
(defun modus-themes--paren (normalbg intensebg)
"Conditional use of intense colors for matching parentheses.
-NORMALBG should be the special palette color 'bg-paren-match' or
+NORMALBG should be the special palette color bg-paren-match or
something similar. INTENSEBG must be easier to discern next to
other backgrounds, such as the special palette color
-'bg-paren-match-intense'."
+bg-paren-match-intense."
(let ((properties (modus-themes--list-or-warn 'modus-themes-paren-match)))
(list :inherit
(if (memq 'bold properties)
@@ -3197,7 +3214,7 @@ an alternative to the default value."
((and (memq 'alt-syntax properties)
(memq 'yellow-comments properties)
(not (memq 'green-strings properties)))
- (or faint-yellow yellow))
+ yellow)
((memq 'yellow-comments properties)
yellow)
((memq 'faint properties)
@@ -3382,8 +3399,8 @@ clearly distinguishes past, present, future tasks."
(defun modus-themes--agenda-habit (default traffic simple &optional default-d
traffic-d simple-d)
"Specify background values for `modus-themes-org-agenda' habits.
DEFAULT is the original foregrounc color. TRAFFIC is to be used
-when the 'traffic-light' style is applied, while SIMPLE
-corresponds to the 'simplified style'.
+when the traffic-light style is applied, while SIMPLE corresponds
+to the simplified style.
Optional DEFAULT-D, TRAFFIC-D, SIMPLE-D are alternatives to the
main colors, meant for dopia when `modus-themes-deuteranopia' is
@@ -3880,32 +3897,44 @@ pressed button style, else the released button."
;;;; Utilities for DIY users
-;;;;; List colors (a respin of M-x list-colors-display)
+;;;;; List colors (a variant of M-x list-colors-display)
-(defun modus-themes--list-colors-render (buffer palette)
- "Render colors in BUFFER from PALETTE.
+(defun modus-themes--list-colors-render (buffer theme &rest _)
+ "Render colors in BUFFER from THEME.
Routine for `modus-themes-list-colors'."
- (with-help-window buffer
- (with-current-buffer standard-output
- (erase-buffer)
- ;; We need this to properly render the first line.
- (insert " ")
- (dolist (cell palette)
- (let* ((name (car cell))
- (color (cdr cell))
- (fg (readable-foreground-color color))
- (pad (make-string 5 ?\s)))
- (let ((old-point (point)))
- (insert (format "%s %s" color pad))
- (put-text-property old-point (point) 'face `( :foreground ,color)))
- (let ((old-point (point)))
- (insert (format " %s %s %s\n" color pad name))
- (put-text-property old-point (point)
- 'face `( :background ,color
- :foreground ,fg
- :extend t)))
- ;; We need this to properly render the last line.
- (insert " "))))))
+ (let ((palette (seq-uniq (modus-themes--palette theme)
+ (lambda (x y)
+ (eq (car x) (car y)))))
+ (current-buffer buffer)
+ (current-theme theme))
+ (with-help-window buffer
+ (with-current-buffer standard-output
+ (erase-buffer)
+ (when (<= (display-color-cells) 256)
+ (insert (concat "Your display terminal may not render all color
previews!\n"
+ "It seems to only support <= 256 colors.\n\n"))
+ (put-text-property (point-min) (point) 'face 'warning))
+ ;; We need this to properly render the first line.
+ (insert " ")
+ (dolist (cell palette)
+ (let* ((name (car cell))
+ (color (cdr cell))
+ (fg (readable-foreground-color color))
+ (pad (make-string 5 ?\s)))
+ (let ((old-point (point)))
+ (insert (format "%s %s" color pad))
+ (put-text-property old-point (point) 'face `( :foreground
,color)))
+ (let ((old-point (point)))
+ (insert (format " %s %s %s\n" color pad name))
+ (put-text-property old-point (point)
+ 'face `( :background ,color
+ :foreground ,fg
+ :extend t)))
+ ;; We need this to properly render the last line.
+ (insert " ")))
+ (setq-local revert-buffer-function
+ (lambda (_ignore-auto _noconfirm)
+ (modus-themes--list-colors-render current-buffer
current-theme)))))))
(defvar modus-themes--list-colors-prompt-history '()
"Minibuffer history for `modus-themes--list-colors-prompt'.")
@@ -3921,15 +3950,10 @@ Helper function for `modus-themes-list-colors'."
(defun modus-themes-list-colors (theme)
"Preview palette of the Modus THEME of choice."
- (interactive
- (list (intern (modus-themes--list-colors-prompt))))
- (let ((palette (pcase theme
- ('modus-operandi modus-themes-operandi-colors)
- ('modus-vivendi modus-themes-vivendi-colors)
- (_ (user-error "`%s' is not a Modus theme" theme)))))
- (modus-themes--list-colors-render
- (format "*%s-list-colors*" theme)
- palette)))
+ (interactive (list (intern (modus-themes--list-colors-prompt))))
+ (modus-themes--list-colors-render
+ (format "*%s-list-colors*" theme)
+ theme))
(defun modus-themes-list-colors-current ()
"Call `modus-themes-list-colors' for the current Modus theme."
@@ -4209,6 +4233,10 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(modus-themes-mark-symbol ((,class :inherit bold :foreground ,blue-alt)))
;;;;; heading levels
;; styles for regular headings used in Org, Markdown, Info, etc.
+ `(modus-themes-heading-0
+ ((,class ,@(modus-themes--heading
+ 0 cyan-alt-other blue-alt
+ cyan-nuanced-bg bg-alt bg-region))))
`(modus-themes-heading-1
((,class ,@(modus-themes--heading
1 fg-main magenta-alt-other
@@ -4265,12 +4293,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
((,class ,@(modus-themes--markup magenta-alt magenta-intense bg-alt
bg-special-faint-calm))))
;;;;; search
- `(modus-themes-search-success ((,class :inherit ,@(modus-themes--deuteran
-
'modus-themes-intense-blue
-
'modus-themes-intense-green))))
- `(modus-themes-search-success-lazy ((,class :inherit
,@(modus-themes--deuteran
-
'modus-themes-special-mild
-
'modus-themes-refine-cyan))))
+ `(modus-themes-search-success ((,class :inherit
modus-themes-intense-yellow)))
+ `(modus-themes-search-success-lazy ((,class :inherit
modus-themes-subtle-cyan)))
`(modus-themes-search-success-modeline ((,class :foreground
,@(modus-themes--deuteran
blue-active
green-active))))
@@ -4330,7 +4354,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
cyan-alt-other blue-alt-other fg-alt
cyan-nuanced-bg blue-refine-bg fg-main
bg-alt bg-active))))
- `(modus-themes-reset-hard ((,class :inherit (fixed-pitch
modus-themes-reset-soft))))
+ `(modus-themes-reset-hard ((,class :inherit (fixed-pitch
modus-themes-reset-soft)
+ :family ,(face-attribute 'default
:family))))
`(modus-themes-reset-soft ((,class :background ,bg-main :foreground
,fg-main
:weight normal :slant normal
:strike-through nil
:box nil :underline nil :overline nil
:extend nil)))
@@ -4350,6 +4375,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(comint-highlight-input ((,class :inherit bold)))
`(comint-highlight-prompt ((,class :inherit modus-themes-prompt)))
`(confusingly-reordered ((,class :inherit modus-themes-lang-error)))
+ `(edmacro-label ((,class :inherit bold :foreground ,cyan)))
`(elisp-shorthand-font-lock-face ((,class :inherit
font-lock-variable-name-face)))
`(error ((,class :inherit bold :foreground ,red)))
`(escape-glyph ((,class :foreground ,fg-escape-char-construct)))
@@ -4369,8 +4395,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(mm-command-output ((,class :foreground ,red-alt-other)))
`(mm-uu-extract ((,class :background ,bg-dim :foreground
,fg-special-mild)))
`(next-error ((,class :inherit modus-themes-subtle-red :extend t)))
- `(pgtk-im-0 ((,class :inherit modus-themes-fringe-blue :underline t)))
- `(rectangle-preview ((,class :background ,bg-special-faint-warm
:foreground ,fg-special-warm)))
+ `(pgtk-im-0 ((,class :inherit modus-themes-refine-cyan)))
+ `(rectangle-preview ((,class :inherit modus-themes-special-warm)))
`(region ((,class ,@(modus-themes--region bg-region fg-main
bg-hl-alt-intense
bg-region-accent
bg-region-accent-subtle))))
@@ -4477,8 +4503,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(anzu-match-3 ((,class :inherit modus-themes-subtle-yellow)))
`(anzu-mode-line ((,class :inherit (bold
modus-themes-search-success-modeline))))
`(anzu-mode-line-no-match ((,class :inherit bold :foreground ,red-active)))
- `(anzu-replace-highlight ((,class :inherit modus-themes-refine-yellow
:underline t)))
- `(anzu-replace-to ((,class :inherit (modus-themes-search-success bold))))
+ `(anzu-replace-highlight ((,class :inherit modus-themes-refine-red
:underline t)))
+ `(anzu-replace-to ((,class :inherit modus-themes-search-success)))
;;;;; apropos
`(apropos-button ((,class :foreground ,magenta-alt-other)))
`(apropos-function-button ((,class :foreground ,magenta)))
@@ -4631,18 +4657,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(calibredb-mark-face ((,class :inherit modus-themes-mark-sel)))
`(calibredb-size-face (( )))
`(calibredb-tag-face ((,class :foreground ,magenta-alt-faint)))
-;;;;; centaur-tabs
- `(centaur-tabs-active-bar-face ((,class :background ,blue-active)))
- `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground
,red-active :underline t)))
- `(centaur-tabs-close-selected ((,class :inherit centaur-tabs-selected)))
- `(centaur-tabs-close-unselected ((,class :inherit
centaur-tabs-unselected)))
- `(centaur-tabs-modified-marker-selected ((,class :inherit
centaur-tabs-selected)))
- `(centaur-tabs-modified-marker-unselected ((,class :inherit
centaur-tabs-unselected)))
- `(centaur-tabs-default ((,class :background ,bg-main)))
- `(centaur-tabs-selected ((,class :inherit modus-themes-tab-active)))
- `(centaur-tabs-selected-modified ((,class :inherit (italic
centaur-tabs-selected))))
- `(centaur-tabs-unselected ((,class :inherit modus-themes-tab-inactive)))
- `(centaur-tabs-unselected-modified ((,class :inherit (italic
centaur-tabs-unselected))))
;;;;; cfrs
`(cfrs-border-color ((,class :background ,fg-window-divider-inner)))
;;;;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
@@ -4737,7 +4751,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(company-tooltip-scrollbar-thumb ((,class :background ,fg-active)))
`(company-tooltip-scrollbar-track ((,class :background ,bg-active)))
`(company-tooltip-search ((,class :inherit
(modus-themes-search-success-lazy bold))))
- `(company-tooltip-search-selection ((,class :inherit
(modus-themes-search-success bold) :underline t)))
+ `(company-tooltip-search-selection ((,class :inherit
modus-themes-search-success :underline t)))
`(company-tooltip-selection ((,class :inherit
modus-themes-completion-selected-popup)))
;;;;; company-posframe
`(company-posframe-active-backend-name ((,class :inherit bold :background
,bg-active :foreground ,blue-active)))
@@ -4815,11 +4829,9 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; csv-mode
`(csv-separator-face ((,class :foreground ,red-intense)))
;;;;; ctrlf
- `(ctrlf-highlight-active ((,class :inherit (modus-themes-search-success
bold))))
+ `(ctrlf-highlight-active ((,class :inherit modus-themes-search-success)))
`(ctrlf-highlight-line ((,class :inherit modus-themes-hl-line)))
`(ctrlf-highlight-passive ((,class :inherit
modus-themes-search-success-lazy)))
-;;;;; cursor-flash
- `(cursor-flash-face ((,class :inherit modus-themes-intense-blue)))
;;;;; custom (M-x customize)
`(custom-button ((,class :inherit modus-themes-box-button)))
`(custom-button-mouse ((,class :inherit (highlight custom-button))))
@@ -4852,12 +4864,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(dap-ui-sessions-stack-frame-face ((,class :inherit bold :foreground
,magenta-alt)))
`(dap-ui-sessions-terminated-active-face ((,class :inherit bold
:foreground ,fg-alt)))
`(dap-ui-sessions-terminated-face ((,class :inherit shadow)))
-;;;;; dashboard (emacs-dashboard)
- `(dashboard-banner-logo-title ((,class :inherit bold :foreground
,fg-special-cold)))
- `(dashboard-footer ((,class :inherit bold :foreground ,fg-special-mild)))
- `(dashboard-heading ((,class :inherit bold :foreground ,fg-special-warm)))
- `(dashboard-navigator ((,class :foreground ,cyan-alt-other)))
- `(dashboard-text-banner ((,class :foreground ,fg-dim)))
;;;;; deadgrep
`(deadgrep-filename-face ((,class :inherit bold :foreground
,fg-special-cold)))
`(deadgrep-match-face ((,class :inherit modus-themes-special-calm)))
@@ -4878,13 +4884,15 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(debbugs-gnu-stale-5 ((,class :foreground ,red-alt)))
`(debbugs-gnu-tagged ((,class :foreground ,magenta-alt)))
;;;;; deft
- `(deft-filter-string-error-face ((,class :inherit
modus-themes-refine-red)))
- `(deft-filter-string-face ((,class :foreground ,green-intense)))
- `(deft-header-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(deft-separator-face ((,class :inherit shadow)))
+ `(deft-filter-string-face ((,class :inherit bold :foreground ,blue)))
+ `(deft-header-face ((,class :foreground ,fg-special-warm)))
+ `(deft-separator-face ((,class :foreground "gray50")))
`(deft-summary-face ((,class :inherit (shadow modus-themes-slant))))
- `(deft-time-face ((,class :foreground ,fg-special-cold)))
- `(deft-title-face ((,class :inherit bold :foreground ,fg-main)))
+ `(deft-time-face ((,class :foreground ,cyan)))
+ `(deft-title-face ((,class :inherit bold)))
+;;;;; denote
+ `(denote-faces-date ((,class :foreground ,cyan)))
+ `(denote-faces-keywords ((,class :inherit modus-themes-bold :foreground
,magenta-alt)))
;;;;; devdocs
`(devdocs-code-block ((,class :inherit modus-themes-fixed-pitch
:background ,bg-dim :extend t)))
;;;;; dictionary
@@ -4962,7 +4970,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(dired-git-branch-else ((,class :inherit bold :foreground ,magenta-alt)))
`(dired-git-branch-master ((,class :inherit bold :foreground
,magenta-alt-other)))
;;;;; dired-git-info
- `(dgi-commit-message-face ((,class :foreground ,fg-special-mild)))
+ `(dgi-commit-message-face ((,class :foreground ,cyan-alt-other)))
;;;;; dired-narrow
`(dired-narrow-blink ((,class :inherit (modus-themes-subtle-cyan bold))))
;;;;; dired-subtree
@@ -5072,11 +5080,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(doom-modeline-unread-number ((,class :inherit italic :foreground
,fg-active)))
`(doom-modeline-urgent ((,class :inherit bold :foreground ,red-active)))
`(doom-modeline-warning ((,class :inherit bold :foreground
,yellow-active)))
-;;;;; dynamic-ruler
- `(dynamic-ruler-negative-face ((,class :inherit
modus-themes-intense-neutral)))
- `(dynamic-ruler-positive-face ((,class :inherit
modus-themes-intense-yellow)))
;;;;; easy-jekyll
- `(easy-jekyll-help-face ((,class :background ,bg-dim :foreground
,cyan-alt-other)))
+ `(easy-jekyll-help-face ((,class :background ,bg-dim :foreground
,blue-alt-other)))
;;;;; ebdb
`(ebdb-address-default ((,class :foreground ,fg-special-calm)))
`(ebdb-defunct ((,class :inherit shadow)))
@@ -5318,7 +5323,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(evil-ex-lazy-highlight ((,class :inherit
modus-themes-search-success-lazy)))
`(evil-ex-search ((,class :inherit modus-themes-search-success)))
`(evil-ex-substitute-matches ((,class :inherit modus-themes-refine-yellow
:underline t)))
- `(evil-ex-substitute-replacement ((,class :inherit
(modus-themes-search-success bold))))
+ `(evil-ex-substitute-replacement ((,class :inherit
modus-themes-search-success)))
;;;;; evil-goggles
`(evil-goggles-change-face ((,class :inherit modus-themes-refine-yellow)))
`(evil-goggles-commentary-face ((,class :inherit
(modus-themes-subtle-neutral modus-themes-slant))))
@@ -5403,13 +5408,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(flx-highlight-face ((,class :inherit modus-themes-completion-match-0)))
;;;;; freeze-it
`(freeze-it-show ((,class :background ,bg-dim :foreground
,fg-special-warm)))
-;;;;; frog-menu
- `(frog-menu-action-keybinding-face ((,class :inherit
modus-themes-key-binding)))
- `(frog-menu-actions-face ((,class :foreground ,magenta)))
- `(frog-menu-border ((,class :background ,bg-active)))
- `(frog-menu-candidates-face ((,class :foreground ,fg-main)))
- `(frog-menu-posframe-background-face ((,class :background ,bg-dim)))
- `(frog-menu-prompt-face ((,class :foreground ,cyan)))
;;;;; focus
`(focus-unfocused ((,class :foreground ,fg-unfocused)))
;;;;; fold-this
@@ -5467,7 +5465,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
blue-alt blue-alt-faint))))
`(font-lock-warning-face ((,class :inherit modus-themes-bold
,@(modus-themes--syntax-foreground
- yellow-active yellow-alt-faint))))
+ yellow yellow-alt-faint))))
;;;;; forge
`(forge-post-author ((,class :inherit bold :foreground ,fg-main)))
`(forge-post-date ((,class :foreground ,fg-special-cold)))
@@ -5715,18 +5713,20 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; helpful
`(helpful-heading ((,class :inherit modus-themes-heading-1)))
;;;;; highlight region or ad-hoc regexp
- `(hi-aquamarine ((,class :background ,cyan-subtle-bg :foreground
,fg-main)))
- `(hi-black-b ((,class :inherit bold :background ,fg-main :foreground
,bg-main)))
- `(hi-black-hb ((,class :inherit bold :background ,fg-alt :foreground
,bg-main)))
- `(hi-blue ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
+ ;; HACK 2022-06-23: The :inverse-video prevents hl-line-mode from
+ ;; overriding the background. Such an override really defeats the
+ ;; purpose of setting those highlights.
+ `(hi-aquamarine ((,class :background ,bg-main :foreground ,cyan
:inverse-video t)))
+ `(hi-black-b ((,class :inverse-video t)))
+ `(hi-black-hb ((,class :background ,bg-main :foreground ,fg-alt
:inverse-video t)))
+ `(hi-blue ((,class :background ,bg-main :foreground ,blue-alt
:inverse-video t)))
`(hi-blue-b ((,class :inherit (bold hi-blue))))
- `(hi-green ((,class :background ,green-subtle-bg :foreground ,fg-main)))
+ `(hi-green ((,class :background ,bg-main :foreground ,green :inverse-video
t)))
`(hi-green-b ((,class :inherit (bold hi-green))))
- `(hi-pink ((,class :background ,magenta-subtle-bg :foreground ,fg-main)))
- `(hi-pink-b ((,class :inherit (bold hi-pink))))
- `(hi-red-b ((,class :inherit bold :background ,red-intense-bg :foreground
,fg-main)))
- `(hi-salmon ((,class :background ,red-subtle-bg :foreground ,fg-main)))
- `(hi-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-main)))
+ `(hi-pink ((,class :background ,bg-main :foreground ,magenta
:inverse-video t)))
+ `(hi-red-b ((,class :inherit bold :background ,bg-main :foreground ,red
:inverse-video t)))
+ `(hi-salmon ((,class :background ,bg-main :foreground ,red-alt-faint
:inverse-video t)))
+ `(hi-yellow ((,class :background ,bg-main :foreground ,yellow-alt
:inverse-video t)))
`(highlight ((,class ,@(if modus-themes-intense-mouseovers
(list :background blue-intense-bg :foreground
fg-main)
(list :background cyan-subtle-bg :foreground
fg-main)))))
@@ -5740,7 +5740,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; highlight-numbers
`(highlight-numbers-number ((,class :foreground ,blue-alt-other)))
;;;;; highlight-thing
- `(highlight-thing ((,class :background ,bg-alt :foreground ,cyan)))
+ `(highlight-thing ((,class :inherit modus-themes-special-calm)))
;;;;; hl-defined
`(hdefd-functions ((,class :foreground ,blue)))
`(hdefd-undefined ((,class :foreground ,red-alt)))
@@ -5805,6 +5805,26 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(info-title-2 ((,class :inherit modus-themes-heading-2)))
`(info-title-3 ((,class :inherit modus-themes-heading-3)))
`(info-title-4 ((,class :inherit modus-themes-heading-4)))
+;;;;; info+ (info-plus)
+ `(info-command-ref-item ((,class :inherit font-lock-function-name-face)))
+ `(info-constant-ref-item ((,class :inherit font-lock-constant-face)))
+ `(info-custom-delimited ((,class :inherit modus-themes-markup-verbatim)))
+ `(info-double-quoted-name ((,class :inherit font-lock-string-face)))
+ `(info-file (( )))
+ `(info-function-ref-item ((,class :inherit font-lock-function-name-face)))
+ `(info-glossary-word ((,class :inherit modus-themes-box-button)))
+ `(info-indented-text (( )))
+ `(info-isolated-backquote (( )))
+ `(info-isolated-quote (( )))
+ `(info-macro-ref-item ((,class :inherit font-lock-keyword-face)))
+ `(info-menu ((,class :inherit bold)))
+ `(info-quoted-name ((,class :inherit modus-themes-markup-verbatim)))
+ `(info-reference-item ((,class :inherit bold)))
+ `(info-special-form-ref-item ((,class :inherit warning)))
+ `(info-string ((,class :inherit font-lock-string-face)))
+ `(info-syntax-class-item ((,class :inherit modus-themes-markup-code)))
+ `(info-user-option-ref-item ((,class :inherit
font-lock-variable-name-face)))
+ `(info-variable-ref-item ((,class :inherit font-lock-variable-name-face)))
;;;;; info-colors
`(info-colors-lisp-code-block ((,class :inherit modus-themes-fixed-pitch)))
`(info-colors-ref-item-command ((,class :inherit
font-lock-function-name-face)))
@@ -5834,13 +5854,13 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(ioccur-regexp-face ((,class :inherit (modus-themes-intense-magenta
bold))))
`(ioccur-title-face ((,class :inherit modus-themes-pseudo-header
:foreground ,fg-special-cold)))
;;;;; isearch, occur, and the like
- `(isearch ((,class :inherit (modus-themes-search-success bold))))
+ `(isearch ((,class :inherit modus-themes-search-success)))
`(isearch-fail ((,class :inherit modus-themes-refine-red)))
`(isearch-group-1 ((,class :inherit modus-themes-refine-blue)))
`(isearch-group-2 ((,class :inherit modus-themes-refine-magenta)))
`(lazy-highlight ((,class :inherit modus-themes-search-success-lazy)))
`(match ((,class :inherit modus-themes-special-calm)))
- `(query-replace ((,class :inherit (modus-themes-intense-yellow bold))))
+ `(query-replace ((,class :inherit modus-themes-intense-red)))
;;;;; ivy
`(ivy-action ((,class :inherit modus-themes-key-binding)))
`(ivy-confirm-face ((,class :inherit success)))
@@ -5921,12 +5941,14 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(ledger-font-payee-pending-face ((,class :foreground ,yellow)))
`(ledger-font-payee-uncleared-face ((,class :foreground ,red-alt-other)))
`(ledger-font-xact-highlight-face ((,class :background ,bg-hl-alt)))
+;;;;; leerzeichen
+ `(leerzeichen ((,class :background ,bg-whitespace :foreground
,fg-whitespace)))
;;;;; line numbers (display-line-numbers-mode and global variant)
;; Here we cannot inherit `modus-themes-fixed-pitch'. We need to
;; fall back to `default' otherwise line numbers do not scale when
;; using `text-scale-adjust'.
`(line-number
- ((,class :inherit ,(if modus-themes-mixed-fonts 'fixed-pitch 'default)
+ ((,class :inherit ,(if modus-themes-mixed-fonts '(fixed-pitch default)
'default)
,@(modus-themes--line-numbers
fg-alt bg-dim
fg-unfocused))))
@@ -6120,8 +6142,9 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(makefile-makepp-perl ((,class :background ,cyan-nuanced-bg)))
`(makefile-space ((,class :background ,magenta-nuanced-bg)))
;;;;; man
- `(Man-overstrike ((,class :inherit bold :foreground ,fg-special-calm)))
+ `(Man-overstrike ((,class :inherit bold :foreground ,magenta-alt)))
`(Man-reverse ((,class :inherit modus-themes-subtle-magenta)))
+ `(Man-underline ((,class :foreground ,cyan-alt-other :underline t)))
;;;;; marginalia
`(marginalia-archive ((,class :foreground ,cyan-alt-other)))
`(marginalia-char ((,class :foreground ,magenta)))
@@ -6235,8 +6258,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(markup-title-4-face ((,class :inherit modus-themes-heading-5)))
`(markup-title-5-face ((,class :inherit modus-themes-heading-6)))
`(markup-verbatim-face ((,class :inherit modus-themes-fixed-pitch
:background ,bg-alt)))
-;;;;; mct
- `(mct-highlight-candidate ((,class :inherit
modus-themes-completion-selected)))
;;;;; mentor
`(mentor-download-message ((,class :foreground ,fg-special-warm)))
`(mentor-download-name ((,class :foreground ,fg-special-cold)))
@@ -6450,14 +6471,12 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-agenda-column-dateline ((,class :background ,bg-alt)))
`(org-agenda-current-time ((,class :foreground ,blue-alt-other-faint)))
`(org-agenda-date ((,class ,@(modus-themes--agenda-date cyan fg-main))))
- `(org-agenda-date-today ((,class ,@(modus-themes--agenda-date cyan fg-main
- nil nil
- bg-inactive
t t))))
- `(org-agenda-date-weekend ((,class ,@(modus-themes--agenda-date
cyan-alt-other-faint fg-alt
- cyan
fg-main))))
- `(org-agenda-date-weekend-today ((,class ,@(modus-themes--agenda-date
cyan-alt-other-faint fg-alt
- cyan
fg-main
-
bg-inactive t t))))
+ `(org-agenda-date-today
+ ((,class ,@(modus-themes--agenda-date cyan fg-main nil nil
bg-special-cold t t))))
+ `(org-agenda-date-weekend
+ ((,class ,@(modus-themes--agenda-date cyan-alt-other-faint fg-alt cyan
fg-main))))
+ `(org-agenda-date-weekend-today
+ ((,class ,@(modus-themes--agenda-date cyan-alt-other-faint fg-alt cyan
fg-main bg-special-cold t t))))
`(org-agenda-diary ((,class :inherit org-agenda-calendar-sexp)))
`(org-agenda-dimmed-todo-face ((,class :inherit shadow)))
`(org-agenda-done ((,class :inherit modus-themes-grue-nuanced)))
@@ -6491,7 +6510,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-dispatcher-highlight ((,class :inherit (bold
modus-themes-mark-alt))))
`(org-document-info ((,class :foreground ,fg-special-cold)))
`(org-document-info-keyword ((,class :inherit (shadow
modus-themes-fixed-pitch))))
- `(org-document-title ((,class :inherit modus-themes-heading-1 :background
,bg-main :overline nil :foreground ,fg-special-cold)))
+ `(org-document-title ((,class :inherit modus-themes-heading-0)))
`(org-done ((,class :inherit modus-themes-grue)))
`(org-drawer ((,class :inherit (shadow modus-themes-fixed-pitch))))
`(org-ellipsis (())) ; inherits from the heading's color
@@ -6589,8 +6608,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-journal-calendar-scheduled-face ((,class :inherit modus-themes-slant
:foreground ,red-alt-other)))
`(org-journal-highlight ((,class :foreground ,magenta-alt)))
;;;;; org-noter
- `(org-noter-no-notes-exist-face ((,class :inherit bold :foreground
,red-active)))
- `(org-noter-notes-exist-face ((,class :inherit bold :foreground
,green-active)))
+ `(org-noter-no-notes-exist-face ((,class :inherit error)))
+ `(org-noter-notes-exist-face ((,class :inherit success)))
;;;;; org-pomodoro
`(org-pomodoro-mode-line ((,class :foreground ,red-active)))
`(org-pomodoro-mode-line-break ((,class :foreground ,cyan-active)))
@@ -6613,9 +6632,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(org-table-sticky-header-face ((,class :inherit
modus-themes-special-cold)))
;;;;; org-tree-slide
`(org-tree-slide-header-overlay-face ((,class :inherit
org-document-title)))
-;;;;; org-treescope
- `(org-treescope-faces--markerinternal-midday ((,class :inherit
modus-themes-intense-blue)))
- `(org-treescope-faces--markerinternal-range ((,class :inherit
modus-themes-special-mild)))
;;;;; origami
`(origami-fold-header-face ((,class :background ,bg-dim :foreground
,fg-dim :box t)))
`(origami-fold-replacement-face ((,class :background ,bg-alt :foreground
,fg-alt)))
@@ -6632,19 +6648,19 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(outline-minor-0 (()))
;;;;; package (M-x list-packages)
`(package-description ((,class :foreground ,fg-special-cold)))
- `(package-help-section-name ((,class :inherit bold :foreground
,magenta-alt-other)))
+ `(package-help-section-name ((,class :inherit bold :foreground ,cyan)))
`(package-name ((,class :inherit button)))
- `(package-status-avail-obso ((,class :inherit bold :foreground ,red)))
- `(package-status-available ((,class :foreground ,fg-special-mild)))
+ `(package-status-available ((,class :foreground ,cyan-alt-other)))
+ `(package-status-avail-obso ((,class :inherit error)))
`(package-status-built-in ((,class :foreground ,magenta)))
`(package-status-dependency ((,class :foreground ,magenta-alt-other)))
`(package-status-disabled ((,class :inherit modus-themes-subtle-red)))
`(package-status-external ((,class :foreground ,cyan-alt-other)))
`(package-status-held ((,class :foreground ,yellow-alt)))
- `(package-status-incompat ((,class :inherit bold :foreground ,yellow)))
+ `(package-status-incompat ((,class :inherit warning)))
`(package-status-installed ((,class :foreground ,fg-special-warm)))
- `(package-status-new ((,class :inherit bold :foreground ,green)))
- `(package-status-unsigned ((,class :inherit bold :foreground ,red-alt)))
+ `(package-status-new ((,class :inherit success)))
+ `(package-status-unsigned ((,class :inherit error)))
;;;;; page-break-lines
`(page-break-lines ((,class :inherit default :foreground
,fg-window-divider-outer)))
;;;;; pandoc-mode
@@ -6653,19 +6669,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(pandoc-directive-braces-face ((,class :foreground ,blue-alt-other)))
`(pandoc-directive-contents-face ((,class :foreground ,cyan-alt-other)))
`(pandoc-directive-type-face ((,class :foreground ,magenta)))
-;;;;; paradox
- `(paradox-archive-face ((,class :foreground ,fg-special-mild)))
- `(paradox-comment-face ((,class :inherit font-lock-comment-face)))
- `(paradox-commit-tag-face ((,class :inherit modus-themes-refine-magenta
:box t)))
- `(paradox-description-face ((,class :foreground ,fg-special-cold)))
- `(paradox-description-face-multiline ((,class :foreground
,fg-special-cold)))
- `(paradox-download-face ((,class :inherit modus-themes-bold :foreground
,blue-alt-other)))
- `(paradox-highlight-face ((,class :inherit modus-themes-bold :foreground
,cyan-alt-other)))
- `(paradox-homepage-button-face ((,class :foreground ,magenta-alt-other
:underline t)))
- `(paradox-mode-line-face ((,class :inherit bold :foreground ,cyan-active)))
- `(paradox-name-face ((,class :foreground ,blue :underline t)))
- `(paradox-star-face ((,class :foreground ,magenta)))
- `(paradox-starred-face ((,class :foreground ,magenta-alt)))
;;;;; paren-face
`(parenthesis ((,class :foreground ,fg-unfocused)))
;;;;; pass
@@ -6695,7 +6698,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(pomidor-work-face ((,class :inherit modus-themes-grue)))
;;;;; popup
`(popup-face ((,class :background ,bg-alt :foreground ,fg-main)))
- `(popup-isearch-match ((,class :inherit (modus-themes-search-success
bold))))
+ `(popup-isearch-match ((,class :inherit modus-themes-search-success)))
`(popup-menu-mouse-face ((,class :inherit highlight)))
`(popup-menu-selection-face ((,class :inherit
modus-themes-completion-selected-popup)))
`(popup-scroll-bar-background-face ((,class :background ,bg-active)))
@@ -6703,12 +6706,12 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(popup-summary-face ((,class :background ,bg-active :foreground
,fg-inactive)))
`(popup-tip-face ((,class :inherit modus-themes-refine-yellow)))
;;;;; powerline
- `(powerline-active0 ((,class :background ,blue-faint :foreground
,bg-main)))
- `(powerline-active1 ((,class :background ,blue-nuanced-bg :foreground
,blue-nuanced-fg)))
- `(powerline-active2 ((,class :background ,bg-active :foreground
,fg-active)))
- `(powerline-inactive0 ((,class :background ,bg-special-cold :foreground
,fg-special-cold)))
- `(powerline-inactive1 ((,class :background ,bg-dim :foreground
,fg-inactive)))
- `(powerline-inactive2 ((,class :background ,bg-inactive :foreground
,fg-inactive)))
+ `(powerline-active0 ((,class :background ,fg-unfocused :foreground
,bg-main)))
+ `(powerline-active1 ((,class :inherit mode-line-active)))
+ `(powerline-active2 ((,class :inherit mode-line-inactive)))
+ `(powerline-inactive0 ((,class :background ,bg-active :foreground
,fg-alt)))
+ `(powerline-inactive1 ((,class :background ,bg-main :foreground ,fg-alt)))
+ `(powerline-inactive2 ((,class :inherit mode-line-inactive)))
;;;;; powerline-evil
`(powerline-evil-base-face ((,class :background ,fg-main :foreground
,bg-main)))
`(powerline-evil-emacs-face ((,class :inherit
modus-themes-active-magenta)))
@@ -6834,10 +6837,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; selectrum
`(selectrum-current-candidate ((,class :inherit
modus-themes-completion-selected)))
`(selectrum-mouse-highlight ((,class :inherit highlight)))
- `(selectrum-quick-keys-highlight
- ((,class :inherit modus-themes-refine-red)))
- `(selectrum-quick-keys-match
- ((,class :inherit (bold modus-themes-search-success))))
+ `(selectrum-quick-keys-highlight ((,class :inherit bold :background
,bg-char-0)))
+ `(selectrum-quick-keys-match ((,class :inherit bold :background
,bg-char-1)))
;;;;; selectrum-prescient
`(selectrum-prescient-primary-highlight ((,class :inherit
modus-themes-completion-match-0)))
`(selectrum-prescient-secondary-highlight ((,class :inherit
modus-themes-completion-match-1)))
@@ -6854,8 +6855,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(semantic-tag-boundary-face ((,class :overline ,blue-intense)))
`(semantic-unmatched-syntax-face ((,class :underline ,fg-lang-error)))
;;;;; sesman
- `(sesman-browser-button-face ((,class :foreground ,blue-alt-other
:underline t)))
- `(sesman-browser-highligh-face ((,class :inherit
modus-themes-subtle-blue)))
+ `(sesman-browser-button-face ((,class :inherit button)))
+ `(sesman-browser-highligh-face ((,class :inherit highlight)))
`(sesman-buffer-face ((,class :foreground ,magenta)))
`(sesman-directory-face ((,class :inherit bold :foreground ,blue)))
`(sesman-project-face ((,class :inherit bold :foreground
,magenta-alt-other)))
@@ -6986,7 +6987,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(speedbar-button-face ((,class :inherit button)))
`(speedbar-directory-face ((,class :inherit bold :foreground ,blue)))
`(speedbar-file-face ((,class :foreground ,fg-main)))
- `(speedbar-highlight-face ((,class :inherit modus-themes-subtle-blue)))
+ `(speedbar-highlight-face ((,class :inherit highlight)))
`(speedbar-selected-face ((,class :inherit bold :foreground ,cyan)))
`(speedbar-separator-face ((,class :inherit modus-themes-intense-neutral)))
`(speedbar-tag-face ((,class :foreground ,yellow-alt-other)))
@@ -7047,14 +7048,14 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(symbol-overlay-face-8 ((,class :inherit modus-themes-refine-cyan)))
;;;;; syslog-mode
`(syslog-debug ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(syslog-error ((,class :inherit bold :foreground ,red)))
+ `(syslog-error ((,class :inherit error)))
`(syslog-file ((,class :inherit bold :foreground ,fg-special-cold)))
`(syslog-hide ((,class :background ,bg-main :foreground ,fg-main)))
`(syslog-hour ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(syslog-info ((,class :inherit bold :foreground ,blue-alt-other)))
+ `(syslog-info ((,class :inherit success)))
`(syslog-ip ((,class :inherit bold :foreground ,fg-special-mild :underline
t)))
`(syslog-su ((,class :inherit bold :foreground ,red-alt)))
- `(syslog-warn ((,class :inherit bold :foreground ,yellow)))
+ `(syslog-warn ((,class :inherit warning)))
;;;;; tab-bar-groups
`(tab-bar-groups-tab-1 ((,class :inherit modus-themes-ui-variable-pitch
:foreground ,blue-tab)))
`(tab-bar-groups-tab-2 ((,class :inherit modus-themes-ui-variable-pitch
:foreground ,red-tab)))
@@ -7427,8 +7428,9 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(writegood-weasels-face ((,class :inherit modus-themes-lang-error)))
;;;;; woman
`(woman-addition ((,class :foreground ,magenta-alt-other)))
- `(woman-bold ((,class :inherit bold :foreground ,fg-special-calm)))
- `(woman-unknown ((,class :foreground ,cyan)))
+ `(woman-bold ((,class :inherit bold :foreground ,magenta-alt)))
+ `(woman-italic ((,class :inherit italic :foreground ,cyan)))
+ `(woman-unknown ((,class :foreground ,green-alt)))
;;;;; xah-elisp-mode
`(xah-elisp-at-symbol ((,class :inherit font-lock-warning-face)))
`(xah-elisp-cap-variable ((,class :inherit font-lock-preprocessor-face)))
@@ -7465,6 +7467,10 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;; awesome-tray
`(awesome-tray-mode-line-active-color ,blue)
`(awesome-tray-mode-line-inactive-color ,bg-active)
+;;;; chart
+ `(chart-face-color-list
+ '( ,red-graph-0-bg ,green-graph-0-bg ,yellow-graph-0-bg ,blue-graph-0-bg
,magenta-graph-0-bg ,cyan-graph-0-bg
+ ,red-graph-1-bg ,green-graph-1-bg ,yellow-graph-1-bg ,blue-graph-1-bg
,magenta-graph-1-bg ,cyan-graph-1-bg))
;;;; exwm
`(exwm-floating-border-color ,fg-window-divider-inner)
;;;; flymake fringe indicators
@@ -7504,29 +7510,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;; pdf-tools
`(pdf-view-midnight-colors
'(,fg-main . ,bg-dim))
-;;;; vc-annotate (C-x v g)
- `(vc-annotate-background nil)
- `(vc-annotate-background-mode nil)
- `(vc-annotate-color-map
- '((20 . ,red)
- (40 . ,magenta)
- (60 . ,magenta-alt)
- (80 . ,red-alt)
- (100 . ,yellow)
- (120 . ,yellow-alt)
- (140 . ,fg-special-warm)
- (160 . ,fg-special-mild)
- (180 . ,green)
- (200 . ,green-alt)
- (220 . ,cyan-alt-other)
- (240 . ,cyan-alt)
- (260 . ,cyan)
- (280 . ,fg-special-cold)
- (300 . ,blue)
- (320 . ,blue-alt)
- (340 . ,blue-alt-other)
- (360 . ,magenta-alt-other)))
- `(vc-annotate-very-old-color nil)
;;;; wid-edit
`(widget-link-prefix ,(if (memq 'all-buttons modus-themes-box-buttons)
" "
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index fe52aefc84..f2c916ef30 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -3,8 +3,10 @@
;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
+;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Version: 2.4.1
+;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Version: 2.5.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
diff --git a/lib-src/etags.c b/lib-src/etags.c
index ef11257926..ed8a218464 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -87,14 +87,6 @@ University of California, as described above. */
#include <config.h>
-/* WIN32_NATIVE is for XEmacs.
- MSDOS, WINDOWSNT, DOS_NT are for Emacs. */
-#ifdef WIN32_NATIVE
-# undef MSDOS
-# undef WINDOWSNT
-# define WINDOWSNT
-#endif /* WIN32_NATIVE */
-
#ifdef MSDOS
# undef MSDOS
# define MSDOS true
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 908d73f525..b5beffce19 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -19,8 +19,8 @@ You should have received a copy of the GNU General Public
License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-/* The arguments given to this program are all the C and some Lisp source files
- of GNU Emacs. .el and .c files are allowed.
+/* The arguments given to this program are all the C files
+ of GNU Emacs. .c files are allowed.
A .o file can also be specified; the .c file it was made from is used.
This helps the makefile pass the correct list of files.
Option -d DIR means change to DIR before looking for files.
@@ -66,7 +66,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#endif /* not DOS_NT */
static void scan_file (char *filename);
-static void scan_lisp_file (const char *filename, const char *mode);
static void scan_c_file (char *filename, const char *mode);
static void scan_c_stream (FILE *infile);
static void start_globals (void);
@@ -236,14 +235,9 @@ put_filename (char *filename)
static void
scan_file (char *filename)
{
- ptrdiff_t len = strlen (filename);
-
if (!generate_globals)
put_filename (filename);
- if (len > 3 && !strcmp (filename + len - 3, ".el"))
- scan_lisp_file (filename, "r");
- else
- scan_c_file (filename, "r");
+ scan_c_file (filename, "r");
}
static void
@@ -1221,352 +1215,4 @@ scan_c_stream (FILE *infile)
fatal ("read error");
}
-/* Read a file of Lisp source code.
- Looks for
- (defun NAME ARGS DOCSTRING ...)
- (defmacro NAME ARGS DOCSTRING ...)
- (defsubst NAME ARGS DOCSTRING ...)
- (autoload (quote NAME) FILE DOCSTRING ...)
- (defvar NAME VALUE DOCSTRING)
- (defconst NAME VALUE DOCSTRING)
- (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
- (fset (quote NAME) #[... DOCSTRING ...])
- (defalias (quote NAME) #[... DOCSTRING ...])
- (custom-declare-variable (quote NAME) VALUE DOCSTRING ...)
- starting in column zero.
- (quote NAME) may appear as 'NAME as well.
-
- We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
- When we find that, we save it for the following defining-form,
- and we use that instead of reading a doc string within that defining-form.
-
- For defvar, defconst, and fset we skip to the docstring with a kludgy
- formatting convention: all docstrings must appear on the same line as the
- initial open-paren (the one in column zero) and must contain a backslash
- and a newline immediately after the initial double-quote. No newlines
- must appear between the beginning of the form and the first double-quote.
- For defun, defmacro, and autoload, we know how to skip over the
- arglist, but the doc string must still have a backslash and newline
- immediately after the double quote.
- The only source files that follow this convention are autoload-generated
- files like loaddefs.el;
- The NAME and DOCSTRING are output.
- NAME is preceded by `F' for a function or `V' for a variable.
- An entry is output only if DOCSTRING has \ newline just after the opening ".
- */
-
-static void
-skip_white (FILE *infile)
-{
- int c;
- do
- c = getc (infile);
- while (c_isspace (c));
-
- ungetc (c, infile);
-}
-
-static void
-read_lisp_symbol (FILE *infile, char *buffer)
-{
- int c;
- char *fillp = buffer;
-
- skip_white (infile);
- while (true)
- {
- c = getc (infile);
- if (c == '\\')
- {
- c = getc (infile);
- if (c < 0)
- return;
- *fillp++ = c;
- }
- else if (c_isspace (c) || c == '(' || c == ')' || c < 0)
- {
- ungetc (c, infile);
- *fillp = 0;
- break;
- }
- else
- *fillp++ = c;
- }
-
- if (! buffer[0])
- fprintf (stderr, "## expected a symbol, got '%c'\n", c);
-
- skip_white (infile);
-}
-
-static bool
-search_lisp_doc_at_eol (FILE *infile)
-{
- int c = 0, c1 = 0, c2 = 0;
-
- /* Skip until the end of line; remember two previous chars. */
- while (c != '\n' && c != '\r' && c != EOF)
- {
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 != '"' || c1 != '\\')
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring found\n");
-#endif
- ungetc (c, infile);
- return false;
- }
- return true;
-}
-
-static void
-scan_lisp_file (const char *filename, const char *mode)
-{
- FILE *infile;
- int c;
-
- if (generate_globals)
- fatal ("scanning lisp file when -g specified");
-
- infile = fopen (filename, mode);
- if (infile == NULL)
- {
- perror (filename);
- exit (EXIT_FAILURE);
- }
-
- c = '\n';
- while (!feof (infile))
- {
- char buffer[BUFSIZ];
- char type;
-
- /* If not at end of line, skip till we get to one. */
- if (c != '\n' && c != '\r')
- {
- c = getc (infile);
- continue;
- }
- /* Skip the line break. */
- while (c == '\n' || c == '\r')
- c = getc (infile);
-
- if (c != '(')
- continue;
-
- read_lisp_symbol (infile, buffer);
-
- if (! strcmp (buffer, "defun")
- || ! strcmp (buffer, "defmacro")
- || ! strcmp (buffer, "defsubst"))
- {
- type = 'F';
- read_lisp_symbol (infile, buffer);
-
- /* Skip the arguments: either "nil" or a list in parens. */
-
- c = getc (infile);
- if (c == 'n') /* nil */
- {
- if ((c = getc (infile)) != 'i'
- || (c = getc (infile)) != 'l')
- {
- fprintf (stderr, "## unparsable arglist in %s (%s)\n",
- buffer, filename);
- continue;
- }
- }
- else if (c != '(')
- {
- fprintf (stderr, "## unparsable arglist in %s (%s)\n",
- buffer, filename);
- continue;
- }
- else
- while (! (c == ')' || c < 0))
- c = getc (infile);
- skip_white (infile);
-
- /* If the next three characters aren't `dquote bslash newline'
- then we're not reading a docstring.
- */
- if ((c = getc (infile)) != '"'
- || (c = getc (infile)) != '\\'
- || ((c = getc (infile)) != '\n' && c != '\r'))
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
-
- else if (! strcmp (buffer, "defvar")
- || ! strcmp (buffer, "defconst")
- || ! strcmp (buffer, "defcustom"))
- {
- type = 'V';
- read_lisp_symbol (infile, buffer);
-
- if (!search_lisp_doc_at_eol (infile))
- continue;
- }
-
- else if (! strcmp (buffer, "custom-declare-variable")
- || ! strcmp (buffer, "defvaralias")
- )
- {
- type = 'V';
-
- c = getc (infile);
- if (c == '\'')
- read_lisp_symbol (infile, buffer);
- else
- {
- if (c != '(')
- {
- fprintf (stderr,
- "## unparsable name in custom-declare-variable in
%s\n",
- filename);
- continue;
- }
- read_lisp_symbol (infile, buffer);
- if (strcmp (buffer, "quote"))
- {
- fprintf (stderr,
- "## unparsable name in custom-declare-variable in
%s\n",
- filename);
- continue;
- }
- read_lisp_symbol (infile, buffer);
- c = getc (infile);
- if (c != ')')
- {
- fprintf (stderr,
- "## unparsable quoted name in
custom-declare-variable in %s\n",
- filename);
- continue;
- }
- }
-
- if (!search_lisp_doc_at_eol (infile))
- continue;
- }
-
- else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
- {
- type = 'F';
-
- c = getc (infile);
- if (c == '\'')
- read_lisp_symbol (infile, buffer);
- else
- {
- if (c != '(')
- {
- fprintf (stderr, "## unparsable name in fset in %s\n",
- filename);
- continue;
- }
- read_lisp_symbol (infile, buffer);
- if (strcmp (buffer, "quote"))
- {
- fprintf (stderr, "## unparsable name in fset in %s\n",
- filename);
- continue;
- }
- read_lisp_symbol (infile, buffer);
- c = getc (infile);
- if (c != ')')
- {
- fprintf (stderr,
- "## unparsable quoted name in fset in %s\n",
- filename);
- continue;
- }
- }
-
- if (!search_lisp_doc_at_eol (infile))
- continue;
- }
-
- else if (! strcmp (buffer, "autoload"))
- {
- type = 'F';
- c = getc (infile);
- if (c == '\'')
- read_lisp_symbol (infile, buffer);
- else
- {
- if (c != '(')
- {
- fprintf (stderr, "## unparsable name in autoload in %s\n",
- filename);
- continue;
- }
- read_lisp_symbol (infile, buffer);
- if (strcmp (buffer, "quote"))
- {
- fprintf (stderr, "## unparsable name in autoload in %s\n",
- filename);
- continue;
- }
- read_lisp_symbol (infile, buffer);
- c = getc (infile);
- if (c != ')')
- {
- fprintf (stderr,
- "## unparsable quoted name in autoload in %s\n",
- filename);
- continue;
- }
- }
- skip_white (infile);
- c = getc (infile);
- if (c != '\"')
- {
- fprintf (stderr, "## autoload of %s unparsable (%s)\n",
- buffer, filename);
- continue;
- }
- read_c_string_or_comment (infile, 0, false, 0);
-
- if (!search_lisp_doc_at_eol (infile))
- continue;
- }
-
-#ifdef DEBUG
- else if (! strcmp (buffer, "if")
- || ! strcmp (buffer, "byte-code"))
- continue;
-#endif
-
- else
- {
-#ifdef DEBUG
- fprintf (stderr, "## unrecognized top-level form, %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
-
- /* At this point, we should gobble a doc string from the input file.
- The opening quote (and leading backslash-newline)
- have already been read. */
-
- printf ("\037%c%s\n", type, buffer);
- read_c_string_or_comment (infile, 1, false, 0);
- }
- if (ferror (infile) || fclose (infile) != 0)
- fatal ("%s: read error", filename);
-}
-
-
/* make-docfile.c ends here */
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index c45c8ae735..a89e515510 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -14359,7 +14359,7 @@
* ldefs-boot.el: Likewise.
* textmodes/bibtex.el (bibtex-validate-globally): Fix typo in a
- message text: "Duplicat" => "Duplicate".
+ message text.
2006-01-06 Sven Joachim <svenjoac@gmx.de> (tiny change)
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 9516f2fc36..c73a623cce 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -123,10 +123,10 @@ SUBDIRS_FINDER = $(filter-out
${srcdir}/leim%,${SUBDIRS_ALMOST})
## All subdirectories in which we might want to create subdirs.el.
SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS})
-# cus-load and finder-inf are not explicitly requested by anything, so
-# we add them here to make sure they get built.
+# cus-load, finder-inf and autoloads are not explicitly requested by
+# anything, so we add them here to make sure they get built.
all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el generate-ja-dic \
- org-manuals
+ org-manuals autoloads
PHONY_EXTRAS =
.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) \
@@ -171,52 +171,42 @@ org-manuals: main-first
## Comments on loaddefs generation:
-# loaddefs depends on gen-lisp for two reasons:
-# 1) In ../src, the emacs target depends on loaddefs but not on eg leim-list.
-# So having leim as a dependency of loaddefs (via gen-lisp) ensures leim-list
+# loaddefs depends on gen-lisp because in ../src, the emacs target
+# depends on loaddefs, but not on, for instance, leim-list. So having
+# leim as a dependency of loaddefs (via gen-lisp) ensures leim-list
# gets created before the final emacs is dumped. Having leim
-# dependencies in ../src as well would create a parallel race condition.
+# dependencies in ../src as well would create a parallel race
+# condition.
#
-# FIXME: 2) is no longer correct, so perhaps we could add unidata to
-# gen-lisp now?
+# FIXME: Is the following true any more?
#
-# 2) Files that are marked no-update-autoloads still get recorded in loaddefs.
-# So those files should be generated before we make autoloads, if we
-# don't want a successive make autoloads to change the output file.
-# Said changes are trivial (only comments in the "files without autoloads"
-# section), but still can be annoying. Of course, if generated lisp files
-# do contain autoloads, it is essential they be built before make autoloads.
-# (Also, if a generated file is not written atomically, it is possible that
-# in a parallel build, make autoloads could read a partial version of it.)
-#
-# We'd really like to add "make -C ../admin/unidata all" to gen-lisp
-# because of 2) above, but it causes a race condition in parallel
-# builds because ../src also runs that rule. Given the limitations of
-# recursive make, the only way to fix that would be to remove unidata
-# from ../src rules, but that doesn't seem possible due to the various
-# non-trivial dependencies.
-
-# We make $(lisp)/loaddefs.el a dependency of .PHONY to cause Make to
-# ignore its time stamp. That's because the real dependencies of
-# loaddefs.el aren't known to Make, they are implemented in
-# loaddefs-generate--emacs-batch.
-
-autoloads .PHONY: $(lisp)/loaddefs.el
-$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) $(lisp)/emacs-lisp/loaddefs-gen.elc
+# We'd really like to add "make -C ../admin/unidata all" to gen-lisp,
+# but it causes a race condition in parallel builds because ../src
+# also runs that rule. Given the limitations of recursive make, the
+# only way to fix that would be to remove unidata from ../src rules,
+# but that doesn't seem possible due to the various non-trivial
+# dependencies.
+
+# The real dependencies of loaddefs.el aren't known to Make, they are
+# implemented in loaddefs-generate--emacs-batch, so autoloads is an
+# "all" dependency. "leim" isn't really a dependency here, but we
+# need leim-list.el at about the same time, so ensure that it's
+# generated, too.
+autoloads: $(lisp)/emacs-lisp/loaddefs-gen.elc gen-lisp
$(AM_V_GEN)$(emacs) \
-l $(lisp)/emacs-lisp/loaddefs-gen.elc \
-f loaddefs-generate--emacs-batch ${SUBDIRS_ALMOST}
-# autoloads only runs when loaddefs.el is nonexistent, although it
-# generates a number of different files. Provide a force option to enable
-# regeneration of all these files.
+# autoloads always runs, but only updates when there's something new.
+# Provide a force option to enable regeneration of all loaddefs files.
.PHONY: autoloads-force
autoloads-force:
rm -f $(lisp)/loaddefs.el
$(MAKE) autoloads
ldefs-boot.el: autoloads-force
- cp $(lisp)/loaddefs.el $(lisp)/ldefs-boot.el
+ sed '/^;; Local Variables:/a ;; no-byte-compile: t'\
+ < $(lisp)/loaddefs.el > $(lisp)/ldefs-boot.el
# This is required by the bootstrap-emacs target in ../src/Makefile, so
# we know that if we have an emacs executable, we also have a subdirs.el.
@@ -362,7 +352,11 @@ endif
# Compile all the Elisp files that need it. Beware: it approximates
# 'no-byte-compile', so watch out for false-positives!
-compile-main: gen-lisp compile-clean main-first
+
+# The "autoloads" target has to run first, because it may generate new
+# loaddefs files. But don't depend on it, because that might trigger
+# unnecessary rebuilds.
+compile-main: gen-lisp compile-clean main-first | autoloads
@(cd $(lisp) && \
els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e
's| |/*.el |g'`; \
for el in $$els; do \
@@ -470,7 +464,7 @@ bootstrap-clean:
rm -f $(AUTOGENEL)
distclean:
- -rm -f ./Makefile $(lisp)/loaddefs.el
+ -rm -f ./Makefile $(lisp)/loaddefs.el $(lisp)/loaddefs.elc
maintainer-clean: distclean bootstrap-clean
rm -f TAGS
diff --git a/lisp/allout.el b/lisp/allout.el
index e07bac4ef9..8e303a8a02 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -394,9 +394,8 @@ else allout's special hanging-indent maintaining auto-fill
function,
;;;_ = allout-use-hanging-indents
(defcustom allout-use-hanging-indents t
"If non-nil, topic body text auto-indent defaults to indent of the header.
-Ie, it is indented to be just past the header prefix. This is
-relevant mostly for use with `indented-text-mode', or other situations
-where auto-fill occurs."
+I.e., it is indented to be just past the header prefix. This is
+relevant mostly for situations where auto-fill occurs."
:type 'boolean
:group 'allout)
(make-variable-buffer-local 'allout-use-hanging-indents)
@@ -1700,7 +1699,7 @@ the HOT-SPOT Operation section.
Misc commands:
-------------
-M-x outlineify-sticky Activate outline mode for current buffer,
+\\[allout-outlinify-sticky] Activate outline mode for current buffer,
and establish a default file-var setting
for `allout-layout'.
\\[allout-mark-topic] `allout-mark-topic'
@@ -6185,19 +6184,18 @@ save. See `allout-encrypt-unencrypted-on-saves' for
more info."
;;;_ #9 miscellaneous
;;;_ : Mode:
-;;;_ > outlineify-sticky ()
-;; outlinify-sticky is correct spelling; provide this alias for sticklers:
+;;;_ > allout-outlinify-sticky ()
;;;###autoload
-(defalias 'outlinify-sticky #'outlineify-sticky)
+(define-obsolete-function-alias 'outlinify-sticky #'allout-outlinify-sticky
"29.1")
;;;###autoload
-(defun outlineify-sticky (&optional _arg)
+(define-obsolete-function-alias 'outlineify-sticky #'allout-outlinify-sticky
"29.1")
+;;;###autoload
+(defun allout-outlinify-sticky (&optional _arg)
"Activate outline mode and establish file var so it is started subsequently.
See `allout-layout' and customization of `allout-auto-activation'
for details on preparing Emacs for automatic allout activation."
-
(interactive "P")
-
(if (allout-mode-p) (allout-mode)) ; deactivate so we can re-activate...
(allout-mode)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 13dc8fa139..624c29cb41 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,7 +1,6 @@
;;; apropos.el --- apropos commands for users and programmers -*-
lexical-binding: t -*-
-;; Copyright (C) 1989, 1994-1995, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1989-2022 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
;; Daniel Pfeiffer <occitan@esperanto.org> (rewrite)
@@ -218,7 +217,7 @@ before `apropos-mode' makes it buffer-local.")
(define-button-type 'apropos-symbol
'face 'apropos-symbol
- 'help-echo "mouse-2, RET: Display more help on this symbol"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this symbol"
'follow-link t
'action #'apropos-symbol-button-display-help)
@@ -232,7 +231,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Function"
'apropos-short-label "f"
'face 'apropos-function-button
- 'help-echo "mouse-2, RET: Display more help on this function"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this function"
'follow-link t
'action (lambda (button)
(describe-function (button-get button 'apropos-symbol))))
@@ -241,7 +240,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Macro"
'apropos-short-label "m"
'face 'apropos-function-button
- 'help-echo "mouse-2, RET: Display more help on this macro"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this macro"
'follow-link t
'action (lambda (button)
(describe-function (button-get button 'apropos-symbol))))
@@ -250,7 +249,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Command"
'apropos-short-label "c"
'face 'apropos-function-button
- 'help-echo "mouse-2, RET: Display more help on this command"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this command"
'follow-link t
'action (lambda (button)
(describe-function (button-get button 'apropos-symbol))))
@@ -264,7 +263,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Variable"
'apropos-short-label "v"
'face 'apropos-variable-button
- 'help-echo "mouse-2, RET: Display more help on this variable"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this variable"
'follow-link t
'action (lambda (button)
(describe-variable (button-get button 'apropos-symbol))))
@@ -273,7 +272,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "User option"
'apropos-short-label "o"
'face 'apropos-user-option-button
- 'help-echo "mouse-2, RET: Display more help on this user option"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this user option"
'follow-link t
'action (lambda (button)
(describe-variable (button-get button 'apropos-symbol))))
@@ -282,7 +281,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Face"
'apropos-short-label "F"
'face 'apropos-button
- 'help-echo "mouse-2, RET: Display more help on this face"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this face"
'follow-link t
'action (lambda (button)
(describe-face (button-get button 'apropos-symbol))))
@@ -291,7 +290,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Group"
'apropos-short-label "g"
'face 'apropos-misc-button
- 'help-echo "mouse-2, RET: Display more help on this group"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this group"
'follow-link t
'action (lambda (button)
(customize-group-other-window
@@ -301,7 +300,7 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Widget"
'apropos-short-label "w"
'face 'apropos-misc-button
- 'help-echo "mouse-2, RET: Display more help on this widget"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this widget"
'follow-link t
'action (lambda (button)
(widget-browse-other-window (button-get button 'apropos-symbol))))
@@ -310,13 +309,13 @@ before `apropos-mode' makes it buffer-local.")
'apropos-label "Properties"
'apropos-short-label "p"
'face 'apropos-misc-button
- 'help-echo "mouse-2, RET: Display more help on this plist"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this plist"
'follow-link t
'action (lambda (button)
(apropos-describe-plist (button-get button 'apropos-symbol))))
(define-button-type 'apropos-library
- 'help-echo "mouse-2, RET: Display more help on this library"
+ 'help-echo "\\`mouse-2', \\`RET': Display more help on this library"
'follow-link t
'action (lambda (button)
(apropos-library (button-get button 'apropos-symbol))))
@@ -1332,14 +1331,14 @@ as a heading."
(defun apropos-follow ()
"Invokes any button at point, otherwise invokes the nearest label button."
- (interactive)
+ (interactive nil apropos-mode)
(button-activate
(or (apropos-next-label-button (line-beginning-position))
(error "There is nothing to follow here"))))
(defun apropos-next-symbol ()
"Move cursor down to the next symbol in an `apropos-mode' buffer."
- (interactive)
+ (interactive nil apropos-mode)
(forward-line)
(while (and (not (eq (face-at-point) 'apropos-symbol))
(< (point) (point-max)))
@@ -1347,7 +1346,7 @@ as a heading."
(defun apropos-previous-symbol ()
"Move cursor back to the last symbol in an `apropos-mode' buffer."
- (interactive)
+ (interactive nil apropos-mode)
(forward-line -1)
(while (and (not (eq (face-at-point) 'apropos-symbol))
(> (point) (point-min)))
diff --git a/lisp/array.el b/lisp/array.el
index 08c5ff45dd..aed93ffb65 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -103,7 +103,7 @@ Set them to the optional arguments A-ROW and A-COLUMN if
those are supplied."
(defun array-update-buffer-position ()
"Set `array-buffer-line' and `array-buffer-column' to their current values."
- (setq array-buffer-line (current-line)
+ (setq array-buffer-line (array-current-line)
array-buffer-column (current-column)))
@@ -113,7 +113,7 @@ Set them to the optional arguments A-ROW and A-COLUMN if
those are supplied."
(defun array-what-position ()
"Display the row and column in which the cursor is positioned."
(interactive)
- (let ((array-buffer-line (current-line))
+ (let ((array-buffer-line (array-current-line))
(array-buffer-column (current-column)))
(message "Array row: %s Array column: %s"
(prin1-to-string (array-current-row))
@@ -147,13 +147,13 @@ Set them to the optional arguments A-ROW and A-COLUMN if
those are supplied."
;;; Internal movement functions.
(defun array-beginning-of-field (&optional go-there)
- "Return the column of the beginning of the current field.
+ "Return the column of the beginning of the current field.
Optional argument GO-THERE, if non-nil, means go there too."
- ;; Requires that array-buffer-column be current.
- (let ((goal-column (- array-buffer-column (% array-buffer-column
array-field-width))))
- (if go-there
- (move-to-column-untabify goal-column)
- goal-column)))
+ ;; Requires that array-buffer-column be current.
+ (let ((goal-column (- array-buffer-column (% array-buffer-column
array-field-width))))
+ (if go-there
+ (array-move-to-column-untabify goal-column)
+ goal-column)))
(defun array-end-of-field (&optional go-there)
"Return the column of the end of the current array field.
@@ -162,7 +162,7 @@ If optional argument GO-THERE is non-nil, go there too."
(let ((goal-column (+ (- array-buffer-column (% array-buffer-column
array-field-width))
array-field-width)))
(if go-there
- (move-to-column-untabify goal-column)
+ (array-move-to-column-untabify goal-column)
goal-column)))
(defun array-move-to-cell (a-row a-column)
@@ -174,7 +174,7 @@ Leave point at the beginning of the field and return the
new buffer column."
(goal-column (* array-field-width (% (1- a-column)
array-columns-per-line))))
(goto-char (point-min))
(forward-line goal-line)
- (move-to-column-untabify goal-column)))
+ (array-move-to-column-untabify goal-column)))
(defun array-move-to-row (a-row)
"Move to array row A-ROW preserving the current array column.
@@ -184,7 +184,7 @@ Leave point at the beginning of the field and return the
new array row."
(% array-buffer-line array-lines-per-row)))
(goal-column (- array-buffer-column (% array-buffer-column
array-field-width))))
(forward-line (- goal-line array-buffer-line))
- (move-to-column-untabify goal-column)
+ (array-move-to-column-untabify goal-column)
a-row))
(defun array-move-to-column (a-column)
@@ -196,7 +196,7 @@ Leave point at the beginning of the field and return the
new array column."
(floor (1- a-column) array-columns-per-line)))
(goal-column (* array-field-width (% (1- a-column)
array-columns-per-line))))
(forward-line (- goal-line array-buffer-line))
- (move-to-column-untabify goal-column)
+ (array-move-to-column-untabify goal-column)
a-column))
(defun array-move-one-row (sign)
@@ -214,7 +214,7 @@ If requested to move beyond the array bounds, signal an
error."
(t
(progn
(forward-line (* sign array-lines-per-row))
- (move-to-column-untabify goal-column)
+ (array-move-to-column-untabify goal-column)
(+ array-row sign))))))
(defun array-move-one-column (sign)
@@ -233,15 +233,15 @@ If requested to move beyond the array bounds, signal an
error."
;; Going backward from first column on the line.
((and (= sign -1) (= 1 (% array-column array-columns-per-line)))
(forward-line -1)
- (move-to-column-untabify
+ (array-move-to-column-untabify
(* array-field-width (1- array-columns-per-line))))
;; Going forward from last column on the line.
((and (= sign 1) (zerop (% array-column array-columns-per-line)))
(forward-line 1))
;; Somewhere in the middle of the line.
(t
- (move-to-column-untabify (+ (array-beginning-of-field)
- (* array-field-width sign)))))
+ (array-move-to-column-untabify (+ (array-beginning-of-field)
+ (* array-field-width sign)))))
(+ array-column sign)))))
(defun array-normalize-cursor ()
@@ -281,15 +281,15 @@ If necessary, scroll horizontally to keep the cursor in
view."
"Move down one array row, staying in the current array column.
If optional ARG is given, move down ARG array rows."
(interactive "p")
- (let ((array-buffer-line (current-line))
+ (let ((array-buffer-line (array-current-line))
(array-buffer-column (current-column)))
(if (= (abs arg) 1)
(array-move-one-row arg)
(array-move-to-row
- (limit-index (+ (or (array-current-row)
- (error "Cursor is not in an array cell"))
- arg)
- array-max-row))))
+ (array--limit-index (+ (or (array-current-row)
+ (error "Cursor is not in an array cell"))
+ arg)
+ array-max-row))))
(array-normalize-cursor))
(defun array-previous-row (&optional arg)
@@ -303,15 +303,15 @@ If optional ARG is given, move up ARG array rows."
If optional ARG is given, move forward ARG array columns.
If necessary, keep the cursor in the window by scrolling right or left."
(interactive "p")
- (let ((array-buffer-line (current-line))
+ (let ((array-buffer-line (array-current-line))
(array-buffer-column (current-column)))
(if (= (abs arg) 1)
(array-move-one-column arg)
(array-move-to-column
- (limit-index (+ (or (array-current-column)
- (error "Cursor is not in an array cell"))
- arg)
- array-max-column))))
+ (array--limit-index (+ (or (array-current-column)
+ (error "Cursor is not in an array cell"))
+ arg)
+ array-max-column))))
(array-normalize-cursor))
(defun array-backward-column (&optional arg)
@@ -325,8 +325,8 @@ If necessary, keep the cursor in the window by scrolling
right or left."
"Go to array row A-ROW and array column A-COLUMN."
(interactive "nArray row: \nnArray column: ")
(array-move-to-cell
- (limit-index a-row array-max-row)
- (limit-index a-column array-max-column))
+ (array--limit-index a-row array-max-row)
+ (array--limit-index a-column array-max-column))
(array-normalize-cursor))
@@ -417,7 +417,7 @@ Leave point at the beginning of the field."
"Copy the current field one array row down.
If optional ARG is given, copy down through ARG array rows."
(interactive "p")
- (let* ((array-buffer-line (current-line))
+ (let* ((array-buffer-line (array-current-line))
(array-buffer-column (current-column))
(array-row (or (array-current-row)
(error "Cursor is not in a valid array cell")))
@@ -425,7 +425,7 @@ If optional ARG is given, copy down through ARG array rows."
(if (= (abs arg) 1)
(array-copy-once-vertically arg)
(array-copy-to-row
- (limit-index (+ array-row arg) array-max-row))))
+ (array--limit-index (+ array-row arg) array-max-row))))
(array-normalize-cursor))
(defun array-copy-up (&optional arg)
@@ -438,7 +438,7 @@ If optional ARG is given, copy up through ARG array rows."
"Copy the current field one array column to the right.
If optional ARG is given, copy through ARG array columns to the right."
(interactive "p")
- (let* ((array-buffer-line (current-line))
+ (let* ((array-buffer-line (array-current-line))
(array-buffer-column (current-column))
(array-column (or (array-current-column)
(error "Cursor is not in a valid array cell")))
@@ -446,7 +446,7 @@ If optional ARG is given, copy through ARG array columns to
the right."
(if (= (abs arg) 1)
(array-copy-once-horizontally arg)
(array-copy-to-column
- (limit-index (+ array-column arg) array-max-column))))
+ (array--limit-index (+ array-column arg) array-max-column))))
(array-normalize-cursor))
(defun array-copy-backward (&optional arg)
@@ -473,7 +473,7 @@ If optional ARG is given, copy through ARG array columns to
the right."
(if (= (abs arg) 1)
(array-copy-once-horizontally arg)
(array-copy-to-column
- (limit-index (+ array-column arg) array-max-column))))))
+ (array--limit-index (+ array-column arg) array-max-column))))))
(message "Working...done")
(array-move-to-row array-row)
(array-normalize-cursor))
@@ -506,7 +506,7 @@ If optional ARG is given, copy through ARG rows down."
(forward-line 1)
(point))))
(this-row array-row)
- (goal-row (limit-index (+ this-row arg) array-max-row))
+ (goal-row (array--limit-index (+ this-row arg) array-max-row))
(num (- goal-row this-row))
(count (abs num))
(sign (if (not (zerop count)) (/ num count))))
@@ -700,13 +700,13 @@ of `array-rows-numbered'."
(floor (1- temp-max-column) new-columns-per-line))
(newlines-added 0))
(while (< newlines-removed newlines-to-be-removed)
- (move-to-column-untabify
+ (array-move-to-column-untabify
(* (1+ newlines-removed) old-line-length))
(kill-line 1)
(setq newlines-removed (1+ newlines-removed)))
(beginning-of-line)
(while (< newlines-added newlines-to-be-added)
- (move-to-column-untabify (* old-field-width new-columns-per-line))
+ (array-move-to-column-untabify (* old-field-width
new-columns-per-line))
(newline)
(setq newlines-added (1+ newlines-added)))
(forward-line 1))))
@@ -735,16 +735,16 @@ of `array-rows-numbered'."
;;; Utilities.
-(defun limit-index (index limit)
+(defun array--limit-index (index limit)
(cond ((< index 1) 1)
((> index limit) limit)
(t index)))
-(defun current-line ()
+(defun array-current-line ()
"Return the current buffer line at point. The first line is 0."
(count-lines (point-min) (line-beginning-position)))
-(defun move-to-column-untabify (column)
+(defun array-move-to-column-untabify (column)
"Move to COLUMN on the current line, untabifying if necessary.
Return COLUMN."
(or (and (= column (move-to-column column))
@@ -753,10 +753,10 @@ Return COLUMN."
(if array-respect-tabs
(error "There is a TAB character in the way")
(progn
- (untabify-backward)
+ (array--untabify-backward)
(move-to-column column)))))
-(defun untabify-backward ()
+(defun array--untabify-backward ()
"Untabify the preceding TAB."
(save-excursion
(let ((start (point)))
@@ -885,7 +885,10 @@ Entering array mode calls the function `array-mode-hook'."
(setq-local truncate-lines t)
(setq overwrite-mode 'overwrite-mode-textual))
-
+(define-obsolete-function-alias 'limit-index #'array--limit-index "29.1")
+(define-obsolete-function-alias 'current-line #'array-current-line "29.1")
+(define-obsolete-function-alias 'move-to-column-untabify
#'array-move-to-column-untabify "29.1")
+(define-obsolete-function-alias 'untabify-backward #'array--untabify-backward
"29.1")
(provide 'array)
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index a802ef856d..f198362f10 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -909,10 +909,17 @@ Remove trailing \": \"."
(defun auth-source--aget (alist key)
(cdr (assoc key alist)))
+;;;###autoload
+(defun auth-source-netrc-parse-all (file)
+ "Parse FILE and return all entries."
+ (auth-source-netrc-parse :file file :allow-null t))
+
;; (auth-source-netrc-parse :file "~/.authinfo.gpg")
(cl-defun auth-source-netrc-parse (&key file max host user port require
- &allow-other-keys)
- "Parse FILE and return a list of all entries in the file.
+ allow-null &allow-other-keys)
+ "Parse FILE and return a list of matching entries in the file.
+If ALLOW-NULL, allow nil values of HOST, USER and PORT to match.
+
Note that the MAX parameter is used so we can exit the parse early."
(if (listp file)
;; We got already parsed contents; just return it.
@@ -925,27 +932,33 @@ Note that the MAX parameter is used so we can exit the
parse early."
(cached (cdr-safe (assoc file auth-source-netrc-cache)))
(cached-mtime (plist-get cached :mtime))
(cached-secrets (plist-get cached :secret))
- (check (lambda(alist)
+ (check (lambda (alist)
(and alist
- (auth-source-search-collection
- host
- (or
- (auth-source--aget alist "machine")
- (auth-source--aget alist "host")
- t))
- (auth-source-search-collection
- user
- (or
- (auth-source--aget alist "login")
- (auth-source--aget alist "account")
- (auth-source--aget alist "user")
- t))
- (auth-source-search-collection
- port
- (or
- (auth-source--aget alist "port")
- (auth-source--aget alist "protocol")
- t))
+ (or
+ (and allow-null (null host))
+ (auth-source-search-collection
+ host
+ (or
+ (auth-source--aget alist "machine")
+ (auth-source--aget alist "host")
+ t)))
+ (or
+ (and allow-null (null user))
+ (auth-source-search-collection
+ user
+ (or
+ (auth-source--aget alist "login")
+ (auth-source--aget alist "account")
+ (auth-source--aget alist "user")
+ t)))
+ (or
+ (and allow-null (null port))
+ (auth-source-search-collection
+ port
+ (or
+ (auth-source--aget alist "port")
+ (auth-source--aget alist "protocol")
+ t)))
(or
;; the required list of keys is nil, or
(null require)
@@ -957,7 +970,8 @@ Note that the MAX parameter is used so we can exit the
parse early."
result)
(if (and (functionp cached-secrets)
- (equal cached-mtime
+ (time-equal-p
+ cached-mtime
(file-attribute-modification-time
(file-attributes file))))
(progn
diff --git a/lisp/battery.el b/lisp/battery.el
index 3cff3167a6..93f4070e4b 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -255,14 +255,14 @@ of the following information may or may not be available:
For instance, to play an alarm when the battery power dips below
10%, you could use a function like the following:
-(defvar my-prev-battery nil)
-(defun my-battery-alarm (data)
- (when (and my-prev-battery
- (equal (alist-get ?L data) \"off-line\")
- (< (string-to-number (alist-get ?p data)) 10)
- (>= (string-to-number (alist-get ?p my-prev-battery)) 10))
- (play-sound-file \"~/alarm.wav\" 5))
- (setq my-prev-battery data))"
+ (defvar my-prev-battery nil)
+ (defun my-battery-alarm (data)
+ (when (and my-prev-battery
+ (equal (alist-get ?L data) \"off-line\")
+ (< (string-to-number (alist-get ?p data)) 10)
+ (>= (string-to-number (alist-get ?p my-prev-battery)) 10))
+ (play-sound-file \"~/alarm.wav\" 5))
+ (setq my-prev-battery data))"
:version "29.1"
:type '(repeat function))
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index b2130557dc..30a03e0431 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -1172,7 +1172,7 @@ it to the name of the bookmark currently being set,
advancing
(defun bookmark--watch-file-already-queried-p (new-mtime)
;; Don't ask repeatedly if user already said "no" to reloading a
;; file with this mtime:
- (prog1 (equal new-mtime bookmark--watch-already-asked-mtime)
+ (prog1 (time-equal-p new-mtime bookmark--watch-already-asked-mtime)
(setq bookmark--watch-already-asked-mtime new-mtime)))
(defun bookmark-maybe-load-default-file ()
@@ -1185,7 +1185,7 @@ it to the name of the bookmark currently being set,
advancing
(let ((new-mtime (nth 5 (file-attributes
(car bookmark-bookmarks-timestamp))))
(old-mtime (cdr bookmark-bookmarks-timestamp)))
- (and (not (equal new-mtime old-mtime))
+ (and (not (time-equal-p new-mtime old-mtime))
(not (bookmark--watch-file-already-queried-p new-mtime))
(or (eq 'silent bookmark-watch-bookmark-file)
(yes-or-no-p
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index d1afd8ce95..7e911d814d 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -174,12 +174,18 @@ If DATE lacks timezone information, GMT is assumed."
(defalias 'time-to-seconds 'float-time)
;;;###autoload
-(defalias 'seconds-to-time 'time-convert)
+(defun seconds-to-time (seconds &rest form)
+ "Convert SECONDS to a proper time, like `current-time' would.
+FORM means the same as in `time-convert'."
+ (time-convert seconds form))
;;;###autoload
(defun days-to-time (days)
"Convert DAYS into a time value."
- (let ((time (time-convert (* 86400 days))))
+ ;; FIXME: We should likely just pass `t' to `time-convert'.
+ ;; All uses I could find in Emacs, GNU ELPA, and NonGNU ELPA can handle
+ ;; any valid time representation as return value.
+ (let ((time (time-convert (* 86400 days) 'list)))
;; Traditionally, this returned a two-element list if DAYS was an integer.
;; Keep that tradition if time-convert outputs timestamps in list form.
(if (and (integerp days) (consp (cdr time)))
@@ -256,10 +262,10 @@ Returns a floating point number."
;;;###autoload
(defun safe-date-to-time (date)
"Parse a string DATE that represents a date-time and return a time value.
-If DATE is malformed, return a time value of zeros."
+If DATE is malformed, return a time value of zero."
(condition-case ()
(date-to-time date)
- (error '(0 0))))
+ (error 0)))
;;;###autoload
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 7bdaf7ceff..6b6cc517a2 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -1247,7 +1247,7 @@ HTML-P is non-nil, HTML markup is added."
(time-out (vector (list t) (list t) (list t) (list t) (list t)))
(breaks (vector (list t) (list t) (list t) (list t) (list t)))
(workday (vector (list t) (list t) (list t) (list t) (list t)))
- (lengths (vector '(0 0) thirty-days-ago three-months-ago
+ (lengths (vector 0 thirty-days-ago three-months-ago
six-months-ago one-year-ago)))
;; collect statistics from complete timelog
(dolist (day day-list)
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index e6befb10e9..c33ac85072 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -25,15 +25,12 @@
;;; Commentary:
;;; Code:
-;;
-;; This file depends on the major components of CEDET, so that you can
-;; load them all by doing (require 'cedet). This is mostly for
-;; compatibility with the upstream, stand-alone CEDET distribution.
(declare-function inversion-find-version "inversion")
(defconst cedet-version "2.0"
"Current version of CEDET.")
+(make-obsolete-variable 'cedet-version 'emacs-version "29.1")
(defconst cedet-packages
`(
@@ -45,6 +42,7 @@
(ede "1.2" nil "ede" )
)
"Table of CEDET packages to install.")
+(make-obsolete-variable 'cedet-packages 'package-built-in-p "29.1")
(defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu")
(let ((map (make-sparse-keymap "CEDET menu")))
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 27016f0f5c..9182fcd5ac 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -141,7 +141,7 @@ For some project types, this will be the file that stores
the project configurat
In other projects types, this file is merely a unique identifier to this type
of project.")
(rootproject ; :initarg - no initarg, don't save this slot!
:initform nil
- :type (or null ede-project-placeholder-child)
+ :type (or null ede-project-placeholder)
:documentation "Pointer to our root project.")
)
"Placeholder object for projects not loaded into memory.
@@ -171,7 +171,7 @@ For Automake based projects, each directory is treated as a
project.")
:label "Local Targets"
:group (targets)
:documentation "List of top level targets in this project.")
- (locate-obj :type (or null ede-locate-base-child)
+ (locate-obj :type (or null ede-locate-base)
:documentation
"A locate object to use as a backup to `ede-expand-filename'.")
(tool-cache :initarg :tool-cache
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
index 529b96f2b0..8c4f52647b 100644
--- a/lisp/cedet/ede/config.el
+++ b/lisp/cedet/ede/config.el
@@ -65,7 +65,7 @@
(defclass ede-extra-config (eieio-persistent)
((extension :initform ".ede")
(file-header-line :initform ";; EDE Project Configuration")
- (project :type ede-project-with-config-child
+ (project :type ede-project-with-config
:documentation
"The project this config is bound to.")
(ignored-file :initform nil
@@ -102,7 +102,7 @@ initialize the :file slot of the persistent baseclass.")
:documentation
"The class of the configuration used by this project.")
(config :initform nil
- :type (or null ede-extra-config-child)
+ :type (or null ede-extra-config)
:documentation
"The configuration object for this project.")
)
diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el
index 2d4f408e96..0854c8cc47 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -35,7 +35,9 @@
(require 'ede)
(eval-when-compile (require 'eieio-custom))
-(defvar eieio-ede-old-variables nil
+(define-obsolete-variable-alias 'ede-eieio-old-variables
+ 'eieio-ede-old-variables "29.1")
+(defvar ede-eieio-old-variables nil
"The old variables for a project.")
;;; Customization Commands
@@ -50,7 +52,7 @@
(let* ((ov (oref (ede-current-project) local-variables))
(cp (ede-current-project)))
(ede-customize cp)
- (setq-local eieio-ede-old-variables ov)))
+ (setq-local ede-eieio-old-variables ov)))
;;;###autoload
(defalias 'customize-project #'ede-customize-project)
@@ -178,9 +180,9 @@ OBJ is the target object to customize."
;; These hooks are used when finishing up a customization.
(cl-defmethod eieio-done-customizing ((proj ede-project))
"Call this when a user finishes customizing PROJ."
- (let ((ov eieio-ede-old-variables)
+ (let ((ov ede-eieio-old-variables)
(nv (oref proj local-variables)))
- (setq eieio-ede-old-variables nil)
+ (setq ede-eieio-old-variables nil)
(while ov
(if (not (assoc (car (car ov)) nv))
(save-excursion
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index b8acb192c1..e44ddea32f 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -340,7 +340,7 @@ Optional FORCE means to ignore the hash of known
directories."
;;
;; These utilities will identify the "toplevel" of a project.
;;
-;; NOTE: These two -toplevel- functions return a directory even though
+;; NOTE: This -toplevel- function returns a directory even though
;; the function name implies a project.
(defun ede-toplevel-project (dir)
@@ -365,8 +365,6 @@ If DIR is not part of a project, return nil."
(t nil))))
-(defalias 'ede-toplevel-project-or-nil #'ede-toplevel-project)
-
;;; DIRECTORY CONVERSION STUFF
;;
(cl-defmethod ede-convert-path ((this ede-project) path)
@@ -535,6 +533,7 @@ Argument DIR is the directory to trim upwards."
nil
fnd)))
+(define-obsolete-function-alias 'ede-toplevel-project-or-nil
#'ede-toplevel-project "29.1")
(provide 'ede/files)
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index f99a1d114b..604b660344 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -62,7 +62,7 @@
(defvar ede-speedbar-menu
'([ "Compile" ede-speedbar-compile-line t]
[ "Compile Project" ede-speedbar-compile-project
- (ede-project-child-p (speedbar-line-token)) ]
+ (cl-typep (speedbar-line-token) 'ede-project) ]
"---"
[ "Edit File/Tag" speedbar-edit-line
(not (eieio-object-p (speedbar-line-token)))]
@@ -79,7 +79,7 @@
(eieio-object-p (speedbar-line-token)) ]
[ "Edit Project File" ede-speedbar-edit-projectfile t]
[ "Make Distribution" ede-speedbar-make-distribution
- (ede-project-child-p (speedbar-line-token)) ]
+ (cl-typep (speedbar-line-token) 'ede-project) ]
)
"Menu part in easymenu format used in speedbar while browsing objects.")
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index 2da16b37d7..b4fc95c607 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -133,7 +133,7 @@ Download tramp, and use /r:machine: for names on remote
sites w/out FTP access."
(defun ede-vc-project-directory ()
"Run `vc-dir' on the current project."
(interactive)
- (let ((top (ede-toplevel-project-or-nil default-directory)))
+ (let ((top (ede-toplevel-project default-directory)))
(vc-dir top nil)))
(provide 'ede/system)
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 436ad08c5f..dc270603a0 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -311,11 +311,43 @@ HISTORY is a symbol representing a variable to story the
history in."
(defvar semantic-complete-current-matched-tag nil
"Variable used to pass the tags being matched to the prompt.")
-;; semantic-displayer-focus-abstract-child-p is part of the
-;; semantic-displayer-focus-abstract class, defined later in this
-;; file.
-(declare-function semantic-displayer-focus-abstract-child-p "semantic/complete"
- t t)
+
+
+;; Abstract baseclass for any displayer which supports focus
+
+(defclass semantic-displayer-abstract ()
+ ((table :type (or null semanticdb-find-result-with-nil)
+ :initform nil
+ :protection :protected
+ :documentation "List of tags this displayer is showing.")
+ (last-prefix :type string
+ :protection :protected
+ :documentation "Prefix associated with slot `table'.")
+ )
+ "Abstract displayer baseclass.
+Manages the display of some number of tags.
+Provides the basics for a displayer, including interacting with
+a collector, and tracking tables of completion to display."
+ :abstract t)
+
+(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract)
+ ((focus :type number
+ :protection :protected
+ :documentation "A tag index from `table' which has focus.
+Multiple calls to the display function can choose to focus on a
+given tag, by highlighting its location.")
+ (find-file-focus
+ :allocation :class
+ :initform nil
+ :documentation
+ "Non-nil if focusing requires a tag's buffer be in memory.")
+ )
+ "Abstract displayer supporting `focus'.
+A displayer which has the ability to focus in on one tag.
+Focusing is a way of differentiating among multiple tags
+which have the same name."
+ :abstract t)
+
(defun semantic-complete-current-match ()
"Calculate a match from the current completion environment.
@@ -346,7 +378,7 @@ Return value can be:
((setq matchlist (semantic-collector-current-exact-match collector))
(if (= (semanticdb-find-result-length matchlist) 1)
(setq answer (semanticdb-find-result-nth-in-buffer matchlist 0))
- (if (semantic-displayer-focus-abstract-child-p displayer)
+ (if (cl-typep displayer 'semantic-displayer-focus-abstract)
;; For focusing displayers, we can claim this is
;; not unique. Multiple focuses can choose the correct
;; one.
@@ -1301,21 +1333,6 @@ Uses semanticdb for searching all tags in the current
project."
;; * semantic-displayer-scroll-request
;; * semantic-displayer-focus-request
-(defclass semantic-displayer-abstract ()
- ((table :type (or null semanticdb-find-result-with-nil)
- :initform nil
- :protection :protected
- :documentation "List of tags this displayer is showing.")
- (last-prefix :type string
- :protection :protected
- :documentation "Prefix associated with slot `table'.")
- )
- "Abstract displayer baseclass.
-Manages the display of some number of tags.
-Provides the basics for a displayer, including interacting with
-a collector, and tracking tables of completion to display."
- :abstract t)
-
(define-obsolete-function-alias 'semantic-displayor-cleanup
#'semantic-displayer-cleanup "27.1")
(cl-defmethod semantic-displayer-cleanup ((_obj semantic-displayer-abstract))
@@ -1407,24 +1424,7 @@ to click on the items to aid in completion.")
)
)
-;;; Abstract baseclass for any displayer which supports focus
-(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract)
- ((focus :type number
- :protection :protected
- :documentation "A tag index from `table' which has focus.
-Multiple calls to the display function can choose to focus on a
-given tag, by highlighting its location.")
- (find-file-focus
- :allocation :class
- :initform nil
- :documentation
- "Non-nil if focusing requires a tag's buffer be in memory.")
- )
- "Abstract displayer supporting `focus'.
-A displayer which has the ability to focus in on one tag.
-Focusing is a way of differentiating among multiple tags
-which have the same name."
- :abstract t)
+;;; Methods for any displayer which supports focus
(define-obsolete-function-alias 'semantic-displayor-next-action
#'semantic-displayer-next-action "27.1")
diff --git a/lisp/cedet/semantic/db-typecache.el
b/lisp/cedet/semantic/db-typecache.el
index 38caac2292..efc1ab2c5f 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -362,7 +362,7 @@ a master list."
;; don't include ourselves in this crazy list.
(when (and i (not (eq i table))
;; @todo - This eieio fcn can be slow! Do I need it?
- ;; (semanticdb-table-child-p i)
+ ;; (cl-typep i 'semanticdb-table)
)
(setq incstream
(semanticdb-typecache-merge-streams
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 82785ec6d2..ff62f53d3c 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -115,11 +115,13 @@ for a new table not associated with a buffer."
"Return a nil, meaning abstract table OBJ is not in a buffer."
nil)
-(cl-defmethod semanticdb-get-buffer ((_obj semanticdb-abstract-table))
- "Return a buffer associated with OBJ.
+(cl-defgeneric semanticdb-get-buffer (_obj)
+ "Return a buffer associated with semanticdb table OBJ.
If the buffer is not in memory, load it with `find-file-noselect'."
nil)
+;; FIXME: Should we merge `semanticdb-get-buffer' and
+;; `semantic-tag-parent-buffer'?
;; This generic method allows for sloppier coding. Many
;; functions treat "table" as something that could be a buffer,
;; file name, or other. This makes use of table more robust.
@@ -271,6 +273,9 @@ For C/C++, the C preprocessor macros can be saved here.")
)
"A single table of tags derived from file.")
+(cl-defmethod semantic-tag-parent-buffer ((parent semanticdb-table))
+ (semanticdb-get-buffer parent)) ;FIXME: η-redex!
+
(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
"Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer."
@@ -609,7 +614,7 @@ The file associated with OBJ does not need to be in a
buffer."
(or (not (slot-boundp obj 'tags))
;; (not (oref obj tags)) --> not needed anymore?
(/= (or (oref obj fsize) 0) actualsize)
- (not (equal (oref obj lastmodtime) actualmod))
+ (not (time-equal-p (oref obj lastmodtime) actualmod))
)
))))
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index 7a80bccb53..a5220f622a 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -28,8 +28,6 @@
(require 'semantic/tag)
(defvar ede-minor-mode)
-(declare-function semanticdb-table-child-p "semantic/db" t t)
-(declare-function semanticdb-get-buffer "semantic/db")
(declare-function semantic-dependency-find-file-on-path "semantic/dep")
(declare-function ede-toplevel "ede/base")
@@ -37,68 +35,66 @@
;;; Location a TAG came from.
;;
+
+(cl-defgeneric semantic-tag-parent-buffer (parent)
+ "Return the buffer in which a tag can be found, knowing its PARENT."
+ (cond ((and (semantic-tag-p parent) (semantic-tag-in-buffer-p parent))
+ ;; We have a parent with a buffer, then go there.
+ (semantic-tag-buffer parent))
+ ((and (semantic-tag-p parent) (semantic-tag-file-name parent))
+ ;; The parent only has a file-name, then
+ ;; find that file, and switch to that buffer.
+ (find-file-noselect (semantic-tag-file-name parent)))))
+
;;;###autoload
-(define-overloadable-function semantic-go-to-tag (tag &optional parent)
+(defun semantic-go-to-tag (tag &optional parent)
"Go to the location of TAG.
TAG may be a stripped element, in which case PARENT specifies a
parent tag that has position information.
PARENT can also be a `semanticdb-table' object."
- (:override
- (save-match-data
+ (save-match-data
+ (set-buffer
(cond ((semantic-tag-in-buffer-p tag)
;; We have a linked tag, go to that buffer.
- (set-buffer (semantic-tag-buffer tag)))
+ (semantic-tag-buffer tag))
((semantic-tag-file-name tag)
;; If it didn't have a buffer, but does have a file
;; name, then we need to get to that file so the tag
;; location is made accurate.
- (set-buffer (find-file-noselect (semantic-tag-file-name tag))))
- ((and parent (semantic-tag-p parent) (semantic-tag-in-buffer-p
parent))
- ;; The tag had nothing useful, but we have a parent with
- ;; a buffer, then go there.
- (set-buffer (semantic-tag-buffer parent)))
- ((and parent (semantic-tag-p parent) (semantic-tag-file-name parent))
- ;; Tag had nothing, and the parent only has a file-name, then
- ;; find that file, and switch to that buffer.
- (set-buffer (find-file-noselect (semantic-tag-file-name parent))))
- ((and parent (featurep 'semantic/db)
- (semanticdb-table-child-p parent))
- (set-buffer (semanticdb-get-buffer parent)))
- (t
- ;; Well, just assume things are in the current buffer.
- nil
- )))
- ;; We should be in the correct buffer now, try and figure out
- ;; where the tag is.
- (cond ((semantic-tag-with-position-p tag)
- ;; If it's a number, go there
- (goto-char (semantic-tag-start tag)))
- ((semantic-tag-with-position-p parent)
- ;; Otherwise, it's a trimmed vector, such as a parameter,
- ;; or a structure part. If there is a parent, we can use it
- ;; as a bounds for searching.
- (goto-char (semantic-tag-start parent))
- ;; Here we make an assumption that the text returned by
- ;; the parser and concocted by us actually exists
- ;; in the buffer.
- (re-search-forward (semantic-tag-name tag)
- (semantic-tag-end parent)
- t))
- ((semantic-tag-get-attribute tag :line)
- ;; The tag has a line number in it. Go there.
- (goto-char (point-min))
- (forward-line (1- (semantic-tag-get-attribute tag :line))))
- ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent
:line))
- ;; The tag has a line number in it. Go there.
- (goto-char (point-min))
- (forward-line (1- (semantic-tag-get-attribute parent :line)))
- (re-search-forward (semantic-tag-name tag) nil t))
- (t
- ;; Take a guess that the tag has a unique name, and just
- ;; search for it from the beginning of the buffer.
- (goto-char (point-min))
- (re-search-forward (semantic-tag-name tag) nil t)))
- )
+ (find-file-noselect (semantic-tag-file-name tag)))
+ ((and parent (semantic-tag-parent-buffer parent)))
+ ;; Well, just assume things are in the current buffer.
+ (t (current-buffer)))))
+ ;; We should be in the correct buffer now, try and figure out
+ ;; where the tag is.
+ (cond ((semantic-tag-with-position-p tag)
+ ;; If it's a number, go there
+ (goto-char (semantic-tag-start tag)))
+ ((semantic-tag-with-position-p parent)
+ ;; Otherwise, it's a trimmed vector, such as a parameter,
+ ;; or a structure part. If there is a parent, we can use it
+ ;; as a bounds for searching.
+ (goto-char (semantic-tag-start parent))
+ ;; Here we make an assumption that the text returned by
+ ;; the parser and concocted by us actually exists
+ ;; in the buffer.
+ (re-search-forward (semantic-tag-name tag)
+ (semantic-tag-end parent)
+ t))
+ ((semantic-tag-get-attribute tag :line)
+ ;; The tag has a line number in it. Go there.
+ (goto-char (point-min))
+ (forward-line (1- (semantic-tag-get-attribute tag :line))))
+ ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line))
+ ;; The tag has a line number in it. Go there.
+ (goto-char (point-min))
+ (forward-line (1- (semantic-tag-get-attribute parent :line)))
+ (re-search-forward (semantic-tag-name tag) nil t))
+ (t
+ ;; Take a guess that the tag has a unique name, and just
+ ;; search for it from the beginning of the buffer.
+ (goto-char (point-min))
+ (re-search-forward (semantic-tag-name tag) nil t)))
)
;;; Dependencies
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 69a7c8f59c..24f71a2dcc 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -77,7 +77,6 @@ If FILE is not loaded, and semanticdb is not available, find
the file
(with-current-buffer (find-file-noselect file)
(semantic-fetch-tags))))))
-(declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t)
(declare-function semanticdb-refresh-table "semantic/db")
(declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t)
(declare-function semanticdb-find-results-p "semantic/db-find" (resultp))
@@ -115,8 +114,6 @@ buffer, or a filename. If SOMETHING is nil return nil."
(require 'semantic/db-mode)
(semanticdb-minor-mode-p)
(progn
- (declare-function semanticdb-abstract-table--eieio-childp
- "semantic/db")
(cl-typep something 'semanticdb-abstract-table)))
(semanticdb-refresh-table something)
(semanticdb-get-tags something))
diff --git a/lisp/cedet/semantic/wisent/comp.el
b/lisp/cedet/semantic/wisent/comp.el
index ba67d25060..e24f6128a6 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -38,6 +38,7 @@
;;; Code:
(require 'semantic/wisent)
(eval-when-compile (require 'cl-lib))
+(require 'subr-x) ; `string-pad'
;;;; -------------------
;;;; Misc. useful things
@@ -80,18 +81,13 @@
`(dlet ,(wisent-context-bindings name)
,@body))
-;; Other utilities
-
(defsubst wisent-pad-string (s n &optional left)
"Fill string S with spaces.
Return a new string of at least N characters. Insert spaces on right.
If optional LEFT is non-nil insert spaces on left."
- (let ((i (length s)))
- (if (< i n)
- (if left
- (concat (make-string (- n i) ?\ ) s)
- (concat s (make-string (- n i) ?\ )))
- s)))
+ (declare (obsolete string-pad "29.1"))
+ (string-pad s n nil left))
+
;;;; ------------------------
;;;; Environment dependencies
@@ -704,7 +700,7 @@ S must be a vector of integers."
(setq i 1)
(while (<= i nrules)
(unless (aref ruseful i)
- (wisent-log "#%s " (wisent-pad-string (format "%d" i) 4))
+ (wisent-log "#%s " (string-pad (format "%d" i) 4))
(wisent-log "%s:" (wisent-tag (aref rlhs i)))
(setq r (aref rrhs i))
(while (natnump (aref ritem r))
@@ -2298,7 +2294,7 @@ there are any reduce/reduce conflicts."
;; Don't print rules disabled in `wisent-reduce-grammar-tables'.
(when (aref ruseful i)
(wisent-log " %s %s ->"
- (wisent-pad-string (number-to-string i) 6)
+ (string-pad (number-to-string i) 6)
(wisent-tag (aref rlhs i)))
(setq r (aref rrhs i))
(if (> (aref ritem r) 0)
diff --git a/lisp/cedet/semantic/wisent/python.el
b/lisp/cedet/semantic/wisent/python.el
index 941efbbbef..6b2833ef44 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -1,6 +1,6 @@
;;; wisent-python.el --- Semantic support for Python -*- lexical-binding: t;
-*-
-;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2022 Free Software Foundation, Inc.
;; Author: Richard Kim <emacs18@gmail.com>
;; Created: June 2002
@@ -27,9 +27,7 @@
;;; Code:
-;; Try to load python support, but fail silently since it is only used
-;; for optional functionality
-(require 'python nil t)
+(require 'python)
(require 'semantic/wisent)
(require 'semantic/wisent/python-wy)
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 37c83be811..bed74861ca 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -38,9 +38,6 @@
(require 'srecode/table)
(require 'srecode/dictionary)
-(declare-function srecode-template-inserter-newline-child-p "srecode/insert"
- t t)
-
;;; Code:
;;; Template Class
@@ -378,8 +375,11 @@ It is hard if the previous inserter is a newline object."
(while (and comp (stringp (car comp)))
(setq comp (cdr comp)))
(or (not comp)
- (progn (require 'srecode/insert)
- (srecode-template-inserter-newline-child-p (car comp)))))
+ (srecord-compile-inserter-newline-p (car comp))))
+
+(cl-defgeneric srecord-compile-inserter-newline-p (_obj)
+ "Non-nil if OBJ is a newline inserter object."
+ nil)
(defun srecode-compile-split-code (tag str STATE
&optional end-name)
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index 8dd5d25157..c0260c62a9 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -319,6 +319,10 @@ by themselves.")
Specify the :indent argument to enable automatic indentation when newlines
occur in your template.")
+(cl-defmethod srecord-compile-inserter-newline-p
+ ((_ srecode-template-inserter-newline))
+ t)
+
(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
dictionary)
"Insert the STI inserter."
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 3dfbb9d58b..f77898f906 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -200,13 +200,13 @@ INIT are the initialization parameters for the new
template table."
;; go front-to-back, the highest priority items are put
;; into the search table first, allowing lower priority items
;; to be the items found in the search table.
- (object-sort-list mt 'modetables (lambda (a b)
- (> (oref a priority)
- (oref b priority))))
+ (srecode-object-sort-list mt 'modetables (lambda (a b)
+ (> (oref a priority)
+ (oref b priority))))
;; Return it.
new))
-(defun object-sort-list (object slot predicate)
+(defun srecode-object-sort-list (object slot predicate)
"Sort the items in OBJECT's SLOT.
Use PREDICATE is the same as for the `sort' function."
(when (slot-boundp object slot)
@@ -284,6 +284,8 @@ Use PREDICATE is the same as for the `sort' function."
(setq temp (cdr temp))))
)
+(define-obsolete-function-alias 'object-sort-list
+ #'srecode-object-sort-list "29.1")
(provide 'srecode/table)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 47d2cac3be..bb07a0694a 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -37,7 +37,7 @@
ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
"Regexp matching file names not to scan for `custom-make-dependencies'.")
-(require 'autoload)
+(require 'loaddefs-gen)
;; Hack workaround for bug#14384.
;; Define defcustom-mh as an alias for defcustom, etc.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 1012d08ab5..edc09f3199 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -5543,6 +5543,7 @@ See `define-icon' for details."
(pcase-dolist (`(,icon ,spec) specs)
(custom-push-theme 'theme-icon icon theme 'set spec)))
+;;;###autoload
(defun custom-set-icons (&rest args)
"Install user customizations of icon specs specified in ARGS.
These settings are registered as theme `user'.
@@ -5556,27 +5557,28 @@ This stores EXP (without evaluating it) as the saved
spec for SYMBOL."
;;;###autoload
(defun custom-save-icons ()
"Save all customized icons in `custom-file'."
- (save-excursion
- (custom-save-delete 'custom-set-icons)
- (let ((values nil))
- (mapatoms
- (lambda (symbol)
- (let ((value (car-safe (get symbol 'theme-icon))))
- (when (eq (car value) 'user)
- (push (list symbol (cadr value)) values)))))
- (ensure-empty-lines)
- (insert "(custom-set-icons
+ (let ((values nil))
+ (mapatoms
+ (lambda (symbol)
+ (let ((value (car-safe (get symbol 'theme-icon))))
+ (when (eq (car value) 'user)
+ (push (list symbol (cadr value)) values)))))
+ (save-excursion
+ (custom-save-delete 'custom-set-icons)
+ (when values
+ (ensure-empty-lines)
+ (insert "(custom-set-icons
;; custom-set-icons was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.\n")
- (dolist (value (sort values (lambda (s1 s2)
- (string< (car s1) (car s2)))))
- (unless (bolp)
- (insert "\n"))
- (insert " '")
- (prin1 value (current-buffer)))
- (insert ")\n"))))
+ (dolist (value (sort values (lambda (s1 s2)
+ (string< (car s1) (car s2)))))
+ (unless (bolp)
+ (insert "\n"))
+ (insert " '")
+ (prin1 value (current-buffer)))
+ (insert ")\n")))))
(provide 'cus-edit)
diff --git a/lisp/custom.el b/lisp/custom.el
index 5ece5047a8..96dfb37d86 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1692,6 +1692,7 @@ Each of the arguments ARGS has this form:
(VARIABLE IGNORED)
This means reset VARIABLE. (The argument IGNORED is ignored)."
+ (declare (obsolete nil "29.1"))
(apply #'custom-theme-reset-variables 'user args))
(defun custom-add-choice (variable choice)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 16971aa661..7fad031add 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -655,7 +655,9 @@ The character information includes:
("file code"
,@(if multibyte-p
(let* ((coding buffer-file-coding-system)
- (encoded (encode-coding-char char coding charset)))
+ (encoded
+ (and coding
+ (encode-coding-char char coding charset))))
(if encoded
(list (encoded-string-description encoded coding)
(format "(encoded by coding system %S)"
diff --git a/lisp/desktop.el b/lisp/desktop.el
index a0931e053e..ef73bc596d 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -701,7 +701,7 @@ DIRNAME omitted or nil means use `desktop-dirname'."
-4))))
;; We should err on the safe side here: if any of the
;; executables is something like "emacs-nox" or "emacs-42.1"
- ;; or "gemacs" or "xemacs", let's recognize them as well.
+ ;; or "gemacs", let's recognize them as well.
(and (string-match-p "emacs" proc-cmd)
(string-match-p "emacs" my-cmd))))))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index b9f33036e3..c8de2669ea 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -760,7 +760,7 @@ with a prefix argument."
(defvar dired-aux-files)
-(defun minibuffer-default-add-dired-shell-commands ()
+(defun dired-minibuffer-default-add-shell-commands ()
"Return a list of all commands associated with current dired files.
This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
@@ -787,7 +787,7 @@ offer a smarter default choice of shell command."
(lambda ()
(setq-local dired-aux-files files)
(setq-local minibuffer-default-add-function
- #'minibuffer-default-add-dired-shell-commands))
+ #'dired-minibuffer-default-add-shell-commands))
(setq prompt (format prompt (dired-mark-prompt arg files)))
(if (functionp 'dired-guess-shell-command)
(dired-mark-pop-up nil 'shell files
@@ -3058,7 +3058,7 @@ Optional third arg LIMIT (>= 1) is a limit to the length
of the
resulting list.
Thus, if SEP is a regexp that only matches itself,
- (mapconcat #'identity (dired-split SEP STRING) SEP)
+ (mapconcat #\\='identity (dired-split SEP STRING) SEP)
is always equal to STRING."
(declare (obsolete split-string "29.1"))
@@ -3529,6 +3529,9 @@ in the Dired buffer."
(setq model (vc-checkout-model backend only-files-list))))
(list backend files only-files-list state model)))
+(define-obsolete-function-alias 'minibuffer-default-add-dired-shell-commands
+ #'dired-minibuffer-default-add-shell-commands "29.1")
+
(provide 'dired-aux)
diff --git a/lisp/dired.el b/lisp/dired.el
index 7cdcc3438d..f261f9f477 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1140,7 +1140,8 @@ If DIRNAME is already in a Dired buffer, that buffer is
used without refresh."
(modtime (visited-file-modtime)))
(or (eq modtime 0)
(not (eq (file-attribute-type attributes) t))
- (equal (file-attribute-modification-time attributes) modtime)))))
+ (time-equal-p (file-attribute-modification-time attributes)
+ modtime)))))
(defvar auto-revert-remote-files)
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index bdc50c5885..efffab9b30 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -251,6 +251,7 @@ If VERBOSE is `1', put everything on one line. If VERBOSE
is omitted
or nil, use a compact 80-column format."
(and macro (symbolp macro) (setq macro (symbol-function macro)))
(edmacro-format-keys (or macro last-kbd-macro) verbose))
+
;;; Commands for *Edit Macro* buffer.
@@ -446,6 +447,7 @@ doubt, use whitespace."
(interactive)
(error "This mode can be enabled only by `edit-kbd-macro'"))
(put 'edmacro-mode 'mode-class 'special)
+
;;; Formatting a keyboard macro as human-readable text.
@@ -637,12 +639,8 @@ This function assumes that the events can be stored in a
string."
(defun edmacro-fix-menu-commands (macro &optional noerror)
(if (vectorp macro)
(let (result)
- ;; Not preloaded in without-x builds.
+ ;; Not preloaded in a --without-x build.
(require 'mwheel)
- (defvar mouse-wheel-down-event)
- (defvar mouse-wheel-left-event)
- (defvar mouse-wheel-right-event)
- (defvar mouse-wheel-up-event)
;; Make a list of the elements.
(setq macro (append macro nil))
(dolist (ev macro)
@@ -669,6 +667,7 @@ This function assumes that the events can be stored in a
string."
;; Reverse them again and make them back into a vector.
(vconcat (nreverse result)))
macro))
+
;;; Parsing a human-readable keyboard macro.
diff --git a/lisp/electric.el b/lisp/electric.el
index 0cf3a299cf..f2ff837333 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -540,6 +540,16 @@ closing double quote otherwise."
:version "26.1"
:type 'boolean :safe #'booleanp :group 'electricity)
+(defcustom electric-quote-replace-consecutive t
+ "Non-nil means to replace a pair of single quotes with a double quote.
+Two single quotes are replaced by the corresponding double quote
+when the second quote of the pair is entered (i.e. by typing ` or
+') by default. If nil, the single quotes are not altered."
+ :version "29.1"
+ :type 'boolean
+ :safe #'booleanp
+ :group 'electricity)
+
(defvar electric-quote-inhibit-functions ()
"List of functions that should inhibit electric quoting.
When the variable `electric-quote-mode' is non-nil, Emacs will
@@ -592,7 +602,9 @@ This requotes when a quoting key is typed."
(memq (char-syntax (char-before))
'(?\s ?\())))
(setq backtick ?\')))
- (cond ((search-backward (string q< backtick) (- (point) 2) t)
+ (cond ((and electric-quote-replace-consecutive
+ (search-backward
+ (string q< backtick) (- (point) 2) t))
(replace-match (string q<<))
(when (and electric-pair-mode
(eq (cdr-safe
@@ -606,7 +618,8 @@ This requotes when a quoting key is typed."
((search-backward "\"" (1- (point)) t)
(replace-match (string q<<))
(setq last-command-event q<<)))
- (cond ((search-backward (string q> ?') (- (point) 2) t)
+ (cond ((and electric-quote-replace-consecutive
+ (search-backward (string q> ?') (- (point) 2) t))
(replace-match (string q>>))
(setq last-command-event q>>))
((search-backward "'" (1- (point)) t)
@@ -627,7 +640,7 @@ and text paragraphs, and these are selectively controlled
with
`electric-quote-paragraph'.
Customize `electric-quote-chars' to use characters other than the
-ones listed here.
+ones listed here. Also see `electric-quote-replace-consecutive'.
This is a global minor mode. To toggle the mode in a single buffer,
use `electric-quote-local-mode'."
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 2a2bcca700..391743d715 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1580,8 +1580,6 @@
:link '(custom-manual "(elisp)Advising Functions")
:group 'lisp)
-(defconst ad-version "2.14")
-
;;;###autoload
(defcustom ad-redefinition-action 'warn
"Defines what to do with redefinitions during Advice de/activation.
@@ -3250,6 +3248,9 @@ Use only in REAL emergencies."
(message "Oops! Left over advised function %S" function)
(ad-pop-advised-function function)))
+(defconst ad-version "2.14")
+(make-obsolete-variable 'ad-version 'emacs-version "29.1")
+
(provide 'advice)
;;; advice.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 7a4bbf2e8a..a7edecfac7 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1747,10 +1747,10 @@ See Info node `(elisp) Integer Basics'."
byte-goto-if-not-nil-else-pop))
(defconst byte-after-unbind-ops
- '(byte-constant byte-dup
+ '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard
byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
byte-eq byte-not
- byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
+ byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN
byte-interactive-p)
;; How about other side-effect-free-ops? Is it safe to move an
;; error invocation (such as from nth) out of an unwind-protect?
@@ -1762,7 +1762,8 @@ See Info node `(elisp) Integer Basics'."
(defconst byte-compile-side-effect-and-error-free-ops
'(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp
byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
- byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
+ byte-cdr-safe byte-cons byte-list1 byte-list2 byte-list3 byte-list4
+ byte-listN byte-point byte-point-max
byte-point-min byte-following-char byte-preceding-char
byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
byte-current-buffer byte-stack-ref))
@@ -2113,13 +2114,15 @@ If FOR-EFFECT is non-nil, the return value is assumed
to be of no importance."
(setcar (cdr rest) lap0)
(setq keep-going t))
;;
- ;; varbind-X unbind-N --> discard unbind-(N-1)
- ;; save-excursion unbind-N --> unbind-(N-1)
- ;; save-restriction unbind-N --> unbind-(N-1)
+ ;; varbind-X unbind-N --> discard unbind-(N-1)
+ ;; save-excursion unbind-N --> unbind-(N-1)
+ ;; save-restriction unbind-N --> unbind-(N-1)
+ ;; save-current-buffer unbind-N --> unbind-(N-1)
;;
((and (eq 'byte-unbind (car lap1))
(memq (car lap0) '(byte-varbind byte-save-excursion
- byte-save-restriction))
+ byte-save-restriction
+ byte-save-current-buffer))
(< 0 (cdr lap1)))
(if (zerop (setcdr lap1 (1- (cdr lap1))))
(delq lap1 rest))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9370bd3a09..4a2860cd43 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -236,6 +236,20 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''command-modes (list 'quote val))))
+(defalias 'byte-run--set-interactive-args
+ #'(lambda (f args &rest val)
+ (setq args (remove '&optional (remove '&rest args)))
+ (list 'function-put (list 'quote f)
+ ''interactive-args
+ (list
+ 'quote
+ (mapcar
+ (lambda (elem)
+ (cons
+ (seq-position args (car elem))
+ (cadr elem)))
+ val)))))
+
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
@@ -255,7 +269,8 @@ If `error-free', drop calls even if
`byte-compile-delete-errors' is nil.")
(list 'indent #'byte-run--set-indent)
(list 'speed #'byte-run--set-speed)
(list 'completion #'byte-run--set-completion)
- (list 'modes #'byte-run--set-modes))
+ (list 'modes #'byte-run--set-modes)
+ (list 'interactive-args #'byte-run--set-interactive-args))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b0ace9dae6..5b9f92a4cc 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -767,7 +767,7 @@ Each element is (INDEX . VALUE)")
(byte-defop 122 0 byte-char-syntax)
(byte-defop 123 -1 byte-buffer-substring)
(byte-defop 124 -1 byte-delete-region)
-(byte-defop 125 -2 byte-narrow-to-region)
+(byte-defop 125 -1 byte-narrow-to-region)
(byte-defop 126 1 byte-widen)
(byte-defop 127 0 byte-end-of-line)
@@ -1760,7 +1760,7 @@ It is too wide if it has any lines longer than the
largest of
kind name col))
;; There's a "naked" ' character before a symbol/list, so it
;; should probably be quoted with \=.
- (when (string-match-p "\\( \"\\|[ \t]\\|^\\)'[a-z(]" docs)
+ (when (string-match-p "\\( [\"#]\\|[ \t]\\|^\\)'[a-z(]" docs)
(byte-compile-warn-x
name "%s%sdocstring has wrong usage of unescaped single quotes (use
\\= or different quoting)"
kind name))
@@ -2416,8 +2416,8 @@ Call from the source buffer."
(defun byte-compile-output-file-form (form)
;; Write the given form to the output buffer, being careful of docstrings
- ;; in defvar, defvaralias, defconst, autoload and
- ;; custom-declare-variable because make-docfile is so amazingly stupid.
+ ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias,
+ ;; defconst, autoload, and custom-declare-variable.
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
@@ -2463,21 +2463,9 @@ list that represents a doc string reference.
(let (position
(print-symbols-bare t)) ; Possibly redundant binding.
;; Insert the doc string, and make it a comment with #@LENGTH.
- (and (>= (nth 1 info) 0)
- dynamic-docstrings
- (progn
- ;; Make the doc string start at beginning of line
- ;; for make-docfile's sake.
- (insert "\n")
- (setq position
- (byte-compile-output-as-comment
- (nth (nth 1 info) form) nil))
- ;; If the doc string starts with * (a user variable),
- ;; negate POSITION.
- (if (and (stringp (nth (nth 1 info) form))
- (> (length (nth (nth 1 info) form)) 0)
- (eq (aref (nth (nth 1 info) form) 0) ?*))
- (setq position (- position)))))
+ (when (and (>= (nth 1 info) 0) dynamic-docstrings)
+ (setq position (byte-compile-output-as-comment
+ (nth (nth 1 info) form) nil)))
(let ((print-continuous-numbering t)
print-number-table
@@ -2604,8 +2592,8 @@ list that represents a doc string reference.
(t
(byte-compile-keep-pending form)))))
-;; Functions and variables with doc strings must be output separately,
-;; so make-docfile can recognize them. Most other things can be output
+;; Functions and variables with doc strings must be output specially,
+;; for `byte-compile-dynamic-docstrings'. Most other things can be output
;; as byte-code.
(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
@@ -3845,7 +3833,7 @@ If it is nil, then the handler is
\"byte-compile-SYMBOL.\""
(byte-defop-compiler setcdr 2)
(byte-defop-compiler buffer-substring 2)
(byte-defop-compiler delete-region 2)
-(byte-defop-compiler narrow-to-region 2-3)
+(byte-defop-compiler narrow-to-region 2)
(byte-defop-compiler (% byte-rem) 2)
(byte-defop-compiler aset 3)
@@ -5004,7 +4992,7 @@ binding slots have been popped."
;;
;; FIXME: we also use this hunk-handler to implement the function's
;; dynamic docstring feature (via byte-compile-file-form-defmumble).
- ;; We should actually implement it (more elegantly) in
+ ;; We should probably actually implement it (more elegantly) in
;; byte-compile-lambda so it applies to all lambdas. We did it here
;; so the resulting .elc format was recognizable by make-docfile,
;; but since then we stopped using DOC for the docstrings of
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 611f32e23c..04ead562f2 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,6 +1,6 @@
;;; checkdoc.el --- check documentation strings for style requirements -*-
lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.6.2
@@ -248,7 +248,7 @@ with these words enabled."
;;;###autoload(put 'checkdoc-spellcheck-documentation-flag
'safe-local-variable #'booleanp)
(defvar checkdoc-ispell-lisp-words
- '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs")
+ '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp")
"List of words that are correct when spell-checking Lisp documentation.")
;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable
#'checkdoc-list-of-strings-p)
@@ -1357,23 +1357,6 @@ checking of documentation strings.
checkdoc-common-verbs-wrong-voice "\\|")
"\\)\\>"))))
-;; Profiler says this is not yet faster than just calling assoc
-;;(defun checkdoc-word-in-alist-vector (word vector)
-;; "Check to see if WORD is in the car of an element of VECTOR.
-;;VECTOR must be sorted. The CDR should be a replacement. Since the
-;;word list is getting bigger, it is time for a quick bisecting search."
-;; (let ((max (length vector)) (min 0) i
-;; (found nil) (fw nil))
-;; (setq i (/ max 2))
-;; (while (and (not found) (/= min max))
-;; (setq fw (car (aref vector i)))
-;; (cond ((string= word fw) (setq found (cdr (aref vector i))))
-;; ((string< word fw) (setq max i))
-;; (t (setq min i)))
-;; (setq i (/ (+ max min) 2))
-;; )
-;; found))
-
;;; Checking engines
;;
(defun checkdoc-this-string-valid (&optional take-notes)
@@ -2360,8 +2343,6 @@ News agents may remove it"
;;; Comment checking engine
;;
-(defvar generate-autoload-cookie)
-
(defun checkdoc-file-comments-engine ()
"Return a message list if this file does not match the Emacs standard.
This checks for style only, such as the first line, Commentary:,
@@ -2862,8 +2843,6 @@ function called to create the messages."
(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
-;; Obsolete
-
(define-obsolete-function-alias 'checkdoc-run-hooks
#'run-hook-with-args-until-success "28.1")
(defvar checkdoc-version "0.6.2"
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 3f40ab0760..a54fa21fa9 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -372,8 +372,8 @@ SEQ, this is like `mapcar'. With several, it is like the
Common Lisp
(cl--defalias 'cl-second 'cadr)
(cl--defalias 'cl-rest 'cdr)
-(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
-(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
+(cl--defalias 'cl-third #'caddr "Return the third element of the list X.")
+(cl--defalias 'cl-fourth #'cadddr "Return the fourth element of the list X.")
(defsubst cl-fifth (x)
"Return the fifth element of the list X."
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 727b3098e3..eefaa36b91 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -527,7 +527,7 @@ its argument list allows full Common Lisp conventions."
(while (and (eq (car args) '&aux) (pop args))
(while (and args (not (memq (car args) cl--lambda-list-keywords)))
(if (consp (car args))
- (if (and cl--bind-enquote (cl-cadar args))
+ (if (and cl--bind-enquote (cadar args))
(cl--do-arglist (caar args)
`',(cadr (pop args)))
(cl--do-arglist (caar args) (cadr (pop args))))
@@ -612,7 +612,7 @@ its argument list allows full Common Lisp conventions."
(if (eq ?_ (aref name 0))
(setq name (substring name 1)))
(intern (format ":%s" name)))))
- (varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
+ (varg (if (consp (car arg)) (cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
;; The ordering between those two or clauses is
;; irrelevant, since in practice only one of the two
@@ -1339,7 +1339,7 @@ For more details, see Info node `(cl)Loop Facility'.
(temp-idx
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
- (eq (cl-caadr cl--loop-args) 'index))
+ (eq (caadr cl--loop-args) 'index))
(cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-idx--"))))
@@ -1370,8 +1370,8 @@ For more details, see Info node `(cl)Loop Facility'.
(other
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
- (memq (cl-caadr cl--loop-args) hash-types)
- (not (eq (cl-caadr cl--loop-args) word)))
+ (memq (caadr cl--loop-args) hash-types)
+ (not (eq (caadr cl--loop-args) word)))
(cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
@@ -1433,8 +1433,8 @@ For more details, see Info node `(cl)Loop Facility'.
(other
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
- (memq (cl-caadr cl--loop-args) key-types)
- (not (eq (cl-caadr cl--loop-args) word)))
+ (memq (caadr cl--loop-args) key-types)
+ (not (eq (caadr cl--loop-args) word)))
(cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
@@ -1656,7 +1656,7 @@ If BODY is `setq', then use SPECS for assignments rather
than for bindings."
(let ((temps nil) (new nil))
(when par
(let ((p specs))
- (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
+ (while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
(setq p (cdr p)))
(when p
(setq par nil)
@@ -1731,7 +1731,7 @@ such that COMBO is equivalent to (and . CLAUSES)."
(setq clauses (cons (nconc (butlast (car clauses))
(if (eq (car-safe (cadr clauses))
'progn)
- (cl-cdadr clauses)
+ (cdadr clauses)
(list (cadr clauses))))
(cddr clauses)))
;; A final (progn ,@A t) is moved outside of the `and'.
@@ -2563,9 +2563,9 @@ values. For compatibility, (cl-values A B C) is a
synonym for (list A B C).
(defun cl--optimize (f _args &rest qualities)
"Serve `cl-optimize' in function declarations.
Example:
-(defun foo (x)
- (declare (cl-optimize (speed 3) (safety 0)))
- x)"
+ (defun foo (x)
+ (declare (cl-optimize (speed 3) (safety 0)))
+ x)"
;; FIXME this should make use of `cl--declare-stack' but I suspect
;; this mechanism should be reviewed first.
(cl-loop for (qly val) in qualities
@@ -2613,7 +2613,7 @@ Example:
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
(while (setq spec (cdr spec))
(if (consp (car spec))
- (if (eq (cl-cadar spec) 0)
+ (if (eq (cadar spec) 0)
(byte-compile-disable-warning (caar spec))
(byte-compile-enable-warning (caar spec)))))))
nil)
@@ -3093,9 +3093,9 @@ To see the documentation for a defined struct type, use
(t `(and (consp cl-x)
(memq (nth ,pos cl-x) ,tag-symbol))))))
pred-check (and pred-form (> safety 0)
- (if (and (eq (cl-caadr pred-form) 'vectorp)
+ (if (and (eq (caadr pred-form) 'vectorp)
(= safety 1))
- (cons 'and (cl-cdddr pred-form))
+ (cons 'and (cdddr pred-form))
`(,predicate cl-x))))
(when pred-form
(push `(,defsym ,predicate (cl-x)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 4354ea03a4..5ee10fcbca 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1915,7 +1915,10 @@ and the annotation emission."
(byte-char-syntax auto)
(byte-buffer-substring auto)
(byte-delete-region auto)
- (byte-narrow-to-region auto)
+ (byte-narrow-to-region
+ (comp-emit-set-call (comp-call 'narrow-to-region
+ (comp-slot)
+ (comp-slot+1))))
(byte-widen
(comp-emit-set-call (comp-call 'widen)))
(byte-end-of-line auto)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1a1d58d6e3..dff16df002 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -864,7 +864,7 @@ marker. The needed data will then come from property
(defun edebug-read-special (stream)
"Read from STREAM a Lisp object beginning with #.
-Turn #'thing into (function thing) and handle the read syntax for
+Turn #\\='thing into (function thing) and handle the read syntax for
circular objects. Let `read' read everything else."
(catch 'return
(forward-char 1)
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 8d7f182e0c..6fd89a690d 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -381,7 +381,6 @@ Also store it in `eldoc-last-message' and return that
value."
(defun eldoc-display-message-no-interference-p ()
"Return nil if displaying a message would cause interference."
(not (or executing-kbd-macro
- (bound-and-true-p edebug-active)
;; The following configuration shows "Matches..." in the
;; echo area when point is after a closing bracket, which
;; conflicts with eldoc.
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 49b54c2d00..c8ff6b6814 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1692,7 +1692,7 @@ test packages depend on each other, it might be helpful.")
(string-match-p "^Running 0 tests" logfile-contents))
(insert (format " <testsuite id=\"%s\" name=\"%s\"
tests=\"1\" errors=\"1\" failures=\"0\" skipped=\"0\" time=\"0\"
timestamp=\"%s\">\n"
id test-report
- (ert--format-time-iso8601 (current-time))))
+ (ert--format-time-iso8601 nil)))
(insert (format " <testcase name=\"Test report missing
%s\" status=\"error\" time=\"0\">\n"
(file-name-nondirectory test-report)))
(insert (format " <error message=\"Test report missing
%s\" type=\"error\">\n"
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 654dbbc5fe..10bb297325 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -131,7 +131,6 @@
(defun Helper-describe-bindings ()
"Describe local key bindings of current mode."
(interactive)
- (message "Making binding list...")
(save-window-excursion (describe-bindings))
(Helper-help-scroller))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index c906ee6e31..c31fbec640 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -728,30 +728,62 @@ font-lock keywords will not be case sensitive."
len))))
(defun lisp-current-defun-name ()
- "Return the name of the defun at point, or nil."
+ "Return the name of the defun at point.
+If there is no defun at point, return the first symbol from the
+top-level form. If there is no top-level form, return nil.
+
+(\"defun\" here means \"form that defines something\", and is
+decided heuristically.)"
(save-excursion
- (let ((location (point)))
+ (let ((location (point))
+ name)
;; If we are now precisely at the beginning of a defun, make sure
;; beginning-of-defun finds that one rather than the previous one.
- (or (eobp) (forward-char 1))
+ (unless (eobp)
+ (forward-char 1))
(beginning-of-defun)
;; Make sure we are really inside the defun found, not after it.
- (when (and (looking-at "\\s(")
- (progn (end-of-defun)
- (< location (point)))
- (progn (forward-sexp -1)
- (>= location (point))))
- (if (looking-at "\\s(")
- (forward-char 1))
- ;; Skip the defining construct name, typically "defun" or
+ (when (and (looking-at "(")
+ (progn
+ (end-of-defun)
+ (< location (point)))
+ (progn
+ (forward-sexp -1)
+ (>= location (point))))
+ (when (looking-at "(")
+ (forward-char 1))
+ ;; Read the defining construct name, typically "defun" or
;; "defvar".
- (forward-sexp 1)
- ;; The second element is usually a symbol being defined. If it
- ;; is not, use the first symbol in it.
- (skip-chars-forward " \t\n'(")
- (buffer-substring-no-properties (point)
- (progn (forward-sexp 1)
- (point)))))))
+ (let ((symbol (ignore-errors (read (current-buffer)))))
+ (when (and symbol (not (symbolp symbol)))
+ (setq symbol nil))
+ ;; If there's an edebug spec, use that to determine what the
+ ;; name is.
+ (when symbol
+ (let ((spec (get symbol 'edebug-form-spec)))
+ (save-excursion
+ (when (and (eq (car-safe spec) '&define)
+ (memq 'name spec))
+ (pop spec)
+ (while (and spec (not name))
+ (let ((candidate (ignore-errors (read (current-buffer)))))
+ (when (eq (pop spec) 'name)
+ (setq name candidate
+ spec nil))))))))
+ ;; We didn't have an edebug spec (or couldn't find the
+ ;; name). If the symbol starts with \"def\", then it's
+ ;; likely that the next symbol is the name.
+ (when (and (not name)
+ (string-match-p "\\(\\`\\|-\\)def" (symbol-name symbol)))
+ (when-let ((candidate (ignore-errors (read (current-buffer)))))
+ (cond
+ ((symbolp candidate)
+ (setq name candidate))
+ ((and (consp candidate)
+ (symbolp (car (delete 'quote candidate))))
+ (setq name (car (delete 'quote candidate)))))))
+ (when-let ((result (or name symbol)))
+ (symbol-name result)))))))
(defvar-keymap lisp-mode-shared-map
:doc "Keymap for commands shared by all sorts of Lisp modes."
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 4b85414943..acae1a0b0a 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -507,6 +507,11 @@ It is called with no argument, right after calling
`beginning-of-defun-raw'.
So the function can assume that point is at the beginning of the defun body.
It should move point to the first position after the defun.")
+(defvar end-of-defun-moves-to-eol t
+ "Whether `end-of-defun' moves to eol before doing anything else.
+Set this to nil if this movement adversely affects the buffer's
+major mode's decisions about context.")
+
(defun buffer-end (arg)
"Return the \"far end\" position of the buffer, in direction ARG.
If ARG is positive, that's the end of the buffer.
@@ -538,7 +543,9 @@ report errors as appropriate for this kind of usage."
(push-mark))
(if (or (null arg) (= arg 0)) (setq arg 1))
(let ((pos (point))
- (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
+ (beg (progn (when end-of-defun-moves-to-eol
+ (end-of-line 1))
+ (beginning-of-defun-raw 1) (point)))
(skip (lambda ()
;; When comparing point against pos, we want to consider that
;; if point was right after the end of the function, it's
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 261e44aece..0c9bc4832b 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -50,17 +50,27 @@ prefix, that will not be registered. But all other
prefixes will
be included.")
(put 'autoload-compute-prefixes 'safe-local-variable #'booleanp)
+(defvar no-update-autoloads nil
+ "File local variable to prevent scanning this file for autoload cookies.")
+
(defvar autoload-ignored-definitions
'("define-obsolete-function-alias"
"define-obsolete-variable-alias"
- "define-category" "define-key"
+ "define-category"
+ "define-key" "define-key-after" "define-keymap"
"defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
"define-erc-module"
"define-erc-response-handler"
- "defun-rcirc-command")
+ "defun-rcirc-command"
+ "define-short-documentation-group"
+ "def-edebug-elem-spec"
+ "defvar-mode-local"
+ "defcustom-mode-local-semantic-dependency-system-include-path"
+ "define-ibuffer-column"
+ "define-ibuffer-sorter")
"List of strings naming definitions to ignore for prefixes.
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
@@ -117,6 +127,15 @@ scanning for autoloads and will be in the `load-path'."
(substring name 0 (match-beginning 0))
name)))
+(defun loaddefs-generate--shorten-autoload (form)
+ "Remove optional nil elements from an `autoload' form."
+ (take (max (- (length form)
+ (seq-position (reverse form) nil
+ (lambda (e1 e2)
+ (not (eq e1 e2)))))
+ 3)
+ form))
+
(defun loaddefs-generate--make-autoload (form file &optional expansion)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
@@ -155,8 +174,8 @@ expression, in which case we want to handle forms
differently."
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (consp args) (setq doc (help-add-fundoc-usage doc args)))
- ;; (message "autoload of %S" (nth 1 form))
- `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
+ (loaddefs-generate--shorten-autoload
+ `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))))
((and expansion (memq car '(progn prog1)))
(let ((end (memq :autoload-end form)))
@@ -210,22 +229,23 @@ expression, in which case we want to handle forms
differently."
;; can recover it.
(when (listp args) (setq doc (help-add-fundoc-usage doc args)))
;; `define-generic-mode' quotes the name, so take care of that
- `(autoload ,(if (listp name) name (list 'quote name))
- ,file ,doc
- ,(or (and (memq car '(define-skeleton define-derived-mode
- define-generic-mode
- easy-mmode-define-global-mode
- define-global-minor-mode
- define-globalized-minor-mode
- easy-mmode-define-minor-mode
- define-minor-mode))
- t)
- (and (eq (car-safe (car body)) 'interactive)
- ;; List of modes or just t.
- (or (if (nthcdr 1 (car body))
- (list 'quote (nthcdr 1 (car body)))
- t))))
- ,(if macrop ''macro nil))))
+ (loaddefs-generate--shorten-autoload
+ `(autoload ,(if (listp name) name (list 'quote name))
+ ,file ,doc
+ ,(or (and (memq car '(define-skeleton define-derived-mode
+ define-generic-mode
+ easy-mmode-define-global-mode
+ define-global-minor-mode
+ define-globalized-minor-mode
+ easy-mmode-define-minor-mode
+ define-minor-mode))
+ t)
+ (and (eq (car-safe (car body)) 'interactive)
+ ;; List of modes or just t.
+ (or (if (nthcdr 1 (car body))
+ (list 'quote (nthcdr 1 (car body)))
+ t))))
+ ,(if macrop ''macro nil)))))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)
@@ -447,7 +467,7 @@ don't include."
(let ((prefs nil))
;; Avoid (defvar <foo>) by requiring a trailing space.
(while (re-search-forward
- "^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
+ "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
(unless (member (match-string 1) autoload-ignored-definitions)
(let ((name (match-string-no-properties 2)))
(when (save-excursion
@@ -459,7 +479,7 @@ don't include."
(push name prefs)))))
(loaddefs-generate--make-prefixes prefs load-name)))
-(defun loaddefs-generate--rubric (file &optional type feature)
+(defun loaddefs-generate--rubric (file &optional type feature compile)
"Return a string giving the appropriate autoload rubric for FILE.
TYPE (default \"autoloads\") is a string stating the type of
information contained in FILE. TYPE \"package\" acts like the default,
@@ -467,7 +487,9 @@ but adds an extra line to the output to modify `load-path'.
If FEATURE is non-nil, FILE will provide a feature. FEATURE may
be a string naming the feature, otherwise it will be based on
-FILE's name."
+FILE's name.
+
+If COMPILE, don't include a \"don't compile\" cookie."
(let ((lp (and (equal type "package") (setq type "autoloads"))))
(with-temp-buffer
(generate-lisp-file-heading
@@ -481,30 +503,10 @@ FILE's name."
(insert " \n;;; End of scraped data\n\n")
(generate-lisp-file-trailer
file :provide (and (stringp feature) feature)
+ :compile compile
:inhibit-provide (not feature))
(buffer-string))))
-(defun loaddefs-generate--insert-section-header (outbuf autoloads
- load-name file time)
- "Insert into buffer OUTBUF the section-header line for FILE.
-The header line lists the file name, its \"load name\", its autoloads,
-and the time the FILE was last updated (the time is inserted only
-if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
- (insert "\f\n;;;### ")
- (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
- outbuf)
- (terpri outbuf)
- ;; Break that line at spaces, to avoid very long lines.
- ;; Make each sub-line into a comment.
- (with-current-buffer outbuf
- (save-excursion
- (forward-line -1)
- (while (not (eolp))
- (move-to-column 64)
- (skip-chars-forward "^ \n")
- (or (eolp)
- (insert "\n" ";;;;;; "))))))
-
;;;###autoload
(defun loaddefs-generate (dir output-file &optional excluded-files
extra-data include-package-version
@@ -517,15 +519,21 @@ binds `generated-autoload-file' as a file-local variable,
write
its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
-directory or directories specified.
+directory or directories specified by DIRS.
+
+Optional argument EXCLUDED-FILES, if non-nil, should be a list of
+files, such as preloaded files, whose autoloads should not be written
+to OUTPUT-FILE.
-If EXTRA-DATA, include this string at the start of the generated
-file. This will also force generation of OUTPUT-FILE even if
-there are no autoloads to put into the file.
+If EXTRA-DATA is non-nil, it should be a string; include that string
+at the beginning of the generated file. This will also force the
+generation of OUTPUT-FILE even if there are no autoloads to put into
+that file.
-If INCLUDE-PACKAGE-VERSION, include package version data.
+If INCLUDE-PACKAGE-VERSION is non-nil, include package version data.
-If GENERATE-FULL, don't update, but regenerate all the loaddefs files."
+If GENERATE-FULL is non-nil, regenerate all the loaddefs files anew,
+instead of just updating them with the new/changed autoloads."
(let* ((files-re (let ((tmp nil))
(dolist (suf (get-load-suffixes))
;; We don't use module-file-suffix below because
@@ -585,7 +593,8 @@ If GENERATE-FULL, don't update, but regenerate all the
loaddefs files."
(with-temp-buffer
(if (and updating (file-exists-p loaddefs-file))
(insert-file-contents loaddefs-file)
- (insert (loaddefs-generate--rubric loaddefs-file nil t))
+ (insert (loaddefs-generate--rubric
+ loaddefs-file nil t include-package-version))
(search-backward "\f")
(when extra-data
(insert extra-data)
@@ -631,18 +640,19 @@ If GENERATE-FULL, don't update, but regenerate all the
loaddefs files."
t "GEN")))))))
(defun loaddefs-generate--print-form (def)
- "Print DEF in the way make-docfile.c expects it."
+ "Print DEF in a format that makes sense for version control."
(if (or (not (consp def))
(not (symbolp (car def)))
(memq (car def) '( make-obsolete
define-obsolete-function-alias))
(not (stringp (nth 3 def))))
(prin1 def (current-buffer) t)
- ;; The salient point here is that we have to have the doc string
- ;; that starts with a backslash and a newline, and there mustn't
- ;; be any newlines before that. So -- typically
- ;; (defvar foo 'value "\
- ;; Doc string" ...).
+ ;; We want to print, for instance, `defvar' values while escaping
+ ;; control characters (so that we don't end up with lines with
+ ;; trailing tab characters and the like), but we don't want to do
+ ;; this for doc strings, because then the doc strings would be on
+ ;; one single line, which would lead to more VC churn. So --
+ ;; typically (defvar foo 'value "\ Doc string" ...).
(insert "(")
(dotimes (_ 3)
(prin1 (pop def) (current-buffer)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ab1a652188..2de5056475 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1064,7 +1064,9 @@ untar into a directory named DIR; otherwise, signal an
error."
(unless (file-exists-p file)
(require 'autoload)
(let ((coding-system-for-write 'utf-8-emacs-unix))
- (write-region (autoload-rubric file "package" nil) nil file nil
'silent)))
+ (with-suppressed-warnings ((obsolete autoload-rubric))
+ (write-region (autoload-rubric file "package" nil)
+ nil file nil 'silent))))
file)
(defvar autoload-timestamps)
@@ -2127,7 +2129,10 @@ If PACKAGE is a `package-desc' object, MIN-VERSION is
ignored."
package-activated-list)
;; We used the quickstart: make it possible to use package-installed-p
;; even before package is fully initialized.
- (memq package package-activated-list))
+ (or
+ (memq package package-activated-list)
+ ;; Also check built-in packages.
+ (package-built-in-p package min-version)))
(t
(or
(let ((pkg-descs (cdr (assq package (package--alist)))))
@@ -3597,7 +3602,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(let ((place (cdr desc))
(out (copy-sequence (car desc))))
(add-text-properties place (1+ place)
- '(face (bold font-lock-warning-face))
+ '(face help-key-binding)
out)
out))
(package--prettify-quick-help-key (cons desc 0))))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 1b8d86563a..b6f0f66e5b 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -455,6 +455,33 @@ TESTFN is used to compare elements, or `equal' if TESTFN
is nil."
(setq result (cons elt result))))
(nreverse result)))
+(cl-defmethod seq-uniq ((sequence list) &optional testfn)
+ (let ((result nil))
+ (if (not testfn)
+ ;; Fast path. If the list is long, use a hash table to speed
+ ;; things up even more.
+ (let ((l (length sequence)))
+ (if (> l 100)
+ (let ((hash (make-hash-table :test #'equal :size l)))
+ (while sequence
+ (unless (gethash (car sequence) hash)
+ (setf (gethash (car sequence) hash) t)
+ (push (car sequence) result))
+ (setq sequence (cdr sequence))))
+ ;; Short list.
+ (while sequence
+ (unless (member (car sequence) result)
+ (push (car sequence) result))
+ (pop sequence))))
+ ;; Slower path.
+ (while sequence
+ (unless (seq-find (lambda (elem)
+ (funcall testfn elem (car sequence)))
+ result)
+ (push (car sequence) result))
+ (pop sequence)))
+ (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."
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 315afd4312..d187af9ac8 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -503,7 +503,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(set-file-modes
:no-value "(set-file-modes \"/tmp/foo\" #o644)")
(set-file-times
- :no-value (set-file-times "/tmp/foo" (current-time)))
+ :no-value (set-file-times "/tmp/foo"))
"File Modes"
(set-default-file-modes
:no-value "(set-default-file-modes #o755)")
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index d5d7bfeb6f..1cce97cdb1 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -118,6 +118,7 @@ the resulting string may be longer than the original if
LENGTH is
(concat "..." (substring string (min (1- strlen)
(max 0 (- strlen length))))))))
+;;;###autoload
(defsubst string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
@@ -253,13 +254,9 @@ the string."
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(let ((pad-length (- length (length string))))
- (if (< pad-length 0)
- string
- (concat (and start
- (make-string pad-length (or padding ?\s)))
- string
- (and (not start)
- (make-string pad-length (or padding ?\s)))))))
+ (cond ((<= pad-length 0) string)
+ (start (concat (make-string pad-length (or padding ?\s)) string))
+ (t (concat string (make-string pad-length (or padding ?\s)))))))
(defun string-chop-newline (string)
"Remove the final newline (if any) from STRING."
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index fd29abf40a..b25a040a96 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -122,7 +122,7 @@ of SECS seconds since the epoch. SECS may be a fraction."
(setq ticks (ash ticks 1))
(setq hz (ash hz 1)))
(let ((more-ticks (+ ticks trunc-s-ticks)))
- (time-convert (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz)))))
+ (time-convert (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz) t))))
(defun timer-relative-time (time secs &optional usecs psecs)
"Advance TIME by SECS seconds.
@@ -159,32 +159,42 @@ SECS may be a fraction."
timer)
(defun timer--activate (timer &optional triggered-p reuse-cell idle)
- (if (and (timerp timer)
- (integerp (timer--high-seconds timer))
- (integerp (timer--low-seconds timer))
- (integerp (timer--usecs timer))
- (integerp (timer--psecs timer))
- (timer--function timer))
- (let ((timers (if idle timer-idle-list timer-list))
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers (timer--time-less-p (car timers) timer))
- (setq last timers
- timers (cdr timers)))
- (if reuse-cell
- (progn
- (setcar reuse-cell timer)
- (setcdr reuse-cell timers))
- (setq reuse-cell (cons timer timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (setf (cond (last (cdr last))
- (idle timer-idle-list)
- (t timer-list))
- reuse-cell)
- (setf (timer--triggered timer) triggered-p)
- (setf (timer--idle-delay timer) idle)
- nil)
- (error "Invalid or uninitialized timer")))
+ (let ((timers (if idle timer-idle-list timer-list))
+ last)
+ (cond
+ ((not (and (timerp timer)
+ (integerp (timer--high-seconds timer))
+ (integerp (timer--low-seconds timer))
+ (integerp (timer--usecs timer))
+ (integerp (timer--psecs timer))
+ (timer--function timer)))
+ (error "Invalid or uninitialized timer"))
+ ;; FIXME: This is not reliable because `idle-delay' is only set late,
+ ;; by `timer-activate-when-idle' :-(
+ ;;((not (eq (not idle)
+ ;; (not (timer--idle-delay timer))))
+ ;; (error "idle arg %S out of sync with idle-delay field of timer: %S"
+ ;; idle timer))
+ ((memq timer timers)
+ (error "Timer already activated"))
+ (t
+ ;; Skip all timers to trigger before the new one.
+ (while (and timers (timer--time-less-p (car timers) timer))
+ (setq last timers
+ timers (cdr timers)))
+ (if reuse-cell
+ (progn
+ (setcar reuse-cell timer)
+ (setcdr reuse-cell timers))
+ (setq reuse-cell (cons timer timers)))
+ ;; Insert new timer after last which possibly means in front of queue.
+ (setf (cond (last (cdr last))
+ (idle timer-idle-list)
+ (t timer-list))
+ reuse-cell)
+ (setf (timer--triggered timer) triggered-p)
+ (setf (timer--idle-delay timer) idle)
+ nil))))
(defun timer-activate (timer &optional triggered-p reuse-cell)
"Insert TIMER into `timer-list'.
@@ -216,7 +226,7 @@ the time of the current timer. That's because the activated
timer will fire right away."
(timer--activate timer (not dont-wait) reuse-cell 'idle))
-(defalias 'disable-timeout 'cancel-timer)
+(defalias 'disable-timeout #'cancel-timer)
(defun cancel-timer (timer)
"Remove TIMER from the list of active timers."
@@ -430,7 +440,7 @@ The action is to call FUNCTION with arguments ARGS.
This function returns a timer object which you can use in `cancel-timer'."
(interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
- (apply 'run-at-time secs repeat function args))
+ (apply #'run-at-time secs repeat function args))
(defun add-timeout (secs function object &optional repeat)
"Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
@@ -457,7 +467,7 @@ This function returns a timer object which you can use in
`cancel-timer'."
(interactive
(list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
(y-or-n-p "Repeat each time Emacs is idle? ")
- (intern (completing-read "Function: " obarray 'fboundp t))))
+ (intern (completing-read "Function: " obarray #'fboundp t))))
(let ((timer (timer-create)))
(timer-set-function timer function args)
(timer-set-idle-time timer secs repeat)
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 516fdeb10e..d60eedbc9c 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -209,7 +209,7 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress."
(text " stop "))
"Suppress warnings."
:version "29.1"
- :help-echo "Click to supress this warning type")
+ :help-echo "Click to suppress this warning type")
(defun warnings-suppress (type)
(pcase (car
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index d1bf5e38d5..ec7b1e4cac 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1547,7 +1547,7 @@ reversed."
(if skip-rest
()
;; setup buffer
- (if (setq wind (viper-get-visible-buffer-window buf))
+ (if (setq wind (get-buffer-window buf 'visible))
()
(setq wind (get-lru-window 'visible))
(set-window-buffer wind buf))
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 5430cd700b..df2487a447 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -71,7 +71,7 @@ In all likelihood, you don't need to bother with this
setting."
(defun viper-has-face-support-p ()
(cond ((viper-window-display-p))
(viper-force-faces)
- ((x-display-color-p))
+ ((display-color-p))
(t (memq window-system '(pc)))))
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 6d23ae9a0f..25c55acf96 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -1,6 +1,6 @@
;;; viper-util.el --- Utilities used by viper.el -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1997, 1999-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -57,7 +57,7 @@
(define-obsolete-function-alias 'viper-int-to-char #'identity "27.1")
(define-obsolete-function-alias 'viper-get-face #'facep "27.1")
(define-obsolete-function-alias 'viper-color-defined-p
- #'x-color-defined-p "27.1")
+ #'color-defined-p "27.1")
(define-obsolete-function-alias 'viper-iconify
#'iconify-or-deiconify-frame "27.1")
@@ -71,7 +71,7 @@
(= char char1))
(t nil)))
-(define-obsolete-function-alias 'viper-color-display-p #'x-display-color-p
"29.1")
+(define-obsolete-function-alias 'viper-color-display-p #'display-color-p
"29.1")
(defun viper-get-cursor-color (&optional _frame)
(cdr (assoc 'cursor-color (frame-parameters))))
@@ -89,8 +89,8 @@ Otherwise return the normal value."
;; cursor colors
(defun viper-change-cursor-color (new-color &optional frame)
- (if (and (viper-window-display-p) (x-display-color-p)
- (stringp new-color) (x-color-defined-p new-color)
+ (if (and (viper-window-display-p) (display-color-p)
+ (stringp new-color) (color-defined-p new-color)
(not (string= new-color (viper-get-cursor-color))))
(modify-frame-parameters
(or frame (selected-frame))
@@ -121,9 +121,9 @@ Otherwise return the normal value."
;; By default, saves current frame cursor color before changing viper state
(defun viper-save-cursor-color (before-which-mode)
- (if (and (viper-window-display-p) (x-display-color-p))
+ (if (and (viper-window-display-p) (display-color-p))
(let ((color (viper-get-cursor-color)))
- (if (and (stringp color) (x-color-defined-p color)
+ (if (and (stringp color) (color-defined-p color)
;; there is something fishy in that the color is not saved if
;; it is the same as frames default cursor color. need to be
;; checked.
@@ -175,35 +175,23 @@ Otherwise return the normal value."
;; Check the current version against the major and minor version numbers
-;; using op: cur-vers op major.minor If emacs-major-version or
-;; emacs-minor-version are not defined, we assume that the current version
-;; is hopelessly outdated. We assume that emacs-major-version and
-;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the
-;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
-;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
-;; incorrect. However, this gives correct result in our cases, since we are
-;; testing for sufficiently high Emacs versions.
-(defun viper-check-version (op major minor &optional type-of-emacs)
+;; using op: cur-vers op major.minor
+(defun viper-check-version (op major minor &optional _type-of-emacs)
(declare (obsolete nil "28.1"))
- (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
- (and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs))
- ((eq type-of-emacs 'emacs) (featurep 'emacs))
- (t t))
- (cond ((eq op '=) (and (= emacs-minor-version minor)
- (= emacs-major-version major)))
- ((memq op '(> >= < <=))
- (and (or (funcall op emacs-major-version major)
- (= emacs-major-version major))
- (if (= emacs-major-version major)
- (funcall op emacs-minor-version minor)
- t)))
- (t
- (error "%S: Invalid op in viper-check-version" op))))
- (cond ((memq op '(= > >=)) nil)
- ((memq op '(< <=)) t))))
+ (cond ((eq op '=) (and (= emacs-minor-version minor)
+ (= emacs-major-version major)))
+ ((memq op '(> >= < <=))
+ (and (or (funcall op emacs-major-version major)
+ (= emacs-major-version major))
+ (if (= emacs-major-version major)
+ (funcall op emacs-minor-version minor)
+ t)))
+ (t
+ (error "%S: Invalid op in viper-check-version" op))))
(defun viper-get-visible-buffer-window (wind)
+ (declare (obsolete "use `(get-buffer-window wind 'visible)'." "29.1"))
(get-buffer-window wind 'visible))
;; Return line position.
@@ -1005,6 +993,7 @@ Otherwise return the normal value."
(t (prin1-to-string event-seq)))))
(defun viper-key-press-events-to-chars (events)
+ (declare (obsolete nil "29.1"))
(mapconcat #'char-to-string events ""))
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index be87d788e9..d1634c64ad 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -379,7 +379,7 @@ widget."
flora-mode
sql-mode
- text-mode indented-text-mode
+ text-mode
tex-mode latex-mode bibtex-mode
ps-mode
@@ -605,7 +605,7 @@ This startup message appears whenever you load Viper,
unless you type \\`y' now.
;; Apply a little heuristic to invoke vi state on major-modes
;; that are not listed in viper-vi-state-mode-list
-(defun this-major-mode-requires-vi-state (mode)
+(defun viper-this-major-mode-requires-vi-state (mode)
(let ((major-mode mode))
(cond ((apply #'derived-mode-p viper-vi-state-mode-list) t)
((apply #'derived-mode-p viper-emacs-state-mode-list) nil)
@@ -634,7 +634,7 @@ This startup message appears whenever you load Viper,
unless you type \\`y' now.
(remove-hook symbol #'viper-minibuffer-post-command-hook)
(remove-hook symbol #'viper-minibuffer-setup-sentinel)
(remove-hook symbol #'viper-major-mode-change-sentinel)
- (remove-hook symbol #'set-viper-state-in-major-mode)
+ (remove-hook symbol #'viper-set-state-in-major-mode)
(remove-hook symbol #'viper-post-command-sentinel)
)))
@@ -786,12 +786,12 @@ It also can't undo some Viper settings."
(defvar viper-new-major-mode-buffer-list nil)
;; set appropriate Viper state in buffers that changed major mode
-(defun set-viper-state-in-major-mode ()
+(defun viper-set-state-in-major-mode ()
(mapc
(lambda (buf)
(if (viper-buffer-live-p buf)
(with-current-buffer buf
- (cond ((and (this-major-mode-requires-vi-state major-mode)
+ (cond ((and (viper-this-major-mode-requires-vi-state major-mode)
(eq viper-current-state 'emacs-state))
(viper-mode))
((cl-member-if #'derived-mode-p viper-emacs-state-mode-list)
@@ -810,7 +810,7 @@ It also can't undo some Viper settings."
;; clear the list of bufs that changed major mode
(setq viper-new-major-mode-buffer-list nil)
;; change the global value of hook
- (remove-hook 'viper-post-command-hooks #'set-viper-state-in-major-mode))
+ (remove-hook 'viper-post-command-hooks #'viper-set-state-in-major-mode))
;; sets up post-command-hook to turn viper-mode, if the current mode is
;; fundamental
@@ -820,7 +820,7 @@ It also can't undo some Viper settings."
(setq viper-new-major-mode-buffer-list
(cons (current-buffer) viper-new-major-mode-buffer-list))))
;; change the global value of hook
- (add-hook 'viper-post-command-hooks #'set-viper-state-in-major-mode t))
+ (add-hook 'viper-post-command-hooks #'viper-set-state-in-major-mode t))
;;; Handling of tty's ESC event
@@ -891,7 +891,7 @@ Two differences:
(viper-setup-ESC-to-escape t)
(add-hook 'change-major-mode-hook #'viper-major-mode-change-sentinel)
- (add-hook 'find-file-hook #'set-viper-state-in-major-mode)
+ (add-hook 'find-file-hook #'viper-set-state-in-major-mode)
;; keep this because many modes we don't know about use this hook
(defvar text-mode-hook)
@@ -1242,12 +1242,15 @@ These two lines must come in the order given."))
(when (eq viper-current-state 'emacs-state)
(viper-change-state-to-emacs))
- (if (this-major-mode-requires-vi-state major-mode)
+ (if (viper-this-major-mode-requires-vi-state major-mode)
(viper-mode))
- (add-function :after initial-major-mode #'set-viper-state-in-major-mode))
-
+ (add-function :after initial-major-mode #'viper-set-state-in-major-mode))
+(define-obsolete-function-alias 'set-viper-state-in-major-mode
+ #'viper-set-state-in-major-mode "29.1")
+(define-obsolete-function-alias 'this-major-mode-requires-vi-state
+ #'viper-this-major-mode-requires-vi-state "29.1")
(run-hooks 'viper-load-hook) ; the last chance to change something
diff --git a/lisp/env.el b/lisp/env.el
index a35383a13b..5cdedbfb99 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -1,6 +1,6 @@
;;; env.el --- functions to manipulate environment variables -*-
lexical-binding:t -*-
-;; Copyright (C) 1991, 1994, 2000-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes, unix
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el
index f41429f773..7c60b659f0 100644
--- a/lisp/epa-ks.el
+++ b/lisp/epa-ks.el
@@ -295,13 +295,11 @@ enough, since keyservers have strict timeout settings."
:created
(and (match-string 4)
(not (string-empty-p (match-string 4)))
- (time-convert
- (string-to-number (match-string 4))))
+ (time-convert (string-to-number (match-string 4)) t))
:expires
(and (match-string 5)
(not (string-empty-p (match-string 5)))
- (time-convert
- (string-to-number (match-string 5))))
+ (time-convert (string-to-number (match-string 5)) t))
:flags
(mapcar (lambda (flag)
(cdr (assq flag '((?r revoked)
diff --git a/lisp/epg.el b/lisp/epg.el
index c5d946cb76..c3c26badbb 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -606,7 +606,7 @@ callback data (if any)."
process
terminal-name
agent-file
- (agent-mtime '(0 0 0 0)))
+ (agent-mtime 0))
;; Set GPG_TTY and TERM for pinentry-curses. Note that we can't
;; use `terminal-name' here to get the real pty name for the child
;; process, though /dev/fd/0" is not portable.
@@ -633,7 +633,7 @@ callback data (if any)."
(setq agent-file (match-string 1 agent-info)
agent-mtime (or (file-attribute-modification-time
(file-attributes agent-file))
- '(0 0 0 0))))
+ 0)))
(if epg-debug
(save-excursion
(unless epg-debug-buffer
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 091b8aa92d..c54b12fcb0 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1547,6 +1547,3 @@ VALUE is the options value.")
(provide 'erc-networks)
;;; erc-networks.el ends here
-;;
-;; Local Variables:
-;; End:
diff --git a/lisp/eshell/em-extpipe.el b/lisp/eshell/em-extpipe.el
index 3db1dea595..7d81f27a18 100644
--- a/lisp/eshell/em-extpipe.el
+++ b/lisp/eshell/em-extpipe.el
@@ -49,7 +49,7 @@
(add-hook 'eshell-pre-rewrite-command-hook
#'eshell-rewrite-external-pipeline -20 t))
-(defmacro em-extpipe--or-with-catch (&rest disjuncts)
+(defmacro eshell-extpipe--or-with-catch (&rest disjuncts)
"Evaluate DISJUNCTS like `or' but catch `eshell-incomplete'.
If `eshell-incomplete' is thrown during the evaluation of a
@@ -118,7 +118,7 @@ as though it were Eshell syntax."
(if (re-search-forward pat next t)
(throw 'found (match-beginning 1))
(goto-char next)
- (while (em-extpipe--or-with-catch
+ (while (eshell-extpipe--or-with-catch
(eshell-parse-lisp-argument)
(eshell-parse-backslash)
(eshell-parse-double-quote)
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 1877749c5c..1db239b9f7 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -55,7 +55,6 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(eval-when-compile (require 'subr-x)) ; `string-blank-p'
(require 'ring)
(require 'esh-opt)
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 3967817b0e..68276b22d9 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -968,7 +968,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
(if eshell-diff-window-config
(set-window-configuration eshell-diff-window-config)))
-(defun nil-blank-string (string)
+(defun eshell-nil-blank-string (string)
"Return STRING, or nil if STRING contains only blank characters."
(cond
((string-match "[^[:blank:]]" string) string)
@@ -999,7 +999,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
(condition-case nil
(diff-no-select
old new
- (nil-blank-string (eshell-flatten-and-stringify args)))
+ (eshell-nil-blank-string (eshell-flatten-and-stringify args)))
(error
(throw 'eshell-replace-command
(eshell-parse-command "*diff" orig-args))))
@@ -1049,6 +1049,8 @@ Show wall-clock time elapsed during execution of
COMMAND.")
(put 'eshell/occur 'eshell-no-numeric-conversions t)
+(define-obsolete-function-alias 'nil-blank-string #'eshell-nil-blank-string
"29.1")
+
(provide 'em-unix)
;; Local Variables:
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 459487f435..8e44a88459 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -186,7 +186,7 @@ If QUOTED is nil, the resulting value(s) may be converted to
numbers (see `eshell-concat-1').
If each argument in REST is a non-list value, the result will be
-a single value, as if (mapconcat #'eshell-stringify REST) had been
+a single value, as if (mapconcat #\\='eshell-stringify REST) had been
called, possibly converted to a number.
If there is at least one (non-nil) list argument, the result will
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index c035890ddf..68e52a2c9c 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -276,18 +276,21 @@ STATUS should be non-nil on successful termination of the
output."
;; If we're redirecting to a process (via a pipe, or process
;; redirection), send it EOF so that it knows we're finished.
((eshell-processp target)
- ;; According to POSIX.1-2017, section 11.1.9, sending EOF causes
- ;; all bytes waiting to be read to be sent to the process
- ;; immediately. Thus, if there are any bytes waiting, we need to
- ;; send EOF twice: once to flush the buffer, and a second time to
- ;; cause the next read() to return a size of 0, indicating
- ;; end-of-file to the reading process. However, some platforms
- ;; (e.g. Solaris) actually require sending a *third* EOF. Since
- ;; sending extra EOFs while the process is running shouldn't break
- ;; anything, we'll just send the maximum we'd ever need. See
- ;; bug#56025 for further details.
- (let ((i 0))
- (while (and (<= (cl-incf i) 3)
+ ;; According to POSIX.1-2017, section 11.1.9, when communicating
+ ;; via terminal, sending EOF causes all bytes waiting to be read
+ ;; to be sent to the process immediately. Thus, if there are any
+ ;; bytes waiting, we need to send EOF twice: once to flush the
+ ;; buffer, and a second time to cause the next read() to return a
+ ;; size of 0, indicating end-of-file to the reading process.
+ ;; However, some platforms (e.g. Solaris) actually require sending
+ ;; a *third* EOF. Since sending extra EOFs while the process is
+ ;; running are a no-op, we'll just send the maximum we'd ever
+ ;; need. See bug#56025 for further details.
+ (let ((i 0)
+ ;; Only call `process-send-eof' once if communicating via a
+ ;; pipe (in truth, this just closes the pipe).
+ (max-attempts (if (process-tty-name target 'stdin) 3 1)))
+ (while (and (<= (cl-incf i) max-attempts)
(eq (process-status target) 'run))
(process-send-eof target))))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 70426ccaf2..99b43661f2 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -250,30 +250,6 @@ The prompt will be set to PROMPT."
"A marker that tracks the beginning of output of the last subprocess.
Used only on systems which do not support async subprocesses.")
-(defvar eshell-needs-pipe
- '("bc"
- ;; xclip.el (in GNU ELPA) calls all of these with
- ;; `process-connection-type' set to nil.
- "pbpaste" "putclip" "xclip" "xsel" "wl-copy")
- "List of commands which need `process-connection-type' to be nil.
-Currently only affects commands in pipelines, and not those at
-the front. If an element contains a directory part it must match
-the full name of a command, otherwise just the nondirectory part must match.")
-
-(defun eshell-needs-pipe-p (command)
- "Return non-nil if COMMAND needs `process-connection-type' to be nil.
-See `eshell-needs-pipe'."
- (and (bound-and-true-p eshell-in-pipeline-p)
- (not (eq eshell-in-pipeline-p 'first))
- ;; FIXME should this return non-nil for anything that is
- ;; neither 'first nor 'last? See bug#1388 discussion.
- (catch 'found
- (dolist (exe eshell-needs-pipe)
- (if (string-equal exe (if (string-search "/" exe)
- command
- (file-name-nondirectory command)))
- (throw 'found t))))))
-
(defun eshell-gather-process-output (command args)
"Gather the output from COMMAND + ARGS."
(require 'esh-var)
@@ -290,31 +266,36 @@ See `eshell-needs-pipe'."
(cond
((fboundp 'make-process)
(setq proc
- (let ((process-connection-type
- (unless (eshell-needs-pipe-p command)
- process-connection-type))
- (command (file-local-name (expand-file-name command))))
- (apply #'start-file-process
- (file-name-nondirectory command) nil command args)))
+ (let ((command (file-local-name (expand-file-name command)))
+ (conn-type (pcase (bound-and-true-p eshell-in-pipeline-p)
+ ('first '(nil . pipe))
+ ('last '(pipe . nil))
+ ('t 'pipe)
+ ('nil nil))))
+ (make-process
+ :name (file-name-nondirectory command)
+ :buffer (current-buffer)
+ :command (cons command args)
+ :filter (if (eshell-interactive-output-p)
+ #'eshell-output-filter
+ #'eshell-insertion-filter)
+ :sentinel #'eshell-sentinel
+ :connection-type conn-type
+ :file-handler t)))
(eshell-record-process-object proc)
- (set-process-buffer proc (current-buffer))
- (set-process-filter proc (if (eshell-interactive-output-p)
- #'eshell-output-filter
- #'eshell-insertion-filter))
- (set-process-sentinel proc #'eshell-sentinel)
(run-hook-with-args 'eshell-exec-hook proc)
(when (fboundp 'process-coding-system)
(let ((coding-systems (process-coding-system proc)))
(setq decoding (car coding-systems)
encoding (cdr coding-systems)))
- ;; If start-process decided to use some coding system for
+ ;; If `make-process' decided to use some coding system for
;; decoding data sent from the process and the coding system
;; doesn't specify EOL conversion, we had better convert CRLF
;; to LF.
(if (vectorp (coding-system-eol-type decoding))
(setq decoding (coding-system-change-eol-conversion decoding 'dos)
changed t))
- ;; Even if start-process left the coding system for encoding
+ ;; Even if `make-process' left the coding system for encoding
;; data sent from the process undecided, we had better use the
;; same one as what we use for decoding. But, we should
;; suppress EOL conversion.
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 5144e30512..9258ca5e40 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -539,7 +539,7 @@ list."
(autoload 'parse-time-string "parse-time")
(eval-when-compile
- (require 'ange-ftp nil t)) ; ange-ftp-parse-filename
+ (require 'ange-ftp)) ; ange-ftp-parse-filename
(defvar tramp-file-name-structure)
(declare-function ange-ftp-ls "ange-ftp"
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index 9e5a08e682..ad98c45336 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -182,11 +182,6 @@ Optional argument STRING is a string upon which to add
text properties."
(when ezimage-use-images
(let* ((bt (buffer-substring start (+ length start)))
(a (assoc bt ezimage-expand-image-button-alist)))
- ;; Regular images (created with `insert-image' are intangible
- ;; which (I suppose) make them more compatible with XEmacs 21.
- ;; Unfortunately, there is a giant pile of code dependent on the
- ;; underlying text. This means if we leave it tangible, then I
- ;; don't have to change said giant piles of code.
(if (and a (symbol-value (cdr a)))
(ezimage-insert-over-text (symbol-value (cdr a))
start
diff --git a/lisp/faces.el b/lisp/faces.el
index 0418cd4c05..390ddbf606 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -657,8 +657,8 @@ If FACE is a face-alias, get the documentation for the
target face."
(put face 'face-documentation (purecopy string)))
-(defalias 'face-doc-string 'face-documentation)
-(defalias 'set-face-doc-string 'set-face-documentation)
+(define-obsolete-function-alias 'face-doc-string #'face-documentation "29.1")
+(define-obsolete-function-alias 'set-face-doc-string #'set-face-documentation
"29.1")
@@ -2037,7 +2037,7 @@ as backgrounds."
(setq color (background-color-at-point))))
(when (and convert-to-RGB
(not (string-equal color "")))
- (let ((components (x-color-values color)))
+ (let ((components (color-values color)))
(unless (string-match-p
"^#\\(?:[[:xdigit:]][[:xdigit:]][[:xdigit:]]\\)+$" color)
(setq color (format "#%04X%04X%04X"
(logand 65535 (nth 0 components))
@@ -2046,18 +2046,29 @@ as backgrounds."
(when msg (message "Color: `%s'" color))
color))
-(defun face-at-point (&optional thing multiple)
- "Return the face of the character after point.
-If it has more than one face, return the first one.
-If THING is non-nil try first to get a face name from the buffer.
-IF MULTIPLE is non-nil, return a list of all faces.
-Return nil if there is no face."
+(defun face-at-point (&optional text multiple)
+ "Return a face name from point in the current buffer.
+This function is meant to be used as a conveniency function for
+providing defaults when prompting the user for a face name.
+
+If TEXT is non-nil, return the text at point if it names an
+existing face.
+
+Otherwise, look at the faces in effect at point as text
+properties or overlay properties, and return one of these face
+names.
+
+IF MULTIPLE is non-nil, return a list of faces.
+
+Return nil if there is no face at point.
+
+This function is not meant for handling faces programatically; to
+do that, use `get-text-property' and `get-char-property'."
(let (faces)
- (if thing
- ;; Try to get a face name from the buffer.
- (let ((face (intern-soft (thing-at-point 'symbol))))
- (if (facep face)
- (push face faces))))
+ (when text
+ ;; Try to get a face name from the buffer.
+ (when-let ((face (thing-at-point 'face)))
+ (push face faces)))
;; Add the named faces that the `read-face-name' or `face' property uses.
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face))))
diff --git a/lisp/files.el b/lisp/files.el
index 65f9039b33..05a924a363 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2950,7 +2950,7 @@
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
("\\.js[mx]?\\'" . javascript-mode)
;; https://en.wikipedia.org/wiki/.har
("\\.har\\'" . javascript-mode)
- ("\\.json\\'" . javascript-mode)
+ ("\\.json\\'" . js-json-mode)
("\\.[ds]?va?h?\\'" . verilog-mode)
("\\.by\\'" . bovine-grammar-mode)
("\\.wy\\'" . wisent-grammar-mode)
@@ -3848,10 +3848,8 @@ DIR-NAME is the name of the associated directory.
Otherwise it is nil."
(cond ((memq var ignored-local-variables)
;; Ignore any variable in `ignored-local-variables'.
nil)
- ((seq-some (lambda (elem)
- (and (eq (car elem) var)
- (eq (cdr elem) val)))
- ignored-local-variable-values)
+ ;; Ignore variables with the specified values.
+ ((member elt ignored-local-variable-values)
nil)
;; Obey `enable-local-eval'.
((eq var 'eval)
@@ -4446,7 +4444,8 @@ This function returns either:
;; The entry MTIME should match the most recent
;; MTIME among matching files.
(and cached-files
- (equal (nth 2 dir-elt)
+ (time-equal-p
+ (nth 2 dir-elt)
(let ((latest 0))
(dolist (f cached-files latest)
(let ((f-time
diff --git a/lisp/filesets.el b/lisp/filesets.el
index a8d837e7e1..4831bf167d 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -146,29 +146,16 @@ is loaded before user customizations. Thus, if (require
\\='filesets)
precedes the `custom-set-variables' command or, for XEmacs, if init.el
is loaded before custom.el, set this variable to t.")
-
-;;; utils
(defun filesets-filter-list (lst cond-fn)
"Remove all elements not conforming to COND-FN from list LST.
COND-FN takes one argument: the current element."
-; (cl-remove 'dummy lst :test (lambda (dummy elt)
-; (not (funcall cond-fn elt)))))
- (let ((rv nil))
- (dolist (elt lst)
- (when (funcall cond-fn elt)
- (push elt rv)))
- (nreverse rv)))
+ (declare (obsolete seq-filter "29.1"))
+ (seq-filter cond-fn lst))
(defun filesets-ormap (fsom-pred lst)
"Return the tail of LST for the head of which FSOM-PRED is non-nil."
- (let ((fsom-lst lst)
- (fsom-rv nil))
- (while (and fsom-lst
- (null fsom-rv))
- (if (funcall fsom-pred (car fsom-lst))
- (setq fsom-rv fsom-lst)
- (setq fsom-lst (cdr fsom-lst))))
- fsom-rv))
+ (declare (obsolete seq-drop-while "29.1"))
+ (seq-drop-while (lambda (x) (not (funcall fsom-pred x))) lst))
(define-obsolete-function-alias 'filesets-some #'cl-some "28.1")
(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
@@ -257,13 +244,13 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set
with
(setq filesets-menu-use-cached-flag nil)
(when (default-boundp 'filesets-data)
(let ((modified-filesets
- (filesets-filter-list val
- (lambda (x)
- (let ((name (car x))
- (data (cdr x)))
- (let ((elt (assoc name filesets-data)))
- (or (not elt)
- (not (equal data (cdr elt))))))))))
+ (seq-filter (lambda (x)
+ (let ((name (car x))
+ (data (cdr x)))
+ (let ((elt (assoc name filesets-data)))
+ (or (not elt)
+ (not (equal data (cdr elt)))))))
+ val)))
(dolist (x modified-filesets)
(filesets-reset-fileset (car x))))))
(filesets-set-default sym val))
@@ -1033,12 +1020,12 @@ defined in `filesets-ingroup-patterns'."
(defun filesets-filter-dir-names (lst &optional negative)
"Remove non-directory names from a list of strings.
If NEGATIVE is non-nil, remove all directory names."
- (filesets-filter-list lst
- (lambda (x)
- (and (not (string-match-p "^\\.+/$" x))
- (if negative
- (not (string-match-p "[:/\\]$" x))
- (string-match-p "[:/\\]$" x))))))
+ (seq-filter (lambda (x)
+ (and (not (string-match-p "^\\.+/$" x))
+ (if negative
+ (not (string-match-p "[:/\\]$" x))
+ (string-match-p "[:/\\]$" x))))
+ lst))
(defun filesets-conditional-sort (lst &optional access-fn)
"Return a sorted copy of LST, LST being a list of strings.
@@ -1683,9 +1670,9 @@ Assume MODE (see `filesets-entry-mode'), if provided."
(filesets-directory-files dir patt ':files t))
;; (message "Filesets: malformed entry: %s" entry)))))))
(error "Filesets: malformed entry: %s" entry)))))))
- (filesets-filter-list fl
- (lambda (file)
- (not (filesets-filetype-property file event))))))
+ (seq-filter (lambda (file)
+ (not (filesets-filetype-property file event)))
+ fl)))
(defun filesets-files-under (level depth entry dir patt &optional relativep)
"Files under DIR that match PATT.
@@ -2499,8 +2486,4 @@ Set up hooks, load the cache file -- if existing -- and
build the menu."
(provide 'filesets)
-;; Local Variables:
-;; sentence-end-double-space:t
-;; End:
-
;;; filesets.el ends here
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index 63f2148e47..be3d106912 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -1,7 +1,6 @@
;;; find-dired.el --- run a `find' command and dired the output -*-
lexical-binding: t -*-
-;; Copyright (C) 1992, 1994-1995, 2000-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>,
;; Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -242,6 +241,11 @@ it finishes, type \\[kill-find]."
(setq default-directory dir)
;; Start the find process.
(shell-command (concat command "&") (current-buffer))
+ (let ((proc (get-buffer-process (current-buffer))))
+ ;; Initialize the process marker; it is used by the filter.
+ (move-marker (process-mark proc) (point) (current-buffer))
+ (set-process-filter proc #'find-dired-filter)
+ (set-process-sentinel proc #'find-dired-sentinel))
(dired-mode dir (cdr find-ls-option))
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
@@ -273,11 +277,6 @@ it finishes, type \\[kill-find]."
(insert " " command "\n")
(dired-insert-set-properties point (point)))
(setq buffer-read-only t)
- (let ((proc (get-buffer-process (current-buffer))))
- (set-process-filter proc #'find-dired-filter)
- (set-process-sentinel proc #'find-dired-sentinel)
- ;; Initialize the process marker; it is used by the filter.
- (move-marker (process-mark proc) (point) (current-buffer)))
(setq mode-line-process '(":%s"))))
(defun find-dired--escaped-ls-option ()
@@ -320,7 +319,7 @@ See `find-name-arg' to customize the arguments."
;; Date: 10 May 91 17:50:00 GMT
;; Organization: University of Waterloo
-(defalias 'lookfor-dired 'find-grep-dired)
+(define-obsolete-function-alias 'lookfor-dired #'find-grep-dired "29.1")
;;;###autoload
(defun find-grep-dired (dir regexp)
"Find files in DIR that contain matches for REGEXP and start Dired on output.
@@ -419,10 +418,10 @@ specifies what to use in place of \"-ls\" as the final
argument."
"Sort entries in *Find* buffer by file name lexicographically."
(sort-subr nil 'forward-line 'end-of-line
(lambda ()
- (buffer-substring-no-properties
- (next-single-property-change
- (point) 'dired-filename)
- (line-end-position)))))
+ (when-let ((start
+ (next-single-property-change
+ (point) 'dired-filename)))
+ (buffer-substring-no-properties start (line-end-position))))))
(provide 'find-dired)
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index 0a712c0b81..e825d9cba0 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -281,7 +281,7 @@ It is a function which takes two arguments, the directory
and its parent."
(set-buffer buffer)
(insert find-lisp-line-indent
(find-lisp-format file (file-attributes file 'string) (list "")
- (current-time))))
+ nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lifted from ls-lisp. We don't want to require it, because that
diff --git a/lisp/finder.el b/lisp/finder.el
index 73072c0cd4..08d20963b4 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -77,6 +77,7 @@ Each element has the form (KEYWORD . DESCRIPTION).")
(defvar-keymap finder-mode-map
:doc "Keymap used in `finder-mode'."
+ :parent special-mode-map
"SPC" #'finder-select
"f" #'finder-select
"<follow-link>" 'mouse-face
@@ -420,15 +421,14 @@ FILE should be in a form suitable for passing to
`locate-library'."
(interactive)
(finder-list-keywords))
-(define-derived-mode finder-mode nil "Finder"
+(define-derived-mode finder-mode special-mode "Finder"
"Major mode for browsing package documentation.
\\<finder-mode-map>
\\[finder-select] more help for the item on the current line
-\\[finder-exit] exit Finder mode and kill the Finder buffer."
- :syntax-table finder-mode-syntax-table
+\\[finder-exit] exit Finder mode and kill the Finder buffer.
+
+\\{finder-mode-map}"
:interactive nil
- (setq buffer-read-only t
- buffer-undo-list t)
(setq-local finder-headmark nil))
(defun finder-summary ()
@@ -436,9 +436,9 @@ FILE should be in a form suitable for passing to
`locate-library'."
(interactive nil finder-mode)
(message "%s"
(substitute-command-keys
- "\\<finder-mode-map>\\[finder-select] = select, \
-\\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
-finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
+ "\\<finder-mode-map>\\[finder-select] select, \
+\\[finder-mouse-select] select, \\[finder-list-keywords] go to \
+finder directory, \\[finder-exit] quit, \\[finder-summary] help")))
(defun finder-exit ()
"Exit Finder mode.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 18baf982b2..480ebe377d 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -268,7 +268,7 @@ This can also be a list of the above values."
(defcustom gnus-hidden-properties
;; We use to have `intangible' here as well, but Emacs's command loop moves
;; point out of invisible text anyway, so `intangible' is clearly not
- ;; needed there. And XEmacs doesn't handle `intangible' anyway.
+ ;; needed there.
'(invisible t)
"Property list to use for hiding text."
:type 'plist
@@ -8470,8 +8470,6 @@ url is put as the `gnus-button-url' overlay property on
the button."
(when comma
(dotimes (_ (with-temp-buffer
(insert comma)
- ;; Note: the XEmacs version of `how-many' takes
- ;; no optional argument.
(goto-char (point-min))
(how-many ",")))
(Info-index-next 1)))
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index d9da8529eb..f6cfd727f7 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -222,7 +222,7 @@ minutes, the connection is closed."
(defun gnus-demon-nntp-close-connection ()
(save-window-excursion
- (when (time-less-p '(0 300) (time-since nntp-last-command-time))
+ (when (time-less-p 300 (time-since nntp-last-command-time))
(nntp-close-server))))
(defun gnus-demon-add-scanmail ()
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index a520bfcd8b..54be0f8e6a 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -699,7 +699,6 @@ claim them."
"n" #'gnus-browse-next-group
"p" #'gnus-browse-prev-group
"DEL" #'gnus-browse-prev-group
- "<delete>" #'gnus-browse-prev-group
"N" #'gnus-browse-next-group
"P" #'gnus-browse-prev-group
"M-n" #'gnus-browse-next-group
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index bf2a083fec..90b57695c5 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1958,8 +1958,6 @@ increase the score of each group you read."
"C-M-b" #'gnus-summary-prev-thread
"M-<down>" #'gnus-summary-next-thread
"M-<up>" #'gnus-summary-prev-thread
- "C-M-u" #'gnus-summary-up-thread
- "C-M-d" #'gnus-summary-down-thread
"&" #'gnus-summary-execute-command
"c" #'gnus-summary-catchup-and-exit
"C-w" #'gnus-summary-mark-region-as-read
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index dda2b4ff5f..d1ad5bd7b2 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -383,7 +383,7 @@ Cache the result as a text property stored in DATE."
;; Either return the cached value...
`(let ((d ,date))
(if (equal "" d)
- '(0 0)
+ 0
(or (get-text-property 0 'gnus-time d)
;; or compute the value...
(let ((time (safe-date-to-time d)))
@@ -750,15 +750,6 @@ nil. See also `gnus-bind-print-variables'."
(when (file-exists-p file)
(delete-file file)))
-(defun gnus-delete-duplicates (list)
- "Remove duplicate entries from LIST."
- (let ((result nil))
- (while list
- (unless (member (car list) result)
- (push (car list) result))
- (pop list))
- (nreverse result)))
-
(defun gnus-delete-directory (directory)
"Delete files in DIRECTORY. Subdirectories remain.
If there's no subdirectory, delete DIRECTORY as well."
@@ -1134,14 +1125,11 @@ sure of changing the value of `foo'."
If you find some problem with the directory separator character, try
\"[/\\\\]\" for some systems.")
-(defun gnus-url-unhex (x)
- (if (> x ?9)
- (if (>= x ?a)
- (+ 10 (- x ?a))
- (+ 10 (- x ?A)))
- (- x ?0)))
+(autoload 'url-unhex "url-util")
+(define-obsolete-function-alias 'gnus-url-unhex #'url-unhex "29.1")
-;; Fixme: Do it like QP.
+;; FIXME: Make obsolete in favor of `url-unhex-string', which is
+;; identical except for the call to `char-to-string'.
(defun gnus-url-unhex-string (str &optional allow-newlines)
"Remove %XX, embedded spaces, etc in a url.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
@@ -1151,9 +1139,9 @@ forbidden in URL encoding."
(case-fold-search t))
(while (string-match "%[0-9a-f][0-9a-f]" str)
(let* ((start (match-beginning 0))
- (ch1 (gnus-url-unhex (elt str (+ start 1))))
+ (ch1 (url-unhex (elt str (+ start 1))))
(code (+ (* 16 ch1)
- (gnus-url-unhex (elt str (+ start 2))))))
+ (url-unhex (elt str (+ start 2))))))
(setq tmp (concat
tmp (substring str 0 start)
(cond
@@ -1254,7 +1242,7 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
contents value)
(if (or (null (setq value (symbol-value variable)))
(not (equal (car value) file))
- (not (equal (nth 1 value) time)))
+ (not (time-equal-p (nth 1 value) time)))
(progn
(setq contents (funcall function file))
(set variable (list file time contents))
@@ -1388,8 +1376,7 @@ sequence, this is like `mapcar'. With several, it is
like the Common Lisp
system-configuration)
((memq 'type lst)
(symbol-name system-type))
- (t nil)))
- ) ;; codename
+ (t nil))))
(cond
((not (memq 'emacs lst))
nil)
@@ -1554,6 +1541,8 @@ lists of strings."
;; gnus-util.
(autoload 'gnus-output-to-rmail "gnus-rmail")
+(define-obsolete-function-alias 'gnus-delete-duplicates #'seq-uniq "29.1")
+
(provide 'gnus-util)
;;; gnus-util.el ends here
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 8221f3017a..b036978efa 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2236,12 +2236,10 @@ Disabling the agent may result in noticeable loss of
performance."
"Which information should be exposed in the User-Agent header.
Can be a list of symbols or a string. Valid symbols are `gnus'
-\(show Gnus version) and `emacs' \(show Emacs version). In
-addition to the Emacs version, you can add `codename' \(show
-\(S)XEmacs codename) or either `config' \(show system
-configuration) or `type' \(show system type). If you set it to
-a string, be sure to use a valid format, see RFC 2616."
-
+(show Gnus version) and `emacs' (show Emacs version). In
+addition to the Emacs version, you can add `config' (show system
+configuration) or `type' (show system type). If you set it to a
+string, be sure to use a valid format, see RFC 2616."
:version "22.1"
:group 'gnus-message
:type '(choice (list (set :inline t
@@ -2249,8 +2247,7 @@ a string, be sure to use a valid format, see RFC 2616."
(const :value emacs :tag "Emacs version")
(choice :tag "system"
(const :value type :tag "system type")
- (const :value config :tag "system
configuration"))
- (const :value codename :tag "Emacs codename")))
+ (const :value config :tag "system
configuration"))))
(string)))
;; Convert old (< 2005-01-10) symbol type values:
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 727e3abfff..48cca45cb9 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -673,7 +673,6 @@ If INHIBIT is non-nil, inhibit
`mm-inhibit-file-name-handlers'."
inhibit-file-name-handlers)))
(write-region start end filename append visit lockname)))
-(defalias 'mm-make-temp-file 'make-temp-file)
(define-obsolete-function-alias 'mm-make-temp-file 'make-temp-file "26.1")
(defvar mm-image-load-path-cache nil)
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 829d912cb2..0c565a8230 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -245,7 +245,8 @@ included.")
(while map
(if (and (member (cadr (car map)) files)
;; We also remove files that have changed mod times.
- (equal (file-attribute-modification-time (file-attributes
+ (time-equal-p
+ (file-attribute-modification-time (file-attributes
(nneething-file-name (cadr (car map)))))
(cadr (cdar map))))
(progn
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 5dc8e5c30d..c3f7073a7b 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -860,7 +860,8 @@ deleted. Point is left where the deleted region was."
(nnheader-find-file-noselect file t)))))
(mm-enable-multibyte) ;; Use multibyte buffer for future copying.
(buffer-disable-undo)
- (if (equal (cadr (assoc group nnfolder-scantime-alist))
+ (if (time-equal-p
+ (cadr (assoc group nnfolder-scantime-alist))
(file-attribute-modification-time (file-attributes file)))
;; This looks up-to-date, so we don't do any scanning.
(if (file-exists-p file)
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index ab57bd7eed..634cc251b8 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -920,9 +920,9 @@ first. Otherwise, find the newest one, though it may take
a time."
(defvar ange-ftp-path-format)
(defun nnheader-re-read-dir (path)
"Re-read directory PATH if PATH is on a remote system."
- (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
+ (when (and (fboundp 'ange-ftp-reread-dir) (boundp 'ange-ftp-path-format))
(when (string-match (car ange-ftp-path-format) path)
- (ange-ftp-re-read-dir path))))
+ (ange-ftp-reread-dir path))))
(defun nnheader-insert-file-contents (filename &optional visit beg end replace)
"Like `insert-file-contents', q.v., but only reads in the file.
@@ -1055,7 +1055,7 @@ See `find-file-noselect' for the arguments."
(or ,end (point-max)))
'(buffer-string)))))
-(defvar nnheader-last-message-time '(0 0))
+(defvar nnheader-last-message-time 0)
(defun nnheader-message-maybe (&rest args)
(let ((now (current-time)))
(when (time-less-p 1 (time-subtract now nnheader-last-message-time))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 746109f26f..73cd183a02 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -34,7 +34,6 @@
(require 'gnus-util)
(require 'gnus)
(require 'nnoo)
-(require 'netrc)
(require 'utf7)
(require 'nnmail)
@@ -556,7 +555,7 @@ during splitting, which may be slow."
;; Look for the credentials based on
;; the virtual server name and the address
(nnimap-credentials
- (gnus-delete-duplicates
+ (seq-uniq
(list server nnimap-address))
ports
nnimap-user))))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 30f473b129..3dc74c95fb 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -99,7 +99,7 @@ SUFFIX should start with \":2,\"."
(let* ((flags (substring suffix 3))
(flags-as-list (append flags nil))
(new-flags
- (concat (gnus-delete-duplicates
+ (concat (seq-uniq
;; maildir flags must be sorted
(sort (cons flag flags-as-list) #'<)))))
(concat ":2," new-flags)))
@@ -463,7 +463,7 @@ This variable is set by `nnmaildir-request-article'.")
;; usable: if the message has been edited or if nnmail-extra-headers
;; has been augmented since this data was parsed from the message,
;; then we have to reparse. Otherwise it's up-to-date.
- (when (and nov (equal mtime (nnmaildir--nov-get-mtime nov)))
+ (when (and nov (time-equal-p mtime (nnmaildir--nov-get-mtime nov)))
;; The timestamp matches. Now check nnmail-extra-headers.
(setq old-extra (nnmaildir--nov-get-extra nov))
(when (equal nnmaildir--extra old-extra) ;; common case
@@ -799,7 +799,7 @@ This variable is set by `nnmaildir-request-article'.")
isnew
(throw 'return t))
(setq nattr (file-attribute-modification-time nattr))
- (if (equal nattr (nnmaildir--grp-new group))
+ (if (time-equal-p nattr (nnmaildir--grp-new group))
(setq nattr nil))
(if read-only (setq dir (and (or isnew nattr) ndir))
(when (or isnew nattr)
@@ -811,7 +811,7 @@ This variable is set by `nnmaildir-request-article'.")
(rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
(setf (nnmaildir--grp-new group) nattr))
(setq cattr (file-attribute-modification-time (file-attributes cdir)))
- (if (equal cattr (nnmaildir--grp-cur group))
+ (if (time-equal-p cattr (nnmaildir--grp-cur group))
(setq cattr nil))
(setq dir (and (or isnew cattr) cdir)))
(unless dir (throw 'return t))
@@ -899,7 +899,7 @@ This variable is set by `nnmaildir-request-article'.")
(remhash scan-group groups))
(setq x (file-attribute-modification-time (file-attributes srv-dir))
scan-group (null scan-group))
- (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server))
+ (if (time-equal-p x (nnmaildir--srv-mtime nnmaildir--cur-server))
(when scan-group
(maphash (lambda (group-name _group)
(nnmaildir--scan group-name t groups
@@ -1015,7 +1015,7 @@ This variable is set by `nnmaildir-request-article'.")
dir (nnmaildir--nndir dir)
dir (nnmaildir--marks-dir dir)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
- all-marks (gnus-delete-duplicates
+ all-marks (seq-uniq
;; get mark names from mark dirs and from flag
;; mappings
(append
@@ -1049,7 +1049,7 @@ This variable is set by `nnmaildir-request-article'.")
(t
markdir-mtime))))
(puthash mark mtime new-mmth)
- (when (equal mtime (gethash mark old-mmth))
+ (when (time-equal-p mtime (gethash mark old-mmth))
(setq ranges (assq mark old-marks))
(if ranges (setq ranges (cdr ranges)))
(throw 'got-ranges nil))
@@ -1697,7 +1697,7 @@ This variable is set by `nnmaildir-request-article'.")
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
- all-marks (gnus-delete-duplicates
+ all-marks (seq-uniq
;; get mark names from mark dirs and from flag
;; mappings
(append
@@ -1785,9 +1785,4 @@ This variable is set by `nnmaildir-request-article'.")
(provide 'nnmaildir)
-;; Local Variables:
-;; indent-tabs-mode: t
-;; fill-column: 77
-;; End:
-
;;; nnmaildir.el ends here
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 5d016267bc..3902af7d2f 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -539,7 +539,7 @@ as unread by Gnus.")
(let ((arts articles)
art)
(while (setq art (pop arts))
- (when (not (equal
+ (when (not (time-equal-p
(file-attribute-modification-time
(file-attributes (concat dir (int-to-string (car art)))))
(cdr art)))
@@ -547,14 +547,17 @@ as unread by Gnus.")
(push (car art) new))))
;; Go through all the new articles and add them, and their
;; time-stamps, to the list.
+ ;; Use list format for timestamps, so Emacs <27 can read .nnmh-articles.
(setq articles
(nconc articles
(mapcar
(lambda (art)
(cons art
- (file-attribute-modification-time
- (file-attributes
- (concat dir (int-to-string art))))))
+ (when-let ((modtime
+ (file-attribute-modification-time
+ (file-attributes
+ (concat dir (int-to-string art))))))
+ (time-convert modtime 'list))))
new)))
;; Make Gnus mark all new articles as unread.
(when new
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index f740af3b6d..8c96d3e067 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -325,7 +325,7 @@ for decoding when the cdr that the data specify is not
available.")
(nnmail-expired-article-p
group
(if (listp (setq days (nth 1 e))) days
- (days-to-time (- days (time-to-days '(0 0)))))
+ (days-to-time (- days (time-to-days 0))))
force))
(setq nnrss-group-data (delq e nnrss-group-data)
changed t)
@@ -453,8 +453,8 @@ which RSS 2.0 allows."
(let (case-fold-search vector year month day time zone given)
(cond ((null date)) ; do nothing for this case
;; if the date is just digits (unix time stamp):
- ((string-match "^[0-9]+$" date)
- (setq given (time-convert (string-to-number date))))
+ ((string-match "\\`[0-9]+\\'" date)
+ (setq given (time-convert (string-to-number date) t)))
;; RFC 822
((string-match " [0-9]+ " date)
(setq vector (timezone-parse-date date)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 9902a280d5..29570fa8c9 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -217,25 +217,6 @@ then use this hook to rsh to the remote machine and start
a proxy NNTP
server there that you can connect to. See also
`nntp-open-connection-function'")
-(defcustom nntp-authinfo-file "~/.authinfo"
- ".netrc-like file that holds nntp authinfo passwords."
- :type
- '(choice file
- (repeat :tag "Entries"
- :menu-tag "Inline"
- (list :format "%v"
- :value ("" ("login" . "") ("password" . ""))
- (string :tag "Host")
- (checklist :inline t
- (cons :format "%v"
- (const :format "" "login")
- (string :format "Login: %v"))
- (cons :format "%v"
- (const :format "" "password")
- (string :format "Password: %v")))))))
-
-(make-obsolete-variable 'nntp-authinfo-file 'netrc-file "24.1")
-
(defvoo nntp-connection-timeout nil
@@ -1152,11 +1133,6 @@ It will make innd servers spawn an nnrpd process to
allow actual article
reading."
(nntp-send-command "^.*\n" "MODE READER"))
-(declare-function netrc-parse "netrc" (&optional file))
-(declare-function netrc-machine "netrc"
- (list machine &optional port defaultport))
-(declare-function netrc-get "netrc" (alist type))
-
(defun nntp-send-authinfo (&optional send-if-force)
"Send the AUTHINFO to the nntp server.
It will look in the \"~/.authinfo\" file for matching entries. If
@@ -1165,30 +1141,16 @@ and a password.
If SEND-IF-FORCE, only send authinfo to the server if the
.authinfo file has the FORCE token."
- (require 'netrc)
- (let* ((list (netrc-parse nntp-authinfo-file))
- (alist (netrc-machine list nntp-address "nntp"))
- (auth-info
+ (let* ((auth-info
(nth 0 (auth-source-search
:max 1
:host (list nntp-address (nnoo-current-server 'nntp))
:port `("119" "nntp" ,(format "%s" nntp-port-number)
"563" "nntps" "snews"))))
(auth-user (plist-get auth-info :user))
- (auth-force (plist-get auth-info :force))
- (auth-passwd (auth-info-password auth-info))
- (force (or (netrc-get alist "force")
- nntp-authinfo-force
- auth-force))
- (user (or
- ;; this is preferred to netrc-*
- auth-user
- (netrc-get alist "login")
- nntp-authinfo-user))
- (passwd (or
- ;; this is preferred to netrc-*
- auth-passwd
- (netrc-get alist "password"))))
+ (passwd (auth-info-password auth-info))
+ (force (or nntp-authinfo-force (plist-get auth-info :force)))
+ (user (or auth-user nntp-authinfo-user)))
(when (or (not send-if-force)
force)
(unless user
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 084eb3d774..5763ac14bb 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -422,7 +422,8 @@ spam-stat (spam-stat-to-hash-table '(" spam-stat-ngood
spam-stat-nbad))
(cond (spam-stat-dirty (message "Spam stat not loaded: spam-stat-dirty t"))
((or (not (boundp 'spam-stat-last-saved-at))
(null spam-stat-last-saved-at)
- (not (equal spam-stat-last-saved-at
+ (not (time-equal-p
+ spam-stat-last-saved-at
(file-attribute-modification-time
(file-attributes spam-stat-file)))))
(progn
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 5af29c0a24..2883a6186b 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -43,14 +43,12 @@
(require 'gnus-uu) ; because of key prefix issues
;;; for the definitions of group content classification and spam processors
(require 'gnus)
+(require 'dig)
(eval-when-compile
(require 'cl-lib)
(require 'hashcash))
-;; autoload query-dig
-(autoload 'query-dig "dig")
-
;; autoload spam-report
(autoload 'spam-report-gmane "spam-report")
(autoload 'spam-report-gmane-spam "spam-report")
@@ -2008,7 +2006,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
(unless matches
(let ((query-string (concat ip "." server)))
(if spam-use-dig
- (let ((query-result (query-dig query-string)))
+ (let ((query-result (dig-query query-string)))
(when query-result
(gnus-message 6 "(DIG): positive blackhole check `%s'"
query-result)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 768023b54c..59a509b221 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -799,7 +799,7 @@ the C sources, too."
;; different purposes, such as function name, var name, face name,
;; property name, ...).
(concat
- ;; The main "canonical" occurence of symbols is within '...'.
+ ;; The main "canonical" occurrence of symbols is within '...'.
"'" quoted "'"
;; Commands can also occur as `M-x blabla'.
"\\|M-x[ \t\n]+" quoted "\\_>"
diff --git a/lisp/help.el b/lisp/help.el
index 1c1ce1618c..37aab15df0 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1182,6 +1182,7 @@ Otherwise, return a new string."
(let ((k (buffer-substring-no-properties (+ orig-point 2)
end-point)))
(when (or (key-valid-p k)
+ (string-match-p "\\`mouse-[1-9]" k)
(string-match-p "\\`M-x " k))
(goto-char orig-point)
(delete-char 2)
@@ -1322,18 +1323,17 @@ If BUFFER, lookup keys while in that buffer. This only
affects
things like :filters for menu bindings."
(let* ((amaps (accessible-keymaps startmap prefix))
(orig-maps (if no-menu
- (progn
- ;; Delete from MAPS each element that is for
- ;; the menu bar.
- (let* ((tail amaps)
- result)
- (while tail
- (let ((elem (car tail)))
- (when (not (and (>= (length (car elem)) 1)
- (eq (elt (car elem) 0)
'menu-bar)))
- (setq result (append result (list elem)))))
- (setq tail (cdr tail)))
- result))
+ ;; Delete from MAPS each element that is for
+ ;; the menu bar.
+ (let* ((tail amaps)
+ result)
+ (while tail
+ (let ((elem (car tail)))
+ (when (not (and (>= (length (car elem)) 1)
+ (eq (elt (car elem) 0)
'menu-bar)))
+ (setq result (append result (list elem)))))
+ (setq tail (cdr tail)))
+ result)
amaps))
(maps orig-maps)
(print-title (or maps always-title))
@@ -1447,8 +1447,7 @@ prefix keys PREFIX (a string or vector).
TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW and BUFFER are as
in `describe-map-tree'."
;; Converted from describe_map in keymap.c.
- (let* ((suppress (and partial 'suppress-keymap))
- (map (keymap-canonicalize map))
+ (let* ((map (keymap-canonicalize map))
(tail map)
(first t)
done vect)
@@ -1479,7 +1478,7 @@ in `describe-map-tree'."
;; commands.
(setq definition (keymap--get-keyelt (cdr (car tail)) nil))
(or (not (symbolp definition))
- (null (get definition suppress)))
+ (not (get definition (when partial 'suppress-keymap))))
;; Don't show a command that isn't really
;; visible because a local definition of the
;; same key shadows it.
@@ -1512,7 +1511,7 @@ in `describe-map-tree'."
(push (cons tail prefix) help--keymaps-seen)))))
(setq tail (cdr tail)))
;; If we found some sparse map events, sort them.
- (let ((vect (sort vect 'help--describe-map-compare))
+ (let ((vect (sort vect #'help--describe-map-compare))
(columns ())
line-start key-end column)
;; Now output them in sorted order.
diff --git a/lisp/hex-util.el b/lisp/hex-util.el
index 0858e46ec5..101c8be7b4 100644
--- a/lisp/hex-util.el
+++ b/lisp/hex-util.el
@@ -41,8 +41,8 @@
(dst (make-string (/ len 2) 0))
(idx 0)(pos 0))
(while (< pos len)
- ;; logior and lsh are not byte-coded.
- ;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
+ ;; logior and ash are not byte-coded.
+ ;; (aset dst idx (logior (ash (hex-char-to-num (aref string pos)) 4)
;; (hex-char-to-num (aref string (1+ pos)))))
(aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16)
(hex-char-to-num (aref string (1+ pos)))))
@@ -56,8 +56,8 @@
(dst (make-string (* len 2) 0))
(idx 0)(pos 0))
(while (< pos len)
- ;; logand and lsh are not byte-coded.
- ;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4)
15)))
+ ;; logand and ash are not byte-coded.
+ ;; (aset dst idx (num-to-hex-char (logand (ash (aref string pos) -4)
15)))
(aset dst idx (num-to-hex-char (/ (aref string pos) 16)))
(setq idx (1+ idx))
;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 822ecbdd99..6b5cccec51 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -48,30 +48,12 @@
;;; Utility functions
(defun ibuffer-remove-alist (key alist)
"Remove all entries in ALIST that have a key equal to KEY."
- (while (ibuffer-awhen (assoc key alist)
- (setq alist (remove it alist)) it))
- alist)
-
-;; borrowed from Gnus
-(defun ibuffer-remove-duplicates (list)
- "Return a copy of LIST with duplicate elements removed."
- (let ((new nil)
- (tail list))
- (while tail
- (or (member (car tail) new)
- (setq new (cons (car tail) new)))
- (setq tail (cdr tail)))
- (nreverse new)))
-
-(defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)
- (let ((hip-crowd nil)
- (lamers nil))
- (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)
- (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)
- (push ibuffer-split-list-elt hip-crowd)
- (push ibuffer-split-list-elt lamers)))
- ;; Too bad Emacs Lisp doesn't have multiple values.
- (list (nreverse hip-crowd) (nreverse lamers))))
+ (assoc-delete-all key (copy-sequence alist)))
+
+(defun ibuffer-split-list (fn elts)
+ (declare (obsolete seq-group-by "29.1"))
+ (let ((res (seq-group-by fn elts)))
+ (list (cdr (assq t res)) (cdr (assq nil res)))))
(defcustom ibuffer-never-show-predicates nil
"A list of predicates (a regexp or function) for buffers not to display.
@@ -769,11 +751,12 @@ specification, with the same structure as an element of
the list
(i 0))
(dolist (filtergroup filter-group-alist)
(let ((filterset (cdr filtergroup)))
- (cl-destructuring-bind (hip-crowd lamers)
- (ibuffer-split-list (lambda (bufmark)
- (ibuffer-included-in-filters-p (car bufmark)
- filterset))
- bmarklist)
+ (let* ((res (seq-group-by (lambda (bufmark)
+ (ibuffer-included-in-filters-p (car
bufmark)
+
filterset))
+ bmarklist))
+ (hip-crowd (cdr (assq t res)))
+ (lamers (cdr (assq nil res))))
(aset vec i hip-crowd)
(cl-incf i)
(setq bmarklist lamers))))
@@ -803,7 +786,7 @@ specification, with the same structure as an element of the
list
(mapcar (lambda (mode)
(cons (format "%s" mode) `((mode . ,mode))))
(let ((modes
- (ibuffer-remove-duplicates
+ (seq-uniq
(mapcar (lambda (buf)
(buffer-local-value 'major-mode buf))
(buffer-list)))))
@@ -880,7 +863,7 @@ specification, with the same structure as an element of the
list
"Move point to the filter group whose name is NAME."
(interactive
(list (ibuffer-read-filter-group-name "Jump to filter group: ")))
- (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
+ (if-let ((it (assoc name (ibuffer-current-filter-groups-with-position))))
(goto-char (cdr it))
(error "No filter group with name %s" name)))
@@ -891,7 +874,7 @@ The group will be added to
`ibuffer-filter-group-kill-ring'."
(interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t)))
(when (equal name "Default")
(error "Can't kill default filter group"))
- (ibuffer-aif (assoc name ibuffer-filter-groups)
+ (if-let ((it (assoc name ibuffer-filter-groups)))
(progn
(push (copy-tree it) ibuffer-filter-group-kill-ring)
(setq ibuffer-filter-groups (ibuffer-remove-alist
@@ -906,13 +889,12 @@ The group will be added to
`ibuffer-filter-group-kill-ring'."
"Kill the filter group at point.
See also `ibuffer-kill-filter-group'."
(interactive "P\np")
- (ibuffer-aif (save-excursion
- (ibuffer-forward-line 0)
- (get-text-property (point) 'ibuffer-filter-group-name))
- (progn
- (ibuffer-kill-filter-group it))
- (funcall (if interactive-p #'call-interactively #'funcall)
- #'kill-line arg)))
+ (if-let ((it (save-excursion
+ (ibuffer-forward-line 0)
+ (get-text-property (point) 'ibuffer-filter-group-name))))
+ (ibuffer-kill-filter-group it)
+ (funcall (if interactive-p #'call-interactively #'funcall)
+ #'kill-line arg)))
(defun ibuffer-insert-filter-group-before (newgroup group)
(let* ((found nil)
@@ -968,7 +950,7 @@ prompt for NAME, and use the current filters."
(list
(read-from-minibuffer "Save current filter groups as: ")
ibuffer-filter-groups)))
- (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
+ (if-let ((it (assoc name ibuffer-saved-filter-groups)))
(setcdr it groups)
(push (cons name groups) ibuffer-saved-filter-groups))
(ibuffer-maybe-save-stuff))
@@ -1140,7 +1122,7 @@ Interactively, prompt for NAME, and use the current
filters."
(list
(read-from-minibuffer "Save current filters as: ")
ibuffer-filtering-qualifiers)))
- (ibuffer-aif (assoc name ibuffer-saved-filters)
+ (if-let ((it (assoc name ibuffer-saved-filters)))
(setcdr it filters)
(push (cons name filters) ibuffer-saved-filters))
(ibuffer-maybe-save-stuff))
@@ -1317,7 +1299,7 @@ For example, for a buffer associated with file
'/a/b/c.d', this
matches against '/a/b/c.d'."
(:description "full file name"
:reader (read-from-minibuffer "Filter by full file name (regexp): "))
- (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
+ (when-let ((it (with-current-buffer buf (ibuffer-buffer-file-name))))
(string-match qualifier it)))
;;;###autoload (autoload 'ibuffer-filter-by-basename "ibuf-ext")
@@ -1329,7 +1311,7 @@ matches against `c.d'."
(:description "file basename"
:reader (read-from-minibuffer
"Filter by file name, without directory part (regex): "))
- (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
+ (when-let ((it (with-current-buffer buf (ibuffer-buffer-file-name))))
(string-match qualifier (file-name-nondirectory it))))
;;;###autoload (autoload 'ibuffer-filter-by-file-extension "ibuf-ext")
@@ -1342,7 +1324,7 @@ pattern. For example, for a buffer associated with file
(:description "filename extension"
:reader (read-from-minibuffer
"Filter by filename extension without separator (regex): "))
- (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
+ (when-let ((it (with-current-buffer buf (ibuffer-buffer-file-name))))
(string-match qualifier (or (file-name-extension it) ""))))
;;;###autoload (autoload 'ibuffer-filter-by-directory "ibuf-ext")
@@ -1352,11 +1334,11 @@ pattern. For example, for a buffer associated with file
For a buffer associated with file '/a/b/c.d', this matches
against '/a/b'. For a buffer not associated with a file, this
matches against the value of `default-directory' in that buffer."
- (:description "directory name"
- :reader (read-from-minibuffer "Filter by directory name (regex): "))
- (ibuffer-aif (with-current-buffer buf (ibuffer-buffer-file-name))
- (let ((dirname (file-name-directory it)))
- (when dirname (string-match qualifier dirname)))
+ ( :description "directory name"
+ :reader (read-from-minibuffer "Filter by directory name (regex): "))
+ (if-let ((it (with-current-buffer buf (ibuffer-buffer-file-name))))
+ (when-let ((dirname (file-name-directory it)))
+ (string-match qualifier dirname))
(when default-directory (string-match qualifier default-directory))))
;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext")
@@ -1990,6 +1972,8 @@ defaults to one."
(push buf ibuffer-do-occur-bufs)))
(occur-1 regexp nlines ibuffer-do-occur-bufs)))
+(define-obsolete-function-alias 'ibuffer-remove-duplicates #'seq-uniq "29.1")
+
(provide 'ibuf-ext)
;; Local Variables:
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 51b206d7c4..acffb74ead 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -35,7 +35,7 @@
If TEST returns non-nil, bind `it' to the value, and evaluate
TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
Compare with `if'."
- (declare (indent 2))
+ (declare (obsolete if-let "29.1") (indent 2))
(let ((sym (make-symbol "ibuffer-aif-sym")))
`(let ((,sym ,test))
(if ,sym
@@ -47,10 +47,9 @@ Compare with `if'."
(defmacro ibuffer-awhen (test &rest body)
"Evaluate BODY if TEST returns non-nil.
During evaluation of body, bind `it' to the value returned by TEST."
- (declare (indent 1))
- `(ibuffer-aif ,test
- (progn ,@body)
- nil))
+ (declare (indent 1) (obsolete when-let "29.1"))
+ `(when-let ((it ,test))
+ ,@body))
(defmacro ibuffer-save-marks (&rest body)
"Save the marked status of the buffers and execute BODY; restore marks."
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 742d21d0b0..5cb4fe2a7a 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -447,7 +447,6 @@ directory, like `default-directory'."
"d" #'ibuffer-mark-for-delete
"C-d" #'ibuffer-mark-for-delete-backwards
- "k" #'ibuffer-mark-for-delete
"x" #'ibuffer-do-kill-on-deletion-marks
;; immediate operations
@@ -833,7 +832,7 @@ width and the longest string in LIST."
(let ((pt (save-excursion
(mouse-set-point event)
(point))))
- (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
+ (if-let ((it (get-text-property (point) 'ibuffer-filter-group-name)))
(ibuffer-toggle-marks it)
(goto-char pt)
(let ((mark (ibuffer-current-mark)))
@@ -1264,8 +1263,8 @@ become unmarked.
If point is on a group name, then this function operates on that
group."
(interactive)
- (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
- (setq group it))
+ (when-let ((it (get-text-property (point) 'ibuffer-filter-group-name)))
+ (setq group it))
(let ((count
(ibuffer-map-lines
(lambda (_buf mark)
@@ -1337,7 +1336,7 @@ If point is on a group name, this function operates on
that group."
(when (and movement (< movement 0))
(setq arg (- arg)))
(ibuffer-forward-line 0)
- (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
+ (if-let ((it (get-text-property (point) 'ibuffer-filter-group-name)))
(progn
(require 'ibuf-ext)
(ibuffer-mark-on-buffer #'identity mark it))
@@ -1541,7 +1540,7 @@ If point is on a group name, this function operates on
that group."
;; `ibuffer-inline-columns' alist and insert it
;; into our generated code. Otherwise, we just
;; generate a call to the column function.
- (ibuffer-aif (assq sym ibuffer-inline-columns)
+ (if-let ((it (assq sym ibuffer-inline-columns)))
(nth 1 it)
`(or (,sym buffer mark) "")))
;; You're not expected to understand this. Hell, I
@@ -1738,7 +1737,7 @@ If point is on a group name, this function operates on
that group."
(cond ((zerop total) "No processes")
((= 1 total) "1 process")
(t (format "%d processes" total))))))
- (ibuffer-aif (get-buffer-process buffer)
+ (if-let ((it (get-buffer-process buffer)))
(format "(%s %s)" it (process-status it))
""))
@@ -1873,8 +1872,8 @@ the buffer object itself and the current mark symbol."
(let ((result
(if (buffer-live-p (ibuffer-current-buffer))
(when (or (null group)
- (ibuffer-aif (get-text-property (point)
'ibuffer-filter-group)
- (equal group it)))
+ (when-let ((it (get-text-property (point)
'ibuffer-filter-group)))
+ (equal group it)))
(save-excursion
(funcall function
(ibuffer-current-buffer)
@@ -2333,7 +2332,18 @@ FORMATS is the value to use for `ibuffer-formats'.
(run-hooks 'ibuffer-hook))
(setq buffer-read-only t))
(unless ibuffer-expert
- (message "Commands: m, u, t, RET, g, k, S, D, Q; q to quit; h for
help"))))))
+ (message (substitute-command-keys
+ (concat "Commands: \\[ibuffer-mark-forward], "
+ "\\[ibuffer-unmark-forward], "
+ "\\[ibuffer-toggle-marks], "
+ "\\[ibuffer-visit-buffer], "
+ "\\[ibuffer-update], "
+ "\\[ibuffer-do-kill-lines], "
+ "\\[ibuffer-do-save], "
+ "\\[ibuffer-do-delete], "
+ "\\[ibuffer-do-query-replace]; "
+ "\\[quit-window] to quit; "
+ "\\[describe-mode] for help"))))))))
;;;###autoload
(defun ibuffer-jump (&optional other-window)
diff --git a/lisp/image.el b/lisp/image.el
index 02e5c85faf..de2afdc2c7 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -32,7 +32,6 @@
:group 'multimedia)
(declare-function image-flush "image.c" (spec &optional frame))
-(defalias 'image-refresh 'image-flush)
(defconst image-type-header-regexps
`(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
@@ -1304,6 +1303,8 @@ changing the displayed image size does not affect the
saved image."
(setf (image-property image :flip)
(not (image-property image :flip)))))
+(define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
+
(provide 'image)
;;; image.el ends here
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index ca28222c81..d6e83c81e7 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1525,6 +1525,17 @@ Setup `char-width-table' appropriate for non-CJK
language environment."
(aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
(aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
+(dotimes (i 256)
+ (let* ((vs-number (1+ i))
+ (codepoint (if (< i 16)
+ (+ #xfe00 i)
+ (+ #xe0100 i -16)))
+ (delimiter (cond ((<= vs-number 9) "0")
+ ((<= vs-number 99) "")
+ (t " "))))
+ (aset char-acronym-table codepoint
+ (format "VS%s%s" delimiter vs-number))))
+
;; We can't use the \N{name} things here, because this file is used
;; too early in the build process.
(defvar bidi-control-characters
@@ -1574,7 +1585,9 @@ option `glyphless-char-display'."
#x80 #x9F method))
((eq target 'variation-selectors)
(glyphless-set-char-table-range glyphless-char-display
- #xFE00 #xFE0F method))
+ #xFE00 #xFE0F method)
+ (glyphless-set-char-table-range glyphless-char-display
+ #xE0100 #xE01EF method))
((or (eq target 'format-control)
(eq target 'bidi-control))
(when unicode-category-table
@@ -1647,10 +1660,10 @@ GROUP must be one of these symbols:
that are relevant for bidirectional formatting control,
like U+2069 (PDI) and U+202B (RLE).
`variation-selectors':
- Characters in the range U+FE00..U+FE0F, used for
- selecting alternate glyph presentations, such as
- Emoji vs Text presentation, of the preceding
- character(s).
+ Characters in the range U+FE00..U+FE0F and
+ U+E0100..U+E01EF, used for selecting alternate glyph
+ presentations, such as Emoji vs Text presentation, of
+ the preceding character(s).
`no-font': For GUI frames, characters for which no suitable
font is found; for text-mode frames, characters
that cannot be encoded by `terminal-coding-system'.
diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el
index cc636986f9..3f6500669a 100644
--- a/lisp/international/ja-dic-utl.el
+++ b/lisp/international/ja-dic-utl.el
@@ -112,11 +112,9 @@ without okurigana are placed at the head of the returned
list."
(princ (substitute-command-keys "\
The library `ja-dic' can't be loaded.
-The most common case is that you have not yet installed the library
-included in LEIM (Libraries of Emacs Input Method) which is
-distributed separately from Emacs.
-
-LEIM is available from the same ftp directory as Emacs.")))
+This might indicate a problem with your Emacs installation, as
+LEIM (Libraries of Emacs Input Method) should normally always be
+installed together with Emacs.")))
(signal (car err) (cdr err)))))
(let ((vec (make-vector len 0))
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 6b630c73e8..cdf2e527e2 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1065,35 +1065,39 @@ see the function `describe-fontset' for the format of
the list."
(help-xref-button 1 'help-input-method (match-string 1))))))))
(defun list-input-methods-1 ()
- (if (not input-method-alist)
- (princ "
-No input method is available, perhaps because you have not
-installed LEIM (Libraries of Emacs Input Methods).")
- (princ (substitute-command-keys
- "LANGUAGE\n NAME (`TITLE' in mode line)\n"))
- (princ " SHORT-DESCRIPTION\n------------------------------\n")
- (setq input-method-alist
- (sort input-method-alist
- (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
-
- (let (language)
- (dolist (elt input-method-alist)
- (when (not (equal language (nth 1 elt)))
- (setq language (nth 1 elt))
- (princ language)
- (terpri))
- (princ (format-message
- " %s (`%s' in mode line)\n %s\n"
- (car elt)
- (let ((title (nth 3 elt)))
- (if (and (consp title) (stringp (car title)))
- (car title)
- title))
- ;; If the doc is multi-line, indent all
- ;; non-blank lines. (Bug#8066)
- (replace-regexp-in-string
- "\n\\(.\\)" "\n \\1"
- (substitute-command-keys (or (nth 4 elt) "")))))))))
+ (with-current-buffer standard-output
+ (if (not input-method-alist)
+ (insert "
+No input method is available.
+
+This might indicate a problem with your Emacs installation, as
+LEIM (Libraries of Emacs Input Method) should normally always be
+installed together with Emacs.")
+ (insert (substitute-command-keys
+ "LANGUAGE\n NAME (`TITLE' in mode line)\n"))
+ (insert " SHORT-DESCRIPTION\n------------------------------\n")
+ (setq input-method-alist
+ (sort input-method-alist
+ (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
+
+ (let (language)
+ (dolist (elt input-method-alist)
+ (when (not (equal language (nth 1 elt)))
+ (setq language (nth 1 elt))
+ (insert "\n" (propertize language 'face 'help-for-help-header)
"\n\n"))
+ (insert (format-message
+ " %s (`%s' in mode line)\n %s\n"
+ (car elt)
+ (let ((title (nth 3 elt)))
+ (if (and (consp title) (stringp (car title)))
+ (car title)
+ title))
+ ;; If the doc is multi-line, indent all
+ ;; non-blank lines. (Bug#8066)
+ (replace-regexp-in-string
+ "\n\\(.\\)" "\n \\1"
+ (substitute-command-keys (or (nth 4 elt) ""))))))))))
+
;;; DIAGNOSIS
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 529cf97215..4bb6dbcc8e 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -249,11 +249,9 @@ This activates input method defined by PACKAGE-NAME by
running
(princ (car libraries))
(princ (substitute-command-keys "\" is not in `load-path'.
-The most common case is that you have not yet installed appropriate
-libraries in LEIM (Libraries of Emacs Input Method) which is
-distributed separately from Emacs.
-
-LEIM is available from the same ftp directory as Emacs.")))
+This might indicate a problem with your Emacs installation, as
+LEIM (Libraries of Emacs Input Method) should normally always be
+installed together with Emacs.")))
(error "Can't use the Quail package `%s'" package-name))
(setq libraries (cdr libraries))))))
(quail-select-package package-name)
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 2a91e7cb5e..080045e752 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1191,10 +1191,7 @@ The library is named pinyin.el, and contains the constant
(dst-file (cadr command-line-args-left))
(coding-system-for-write 'utf-8-unix))
(with-temp-file dst-file
- (insert ";;; " (file-name-nondirectory dst-file)
- " -*- lexical-binding:t -*-
-;; This file is automatically generated from pinyin.map, by the
-;; function pinyin-convert.\n\n")
+ (generate-lisp-file-heading dst-file 'pinyin-convert)
(insert "(defconst pinyin-character-map\n'(")
(let ((pos (point)))
(insert-file-contents src-file)
@@ -1214,7 +1211,7 @@ The library is named pinyin.el, and contains the constant
(forward-line 1)))
(insert ")\n\"An alist holding correspondences between pinyin syllables\
and\nChinese characters.\")\n\n")
- (insert "(provide 'pinyin)\n"))
+ (generate-lisp-file-trailer dst-file :compile t))
(kill-emacs 0)))
;;; titdic-cnv.el ends here
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 8f480a87d9..31fcf01949 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -537,8 +537,6 @@ This is like `describe-bindings', but displays only Isearch
keys."
(describe-function 'isearch-forward))
(when isearch-mode (isearch-update)))
-(defalias 'isearch-mode-help 'isearch-describe-mode)
-
;; Define isearch-mode keymap.
@@ -2838,7 +2836,9 @@ The command accepts Unicode names like \"smiling face\" or
isearch-barrier
(1+ isearch-other-end)))))
(isearch-search)
- ))
+ (when (and (memq isearch-wrap-pause '(no no-ding))
+ (not isearch-success))
+ (isearch-repeat (if isearch-forward 'forward 'backward)))))
(isearch-push-state)
(if isearch-op-fun (funcall isearch-op-fun))
(isearch-update))
@@ -4634,6 +4634,8 @@ CASE-FOLD non-nil means the search was case-insensitive."
(replace-regexp-in-string "\"" "[\"“”]")))))
(buffer-local-restore-state isearch-fold-quotes-mode--state)))
+(define-obsolete-function-alias 'isearch-mode-help #'isearch-describe-mode
"29.1")
+
(provide 'isearch)
;;; isearch.el ends here
diff --git a/lisp/keymap.el b/lisp/keymap.el
index ad7d4fbbba..107565590c 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -313,7 +313,7 @@ Modifiers have to be specified in this order:
which is
Alt-Control-Hyper-Meta-Shift-super"
- (declare (pure t) (side-effect-free t))
+ (declare (pure t) (side-effect-free error-free))
(let ((case-fold-search nil))
(and
(stringp keys)
@@ -530,7 +530,8 @@ should be a MENU form as accepted by `easy-menu-define'.
(keymap keymap)
(prefix (define-prefix-command prefix nil name))
(full (make-keymap name))
- (t (make-sparse-keymap name)))))
+ (t (make-sparse-keymap name))))
+ seen-keys)
(when suppress
(suppress-keymap keymap (eq suppress 'nodigits)))
(when parent
@@ -544,6 +545,9 @@ should be a MENU form as accepted by `easy-menu-define'.
(let ((def (pop definitions)))
(if (eq key :menu)
(easy-menu-define nil keymap "" def)
+ (if (member key seen-keys)
+ (error "Duplicate definition for key: %S %s" key keymap)
+ (push key seen-keys))
(keymap-set keymap key def)))))
keymap)))
@@ -571,6 +575,16 @@ as the variable documentation string.
(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
+ (setq key (pop defs))
+ (pop defs)
+ (when (not (eq key :menu))
+ (if (member key seen-keys)
+ (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)))))
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 1e915c2f83..3d5b68f84b 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -137,10 +137,13 @@ thin (i.e. 1-dot width) space."
(set-char-table-range
composition-function-table
'(#x600 . #x74F)
- (list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
- 1 #'arabic-shape-gstring)
- (vector "[\u0600-\u074F\u200C\u200D]+"
+ (list (vector "[\u0600-\u074F\u200C\u200D]+"
0 #'arabic-shape-gstring)))
+(set-char-table-range
+ composition-function-table
+ '(#x200C . #x200D)
+ (list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
+ 0 #'arabic-shape-gstring)))
;; The Egyptian Hieroglyph Format Controls were introduced in Unicode
;; Standard v12.0. Apparently, they are not yet well supported in
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index dfbdf401dc..429d7ab532 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -825,7 +825,7 @@ it is disabled.
;;; Generated autoloads from net/ange-ftp.el
-(defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
+(define-obsolete-function-alias 'ange-ftp-re-read-dir #'ange-ftp-reread-dir
"29.1")
(autoload 'ange-ftp-reread-dir "ange-ftp" "\
Reread remote directory DIR to update the directory cache.
The implementation of remote FTP file names caches directory contents
@@ -1426,6 +1426,10 @@ Special commands:
How many seconds passwords are cached, or nil to disable expiring.
Overrides `password-cache-expiry' through a let-binding.")
(custom-autoload 'auth-source-cache-expiry "auth-source" t)
+(autoload 'auth-source-netrc-parse-all "auth-source" "\
+Parse FILE and return all entries.
+
+(fn FILE)" nil nil)
(autoload 'authinfo-mode "auth-source" "\
Mode for editing .authinfo/.netrc files.
@@ -1463,6 +1467,15 @@ key2: value2
;;; Generated autoloads from cedet/ede/auto.el
+(autoload 'ede-add-project-autoload "ede/auto" "\
+Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'.
+Optional argument FLAG indicates how this autoload should be
+added. Possible values are:
+ `generic' - A generic project type. Keep this at the very end.
+ `unique' - A unique project type for a specific project. Keep at the very
+ front of the list so more generic projects don't get priority.
+
+(fn PROJAUTO &optional FLAG)" nil nil)
(register-definition-prefixes "ede/auto" '("ede-"))
@@ -1525,60 +1538,6 @@ it is disabled.
(register-definition-prefixes "autoinsert" '("auto-insert"))
-;;; Generated autoloads from emacs-lisp/autoload.el
-
-(put 'autoload-ensure-writable 'risky-local-variable t)
-(autoload 'update-file-autoloads "autoload" "\
-Update the autoloads for FILE.
-If prefix arg SAVE-AFTER is non-nil, save the buffer too.
-
-If FILE binds `generated-autoload-file' as a file-local variable,
-autoloads are written into that file. Otherwise, the autoloads
-file is determined by OUTFILE. If called interactively, prompt
-for OUTFILE; if called from Lisp with OUTFILE nil, use the
-existing value of `generated-autoload-file'.
-
-Return FILE if there was no autoload cookie in it, else nil.
-
-(fn FILE &optional SAVE-AFTER OUTFILE)" t nil)
-(autoload 'update-directory-autoloads "autoload" "\
-Update autoload definitions for Lisp files in the directories DIRS.
-In an interactive call, you must give one argument, the name of a
-single directory. In a call from Lisp, you can supply multiple
-directories as separate arguments, but this usage is discouraged.
-
-The function does NOT recursively descend into subdirectories of the
-directory or directories specified.
-
-In an interactive call, prompt for a default output file for the
-autoload definitions. When called from Lisp, use the existing
-value of `generated-autoload-file'. If any Lisp file binds
-`generated-autoload-file' as a file-local variable, write its
-autoloads into the specified file instead.
-
-(fn &rest DIRS)" t nil)
-(make-obsolete 'update-directory-autoloads 'make-directory-autoloads "28.1")
-(autoload 'make-directory-autoloads "autoload" "\
-Update autoload definitions for Lisp files in the directories DIRS.
-DIR can be either a single directory or a list of
-directories. (The latter usage is discouraged.)
-
-The autoloads will be written to OUTPUT-FILE. If any Lisp file
-binds `generated-autoload-file' as a file-local variable, write
-its autoloads into the specified file instead.
-
-The function does NOT recursively descend into subdirectories of the
-directory or directories specified.
-
-(fn DIR OUTPUT-FILE)" t nil)
-(autoload 'batch-update-autoloads "autoload" "\
-Update loaddefs.el autoloads in batch mode.
-Calls `update-directory-autoloads' on the command line arguments.
-Definitions are written to `generated-autoload-file' (which
-should be non-nil)." nil nil)
-(register-definition-prefixes "autoload" '("autoload-"
"batch-update-autoloads--summary" "generate-" "make-autoload"
"no-update-autoloads"))
-
-
;;; Generated autoloads from autorevert.el
(autoload 'auto-revert-mode "autorevert" "\
@@ -1816,7 +1775,7 @@ The mode's hook is called both when the mode is enabled
and when
it is disabled.
(fn &optional ARG)" t nil)
-(register-definition-prefixes "battery" '("battery-" "my-"))
+(register-definition-prefixes "battery" '("battery-"))
;;; Generated autoloads from emacs-lisp/benchmark.el
@@ -1874,7 +1833,7 @@ The return value is the value of the final form in BODY.
;;; Generated autoloads from textmodes/bib-mode.el
-(register-definition-prefixes "bib-mode" '("addbib" "bib-" "mark-bib"
"return-key-bib" "unread-bib"))
+(register-definition-prefixes "bib-mode" '("bib-"))
;;; Generated autoloads from textmodes/bibtex.el
@@ -2652,7 +2611,7 @@ User can move with [up] or [down], select a buffer
by \\[bs-select] or [SPC]
Type \\[bs-kill] to leave Buffer Selection Menu without a selection.
-Type \\[bs-help] after invocation to get help on commands available.
+Type \\[describe-mode] after invocation to get help on commands available.
With prefix argument ARG show a different buffer list. Function
`bs--configuration-name-for-prefix-arg' determine accordingly
name of buffer configuration.
@@ -2856,7 +2815,7 @@ and corresponding effects.
;;; Generated autoloads from cedet/semantic/bovine/c.el
-(register-definition-prefixes "semantic/bovine/c" '("c-mode" "semantic"))
+(register-definition-prefixes "semantic/bovine/c" '("semantic"))
;;; Generated autoloads from calendar/cal-bahai.el
@@ -4557,7 +4516,7 @@ it is disabled.
;;; Generated autoloads from emacs-lisp/cl-macs.el
-(register-definition-prefixes "cl-macs" '("cl-" "foo" "function-form"))
+(register-definition-prefixes "cl-macs" '("cl-"))
;;; Generated autoloads from emacs-lisp/cl-print.el
@@ -4954,7 +4913,7 @@ You might also use mode hooks to specify it in certain
modes, like this:
It's often useful to leave a space at the end of the value.")
(custom-autoload 'compile-command "compile" t)
-(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or
(not (boundp 'compilation-read-command)) compilation-read-command))))
+(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (if
(boundp 'compilation-read-command) compilation-read-command t))))
(defvar compilation-disable-input nil "\
If non-nil, send end-of-file as compilation process input.
This only affects platforms that support asynchronous processes (see
@@ -4990,6 +4949,10 @@ the function in `compilation-buffer-name-function', so
you can set that
to a function that generates a unique name.
(fn COMMAND &optional COMINT)" t nil)
+(autoload 'compilation--default-buffer-name "compile" "\
+
+
+(fn NAME-OF-MODE)" nil nil)
(autoload 'compilation-start "compile" "\
Run compilation command COMMAND (low level interface).
If COMMAND starts with a cd command, that becomes the `default-directory'.
@@ -5549,7 +5512,7 @@ Run `perldoc' on WORD.
(fn WORD)" t nil)
(autoload 'cperl-perldoc-at-point "cperl-mode" "\
Run a `perldoc' on the word around point." t nil)
-(register-definition-prefixes "cperl-mode" '("cperl-" "pod2man-program"))
+(register-definition-prefixes "cperl-mode" '("cperl-"))
;;; Generated autoloads from progmodes/cpp.el
@@ -6072,6 +6035,22 @@ Otherwise the menu will be named `Customize'.
The format is suitable for use with `easy-menu-define'.
(fn SYMBOL &optional NAME)" nil nil)
+(autoload 'customize-icon "cus-edit" "\
+Customize ICON.
+
+(fn ICON)" t nil)
+(autoload 'custom-set-icons "cus-edit" "\
+Install user customizations of icon specs specified in ARGS.
+These settings are registered as theme `user'.
+The arguments should each be a list of the form:
+
+ (SYMBOL EXP)
+
+This stores EXP (without evaluating it) as the saved spec for SYMBOL.
+
+(fn &rest ARGS)" nil nil)
+(autoload 'custom-save-icons "cus-edit" "\
+Save all customized icons in `custom-file'." nil nil)
(register-definition-prefixes "cus-edit" '("Custom-" "cus" "widget-"))
@@ -6106,7 +6085,7 @@ omitted, a buffer named *Custom Themes* is used.
;;; Generated autoloads from cedet/ede/custom.el
-(register-definition-prefixes "ede/custom" '("ede-" "eieio-ede-old-variables"))
+(register-definition-prefixes "ede/custom" '("ede-"))
;;; Generated autoloads from vc/cvs-status.el
@@ -6264,12 +6243,12 @@ Create a new data-debug buffer with NAME.
;;; Generated autoloads from cedet/semantic/db-ebrowse.el
-(register-definition-prefixes "semantic/db-ebrowse" '("c++-mode"
"semanticdb-"))
+(register-definition-prefixes "semantic/db-ebrowse" '("semanticdb-"))
;;; Generated autoloads from cedet/semantic/db-el.el
-(register-definition-prefixes "semantic/db-el" '("emacs-lisp-mode"
"semanticdb-"))
+(register-definition-prefixes "semantic/db-el" '("semanticdb-"))
;;; Generated autoloads from cedet/semantic/db-file.el
@@ -6289,7 +6268,7 @@ Create a new data-debug buffer with NAME.
;;; Generated autoloads from cedet/semantic/db-javascript.el
-(register-definition-prefixes "semantic/db-javascript" '("javascript-mode"
"semanticdb-"))
+(register-definition-prefixes "semantic/db-javascript" '("semanticdb-"))
;;; Generated autoloads from cedet/semantic/db-mode.el
@@ -7090,7 +7069,7 @@ protocol defined in RFC 2229.
This is a quick reference to this mode describing the default key bindings:
\\<dictionary-mode-map>
* \\[dictionary-close] close the dictionary buffer
-* \\[dictionary-help] display this help information
+* \\[describe-mode] display this help information
* \\[dictionary-search] ask for a new word to search
* \\[dictionary-lookup-definition] search the word at point
* \\[forward-button] or TAB place point to the next link
@@ -7100,7 +7079,7 @@ This is a quick reference to this mode describing the
default key bindings:
* \\[dictionary-select-dictionary] select the default dictionary
* \\[dictionary-select-strategy] select the default search strategy
-* RET or <mouse-2> visit that link" nil nil)
+* \\`RET' or \\`<mouse-2>' visit that link" nil nil)
(autoload 'dictionary "dictionary" "\
Create a new dictionary buffer and install `dictionary-mode'." t nil)
(autoload 'dictionary-search "dictionary" "\
@@ -7280,7 +7259,7 @@ If given a \\[universal-argument] prefix, also prompt for
the QUERY-TYPE paramet
If given a \\[universal-argument] \\[universal-argument] prefix, also prompt
for the SERVER parameter.
(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t
nil)
-(register-definition-prefixes "dig" '("dig-" "query-dig"))
+(register-definition-prefixes "dig" '("dig-"))
;;; Generated autoloads from cedet/ede/dired.el
@@ -7435,7 +7414,7 @@ Like \\[dired-jump] (`dired-jump') but in other window.
;;; Generated autoloads from dired-aux.el
-(register-definition-prefixes "dired-aux" '("dired-"
"minibuffer-default-add-dired-shell-commands"))
+(register-definition-prefixes "dired-aux" '("dired-"))
;;; Generated autoloads from dired-x.el
@@ -7892,7 +7871,7 @@ it is disabled.
(autoload 'doctor "doctor" "\
Switch to *doctor* buffer and start giving psychotherapy." t nil)
-(register-definition-prefixes "doctor" '("doc" "make-doctor-variables"))
+(register-definition-prefixes "doctor" '("doc"))
;;; Generated autoloads from cedet/srecode/document.el
@@ -8607,7 +8586,7 @@ already is one.)" t nil)
Toggle edebugging of all definitions." t nil)
(autoload 'edebug-all-forms "edebug" "\
Toggle edebugging of all forms." t nil)
-(register-definition-prefixes "edebug" '("arglist" "backquote-form"
"def-declarations" "edebug" "function-form" "interactive" "lambda-" "name"
"nested-backquote-form"))
+(register-definition-prefixes "edebug" '("edebug"))
;;; Generated autoloads from vc/ediff.el
@@ -9060,6 +9039,18 @@ BUFFER is put back into its original major mode.
;;; Generated autoloads from emacs-lisp/eieio.el
(push (purecopy '(eieio 1 4)) package--builtin-versions)
+(autoload 'make-instance "eieio" "\
+Make a new instance of CLASS based on INITARGS.
+For example:
+
+ (make-instance \\='foo)
+
+INITARGS is a property list with keywords based on the `:initarg'
+for each slot. For example:
+
+ (make-instance \\='foo :slot1 value1 :slotN valueN)
+
+(fn CLASS &rest INITARGS)" nil nil)
(register-definition-prefixes "eieio" '("child-of-class-p" "defclass" "eieio-"
"find-class" "obj" "oref" "oset" "same-class-p" "set-slot-value" "slot-"
"with-slots"))
@@ -9127,12 +9118,12 @@ Describe CTR if it is a class constructor.
;;; Generated autoloads from cedet/semantic/bovine/el.el
-(register-definition-prefixes "semantic/bovine/el" '("emacs-lisp-mode"
"semantic-"))
+(register-definition-prefixes "semantic/bovine/el" '("semantic-"))
;;; Generated autoloads from emacs-lisp/eldoc.el
-(push (purecopy '(eldoc 1 12 0)) package--builtin-versions)
+(push (purecopy '(eldoc 1 13 0)) package--builtin-versions)
;;; Generated autoloads from elec-pair.el
@@ -9325,7 +9316,7 @@ displayed." t nil)
;;; Generated autoloads from eshell/em-extpipe.el
-(register-definition-prefixes "em-extpipe" '("em-extpipe--or-with-catch"
"eshell-"))
+(register-definition-prefixes "em-extpipe" '("eshell-"))
;;; Generated autoloads from eshell/em-glob.el
@@ -9380,7 +9371,7 @@ displayed." t nil)
;;; Generated autoloads from eshell/em-unix.el
-(register-definition-prefixes "em-unix" '("eshell" "nil-blank-string"))
+(register-definition-prefixes "em-unix" '("eshell"))
;;; Generated autoloads from eshell/em-xtra.el
@@ -11038,7 +11029,7 @@ Display the bookmarks." t nil)
Default bookmark handler for EWW buffers.
(fn BOOKMARK)" nil nil)
-(register-definition-prefixes "eww" '("erc--download-directory" "eww-"))
+(register-definition-prefixes "eww" '("eww-"))
;;; Generated autoloads from progmodes/executable.el
@@ -11328,7 +11319,7 @@ used to invoke the command, with all modifiers removed:
After adjusting, further adjust the font size as long as the key,
with all modifiers removed, is one of the above characters.
-Buffer-local face adjustements have higher priority than global
+Buffer-local face adjustments have higher priority than global
face adjustments.
The variable `global-text-scale-adjust-resizes-frames' controls
@@ -11505,7 +11496,7 @@ reminders, you can set `feedmail-queue-reminder-alist'
to nil.
;;; Generated autoloads from ffap.el
-(defvar ffap-file-finder 'find-file "\
+(defvar ffap-file-finder #'find-file "\
The command called by `find-file-at-point' to find a file.")
(custom-autoload 'ffap-file-finder "ffap" t)
(autoload 'ffap-next "ffap" "\
@@ -11528,7 +11519,7 @@ Find FILENAME, guessing a default from text around
point.
If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
-See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
+See also the variables `ffap-dired-wildcards',
`ffap-url-unwrap-local', `ffap-url-unwrap-remote',
`ffap-file-name-with-spaces', and the functions `ffap-file-at-point'
and `ffap-url-at-point'.
@@ -11873,7 +11864,7 @@ where the first string in the value of the variable
`find-ls-option'
specifies what to use in place of \"-ls\" as the final argument.
(fn DIR REGEXP)" t nil)
-(register-definition-prefixes "find-dired" '("find-" "kill-find"
"lookfor-dired"))
+(register-definition-prefixes "find-dired" '("find-" "kill-find"))
;;; Generated autoloads from find-file.el
@@ -13052,7 +13043,7 @@ detailed description of this mode.
+-----------------------------------+----------------------------------+
(fn COMMAND-LINE)" t nil)
-(register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-"
"hollow-right-triangle" "nil"))
+(register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-"
"hollow-right-triangle"))
;;; Generated autoloads from emacs-lisp/generator.el
@@ -13376,7 +13367,7 @@ CLEAN is obsolete and ignored.
(autoload 'gnus-article-prepare-display "gnus-art" "\
Make the current buffer look like a nice article." nil nil)
-(register-definition-prefixes "gnus-art" '(":keymap" "article-" "gnus-"))
+(register-definition-prefixes "gnus-art" '("article-" "gnus-"))
;;; Generated autoloads from gnus/gnus-async.el
@@ -13616,7 +13607,7 @@ The arguments have the same meaning as those of
`gnus-read-ephemeral-bug-group', which see.
(fn IDS &optional WINDOW-CONF)" t nil)
-(register-definition-prefixes "gnus-group" '(":keymap" "gnus-"))
+(register-definition-prefixes "gnus-group" '("gnus-"))
;;; Generated autoloads from gnus/gnus-html.el
@@ -13809,7 +13800,7 @@ Like `message-reply'.
(fn &optional TO-ADDRESS WIDE)" t nil)
(define-mail-user-agent 'gnus-user-agent 'gnus-msg-mail 'message-send-and-exit
'message-kill-buffer 'message-send-hook)
-(register-definition-prefixes "gnus-msg" '(":prefix" "gnus-"))
+(register-definition-prefixes "gnus-msg" '("gnus-"))
;;; Generated autoloads from gnus/gnus-notifications.el
@@ -13970,7 +13961,7 @@ Handler function for record returned by
`gnus-summary-bookmark-make-record'.
BOOKMARK is a bookmark name or a bookmark record.
(fn BOOKMARK)" nil nil)
-(register-definition-prefixes "gnus-sum" '(":keymap" "gnus-"))
+(register-definition-prefixes "gnus-sum" '("gnus-"))
;;; Generated autoloads from gnus/gnus-topic.el
@@ -14166,6 +14157,33 @@ retrieval failed.
(defvar grep-window-height nil "\
Number of lines in a grep window. If nil, use `compilation-window-height'.")
(custom-autoload 'grep-window-height "grep" t)
+(defvar grep-highlight-matches 'auto-detect "\
+Use special markers to highlight grep matches.
+
+Some grep programs are able to surround matches with special
+markers in grep output. Such markers can be used to highlight
+matches in grep mode. This requires `font-lock-mode' to be active
+in grep buffers, so if you have globally disabled `font-lock-mode',
+you will not get highlighting.
+
+This option sets the environment variable GREP_COLORS to specify
+markers for highlighting and adds the --color option in front of
+any explicit grep options before starting the grep.
+
+When this option is `auto', grep uses `--color=auto' to highlight
+matches only when it outputs to a terminal (when `grep' is the last
+command in the pipe), thus avoiding the use of any potentially-harmful
+escape sequences when standard output goes to a file or pipe.
+
+To make grep highlight matches even into a pipe, you need the option
+`always' that forces grep to use `--color=always' to unconditionally
+output escape sequences.
+
+If the value is `auto-detect' (the default), `grep' will call
+`grep-compute-defaults' to compute the value. To change the
+default value, use \\[customize] or call the function
+`grep-apply-setting'.")
+(custom-autoload 'grep-highlight-matches "grep" nil)
(defvar grep-command nil "\
The default grep command for \\[grep].
If the grep program used supports an option to always include file names
@@ -14190,6 +14208,8 @@ for easier editing.")
(defvar grep-setup-hook nil "\
List of hook functions run by `grep-process-setup' (see `run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
+(defvar grep-match-face 'match "\
+Face name to use for grep matches.")
(defconst grep-regexp-alist `((,(concat "^\\(?:"
"\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:"
"\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:"
"\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end
0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg
(text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (-
mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg
(match-end [...]
Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
@@ -14565,7 +14585,7 @@ FUNC is a function to handle input key.
HELP-TEXT is a text set in `hangul-input-method-help-text'.
(fn INPUT-METHOD FUNC HELP-TEXT &rest ARGS)" nil nil)
-(register-definition-prefixes "quail/hangul" '("alphabetp" "hangul"
"notzerop"))
+(register-definition-prefixes "quail/hangul" '("hangul" "notzerop"))
;;; Generated autoloads from language/hanja-util.el
@@ -14580,16 +14600,13 @@ Towers of Hanoi diversion. Use NRINGS rings.
(fn NRINGS)" t nil)
(autoload 'hanoi-unix "hanoi" "\
-Towers of Hanoi, UNIX doomsday version.
-Displays 32-ring towers that have been progressing at one move per
-second since 1970-01-01 00:00:00 GMT.
+Towers of Hanoi, 32-bit UNIX doomsday version.
+Display 32-ring towers that have been progressing at one move per
+second since 1970-01-01 00:00:00 UTC.
Repent before ring 31 moves." t nil)
(autoload 'hanoi-unix-64 "hanoi" "\
-Like `hanoi-unix', but pretend to have a 64-bit clock.
-This is, necessarily (as of Emacs 20.3), a crock. When the
-`current-time' interface is made s2G-compliant, hanoi.el will need
-to be updated." t nil)
+Like `hanoi-unix', but with a 64-bit clock." t nil)
(register-definition-prefixes "hanoi" '("hanoi-"))
@@ -14981,7 +14998,7 @@ See `help-make-xrefs'.
Add xrefs for symbols in `pp's output between FROM and TO.
(fn FROM TO)" nil nil)
-(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")
+(define-obsolete-function-alias 'help-xref-interned #'describe-symbol "25.1")
(autoload 'help-bookmark-jump "help-mode" "\
Jump to `help-mode' bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
@@ -15974,7 +15991,7 @@ Call Ibuffer and set point at the line listing the
current buffer.
If optional arg OTHER-WINDOW is non-nil, then use another window.
(fn &optional OTHER-WINDOW)" t nil)
-(register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked"
"mark" "mod" "name" "process" "read-only" "recency" "size"))
+(register-definition-prefixes "ibuffer" '("ibuffer-"))
;;; Generated autoloads from calendar/icalendar.el
@@ -16203,6 +16220,15 @@ with no args, if that value is non-nil.
(register-definition-prefixes "icon" '("beginning-of-icon-defun"
"calculate-icon-indent" "electric-icon-brace" "end-of-icon-defun" "icon-"
"indent-icon-exp" "mark-icon-function"))
+;;; Generated autoloads from emacs-lisp/icons.el
+
+(autoload 'describe-icon "icons" "\
+Pop to a buffer to describe ICON.
+
+(fn ICON)" t nil)
+(register-definition-prefixes "icons" '("button" "define-icon" "icon"))
+
+
;;; Generated autoloads from cedet/semantic/idle.el
(register-definition-prefixes "semantic/idle" '("define-semantic-idle-service"
"global-semantic-idle-summary-mode" "semantic-"))
@@ -17271,7 +17297,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-"))
+(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u"
"inscript-" "quail-" "tamil-"))
;;; Generated autoloads from progmodes/inf-lisp.el
@@ -18337,6 +18363,13 @@ KEYS should be a vector or a string that obeys
`key-valid-p'.
(fn MAC &optional COUNTER FORMAT)" nil nil)
(make-obsolete 'kmacro-lambda-form 'kmacro "29.1")
+(autoload 'kmacro-name-last-macro "kmacro" "\
+Assign a name to the last keyboard macro defined.
+Argument SYMBOL is the name to define.
+The symbol's function definition becomes the keyboard macro string.
+Such a \"function\" cannot be called from Lisp, but it is a valid editor
command.
+
+(fn SYMBOL)" t nil)
(register-definition-prefixes "kmacro" '("kmacro-"))
@@ -18644,7 +18677,7 @@ This scans for ;;;###autoload forms and related things.
The first element on the command line should be the (main)
loaddefs.el output file, and the rest are the directories to
use." nil nil)
-(register-definition-prefixes "loaddefs-gen" '("autoload-"
"generated-autoload-" "loaddefs-generate--"))
+(register-definition-prefixes "loaddefs-gen" '("autoload-"
"generated-autoload-" "loaddefs-generate--" "no-update-autoloads"))
;;; Generated autoloads from loadhist.el
@@ -18768,41 +18801,6 @@ Major mode for browsing CVS log output.
(register-definition-prefixes "log-view" '("log-view-"))
-;;; Generated autoloads from longlines.el
-
-(autoload 'longlines-mode "longlines" "\
-Toggle Long Lines mode in this buffer.
-
-When Long Lines mode is enabled, long lines are wrapped if they
-extend beyond `fill-column'. The soft newlines used for line
-wrapping will not show up when the text is yanked or saved to
-disk.
-
-If the variable `longlines-auto-wrap' is non-nil, lines are
-automatically wrapped whenever the buffer is changed. You can
-always call `fill-paragraph' to fill individual paragraphs.
-
-If the variable `longlines-show-hard-newlines' is non-nil, hard
-newlines are indicated with a symbol.
-
-This is a minor mode. If called interactively, toggle the
-`Longlines mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `longlines-mode'.
-
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
-
-(fn &optional ARG)" t nil)
-(register-definition-prefixes "longlines" '("longlines-"))
-
-
;;; Generated autoloads from lpr.el
(defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\
@@ -19292,7 +19290,7 @@ Mairix will be called asynchronously unless
;;; Generated autoloads from cedet/semantic/bovine/make.el
-(register-definition-prefixes "semantic/bovine/make" '("makefile-mode"
"semantic-"))
+(register-definition-prefixes "semantic/bovine/make" '("semantic-"))
;;; Generated autoloads from cedet/ede/make.el
@@ -19706,7 +19704,7 @@ Major mode for editing Metafont sources.
Major mode for editing MetaPost sources.
(fn)" t nil)
-(register-definition-prefixes "meta-mode"
'("font-lock-match-meta-declaration-item-and-skip-to-next" "meta"))
+(register-definition-prefixes "meta-mode" '("meta"))
;;; Generated autoloads from mh-e/mh-acros.el
@@ -19891,7 +19889,7 @@ perform the operation on all messages in that region.
\\{mh-folder-mode-map}
(fn)" t nil)
-(register-definition-prefixes "mh-folder" '(":keymap" "mh-"))
+(register-definition-prefixes "mh-folder" '("mh-"))
;;; Generated autoloads from mh-e/mh-funcs.el
@@ -19916,7 +19914,7 @@ perform the operation on all messages in that region.
;;; Generated autoloads from mh-e/mh-letter.el
-(register-definition-prefixes "mh-letter" '(":keymap" "mh-"))
+(register-definition-prefixes "mh-letter" '("mh-"))
;;; Generated autoloads from mh-e/mh-limit.el
@@ -19941,7 +19939,7 @@ perform the operation on all messages in that region.
;;; Generated autoloads from mh-e/mh-search.el
-(register-definition-prefixes "mh-search" '(":keymap" "mh-"))
+(register-definition-prefixes "mh-search" '("mh-"))
;;; Generated autoloads from mh-e/mh-seq.el
@@ -19951,12 +19949,12 @@ perform the operation on all messages in that region.
;;; Generated autoloads from mh-e/mh-show.el
-(register-definition-prefixes "mh-show" '(":keymap" "mh-"))
+(register-definition-prefixes "mh-show" '("mh-"))
;;; Generated autoloads from mh-e/mh-speed.el
-(register-definition-prefixes "mh-speed" '(":keymap" "mh-"))
+(register-definition-prefixes "mh-speed" '("mh-"))
;;; Generated autoloads from mh-e/mh-thread.el
@@ -20095,6 +20093,14 @@ Duplicate the current line N times.
Interactively, N is the prefix numeric argument, and defaults to 1.
Also see the `copy-from-above-command' command.
+(fn &optional N)" t nil)
+(autoload 'duplicate-dwim "misc" "\
+Duplicate the current line or region N times.
+If the region is inactive, duplicate the current line (like `duplicate-line').
+Otherwise, duplicate the region, which remains active afterwards.
+If the region is rectangular, duplicate on its right-hand side.
+Interactively, N is the prefix numeric argument, and defaults to 1.
+
(fn &optional N)" t nil)
(autoload 'zap-up-to-char "misc" "\
Kill up to, but not including ARGth occurrence of CHAR.
@@ -20531,7 +20537,7 @@ To test this function, evaluate:
(autoload 'mpc "mpc" "\
Main entry point for MPC." t nil)
-(register-definition-prefixes "mpc" '("mpc-" "tag-browser-tagtypes"))
+(register-definition-prefixes "mpc" '("mpc-"))
;;; Generated autoloads from play/mpuz.el
@@ -20990,17 +20996,6 @@ Open a network connection to HOST on PORT.
(register-definition-prefixes "net-utils" '("arp-program" "dns-lookup-program"
"finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig"
"iwconfig-program" "net" "nslookup-" "ping-program" "route-program"
"run-network-program" "smbclient" "traceroute-program" "whois-"))
-;;; Generated autoloads from net/netrc.el
-
-(autoload 'netrc-credentials "netrc" "\
-Return a user name/password pair.
-Port specifications will be prioritized in the order they are
-listed in the PORTS list.
-
-(fn MACHINE &rest PORTS)" nil nil)
-(register-definition-prefixes "netrc" '("netrc-"))
-
-
;;; Generated autoloads from net/network-stream.el
(autoload 'open-network-stream "network-stream" "\
@@ -22790,15 +22785,17 @@ call (package-activate-all) in your init-file.")
Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
Apart from this directory, Emacs also looks for system-wide
-packages in `package-directory-list'." :type 'directory :initialize
#'custom-initialize-delay :risky t :version "24.1")
+packages in `package-directory-list'." :type 'directory :initialize
#'custom-initialize-delay :risky t :group 'applications :version "24.1")
(custom-autoload 'package-user-dir "package" t)
(defcustom package-directory-list (let (result) (dolist (f load-path) (and
(stringp f) (equal (file-name-nondirectory f) "site-lisp") (push
(expand-file-name "elpa" f) result))) (nreverse result)) "\
List of additional directories containing Emacs Lisp packages.
Each directory name should be absolute.
These directories contain packages intended for system-wide; in
-contrast, `package-user-dir' contains packages for personal use." :type
'(repeat directory) :initialize #'custom-initialize-delay :risky t :version
"24.1")
+contrast, `package-user-dir' contains packages for personal use." :type
'(repeat directory) :initialize #'custom-initialize-delay :group 'applications
:risky t :version "24.1")
(custom-autoload 'package-directory-list "package" t)
+(defvar package-activated-list nil "\
+List of the names of currently activated packages.")
(defvar package--activated nil "\
Non-nil if `package-activate-all' has been run.")
(autoload 'package-initialize "package" "\
@@ -22821,6 +22818,7 @@ that code in the early init-file.
(defun package-activate-all nil "\
Activate all installed packages.
The variable `package-load-list' controls which packages to load." (setq
package--activated t) (let* ((elc (concat package-quickstart-file "c")) (qs (if
(file-readable-p elc) elc (if (file-readable-p package-quickstart-file)
package-quickstart-file)))) (if (and qs (not (bound-and-true-p
package-activated-list))) (let ((load-source-file-function nil)) (unless
(boundp 'package-activated-list) (setq package-activated-list nil)) (load qs
nil 'nomessage)) (require 'package) (package--activate [...]
+(autoload 'package--activate-all "package" nil nil nil)
(autoload 'package-import-keyring "package" "\
Import keys from FILE.
@@ -22938,7 +22936,7 @@ It works in more cases if the call is in the file which
contains
the `Version:' header." nil nil)
(function-put 'package-get-version 'pure 't)
(defcustom package-quickstart-file (locate-user-emacs-file
"package-quickstart.el") "\
-Location of the file used to speed up activation of packages at startup."
:type 'file :initialize #'custom-initialize-delay :version "27.1")
+Location of the file used to speed up activation of packages at startup."
:type 'file :group 'applications :initialize #'custom-initialize-delay :version
"27.1")
(custom-autoload 'package-quickstart-file "package" t)
(register-definition-prefixes "package" '("bad-signature" "define-package"
"describe-package-1" "package-"))
@@ -23457,7 +23455,7 @@ Various indentation styles: K&R BSD BLK GNU LW
Turning on Perl mode runs the normal hook `perl-mode-hook'.
(fn)" t nil)
-(register-definition-prefixes "perl-mode" '("indent-perl-exp"
"mark-perl-function" "perl-"))
+(register-definition-prefixes "perl-mode" '("perl-"))
;;; Generated autoloads from pgtk-dnd.el
@@ -23541,11 +23539,6 @@ they are not by default assigned to keys." t nil)
(register-definition-prefixes "picture" '("picture-"))
-;;; Generated autoloads from language/pinyin.el
-
-(register-definition-prefixes "pinyin" '("pinyin-character-map"))
-
-
;;; Generated autoloads from textmodes/pixel-fill.el
(register-definition-prefixes "pixel-fill" '("pixel-fill-"))
@@ -24552,11 +24545,6 @@ The default value is
(\"/usr/local/share/emacs/fonts/bdf\").")
(register-definition-prefixes "ps-bdf" '("bdf-"))
-;;; Generated autoloads from ps-def.el
-
-(register-definition-prefixes "ps-def" '("ps-"))
-
-
;;; Generated autoloads from progmodes/ps-mode.el
(push (purecopy '(ps-mode 1 1 9)) package--builtin-versions)
@@ -25073,64 +25061,6 @@ of each directory.
(register-definition-prefixes "quail" '("quail-"))
-;;; Generated autoloads from net/quickurl.el
-
-(defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn
(require 'quickurl) (add-hook 'write-file-functions (lambda () (quickurl-read)
nil) nil t))\n;; End:\n" "\
-Example `quickurl-postfix' text that adds a local variable to the
-`quickurl-url-file' so that if you edit it by hand it will ensure that
-`quickurl-urls' is updated with the new URL list.
-
-To make use of this do something like:
-
- (setq quickurl-postfix quickurl-reread-hook-postfix)
-
-in your init file (after loading/requiring quickurl).")
-(autoload 'quickurl "quickurl" "\
-Insert a URL based on LOOKUP.
-
-If not supplied LOOKUP is taken to be the word at point in the current
-buffer, this default action can be modified via
-`quickurl-grab-lookup-function'.
-
-(fn &optional LOOKUP)" t nil)
-(autoload 'quickurl-ask "quickurl" "\
-Insert a URL, with `completing-read' prompt, based on LOOKUP.
-
-(fn LOOKUP)" t nil)
-(autoload 'quickurl-add-url "quickurl" "\
-Allow the user to interactively add a new URL associated with WORD.
-
-See `quickurl-grab-url' for details on how the default word/URL combination
-is decided.
-
-(fn WORD URL COMMENT)" t nil)
-(autoload 'quickurl-browse-url "quickurl" "\
-Browse the URL associated with LOOKUP.
-
-If not supplied LOOKUP is taken to be the word at point in the
-current buffer, this default action can be modified via
-`quickurl-grab-lookup-function'.
-
-(fn &optional LOOKUP)" t nil)
-(autoload 'quickurl-browse-url-ask "quickurl" "\
-Browse the URL, with `completing-read' prompt, associated with LOOKUP.
-
-(fn LOOKUP)" t nil)
-(autoload 'quickurl-edit-urls "quickurl" "\
-Pull `quickurl-url-file' into a buffer for hand editing." t nil)
-(autoload 'quickurl-list-mode "quickurl" "\
-A mode for browsing the quickurl URL list.
-
-The key bindings for `quickurl-list-mode' are:
-
-\\{quickurl-list-mode-map}
-
-(fn)" t nil)
-(autoload 'quickurl-list "quickurl" "\
-Display `quickurl-list' as a formatted list using `quickurl-list-mode'." t nil)
-(register-definition-prefixes "quickurl" '("quickurl-"))
-
-
;;; Generated autoloads from emacs-lisp/radix-tree.el
(register-definition-prefixes "radix-tree" '("radix-tree-"))
@@ -26759,9 +26689,13 @@ following constructs:
(backref REF) matches whatever the submatch REF matched.
REF can be a number, as usual, or a name
introduced by a previous (let REF ...)
- construct." (let* ((rx--pcase-vars nil) (regexp
(rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) `(and (pred stringp)
,(pcase (length rx--pcase-vars) (0 `(pred (string-match ,regexp))) (1 `(app
(lambda (s) (if (string-match ,regexp s) (match-string 1 s) 0)) (and ,(car
rx--pcase-vars) (pred (not numberp))))) (nvars `(app (lambda (s) (and
(string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b))
(mapcar (lambda (i) `(match-string ,i s)) (number-se [...]
+ construct." (rx--pcase-expand regexps)))
(define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil)
(define-symbol-prop 'rx 'pcase-macroexpander #'rx--pcase-macroexpander)
+(autoload 'rx--pcase-expand "rx" "\
+
+
+(fn REGEXPS)" nil nil)
(register-definition-prefixes "rx" '("rx-"))
@@ -26911,7 +26845,7 @@ The mode's hook is called both when the mode is enabled
and when
it is disabled.
(fn &optional ARG)" t nil)
-(register-definition-prefixes "saveplace" '("load-save-place-alist-from-file"
"save-place"))
+(register-definition-prefixes "saveplace" '("save-place"))
;;; Generated autoloads from cedet/semantic/sb.el
@@ -27288,6 +27222,11 @@ Turning on Mail mode runs the normal hooks
`text-mode-hook' and
`mail-mode-hook' (in that order).
(fn)" t nil)
+(autoload 'mail-send-and-exit "sendmail" "\
+Send message like `mail-send', then, if no errors, exit from mail buffer.
+Prefix arg means don't delete this window.
+
+(fn &optional ARG)" t nil)
(defvar mail-mailing-lists nil "\
List of mailing list addresses the user is subscribed to.
The variable is used to trigger insertion of the \"Mail-Followup-To\"
@@ -27842,7 +27781,7 @@ If SAME-WINDOW, don't pop to a new window.
(fn GROUP &optional FUNCTION SAME-WINDOW)" t nil)
(defalias 'shortdoc #'shortdoc-display-group)
-(register-definition-prefixes "shortdoc" '("alist" "buffer" "file"
"hash-table" "keymaps" "list" "number" "overlay" "process" "regexp" "sequence"
"shortdoc-" "string" "text-properties" "vector"))
+(register-definition-prefixes "shortdoc" '("shortdoc-"))
;;; Generated autoloads from net/shr.el
@@ -28620,7 +28559,7 @@ explicitly, and matters only if you need the extra
headers
installed through `spam-necessary-extra-headers'.
(fn &rest SYMBOLS)" t nil)
-(register-definition-prefixes "spam" '(":keymap" "spam-"))
+(register-definition-prefixes "spam" '("spam-"))
;;; Generated autoloads from gnus/spam-report.el
@@ -29368,7 +29307,10 @@ Studlify-case the current buffer." t nil)
;;; Generated autoloads from emacs-lisp/subr-x.el
(autoload 'string-truncate-left "subr-x" "\
-Truncate STRING to LENGTH, replacing initial surplus with \"...\".
+If STRING is longer than LENGTH, return a truncated version.
+When truncating, \"...\" is always prepended to the string, so
+the resulting string may be longer than the original if LENGTH is
+3 or smaller.
(fn STRING LENGTH)" nil nil)
(autoload 'string-clean-whitespace "subr-x" "\
@@ -30225,7 +30167,7 @@ converts a table into plain text without frames. It is
a companion to
;;; Generated autoloads from cedet/srecode/table.el
-(register-definition-prefixes "srecode/table" '("object-sort-list" "srecode-"))
+(register-definition-prefixes "srecode/table" '("srecode-"))
;;; Generated autoloads from emacs-lisp/tabulated-list.el
@@ -31228,7 +31170,11 @@ If DATE lacks timezone information, GMT is assumed.
(fn DATE)" nil nil)
(defalias 'time-to-seconds 'float-time)
-(defalias 'seconds-to-time 'time-convert)
+(autoload 'seconds-to-time "time-date" "\
+Convert SECONDS to a proper time, like `current-time' would.
+FORM means the same as in `time-convert'.
+
+(fn SECONDS &rest FORM)" nil nil)
(autoload 'days-to-time "time-date" "\
Convert DAYS into a time value.
@@ -31266,7 +31212,7 @@ Gregorian date Sunday, December 31, 1 BC.
(fn TIME)" nil nil)
(autoload 'safe-date-to-time "time-date" "\
Parse a string DATE that represents a date-time and return a time value.
-If DATE is malformed, return a time value of zeros.
+If DATE is malformed, return a time value of zero.
(fn DATE)" nil nil)
(autoload 'format-seconds "time-date" "\
@@ -31741,6 +31687,15 @@ Regular expression matching file names handled by
Tramp autoload.
It must match the initial `tramp-syntax' settings. It should not
match file names at root of the underlying local file system,
like \"/sys\" or \"/C:\".")
+(defvar tramp-foreign-file-name-handler-alist nil "\
+Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
+If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
+calling HANDLER.")
+(autoload 'tramp-file-name-handler "tramp" "\
+Invoke Tramp file name handler for OPERATION and ARGS.
+Fall back to normal file name handler if no Tramp file name handler exists.
+
+(fn OPERATION &rest ARGS)" nil nil)
(defun tramp-autoload-file-name-handler (operation &rest args) "\
Load Tramp file name handler, and perform OPERATION."
(tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory
temporary-file-directory)) (when (bound-and-true-p tramp-archive-autoload)
(load "tramp-archive" 'noerror 'nomessage)) (load "tramp" 'noerror
'nomessage))) (apply operation args))
(defun tramp-register-autoload-file-name-handlers nil "\
@@ -31770,6 +31725,7 @@ List of suffixes which indicate a compressed file.
It must be supported by libarchive(3).")
(defmacro tramp-archive-autoload-file-name-regexp nil "\
Regular expression matching archive file names." '(concat "\\`" "\\(" ".+"
"\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt
tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'"))
+(autoload 'tramp-archive-file-name-handler "tramp-archine")
(defun tramp-archive-autoload-file-name-handler (operation &rest args) "\
Load Tramp archive file name handler, and perform OPERATION." (defvar
tramp-archive-autoload) (let ((default-directory temporary-file-directory)
(tramp-archive-autoload tramp-archive-enabled)) (apply
#'tramp-autoload-file-name-handler operation args)))
(defun tramp-register-archive-file-name-handler nil "\
@@ -31781,7 +31737,7 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
;;; Generated autoloads from net/tramp-cache.el
-(register-definition-prefixes "tramp-cache" '("tramp-"))
+(register-definition-prefixes "tramp-cache" '("tramp-" "with-tramp-"))
;;; Generated autoloads from net/tramp-cmds.el
@@ -31857,6 +31813,48 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
;;; Generated autoloads from transient.el
+(autoload 'transient-define-prefix "transient" "\
+Define NAME as a transient prefix command.
+
+ARGLIST are the arguments that command takes.
+DOCSTRING is the documentation string and is optional.
+
+These arguments can optionally be followed by key-value pairs.
+Each key has to be a keyword symbol, either `:class' or a keyword
+argument supported by the constructor of that class. The
+`transient-prefix' class is used if the class is not specified
+explicitly.
+
+GROUPs add key bindings for infix and suffix commands and specify
+how these bindings are presented in the popup buffer. At least
+one GROUP has to be specified. See info node `(transient)Binding
+Suffix and Infix Commands'.
+
+The BODY is optional. If it is omitted, then ARGLIST is also
+ignored and the function definition becomes:
+
+ (lambda ()
+ (interactive)
+ (transient-setup \\='NAME))
+
+If BODY is specified, then it must begin with an `interactive'
+form that matches ARGLIST, and it must call `transient-setup'.
+It may however call that function only when some condition is
+satisfied; that is one of the reason why you might want to use
+an explicit BODY.
+
+All transients have a (possibly nil) value, which is exported
+when suffix commands are called, so that they can consume that
+value. For some transients it might be necessary to have a sort
+of secondary value, called a scope. Such a scope would usually
+be set in the commands `interactive' form and has to be passed
+to the setup function:
+
+ (transient-setup \\='NAME nil nil :scope SCOPE)
+
+(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" nil t)
+(function-put 'transient-define-prefix 'lisp-indent-function 'defun)
+(function-put 'transient-define-prefix 'doc-string-elt 3)
(autoload 'transient-insert-suffix "transient" "\
Insert a SUFFIX into PREFIX before LOC.
PREFIX is a prefix command, a symbol.
@@ -31865,9 +31863,11 @@ SUFFIX is a suffix command or a group specification (of
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
+Remove a conflicting binding unless optional KEEP-OTHER is
+ non-nil.
See info node `(transient)Modifying Existing Transients'.
-(fn PREFIX LOC SUFFIX)" nil nil)
+(fn PREFIX LOC SUFFIX &optional KEEP-OTHER)" nil nil)
(function-put 'transient-insert-suffix 'lisp-indent-function 'defun)
(autoload 'transient-append-suffix "transient" "\
Insert a SUFFIX into PREFIX after LOC.
@@ -31877,9 +31877,11 @@ SUFFIX is a suffix command or a group specification (of
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
+Remove a conflicting binding unless optional KEEP-OTHER is
+ non-nil.
See info node `(transient)Modifying Existing Transients'.
-(fn PREFIX LOC SUFFIX)" nil nil)
+(fn PREFIX LOC SUFFIX &optional KEEP-OTHER)" nil nil)
(function-put 'transient-append-suffix 'lisp-indent-function 'defun)
(autoload 'transient-replace-suffix "transient" "\
Replace the suffix at LOC in PREFIX with SUFFIX.
@@ -31903,7 +31905,7 @@ See info node `(transient)Modifying Existing
Transients'.
(fn PREFIX LOC)" nil nil)
(function-put 'transient-remove-suffix 'lisp-indent-function 'defun)
-(register-definition-prefixes "transient" '("magit--fit-window-to-buffer"
"transient-"))
+(register-definition-prefixes "transient" '("magit--fit-window-to-buffer"
"transient"))
;;; Generated autoloads from tree-widget.el
@@ -32119,7 +32121,7 @@ FRAC should be the inverse of the fractional value; for
example, a value of
2 would mean to use one half, a value of 4 would mean to use one quarter, etc.
(fn WPM &optional WORDLEN FRAC)" t nil)
-(register-definition-prefixes "type-break" '("timep" "type-break-"))
+(register-definition-prefixes "type-break" '("type-break-"))
;;; Generated autoloads from international/ucs-normalize.el
@@ -32267,11 +32269,6 @@ how long to wait for a response before giving up.
(register-definition-prefixes "url" '("url-"))
-;;; Generated autoloads from url/url-about.el
-
-(register-definition-prefixes "url-about" '("url-"))
-
-
;;; Generated autoloads from url/url-auth.el
(autoload 'url-get-authentication "url-auth" "\
@@ -32373,11 +32370,6 @@ added to this list, so most requests can just pass in
nil.
(register-definition-prefixes "url-dav" '("url-dav-"))
-;;; Generated autoloads from url/url-dired.el
-
-(register-definition-prefixes "url-dired" '("url-"))
-
-
;;; Generated autoloads from url/url-domsuf.el
(register-definition-prefixes "url-domsuf" '("url-domsuf-"))
@@ -32730,14 +32722,8 @@ Will not do anything if `url-show-status' is nil.
Return a date string that most HTTP servers can understand.
(fn &optional SPECIFIED-TIME)" nil nil)
-(autoload 'url-eat-trailing-space "url-util" "\
-Remove spaces/tabs at the end of a string.
-
-(fn X)" nil nil)
-(autoload 'url-strip-leading-spaces "url-util" "\
-Remove spaces at the front of a string.
-
-(fn X)" nil nil)
+(define-obsolete-function-alias 'url-eat-trailing-space #'string-trim-right
"29.1")
+(define-obsolete-function-alias 'url-strip-leading-spaces #'string-trim-left
"29.1")
(autoload 'url-display-percentage "url-util" "\
@@ -34524,7 +34510,7 @@ Toggle Viper on/off.
If Viper is enabled, turn it off. Otherwise, turn it on." t nil)
(autoload 'viper-mode "viper" "\
Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
-(register-definition-prefixes "viper" '("set-viper-state-in-major-mode"
"this-major-mode-requires-vi-state" "viper-"))
+(register-definition-prefixes "viper" '("viper-"))
;;; Generated autoloads from emulation/viper-cmd.el
@@ -34544,7 +34530,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node
`(viper)Top'." t nil)
;;; Generated autoloads from emulation/viper-keym.el
-(register-definition-prefixes "viper-keym" '("ex-read-filename-map" "viper-"))
+(register-definition-prefixes "viper-keym" '("viper-"))
;;; Generated autoloads from emulation/viper-macs.el
@@ -34668,7 +34654,7 @@ this is equivalent to `display-warning', using
`emacs' as the type and `:warning' as the level.
(fn MESSAGE &rest ARGS)" nil nil)
-(register-definition-prefixes "warnings" '("warning-"))
+(register-definition-prefixes "warnings" '("warning"))
;;; Generated autoloads from wdired.el
@@ -35471,7 +35457,7 @@ decompress the file if appropriate. See the
documentation for the
Default bookmark handler for Woman buffers.
(fn BOOKMARK)" nil nil)
-(register-definition-prefixes "woman" '("WoMan-" "menu-bar-manuals-menu"
"set-woman-file-regexp" "woman"))
+(register-definition-prefixes "woman" '("WoMan-" "woman"))
;;; Generated autoloads from textmodes/word-wrap-mode.el
@@ -35613,7 +35599,7 @@ If LIMIT is non-nil, then do not consider characters
beyond LIMIT.
;;; Generated autoloads from progmodes/xref.el
-(push (purecopy '(xref 1 4 1)) package--builtin-versions)
+(push (purecopy '(xref 1 5 0)) package--builtin-versions)
(autoload 'xref-find-backend "xref" nil nil nil)
(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1")
(autoload 'xref-go-back "xref" "\
@@ -35716,7 +35702,7 @@ to control which program to use when looking for
matches.
;;; Generated autoloads from progmodes/xscheme.el
-(register-definition-prefixes "xscheme" '("default-xscheme-runlight"
"exit-scheme-interaction-mode" "global-set-scheme-interaction-buffer" "local-"
"reset-scheme" "run-scheme" "scheme-" "start-scheme" "verify-xscheme-buffer"
"xscheme-"))
+(register-definition-prefixes "xscheme" '("exit-scheme-interaction-mode"
"global-set-scheme-interaction-buffer" "local-" "reset-scheme" "run-scheme"
"scheme-" "start-scheme" "xscheme-"))
;;; Generated autoloads from nxml/xsd-regexp.el
@@ -35829,8 +35815,8 @@ Zone out, completely." t nil)
(provide 'loaddefs)
;; Local Variables:
-;; version-control: never
;; no-byte-compile: t
+;; version-control: never
;; no-update-autoloads: t
;; coding: utf-8-emacs-unix
;; End:
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index 0ef5b2d5c7..83fee1e04c 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -103,9 +103,10 @@
(make-vector 6 0))
(defsubst notzerop (number)
+ (declare (obsolete "use `(not (zerop ...))'." "29.1"))
(not (zerop number)))
-(defsubst alphabetp (char)
+(defsubst hangul-alphabetp (char)
(or (and (>= char ?A) (<= char ?Z))
(and (>= char ?a) (<= char ?z))))
@@ -191,10 +192,10 @@ and insert CHAR to new `hangul-queue'."
(aset hangul-queue 0 char))
((and (zerop (aref hangul-queue 1))
(zerop (aref hangul-queue 2))
- (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
+ (not (zerop (hangul-djamo 'cho (aref hangul-queue 0) char))))
(aset hangul-queue 1 char))
((and (zerop (aref hangul-queue 4))
- (notzerop (aref hangul-queue 2))
+ (not (zerop (aref hangul-queue 2)))
(/= char 8)
(/= char 19)
(/= char 25)
@@ -213,7 +214,7 @@ and insert CHAR to new `hangul-queue'."
char)))
(aset hangul-queue 4 char))
((and (zerop (aref hangul-queue 5))
- (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
+ (not (zerop (hangul-djamo 'jong (aref hangul-queue 4) char)))
(numberp
(hangul-character
(+ (aref hangul-queue 0)
@@ -246,14 +247,14 @@ Other parts are the same as a
`hangul2-input-method-jaum'."
(aset hangul-queue 2 char))
((and (zerop (aref hangul-queue 3))
(zerop (aref hangul-queue 4))
- (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
+ (not (zerop (hangul-djamo 'jung (aref hangul-queue 2)
char))))
(aset hangul-queue 3 char)))
(hangul-insert-character hangul-queue)
(let ((next-char (vector 0 0 char 0 0 0)))
- (cond ((notzerop (aref hangul-queue 5))
+ (cond ((not (zerop (aref hangul-queue 5)))
(aset next-char 0 (aref hangul-queue 5))
(aset hangul-queue 5 0))
- ((notzerop (aref hangul-queue 4))
+ ((not (zerop (aref hangul-queue 4)))
(aset next-char 0 (aref hangul-queue 4))
(aset hangul-queue 4 0)))
(hangul-insert-character hangul-queue
@@ -271,7 +272,7 @@ Other parts are the same as a `hangul2-input-method-jaum'."
(aset hangul-queue 0 char))
((and (zerop (aref hangul-queue 1))
(zerop (aref hangul-queue 2))
- (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
+ (not (zerop (hangul-djamo 'cho (aref hangul-queue 0) char))))
(aset hangul-queue 1 char)))
(hangul-insert-character hangul-queue)
(hangul-insert-character hangul-queue
@@ -287,7 +288,7 @@ Other parts are the same as a `hangul3-input-method-cho'."
(zerop (aref hangul-queue 4)))
(aset hangul-queue 2 char))
((and (zerop (aref hangul-queue 3))
- (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
+ (not (zerop (hangul-djamo 'jung (aref hangul-queue 2)
char))))
(aset hangul-queue 3 char)))
(hangul-insert-character hangul-queue)
(hangul-insert-character hangul-queue
@@ -300,8 +301,8 @@ This function processes a Hangul 3-Bulsik Jongseong.
The Jongseong can be located in a Jongseong position.
Other parts are the same as a `hangul3-input-method-cho'."
(if (cond ((and (zerop (aref hangul-queue 4))
- (notzerop (aref hangul-queue 0))
- (notzerop (aref hangul-queue 2))
+ (not (zerop (aref hangul-queue 0)))
+ (not (zerop (aref hangul-queue 2)))
(numberp
(hangul-character
(+ (aref hangul-queue 0)
@@ -317,7 +318,7 @@ Other parts are the same as a `hangul3-input-method-cho'."
char)))
(aset hangul-queue 4 char))
((and (zerop (aref hangul-queue 5))
- (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
+ (not (zerop (hangul-djamo 'jong (aref hangul-queue 4) char)))
(numberp
(hangul-character
(+ (aref hangul-queue 0)
@@ -349,7 +350,7 @@ Other parts are the same as a `hangul3-input-method-cho'."
(while (and (> i 0) (zerop (aref hangul-queue i)))
(setq i (1- i)))
(aset hangul-queue i 0))
- (if (notzerop (apply #'+ (append hangul-queue nil)))
+ (if (not (zerop (apply #'+ (append hangul-queue nil))))
(hangul-insert-character hangul-queue)
(delete-char -1)))
@@ -388,7 +389,7 @@ When a Korean input method is off, convert the following
hangul character."
(defun hangul2-input-method (key)
"2-Bulsik input method."
- (if (or buffer-read-only (not (alphabetp key)))
+ (if (or buffer-read-only (not (hangul-alphabetp key)))
(list key)
(quail-setup-overlays nil)
(let ((input-method-function nil)
@@ -405,7 +406,7 @@ When a Korean input method is off, convert the following
hangul character."
(cond ((and (stringp seq)
(= 1 (length seq))
(setq key (aref seq 0))
- (alphabetp key))
+ (hangul-alphabetp key))
(hangul2-input-method-internal key))
((commandp cmd)
(call-interactively cmd))
@@ -546,6 +547,8 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'."
(with-output-to-temp-buffer "*Help*"
(princ hangul-input-method-help-text)))
+(define-obsolete-function-alias 'alphabetp 'hangul-alphabetp "29.1")
+
(provide 'hangul)
;; Local Variables:
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index e652f108dd..431d8369c1 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -702,7 +702,7 @@ is."
;; Probhat Input Method
(quail-define-package
"bengali-probhat" "Bengali" "BngPB" t
- "Probhat keyboard for Bengali/Bangla" nil t nil nil nil nil nil nil nil nil t)
+ "Probhat keyboard for Bengali/Bangla" nil t nil t t nil nil nil nil nil t)
(quail-define-rules
("!" ?!)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 21a87dbd77..8dad382ac0 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -32,9 +32,6 @@
;; If you add a file to be loaded here, keep the following points in mind:
;; i) If the file is no-byte-compile, explicitly load the .el version.
-;; Such files should (where possible) obey the doc-string conventions
-;; expected by make-docfile. They should also be added to the
-;; uncompiled[] list in make-docfile.c.
;; ii) If the file is dumped with Emacs (on any platform), put the
;; load statement at the start of a line (leading whitespace is ok).
@@ -42,11 +39,9 @@
;; iii) If the file is _not_ dumped with Emacs, make sure the load
;; statement is _not_ at the start of a line. See pcase for an example.
-;; These rules are so that src/Makefile can construct lisp.mk automatically.
-;; This ensures both that the Lisp files are compiled (if necessary)
-;; before the emacs executable is dumped, and that they are passed to
-;; make-docfile. (Any that are not processed for DOC will not have
-;; doc strings in the dumped Emacs.)
+;; These rules are so that src/Makefile can construct lisp.mk
+;; automatically. This ensures that the Lisp files are compiled (if
+;; necessary) before the emacs executable is dumped.
;;; Code:
@@ -185,9 +180,10 @@
;; should be updated by overwriting it with an up-to-date copy of
;; loaddefs.el that is not corrupted by local changes.
;; admin/update_autogen can be used to update ldefs-boot.el periodically.
-(condition-case nil (load "loaddefs.el")
- ;; In case loaddefs hasn't been generated yet.
- (file-error (load "ldefs-boot.el")))
+(condition-case nil
+ (load "loaddefs")
+ (file-error
+ (load "ldefs-boot.el")))
(let ((new (make-hash-table :test #'equal)))
;; Now that loaddefs has populated definition-prefixes, purify its contents.
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index ad6ce19a95..93dd8697bd 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -23,9 +23,13 @@
;;; Commentary:
;; BinHex is a binary-to-text encoding scheme similar to uuencode.
+;; It was used on the classic Mac OS, last released in 2001.
+;;
;; The command `binhex-decode-region' decodes BinHex-encoded text, via
;; the external program "hexbin" if that is available, or an Emacs
;; Lisp implementation if not.
+;;
+;; See also: https://en.wikipedia.org/wiki/BinHex
;;; Code:
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 29e16c419b..a594fa3ccb 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -93,6 +93,7 @@ displaying footnotes."
(defcustom footnote-use-message-mode t ; Nowhere used.
"If non-nil, assume Footnoting will be done in `message-mode'."
:type 'boolean)
+(make-obsolete-variable 'footnote-use-message-mode "it does nothing." "29.1")
(defcustom footnote-body-tag-spacing 2
"Number of spaces separating a footnote body tag and its text.
@@ -839,22 +840,18 @@ being set it is automatically widened."
(when (looking-at (footnote--current-regexp))
(goto-char (match-end 0))))))
-(defvar footnote-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "a" #'footnote-add-footnote)
- (define-key map "b" #'footnote-back-to-message)
- (define-key map "c" #'footnote-cycle-style)
- (define-key map "d" #'footnote-delete-footnote)
- (define-key map "g" #'footnote-goto-footnote)
- (define-key map "r" #'footnote-renumber-footnotes)
- (define-key map "s" #'footnote-set-style)
- map))
-
-(defvar footnote-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map footnote-prefix footnote-mode-map)
- map)
- "Keymap used for binding footnote minor mode.")
+(defvar-keymap footnote-mode-map
+ "a" #'footnote-add-footnote
+ "b" #'footnote-back-to-message
+ "c" #'footnote-cycle-style
+ "d" #'footnote-delete-footnote
+ "g" #'footnote-goto-footnote
+ "r" #'footnote-renumber-footnotes
+ "s" #'footnote-set-style)
+
+(defvar-keymap footnote-minor-mode-map
+ :doc "Keymap used for binding footnote minor mode."
+ (key-description footnote-prefix) footnote-mode-map)
(defmacro footnote--local-advice (mode variable function)
"Add advice to a variable holding buffer-local functions.
@@ -888,7 +885,6 @@ play around with the following keys:
(footnote--local-advice footnote-mode fill-paragraph-function
footnote--fill-paragraph)
(when footnote-mode
- ;; (footnote-setup-keybindings)
(make-local-variable 'footnote-style)
(make-local-variable 'footnote-body-tag-spacing)
(make-local-variable 'footnote-spaced-footnotes)
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index e4061bd2f1..86711a4543 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -163,7 +163,7 @@ no aliases, which is represented by this being a table with
no entries.)")
(if (file-exists-p mail-personal-alias-file)
(let ((modtime (file-attribute-modification-time
(file-attributes mail-personal-alias-file))))
- (if (not (equal mail-abbrev-modtime modtime))
+ (if (not (time-equal-p mail-abbrev-modtime modtime))
(progn
(setq mail-abbrev-modtime modtime)
(build-mail-abbrevs)))))))
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 4dcde0d354..2ab4fa411a 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -164,17 +164,13 @@ your primary spool is. If this fails, set it to
something like
(defvar mspools-buffer "*spools*"
"Name of buffer for displaying spool info.")
-(defvar mspools-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" #'mspools-visit-spool)
- (define-key map "\C-m" #'mspools-visit-spool)
- (define-key map " " #'mspools-visit-spool)
- (define-key map "n" #'next-line)
- (define-key map "p" #'previous-line)
- map)
- "Keymap for the *spools* buffer.")
-
-;;; Code
+(defvar-keymap mspools-mode-map
+ :doc "Keymap for the *spools* buffer."
+ "C-c C-c" #'mspools-visit-spool
+ "RET" #'mspools-visit-spool
+ "SPC" #'mspools-visit-spool
+ "n" #'next-line
+ "p" #'previous-line)
;;; VM Specific code
(if mspools-using-vm
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index bb0d646346..67874d508b 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -45,6 +45,9 @@
'(("Newsgroups" . nil)
("Followup-To" . nil)
("Message-ID" . nil)
+ ;; This header must be pre-encoded by the MTA, so avoid
+ ;; double-encoding it.
+ ("Content-Disposition" . default)
("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\
\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\|Disposition-Notification-To\\)"
. address-mime)
(t . mime))
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index 79bd02fd67..553fac26f9 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -34,13 +34,10 @@
:group 'rmail-edit)
-(defvar rmail-edit-map
- (let ((map (make-sparse-keymap)))
- ;; Make a keymap that inherits text-mode-map.
- (set-keymap-parent map text-mode-map)
- (define-key map "\C-c\C-c" #'rmail-cease-edit)
- (define-key map "\C-c\C-]" #'rmail-abort-edit)
- map))
+(defvar-keymap rmail-edit-map
+ :parent text-mode-map
+ "C-c C-c" #'rmail-cease-edit
+ "C-c C-]" #'rmail-abort-edit)
(declare-function rmail-summary-disable "rmailsum" ())
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index b23fbc3f60..b959f45250 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1480,11 +1480,10 @@ argument says to read a file name and use that file as
the inbox."
(declare-function rmail-output-read-file-name "rmailout" ())
(declare-function mail-send-and-exit "sendmail" (&optional arg))
-(defvar rmail-summary-edit-map
- (let ((map (nconc (make-sparse-keymap) text-mode-map)))
- (define-key map "\C-c\C-c" #'rmail-cease-edit)
- (define-key map "\C-c\C-]" #'rmail-abort-edit)
- map))
+(defvar-keymap rmail-summary-edit-map
+ :parent text-mode-map
+ "C-c C-c" #'rmail-cease-edit
+ "C-c C-]" #'rmail-abort-edit)
(defun rmail-summary-edit-current-message ()
"Edit the contents of this message."
@@ -1728,8 +1727,6 @@ even if the header display is currently pruned."
(if (< i n)
(rmail-summary-next-msg 1))))))
-(defalias 'rmail-summary-output-to-rmail-file 'rmail-summary-output)
-
(declare-function rmail-output-as-seen "rmailout"
(file-name &optional count noattribute from-gnus))
@@ -1875,6 +1872,9 @@ the summary is only showing a subset of messages."
(funcall sortfun reverse))
(select-window selwin))))
+(define-obsolete-function-alias 'rmail-summary-output-to-rmail-file
+ #'rmail-summary-output "29.1")
+
(provide 'rmailsum)
;;; rmailsum.el ends here
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 76ef65b343..189ad075c4 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -49,7 +49,9 @@
((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
(t "sendmail")))
- "Program used to send messages."
+ "Program used to send messages.
+If the program returns a non-zero error code, or outputs any
+text, sending is considered \"failed\" by Emacs."
:version "24.1" ; add executable-find, remove fakemail
:type 'file)
@@ -537,7 +539,7 @@ This also saves the value of `send-mail-function' via
Customize."
(when mail-personal-alias-file
(let ((modtime (file-attribute-modification-time
(file-attributes mail-personal-alias-file))))
- (or (equal mail-alias-modtime modtime)
+ (or (time-equal-p mail-alias-modtime modtime)
(setq mail-alias-modtime modtime
mail-aliases t)))))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 3f8a940382..98f46a3af5 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -520,75 +520,67 @@ string."
;; ======================================================================
;; supercite keymaps
-(defvar sc-T-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "a" #'sc-S-preferred-attribution-list)
- (define-key map "b" #'sc-T-mail-nuke-blank-lines)
- (define-key map "c" #'sc-T-confirm-always)
- (define-key map "d" #'sc-T-downcase)
- (define-key map "e" #'sc-T-electric-references)
- (define-key map "f" #'sc-T-auto-fill-region)
- (define-key map "h" #'sc-T-describe)
- (define-key map "l" #'sc-S-cite-region-limit)
- (define-key map "n" #'sc-S-mail-nuke-mail-headers)
- (define-key map "N" #'sc-S-mail-header-nuke-list)
- (define-key map "o" #'sc-T-electric-circular)
- (define-key map "p" #'sc-S-preferred-header-style)
- (define-key map "s" #'sc-T-nested-citation)
- (define-key map "u" #'sc-T-use-only-preferences)
- (define-key map "w" #'sc-T-fixup-whitespace)
- (define-key map "?" #'sc-T-describe)
- map)
- "Keymap for sub-keymap of setting and toggling functions.")
-
-(defvar sc-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "c" #'sc-cite-region)
- (define-key map "f" #'sc-mail-field-query)
- (define-key map "g" #'sc-mail-process-headers)
- (define-key map "h" #'sc-describe)
- (define-key map "i" #'sc-insert-citation)
- (define-key map "o" #'sc-open-line)
- (define-key map "r" #'sc-recite-region)
- (define-key map "\C-p" #'sc-raw-mode-toggle)
- (define-key map "u" #'sc-uncite-region)
- (define-key map "w" #'sc-insert-reference)
- (define-key map "\C-t" sc-T-keymap)
- (define-key map "?" #'sc-describe)
- map)
- "Keymap for Supercite quasi-mode.")
-
-(defvar sc-electric-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "p" #'sc-eref-prev)
- (define-key map "n" #'sc-eref-next)
- (define-key map "s" #'sc-eref-setn)
- (define-key map "j" #'sc-eref-jump)
- (define-key map "x" #'sc-eref-abort)
- (define-key map "q" #'sc-eref-abort)
- (define-key map "\r" #'sc-eref-exit)
- (define-key map "\n" #'sc-eref-exit)
- (define-key map "g" #'sc-eref-goto)
- (define-key map "?" #'describe-mode)
- (define-key map "\C-h" #'describe-mode)
- (define-key map [f1] #'describe-mode)
- (define-key map [help] #'describe-mode)
- map)
- "Keymap for `sc-electric-mode' electric references mode.")
-
-
-(defvar sc-minibuffer-local-completion-map
- (let ((map (copy-keymap minibuffer-local-completion-map)))
- (define-key map "\C-t" #'sc-toggle-fn)
- (define-key map " " #'self-insert-command)
- map)
- "Keymap for minibuffer confirmation of attribution strings.")
-
-(defvar sc-minibuffer-local-map
- (let ((map (copy-keymap minibuffer-local-map)))
- (define-key map "\C-t" #'sc-toggle-fn)
- map)
- "Keymap for minibuffer confirmation of attribution strings.")
+(defvar-keymap sc-T-keymap
+ :doc "Keymap for sub-keymap of setting and toggling functions."
+ "a" #'sc-S-preferred-attribution-list
+ "b" #'sc-T-mail-nuke-blank-lines
+ "c" #'sc-T-confirm-always
+ "d" #'sc-T-downcase
+ "e" #'sc-T-electric-references
+ "f" #'sc-T-auto-fill-region
+ "h" #'sc-T-describe
+ "l" #'sc-S-cite-region-limit
+ "n" #'sc-S-mail-nuke-mail-headers
+ "N" #'sc-S-mail-header-nuke-list
+ "o" #'sc-T-electric-circular
+ "p" #'sc-S-preferred-header-style
+ "s" #'sc-T-nested-citation
+ "u" #'sc-T-use-only-preferences
+ "w" #'sc-T-fixup-whitespace
+ "?" #'sc-T-describe)
+
+(defvar-keymap sc-mode-map
+ :doc "Keymap for Supercite quasi-mode."
+ "c" #'sc-cite-region
+ "f" #'sc-mail-field-query
+ "g" #'sc-mail-process-headers
+ "h" #'sc-describe
+ "i" #'sc-insert-citation
+ "o" #'sc-open-line
+ "r" #'sc-recite-region
+ "C-p" #'sc-raw-mode-toggle
+ "u" #'sc-uncite-region
+ "w" #'sc-insert-reference
+ "C-t" sc-T-keymap
+ "?" #'sc-describe)
+
+(defvar-keymap sc-electric-mode-map
+ :doc "Keymap for `sc-electric-mode' electric references mode."
+ "p" #'sc-eref-prev
+ "n" #'sc-eref-next
+ "s" #'sc-eref-setn
+ "j" #'sc-eref-jump
+ "x" #'sc-eref-abort
+ "q" #'sc-eref-abort
+ "RET" #'sc-eref-exit
+ "C-j" #'sc-eref-exit
+ "g" #'sc-eref-goto
+ "?" #'describe-mode
+ "C-h" #'describe-mode
+ "<f1>" #'describe-mode
+ "<help>" #'describe-mode)
+
+
+(defvar-keymap sc-minibuffer-local-completion-map
+ :doc "Keymap for minibuffer confirmation of attribution strings."
+ :parent minibuffer-local-completion-map
+ "C-t" #'sc-toggle-fn
+ "SPC" #'self-insert-command)
+
+(defvar-keymap sc-minibuffer-local-map
+ :doc "Keymap for minibuffer confirmation of attribution strings."
+ :parent minibuffer-local-map
+ "C-t" #'sc-toggle-fn)
;; ======================================================================
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 805b0820b0..2b4807ab69 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -269,11 +269,25 @@ MH-E functions."
binders)
(let* ,binders ,@body))))
+;; Emacs 24 made flet obsolete and suggested either cl-flet or
+;; cl-letf. This macro is based upon gmm-flet from Gnus.
+(defmacro mh-flet (bindings &rest body)
+ "Make temporary overriding function definitions.
+That is, temporarily rebind the functions listed in BINDINGS and then
+execute BODY. BINDINGS is a list containing one or more lists of the
+form (FUNCNAME ARGLIST BODY...), similar to defun."
+ (declare (indent 1) (debug ((&rest (sexp sexp &rest form)) &rest form)))
+ (if (fboundp 'cl-letf)
+ `(cl-letf ,(mapcar (lambda (binding)
+ `((symbol-function ',(car binding))
+ (lambda ,@(cdr binding))))
+ bindings)
+ ,@body)
+ `(flet ,bindings ,@body)))
+
(provide 'mh-acros)
;; Local Variables:
-;; no-byte-compile: t
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index f39caac893..3ceb419023 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -245,10 +245,6 @@ Blind aliases or users from /etc/passwd are not expanded."
(t
(mh-alias-ali alias))))
-(eval-and-compile
- (require 'crm nil t) ; completing-read-multiple
- (require 'multi-prompt nil t))
-
;;;###mh-autoload
(defun mh-read-address (prompt)
"Read an address from the minibuffer with PROMPT."
@@ -662,7 +658,6 @@ show buffer, the message in the show buffer doesn't match."
(provide 'mh-alias)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el
index f21b57663b..4b15b77413 100644
--- a/lisp/mh-e/mh-buffers.el
+++ b/lisp/mh-e/mh-buffers.el
@@ -75,7 +75,6 @@ The function returns the size of the final size of the log
buffer."
(provide 'mh-buffers)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index a9f6274e9d..678bffd168 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -1272,7 +1272,6 @@ discarded."
(provide 'mh-comp)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index a3a363e33f..93af525e39 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -86,7 +86,6 @@
(require 'cl-lib)
(require 'mh-buffers)
-(require 'mh-compat)
@@ -3716,7 +3715,6 @@ The background and foreground are used in the image."
(provide 'mh-e)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 09df0465ed..5b90290237 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -510,7 +510,7 @@ font-lock is done highlighting.")
nil)
;; Register mh-folder-mode as supporting which-function-mode...
-(eval-and-compile (require 'which-func nil t))
+(require 'which-func)
(when (and (boundp 'which-func-modes) (listp which-func-modes))
(add-to-list 'which-func-modes 'mh-folder-mode))
@@ -2012,7 +2012,6 @@ If MSG is nil then act on the message at point"
(provide 'mh-folder)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index f011ea47f8..ab89ef2a3d 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -366,7 +366,6 @@ Arguments are IGNORED (for `revert-buffer')."
(provide 'mh-funcs)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index c341b09683..b797000566 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -28,12 +28,11 @@
(require 'mh-e)
-(eval-and-compile
- (require 'gnus-util nil t)
- (require 'mm-bodies nil t)
- (require 'mm-decode nil t)
- (require 'mm-view nil t)
- (require 'mml nil t))
+(require 'gnus-util)
+(require 'mm-bodies)
+(require 'mm-decode)
+(require 'mm-view)
+(require 'mml)
(defun mh-gnus-local-map-property (map)
"Return a list suitable for a text property list specifying keymap MAP."
@@ -109,7 +108,6 @@ PROMPT overrides the default one used to ask user for a
file name."
;; Local Variables:
;; no-update-autoloads: t
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index 43eaeb7aa0..b7fa35a92f 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -316,7 +316,6 @@ the header."
(provide 'mh-identity)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 2c29ec3223..cc6ebfef42 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -78,7 +78,6 @@
(provide 'mh-inc)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 1f773b878a..be1b7642eb 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -540,7 +540,6 @@ See `mh-spamprobe-blocklist' for more information."
(provide 'mh-junk)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index 4e3e101231..723e5bb36c 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -864,16 +864,17 @@ Any match found replaces the text from BEGIN to END."
((stringp completion)
(if (equal word completion)
(with-output-to-temp-buffer completions-buffer
- (mh-display-completion-list
- (all-completions word choices)
- ;; The `common-substring' arg only works if it's a prefix.
- (unless (and (functionp choices)
- (let ((bounds
- (funcall choices
- word nil '(boundaries . ""))))
- (and (eq 'boundaries (car-safe bounds))
- (< 0 (cadr bounds)))))
- word)))
+ (display-completion-list
+ (completion-hilit-commonality
+ (all-completions word choices)
+ ;; The `common-substring' arg only works if it's a prefix.
+ (unless (and (functionp choices)
+ (let ((bounds
+ (funcall choices
+ word nil '(boundaries . ""))))
+ (and (eq 'boundaries (car-safe bounds))
+ (< 0 (cadr bounds)))))
+ word))))
(ignore-errors
(kill-buffer completions-buffer))
(delete-region begin end)
@@ -935,7 +936,6 @@ Otherwise, simply insert MH-INS-STRING before each line."
(provide 'mh-letter)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index 3e731e22a1..da3e5b4f35 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -325,7 +325,6 @@ The MH command pick is used to do the match."
(provide 'mh-limit)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 865f817da5..2f1b835de0 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1788,7 +1788,6 @@ initialized. Always use the command
`mh-have-file-command'.")
(provide 'mh-mime)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
index 2eec8d9160..78906b68ad 100644
--- a/lisp/mh-e/mh-print.el
+++ b/lisp/mh-e/mh-print.el
@@ -242,7 +242,6 @@ Consider using \\[mh-ps-print-msg] instead."
(provide 'mh-print)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 06381a2e0e..4b4c594286 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -526,7 +526,6 @@ comes after that."
(provide 'mh-scan)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index c5519eba0a..058ea4499f 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1411,7 +1411,7 @@ being the list of messages originally from that folder."
(when cur-msg (mh-goto-msg cur-msg t t))
(set-buffer-modified-p old-buffer-modified-flag)))
-(eval-and-compile (require 'which-func nil t))
+(require 'which-func)
;;;###mh-autoload
(defun mh-index-create-imenu-index ()
@@ -1932,7 +1932,6 @@ folder buffer."
(provide 'mh-search)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index a95c7c03d1..8339273fc9 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -996,7 +996,6 @@ removed."
(provide 'mh-seq)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index cc76b8d7e6..1731d75738 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -894,7 +894,6 @@ See also `mh-folder-mode'.
(provide 'mh-show)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index a7e9c9bd67..3babea7612 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -568,7 +568,6 @@ The function invalidates the latest ancestor that is
present."
(provide 'mh-speed)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index 139e9b74cb..2358ba4bc6 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -865,7 +865,6 @@ This function can only be used the folder is threaded."
(provide 'mh-thread)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 17df075cfa..933b3b633a 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -376,7 +376,6 @@ This button runs `mh-widen'"))
(provide 'mh-tool-bar)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index d7a92be5b5..dd662f3552 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -29,6 +29,7 @@
(require 'mh-e)
(require 'font-lock)
+(require 'mailabbrev)
;;; CL Replacements
@@ -444,10 +445,8 @@ no effect."
(setq folder (format "%s/%s/" mh-current-folder-name
(substring folder 1))))
;; XXX: Purge empty strings from the list that split-string
- ;; returns. In XEmacs, (split-string "+foo/" "/") returns
- ;; ("+foo" "") while in GNU Emacs it returns ("+foo"). In the
- ;; code it is assumed that the components list has no empty
- ;; strings.
+ ;; returns. In the code it is assumed that the components list
+ ;; has no empty strings.
(let ((components (delete "" (split-string folder "/")))
(result ()))
;; Remove .. and . from the pathname.
@@ -1009,7 +1008,6 @@ If the current line is too long truncate a part of it as
well."
(provide 'mh-utils)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index b144c58d69..d6ecd83655 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -414,7 +414,6 @@ The argument CHANGE is ignored."
(provide 'mh-xface)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/mouse.el b/lisp/mouse.el
index ddcb51aecf..bee664dc56 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,6 +1,6 @@
;;; mouse.el --- window system-independent mouse support -*- lexical-binding:
t -*-
-;; Copyright (C) 1993-1995, 1999-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware, mouse
@@ -31,8 +31,6 @@
(eval-when-compile (require 'rect))
-;;; Utility functions.
-
;; Indent track-mouse like progn.
(put 'track-mouse 'lisp-indent-function 0)
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 1464c36a91..ba95308bf6 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1569,8 +1569,9 @@ when constructing the set of constraints."
(mpc-tagbrowser-refresh)
buf))))
-(defvar tag-browser-tagtypes
- (lazy-completion-table tag-browser-tagtypes
+(define-obsolete-variable-alias 'tag-browser-tagtypes
'mpc-tag-browser-tagtypes "29.1")
+(defvar mpc-tag-browser-tagtypes
+ (lazy-completion-table mpc-tag-browser-tagtypes
(lambda ()
(append '("Playlist" "Directory")
(mpc-cmd-tagtypes)))))
@@ -1581,7 +1582,7 @@ when constructing the set of constraints."
(list
(let ((completion-ignore-case t))
(intern
- (completing-read "Tag: " tag-browser-tagtypes nil 'require-match)))))
+ (completing-read "Tag: " mpc-tag-browser-tagtypes nil
'require-match)))))
(let* ((newbuf (mpc-tagbrowser-buf tag))
(win (get-buffer-window newbuf 0)))
(if win (select-window win)
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 52b900be0c..6ffa65a2dd 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4099,11 +4099,11 @@ E.g.,
;; Put these lines uncommented in your .emacs if you want C-r to refresh
;; ange-ftp's cache whilst doing filename completion.
;;
-;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
-;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir)
+;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-reread-dir)
+;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-reread-dir)
;;;###autoload
-(defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
+(define-obsolete-function-alias 'ange-ftp-re-read-dir #'ange-ftp-reread-dir
"29.1")
;;;###autoload
(defun ange-ftp-reread-dir (&optional dir)
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 9143c7d111..43dd28ff6d 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -357,7 +357,7 @@ is utf-8"
(defvar dictionary-color-support
(condition-case nil
- (x-display-color-p)
+ (display-color-p)
(error nil))
"Determines if the Emacs has support to display color.")
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index d4fad0c61f..d6436c579b 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -22,18 +22,14 @@
;;; Commentary:
-;; This provide an interface for "dig".
+;; This provides an interface for "dig".
;;
-;; For interactive use, try M-x dig and type a hostname. Use `q' to quit
-;; dig buffer.
+;; For interactive use, try `M-x dig' and type a hostname. Use `q' to
+;; quit dig buffer.
;;
-;; For use in elisp programs, call `dig-invoke' and use
+;; For use in Emacs Lisp programs, call `dig-invoke' and use
;; `dig-extract-rr' to extract resource records.
-;;; Release history:
-
-;; 2000-10-28 posted on gnu.emacs.sources
-
;;; Code:
(defgroup dig nil
@@ -168,20 +164,21 @@ prefix, also prompt for the SERVER parameter."
(forward-line))
(dig-mode))
-;; named for consistency with query-dns in dns.el
-(defun query-dig (domain &optional
- query-type query-class query-option dig-option server)
+(defun dig-query (domain &optional
+ query-type query-class query-option dig-option server)
"Query addresses of a DOMAIN using dig.
It works by calling `dig-invoke' and `dig-extract-rr'.
Optional arguments are passed to `dig-invoke' and `dig-extract-rr'.
Returns nil for domain/class/type queries that result in no data."
-(let ((buffer (dig-invoke domain query-type query-class
- query-option dig-option server)))
- (when buffer
- (pop-to-buffer-same-window buffer)
- (let ((digger (dig-extract-rr domain query-type query-class)))
- (kill-buffer buffer)
- digger))))
+ (let ((buffer (dig-invoke domain query-type query-class
+ query-option dig-option server)))
+ (when buffer
+ (pop-to-buffer-same-window buffer)
+ (let ((digger (dig-extract-rr domain query-type query-class)))
+ (kill-buffer buffer)
+ digger))))
+
+(define-obsolete-function-alias 'query-dig #'dig-query "29.1")
(provide 'dig)
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index d70e0cf4f6..458d13fb24 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -32,7 +32,6 @@
(require 'eudc)
-(defvar eudc-hotlist-menu nil)
(defvar eudc-hotlist-list-beginning nil)
(defvar-keymap eudc-hotlist-mode-map
@@ -46,13 +45,13 @@
(define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers"
"Major mode used to edit the hotlist of servers.
-These are the special commands of this mode:
- a -- Add a new server to the list.
- d -- Delete the server at point from the list.
- s -- Select the server at point.
- t -- Transpose the server at point and the previous one
- q -- Commit the changes and quit.
- x -- Quit without committing the changes."
+These are the special commands of this mode:\\<eudc-hotlist-mode-map>
+ \\[eudc-hotlist-add-server] -- Add a new server to the list.
+ \\[eudc-hotlist-delete-server] -- Delete the server at point from the list.
+ \\[eudc-hotlist-select-server] -- Select the server at point.
+ \\[eudc-hotlist-transpose-servers] -- Transpose the server at point and
the previous one
+ \\[eudc-hotlist-quit-edit] -- Commit the changes and quit.
+ \\[kill-current-buffer] -- Quit without committing the changes."
(setq buffer-read-only t))
;;;###autoload
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 5cfd4e25ec..eb440ba614 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -48,7 +48,6 @@
(require 'wid-edit)
(require 'cl-lib)
(require 'eudc-vars)
-(eval-when-compile (require 'subr-x))
;;{{{ Internal cooking
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 4dbd5de2ef..6ed0719eca 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -64,7 +64,7 @@ The action to be taken can be further customized via
:version "28.1"
:type 'regexp)
-(defun erc--download-directory ()
+(defun eww--download-directory ()
"Return the name of the download directory.
If ~/Downloads/ exists, that will be used, and if not, the
DOWNLOAD XDG user directory will be returned. If that's
@@ -75,7 +75,7 @@ undefined, ~/Downloads/ is returned anyway."
(file-name-as-directory dir))
"~/Downloads/"))
-(defcustom eww-download-directory 'erc--download-directory
+(defcustom eww-download-directory 'eww--download-directory
"Directory where files will downloaded.
This should either be a directory name or a function (called with
no parameters) that returns a directory name."
@@ -349,6 +349,8 @@ This can also be used on the command line directly:
will start Emacs and browse the GNU web site."
(interactive)
+ (unless command-line-args-left
+ (user-error "No URL given"))
(eww (pop command-line-args-left)))
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index c7ff175e08..192c8446eb 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -442,15 +442,6 @@ If your system's ping continues until interrupted, you can
try setting
ping-program
options)))
-;; FIXME -- Needs to be a process filter
-;; (defun netstat-with-filter (filter)
-;; "Run netstat program."
-;; (interactive "sFilter: ")
-;; (netstat)
-;; (set-buffer (get-buffer "*Netstat*"))
-;; (goto-char (point-min))
-;; (delete-matching-lines filter))
-
;;;###autoload
(defun nslookup-host (host &optional name-server)
"Look up the DNS information for HOST (name or IP address).
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index 5ae2df769a..f65ef522f2 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -1552,12 +1552,8 @@ argument, which is one of the items in ITEMLIST."
(defun newsticker--remove-whitespace (string)
"Remove leading and trailing whitespace from STRING."
- ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
- ;; endlessly...
- (when (and string (stringp string))
- (replace-regexp-in-string
- "[ \t\r\n]+$" ""
- (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
+ (when (stringp string)
+ (string-trim string)))
(defun newsticker--do-forget-preformatted (item)
"Forget pre-formatted data for ITEM.
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 637f53e655..e98767ae7c 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -361,7 +361,8 @@ AGES is the list of ages that are to be shown."
(mapc (lambda (feed)
(let ((feed-name-symbol (intern (car feed))))
(mapc (lambda (item)
- (when (memq (newsticker--age item) ages)
+ (when (or (memq 'all ages)
+ (memq (newsticker--age item) ages))
(newsticker--treeview-list-add-item
item feed-name-symbol t)))
(newsticker--treeview-list-sort-items
@@ -1218,11 +1219,11 @@ Note: does not update the layout."
(newsticker--treeview-list-update t)
(newsticker--treeview-item-update)
(newsticker--treeview-tree-update-tags)
- (cond (newsticker--treeview-current-feed
- (newsticker--treeview-list-items newsticker--treeview-current-feed))
- (newsticker--treeview-current-vfeed
+ (cond (newsticker--treeview-current-vfeed
(newsticker--treeview-list-items-with-age
- (intern newsticker--treeview-current-vfeed))))
+ (intern newsticker--treeview-current-vfeed)))
+ (newsticker--treeview-current-feed
+ (newsticker--treeview-list-items
newsticker--treeview-current-feed)))
(newsticker--treeview-tree-update-highlight)
(newsticker--treeview-list-update-highlight)
(let ((cur-feed (or newsticker--treeview-current-feed
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3e780aa1a1..d033667e87 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -95,7 +95,7 @@ It is used for TCP/IP devices."
(add-to-list 'tramp-methods
`(,tramp-adb-method
(tramp-login-program ,tramp-adb-program)
- (tramp-login-args (("shell")))
+ (tramp-login-args (("-s" "%d") ("shell")))
(tramp-direct-async t)
(tramp-tmpdir "/data/local/tmp")
(tramp-default-port 5555)))
@@ -257,7 +257,7 @@ arguments to pass to the OPERATION."
(tramp-convert-file-attributes v localname id-format
(and
(tramp-adb-send-command-and-check
- v (format "%s -d -l %s"
+ v (format "%s -d -l %s | cat"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-buffer v)
@@ -310,21 +310,25 @@ arguments to pass to the OPERATION."
directory full match nosort id-format count
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
- v (format "%s -a -l %s"
+ v (format "%s -a -l %s | cat"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument localname)))
;; We insert also filename/. and filename/.., because "ls"
- ;; doesn't. Looks like it does include them in toybox, since
- ;; Android 6.
+ ;; doesn't on some file systems, like "sdcard".
(unless (re-search-backward "\\.$" nil t)
(narrow-to-region (point-max) (point-max))
(tramp-adb-send-command
- v (format "%s -d -a -l %s %s"
+ v (format "%s -d -a -l %s %s | cat"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument
(tramp-compat-file-name-concat localname "."))
(tramp-shell-quote-argument
(tramp-compat-file-name-concat localname ".."))))
+ (replace-regexp-in-region
+ (regexp-quote
+ (tramp-compat-file-name-unquote
+ (file-name-as-directory localname)))
+ "" (point-min))
(widen)))
(tramp-adb-sh-fix-ls-output)
(tramp-do-parse-file-attributes-with-ls v))))
@@ -451,7 +455,7 @@ Emacs dired can't find files."
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
(tramp-adb-send-command
- v (format "%s -a %s"
+ v (format "%s -a %s | cat"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument localname)))
(mapcar
@@ -462,9 +466,8 @@ Emacs dired can't find files."
(with-current-buffer (tramp-get-buffer v)
(delete-dups
(append
- ;; In older Android versions, "." and ".." are not
- ;; included. In newer versions (toybox, since Android 6)
- ;; they are. We fix this by `delete-dups'.
+ ;; On some file systems like "sdcard", "." and ".." are
+ ;; not included. We fix this by `delete-dups'.
'("." "..")
(delq
nil
@@ -517,34 +520,39 @@ Emacs dired can't find files."
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(tramp-skeleton-write-region start end filename append visit lockname
mustbenew
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok)
- (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
- (let (create-lockfiles)
- (write-region start end tmpfile append 'no-message))
- (with-tramp-progress-reporter
- v 3 (format-message
- "Moving tmp file `%s' to `%s'" tmpfile filename)
- (unwind-protect
- (unless (tramp-adb-execute-adb-command
- v "push" tmpfile (tramp-compat-file-name-unquote
localname))
- (tramp-error v 'file-error "Cannot write: `%s'" filename))
- (delete-file tmpfile))))))
+ ;; If `start' is the empty string, it is likely that a temporary
+ ;; file is created. Do it directly.
+ (if (and (stringp start) (string-empty-p start))
+ (tramp-adb-send-command-and-check
+ v (format "echo -n \"\" >%s" (tramp-shell-quote-argument localname)))
+
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok)
+ (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Moving tmp file `%s' to `%s'" tmpfile filename)
+ (unwind-protect
+ (unless (tramp-adb-execute-adb-command
+ v "push" tmpfile
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error v 'file-error "Cannot write: `%s'" filename))
+ (delete-file tmpfile)))))))
(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; ADB shell does not support "chmod -h".
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ ;; ADB shell does not support "chmod -h".
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-adb-send-command-and-check
v (format "chmod %o %s" mode (tramp-shell-quote-argument localname))))))
(defun tramp-adb-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
@@ -827,7 +835,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@@ -872,7 +880,10 @@ implementation will be used."
(signal 'wrong-type-argument (list #'symbolp coding)))
(when (eq connection-type t)
(setq connection-type 'pty))
- (unless (memq connection-type '(nil pipe pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (eq filter t) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -923,102 +934,99 @@ implementation will be used."
name1 (format "%s<%d>" name i)))
(setq name name1)
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise,
- ;; `make-process' could be called on the local
- ;; host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save
- ;; BUFFER contents. Clear also the
- ;; modification time; otherwise we might be
- ;; interrupted by `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-adb-maybe-open-connection',
- ;; in order to cleanup the prompt afterwards.
- (tramp-adb-maybe-open-connection v)
- (delete-region (point-min) (point-max))
- ;; Send the command.
- (setq p (tramp-get-connection-process v))
- (tramp-adb-send-command v command nil t) ; nooutput
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- (process-put p 'remote-command orig-command)
- (tramp-set-connection-property
- p "remote-command" orig-command)
- ;; Set query flag and process marker for
- ;; this process. We ignore errors,
- ;; because the process could have finished
- ;; already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point))
- ;; We must flush them here already;
- ;; otherwise `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property
- v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Read initial output. Remove the
- ;; first line, which is the command
- ;; echo.
- (unless (eq filter t)
- (while
- (progn
- (goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
- (tramp-accept-process-output p 0))
- (delete-region (point-min) (point)))
- ;; Provide error buffer. This shows
- ;; only initial error messages; messages
- ;; arriving later on will be inserted
- ;; when the process is deleted. The
- ;; temporary file will exist until the
- ;; process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit nil nil 'replace))
- (delete-file remote-tmpstderr))))
- ;; Return process.
- p))))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))))))))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification
+ ;; time; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection',
+ ;; in order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (delete-region (point-min) (point-max))
+ ;; Send the command.
+ (setq p (tramp-get-connection-process v))
+ (tramp-adb-send-command v command nil t) ; nooutput
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors, because
+ ;; the process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point))
+ ;; We must flush them here already;
+ ;; otherwise `rename-file', `delete-file'
+ ;; or `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property
+ v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; Read initial output. Remove the first
+ ;; line, which is the command echo.
+ (unless (eq filter t)
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "[\n]" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point)))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages
+ ;; arriving later on will be inserted when
+ ;; the process is deleted. The temporary
+ ;; file will exist until the process is
+ ;; deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit nil nil 'replace))
+ (delete-file remote-tmpstderr))))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
@@ -1235,9 +1243,8 @@ connection if a previous connection has died for some
reason."
(with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
(process-connection-type tramp-process-connection-type)
- (args (if (> (length host) 0)
- (list "-s" device "shell")
- (list "shell")))
+ (args (tramp-expand-args
+ vec 'tramp-login-args ?d (or device "")))
(p (let ((default-directory
tramp-compat-temporary-file-directory))
(apply #'start-process (tramp-get-connection-name vec) buf
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index b224494110..548999ca1d 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -240,7 +240,7 @@ It must be supported by libarchive(3).")
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-archive-handle-file-executable-p)
- (file-exists-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-archive-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-archive-handle-file-local-copy)
(file-locked-p . ignore)
@@ -322,7 +322,11 @@ arguments to pass to the OPERATION."
(inhibit-file-name-operation operation))
(apply operation args))))
-;;;###autoload
+;; Starting with Emacs 29, `tramp-archive-file-name-handler' is
+;; autoloaded. But it must still be in tramp-loaddefs.el for older
+;; Emacsen.
+;;;###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.
First arg specifies the OPERATION, second arg ARGS is a list of
@@ -645,6 +649,10 @@ offered."
"Like `file-executable-p' for file archives."
(file-executable-p (tramp-archive-gvfs-file-name filename)))
+(defun tramp-archive-handle-file-exists-p (filename)
+ "Like `file-exists-p' for file archives."
+ (file-exists-p (tramp-archive-gvfs-file-name filename)))
+
(defun tramp-archive-handle-file-local-copy (filename)
"Like `file-local-copy' for file archives."
(file-local-copy (tramp-archive-gvfs-file-name filename)))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 68f4fda475..289df2f9aa 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -48,7 +48,7 @@
;; - The key is a process. These are temporary properties related to
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
-;; the time stamp a command has been sent to the remote process.
+;; the timestamp a command has been sent to the remote process.
;;
;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
@@ -75,8 +75,9 @@
;;; Code:
-(require 'tramp)
-(autoload 'time-stamp-string "time-stamp")
+(require 'tramp-compat)
+(require 'tramp-loaddefs)
+(require 'time-stamp)
;;; -- Cache --
@@ -133,11 +134,7 @@ If KEY is `tramp-cache-undefined', don't create anything,
and return nil."
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(let* ((hash (tramp-get-hash-table key))
(cached (and (hash-table-p hash) (gethash property hash)))
(cached-at (and (consp cached) (format-time-string "%T" (car cached))))
@@ -161,7 +158,8 @@ Return DEFAULT if not set."
(tramp-message
key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
- file property value remote-file-name-inhibit-cache cache-used cached-at)
+ (tramp-file-name-localname key)
+ property value remote-file-name-inhibit-cache cache-used cached-at)
;; For analysis purposes, count the number of getting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
@@ -181,15 +179,12 @@ Return DEFAULT if not set."
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(let ((hash (tramp-get-hash-table key)))
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
- (tramp-message key 8 "%s %s %s" file property value)
+ (tramp-message
+ key 8 "%s %s %s" (tramp-file-name-localname key) property value)
;; For analysis purposes, count the number of setting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
@@ -214,13 +209,9 @@ Return VALUE."
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(remhash property (tramp-get-hash-table key))
- (tramp-message key 8 "%s %s" file property)
+ (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property)
(when (>= tramp-verbose 10)
(let ((var (intern (concat "tramp-cache-set-count-" property))))
(makunbound var))))
@@ -232,10 +223,7 @@ Return VALUE."
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) file
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
(when (string-match-p
"^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
@@ -245,14 +233,10 @@ Return VALUE."
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
- (let* ((file (tramp-run-real-handler #'directory-file-name (list file)))
- (truename (tramp-get-file-property key file "file-truename")))
+ (let ((truename (tramp-get-file-property key file "file-truename")))
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) file
- (tramp-file-name-hop key) nil)
- (tramp-message key 8 "%s" file)
+ (setq key (tramp-file-name-unify key file))
+ (tramp-message key 8 "%s" (tramp-file-name-localname key))
(remhash key tramp-cache-data)
;; Remove file properties of symlinks.
(when (and (stringp truename)
@@ -265,9 +249,8 @@ Return VALUE."
(defun tramp-flush-directory-properties (key directory)
"Remove all properties of DIRECTORY in the cache context of KEY.
Remove also properties of all files in subdirectories."
- (setq directory (tramp-compat-file-name-unquote directory))
- (let* ((directory (tramp-run-real-handler
- #'directory-file-name (list directory)))
+ (let* ((directory
+ (directory-file-name (tramp-compat-file-name-unquote directory)))
(truename (tramp-get-file-property key directory "file-truename")))
(tramp-message key 8 "%s" directory)
(dolist (key (hash-table-keys tramp-cache-data))
@@ -288,6 +271,7 @@ Remove also properties of all files in subdirectories."
;; not show proper directory contents when a file has been copied or
;; deleted before. We must apply `save-match-data', because it would
;; corrupt other packages otherwise (reported from org).
+;;;###tramp-autoload
(defun tramp-flush-file-function ()
"Flush all Tramp cache properties from `buffer-file-name'.
This is suppressed for temporary buffers."
@@ -299,8 +283,8 @@ This is suppressed for temporary buffers."
default-directory))
(tramp-verbose 0))
(when (tramp-tramp-file-p bfn)
- (with-parsed-tramp-file-name bfn nil
- (tramp-flush-file-properties v localname)))))))
+ (tramp-flush-file-properties
+ (tramp-dissect-file-name bfn) (tramp-file-local-name bfn)))))))
(add-hook 'before-revert-hook #'tramp-flush-file-function)
(add-hook 'eshell-pre-command-hook #'tramp-flush-file-function)
@@ -314,6 +298,61 @@ This is suppressed for temporary buffers."
(remove-hook 'kill-buffer-hook
#'tramp-flush-file-function)))
+;;;###tramp-autoload
+(defmacro with-tramp-file-property (key file property &rest body)
+ "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
+FILE must be a local file name on a connection identified via KEY."
+ (declare (indent 3) (debug t))
+ `(let ((value (tramp-get-file-property
+ ,key ,file ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass @body as parameter to
+ ;; `tramp-set-file-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-file-property ,key ,file ,property value))
+ value))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-file-property (key file property &rest body)
+ "Save PROPERTY, run BODY, reset PROPERTY.
+Preserve timestamps."
+ (declare (indent 3) (debug t))
+ `(progn
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq ,key (tramp-file-name-unify ,key ,file))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (cached (and (hash-table-p hash) (gethash ,property hash))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (if (consp cached)
+ (puthash ,property cached hash)
+ (remhash ,property hash))))))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-file-properties (key file properties &rest body)
+ "Save PROPERTIES, run BODY, reset PROPERTIES.
+PROPERTIES is a list of file properties (strings).
+Preserve timestamps."
+ (declare (indent 3) (debug t))
+ `(progn
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq ,key (tramp-file-name-unify ,key ,file))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (values
+ (and (hash-table-p hash)
+ (mapcar
+ (lambda (property) (cons property (gethash property hash)))
+ ,properties))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (dolist (value values)
+ (if (consp (cdr value))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash)))))))
+
;;; -- Properties --
;;;###tramp-autoload
@@ -396,6 +435,57 @@ used to cache connection properties of the local machine."
(or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
+;;;###tramp-autoload
+(defmacro with-tramp-connection-property (key property &rest body)
+ "Check in Tramp for property PROPERTY, otherwise execute BODY and set."
+ (declare (indent 2) (debug t))
+ `(let ((value (tramp-get-connection-property
+ ,key ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass ,@body as parameter to
+ ;; `tramp-set-connection-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-connection-property ,key ,property value))
+ value))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-connection-property (key property &rest body)
+ "Save PROPERTY, run BODY, reset PROPERTY."
+ (declare (indent 2) (debug t))
+ `(progn
+ (setq ,key (tramp-file-name-unify ,key))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (cached (and (hash-table-p hash)
+ (gethash ,property hash tramp-cache-undefined))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (if (not (eq cached tramp-cache-undefined))
+ (puthash ,property cached hash)
+ (remhash ,property hash))))))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-connection-properties (key properties &rest body)
+ "Save PROPERTIES, run BODY, reset PROPERTIES.
+PROPERTIES is a list of file properties (strings)."
+ (declare (indent 2) (debug t))
+ `(progn
+ (setq ,key (tramp-file-name-unify ,key))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (values
+ (mapcar
+ (lambda (property)
+ (cons property (gethash property hash tramp-cache-undefined)))
+ ,properties)))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (dolist (value values)
+ (if (not (eq (cdr value) tramp-cache-undefined))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash)))))))
+
;;;###tramp-autoload
(defun tramp-cache-print (table)
"Print hash table TABLE."
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 5c8012e553..f7704864ec 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -139,7 +139,7 @@ When called interactively, a Tramp connection has to be
selected."
(when (bufferp buf) (kill-buffer buf)))
;; Flush file cache.
- (tramp-flush-directory-properties vec "")
+ (tramp-flush-directory-properties vec "/")
;; Flush connection cache.
(tramp-flush-connection-properties vec)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index e813533270..b83f9f0724 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -320,6 +320,16 @@ CONDITION can also be a list of error conditions."
(lambda (string1 string2)
(eq t (compare-strings string1 nil nil string2 nil nil t)))))
+;; Function `auth-source-netrc-parse-all' is new in Emacs 29.1.
+;; `netrc-parse' has been obsoleted in parallel.
+(defalias 'tramp-compat-auth-source-netrc-parse-all
+ (if (fboundp 'auth-source-netrc-parse-all)
+ #'auth-source-netrc-parse-all
+ (lambda (&optional file)
+ (declare-function netrc-parse "netrc")
+ (autoload 'netrc-parse "netrc")
+ (netrc-parse file))))
+
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 4fcd132ab0..7f38529262 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -824,24 +824,21 @@ WILDCARD is not supported."
(defun tramp-crypt-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-modes
(tramp-crypt-encrypt-file-name filename) mode flag))))
(defun tramp-crypt-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-times
(tramp-crypt-encrypt-file-name filename) time flag))))
(defun tramp-crypt-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-set-file-uid-gid
(tramp-crypt-encrypt-file-name filename) uid gid))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 2f97b2cb91..0b40ff867f 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -960,6 +960,15 @@ The global value will always be nil; it is bound where
needed.")
;; File name primitives.
+(defun tramp-gvfs-info (filename &optional arg)
+ "Check FILENAME via `gvfs-info'.
+Set file property \"file-exists-p\" with the result."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-set-file-property
+ v localname "file-exists-p"
+ (tramp-gvfs-send-command
+ v "gvfs-info" arg (tramp-gvfs-url-file-name filename)))))
+
(defun tramp-gvfs-do-copy-or-rename-file
(op filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
@@ -1046,12 +1055,9 @@ file names."
;; code in case of direct copy/move. Apply
;; sanity checks.
(or (not equal-remote)
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name newname))
+ (tramp-gvfs-info newname)
(eq op 'copy)
- (not (tramp-gvfs-send-command
- v "gvfs-info"
- (tramp-gvfs-url-file-name filename)))))
+ (not (tramp-gvfs-info filename))))
(if (or (not equal-remote)
(and equal-remote
@@ -1111,8 +1117,9 @@ file names."
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
- (unless (tramp-gvfs-send-command
- v "gvfs-rm" (tramp-gvfs-url-file-name directory))
+ (unless (and (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name directory))
+ (not (tramp-gvfs-info directory)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -1125,8 +1132,9 @@ file names."
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
- (unless (tramp-gvfs-send-command
- v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ (unless (and (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ (not (tramp-gvfs-info filename)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -1239,10 +1247,8 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(if file-system " system" "") localname)
;; Send command.
(if file-system
- (tramp-gvfs-send-command
- v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name filename)))
+ (tramp-gvfs-info filename "--filesystem")
+ (tramp-gvfs-info filename))
;; Parse output.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -1547,8 +1553,10 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(make-directory ldir parents))
;; Just do it.
(or (when-let ((mkdir-succeeded
- (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))))
+ (and
+ (tramp-gvfs-send-command
+ v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (tramp-gvfs-info dir))))
(set-file-modes dir (default-file-modes))
mkdir-succeeded)
(and parents (file-directory-p dir))
@@ -1582,16 +1590,14 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint32"
(tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string
mode))))
(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint64"
(tramp-gvfs-url-file-name filename) "time::modified"
@@ -1644,8 +1650,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (natnump uid)
(tramp-gvfs-set-attribute
v "-t" "uint32"
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 172933859c..a2b675cf88 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1113,7 +1113,8 @@ component is used as the target of the symlink."
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target (tramp-file-local-name (expand-file-name target))))
;; There could be a cyclic link.
- (tramp-flush-file-properties v target))
+ (tramp-flush-file-properties
+ v (expand-file-name target (tramp-file-local-name default-directory))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@@ -1465,12 +1466,11 @@ of."
(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; We need "chmod -h" when the flag is set.
- (when (or (not (eq flag 'nofollow))
- (not (file-symlink-p filename))
- (tramp-get-remote-chmod-h v))
- (tramp-flush-file-properties v localname)
+ ;; We need "chmod -h" when the flag is set.
+ (when (or (not (eq flag 'nofollow))
+ (not (file-symlink-p filename))
+ (tramp-get-remote-chmod-h (tramp-dissect-file-name filename)))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
v
@@ -1482,9 +1482,8 @@ of."
(defun tramp-sh-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-get-remote-touch v)
- (tramp-flush-file-properties v localname)
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
@@ -1543,9 +1542,9 @@ ID-FORMAT valid values are `string' and `integer'."
;; another implementation, see `dired-do-chown'. OTOH, it is mostly
;; working with su(do)? when it is needed, so it shall succeed in
;; the majority of cases.
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name filename nil
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
(if (and (zerop (user-uid)) (tramp-local-host-p v))
;; If we are root on the local host, we can do it directly.
(tramp-set-file-uid-gid localname uid gid)
@@ -1767,10 +1766,11 @@ ID-FORMAT valid values are `string' and `integer'."
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (tramp-compat-string-search "/" filename)
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (when (and (not (tramp-compat-string-search "/" filename))
+ (tramp-connectable-p v))
+ (all-completions
+ filename
(with-tramp-file-property v localname "file-name-all-completions"
(let (result)
;; Get a list of directories and files, including reliably
@@ -2197,6 +2197,8 @@ the uid and gid from FILENAME."
(file-name-directory (concat prefix localname2)))
(or (file-directory-p (concat prefix localname2))
(file-writable-p (concat prefix localname2))))
+ (with-parsed-tramp-file-name prefix nil
+ (tramp-flush-file-properties v localname2))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
ok-if-already-exists keep-date preserve-uid-gid)
@@ -2406,52 +2408,52 @@ The method used must be an out-of-band method."
(with-temp-buffer
(unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; The default directory must be remote.
- (let ((default-directory
- (file-name-directory (if v1 filename newname)))
- (process-environment (copy-sequence process-environment)))
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
- (when copy-env
- (tramp-message
- v 6 "%s=\"%s\""
- (car copy-env) (string-join (cdr copy-env) " "))
- (setenv (car copy-env) (string-join (cdr copy-env) " ")))
- (setq
- copy-args
- (append
- copy-args
- (if remote-copy-program
- (list (if v1 (concat ">" target) (concat "<" source)))
- (list source target)))
- ;; Use an asynchronous process. By this, password
- ;; can be handled. We don't set a timeout, because
- ;; the copying of large files can last longer than
- ;; 60 secs.
- p (let ((default-directory
- tramp-compat-temporary-file-directory))
- (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- copy-program copy-args)))
- (tramp-message v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
-
- ;; We must adapt `tramp-local-end-of-line' for sending
- ;; the password. Also, we indicate that perhaps several
- ;; password prompts might appear.
- (let ((tramp-local-end-of-line tramp-rsh-end-of-line)
- (tramp-password-prompt-not-unique (and v1 v2)))
- (tramp-process-actions
- p v nil tramp-actions-copy-out-of-band)))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; The default directory must be remote.
+ (let ((default-directory
+ (file-name-directory (if v1 filename newname)))
+ (process-environment (copy-sequence process-environment)))
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+ (when copy-env
+ (tramp-message
+ v 6 "%s=\"%s\""
+ (car copy-env) (string-join (cdr copy-env) " "))
+ (setenv (car copy-env) (string-join (cdr copy-env) " ")))
+ (setq
+ copy-args
+ (append
+ copy-args
+ (if remote-copy-program
+ (list (if v1 (concat ">" target) (concat "<" source)))
+ (list source target)))
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled. We don't set a timeout, because
+ ;; the copying of large files can last longer than 60
+ ;; secs.
+ p (let ((default-directory
+ tramp-compat-temporary-file-directory))
+ (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ copy-program copy-args)))
+ (tramp-message v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; We must adapt `tramp-local-end-of-line' for sending
+ ;; the password. Also, we indicate that perhaps
+ ;; several password prompts might appear.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line)
+ (tramp-password-prompt-not-unique (and v1 v2)))
+ (tramp-process-actions
+ p v nil tramp-actions-copy-out-of-band))))
;; Clear the remote prompt.
(when (and remote-copy-program
@@ -2510,12 +2512,12 @@ The method used must be an out-of-band method."
"Like `delete-file' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(tramp-barf-unless-okay
v (format "rm -f %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename))))
+ "Couldn't delete %s" filename))
+ (tramp-flush-file-properties v localname)))
;; Dired.
@@ -2840,7 +2842,10 @@ implementation will be used."
(signal 'wrong-type-argument (list #'symbolp coding)))
(when (eq connection-type t)
(setq connection-type 'pty))
- (unless (memq connection-type '(nil pipe pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (eq filter t) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -2966,102 +2971,102 @@ implementation will be used."
name1 (format "%s<%d>" name i)))
(setq name name1)
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise,
- ;; `make-process' could be called on the local
- ;; host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save
- ;; BUFFER contents. Clear also the
- ;; modification time; otherwise we might be
- ;; interrupted by `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point-max))
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification
+ ;; time; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (mark (point-max))
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ (catch 'suppress
+ ;; Set the pid of the remote shell. This
+ ;; is needed when sending signals
+ ;; remotely.
+ (let ((pid
+ (tramp-send-command-and-read v "echo $$")))
+ (setq p (tramp-get-connection-process v))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property
+ p "remote-pid" pid))
+ ;; Disable carriage return to newline
+ ;; translation. This does not work on
+ ;; macOS, see Bug#50748.
+ (when (and (memq connection-type '(nil pipe))
+ (not
+ (tramp-check-remote-uname v "Darwin")))
+ (tramp-send-command v "stty -icrnl"))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could
+ ;; have trashed the connection buffer.
+ ;; Remove this.
+ (widen)
+ (delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
- (catch 'suppress
- ;; Set the pid of the remote shell. This is
- ;; needed when sending signals remotely.
- (let ((pid
- (tramp-send-command-and-read v "echo $$")))
- (setq p (tramp-get-connection-process v))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property
- p "remote-pid" pid))
- ;; Disable carriage return to newline
- ;; translation. This does not work on
- ;; macOS, see Bug#50748.
- (when (and (memq connection-type '(nil pipe))
- (not
- (tramp-check-remote-uname v
"Darwin")))
- (tramp-send-command v "stty -icrnl"))
- ;; `tramp-maybe-open-connection' and
- ;; `tramp-send-command-and-read' could have
- ;; trashed the connection buffer. Remove this.
- (widen)
- (delete-region mark (point-max))
- (narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ;
nooutput
- ;; Check, whether a pty is associated.
- (unless (process-get p 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'"
- name))))
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- (process-put p 'remote-command orig-command)
- (tramp-set-connection-property
- p "remote-command" orig-command)
- ;; Set query flag and process marker for
- ;; this process. We ignore errors,
- ;; because the process could have finished
- ;; already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; We must flush them here already;
- ;; otherwise `delete-file' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Kill stderr process and delete named pipe.
- (when (bufferp stderr)
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (ignore-errors
- (while (accept-process-output
- (get-buffer-process stderr) 0 nil t))
- (delete-process (get-buffer-process stderr)))
- (ignore-errors
- (delete-file remote-tmpstderr)))))
- ;; Return process.
- p)))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))))))))))))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (process-get p 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'"
+ name))))
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors, because
+ ;; the process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; We must flush them here already;
+ ;; otherwise `delete-file' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Kill stderr process and delete named pipe.
+ (when (bufferp stderr)
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (ignore-errors
+ (while (accept-process-output
+ (get-buffer-process stderr) 0 nil t))
+ (delete-process (get-buffer-process stderr)))
+ (ignore-errors
+ (delete-file remote-tmpstderr)))))
+ ;; Return process.
+ p)))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -3242,7 +3247,7 @@ implementation will be used."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@@ -3265,6 +3270,9 @@ implementation will be used."
(condition-case err
(cond
+ ;; Empty file.
+ ((zerop size))
+
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
(tramp-method-out-of-band-p v size))
@@ -3280,6 +3288,11 @@ implementation will be used."
v (format rem-enc (tramp-shell-quote-argument localname))
"Encoding remote file failed"))
+ ;; Check error. `rem-enc' could be a pipe, which doesn't
+ ;; flag the error in the first command.
+ (when (zerop (buffer-size (tramp-get-buffer v)))
+ (tramp-error v 'file-error' "Encoding remote file failed"))
+
(with-tramp-progress-reporter
v 3 (format-message
"Decoding local file `%s' with `%s'" tmpfile loc-dec)
@@ -3334,194 +3347,203 @@ implementation will be used."
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(tramp-skeleton-write-region start end filename append visit lockname
mustbenew
- (if (and (tramp-local-host-p v)
- ;; `file-writable-p' calls `file-expand-file-name'. We
- ;; cannot use `tramp-run-real-handler' therefore.
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))
- ;; Short track: if we are on the local host, we can run directly.
- (let ((create-lockfiles (not file-locked)))
- (write-region start end localname append 'no-message lockname))
-
- (let* ((modes (tramp-default-file-modes
- filename (and (eq mustbenew 'excl) 'nofollow)))
- ;; We use this to save the value of
- ;; `last-coding-system-used' after writing the tmp file.
- ;; At the end of the function, we set
- ;; `last-coding-system-used' to this saved value. This
- ;; way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose
- ;; this variable. This approach was snarfed from
- ;; ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really
- ;; needed if we use an encoding function, but currently
- ;; we use it always because this makes the logic simpler.
- ;; We must also set `temporary-file-directory', because
- ;; it could point to a remote directory.
- (temporary-file-directory
- tramp-compat-temporary-file-directory)
- (tmpfile (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename))))
-
- ;; If `append' is non-nil, we copy the file locally, and let
- ;; the native `write-region' implementation do the job.
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok))
-
- ;; We say `no-message' here because we don't want the visited
- ;; file modtime data to be clobbered from the temp file. We
- ;; call `set-visited-file-modtime' ourselves later on. We
- ;; must ensure that `file-coding-system-alist' matches
- ;; `tmpfile'.
- (let ((file-coding-system-alist
- (tramp-find-file-name-coding-system-alist filename tmpfile))
- create-lockfiles)
- (condition-case err
- (write-region start end tmpfile append 'no-message)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Now, `last-coding-system-used' has the right value.
- ;; Remember it.
- (setq coding-system-used last-coding-system-used))
-
- ;; The permissions of the temporary file should be set. If
- ;; FILENAME does not exist (eq modes nil) it has been renamed
- ;; to the backup file. This case `save-buffer' handles
- ;; permissions. Ensure that it is still readable.
- (when modes
- (set-file-modes tmpfile (logior (or modes 0) #o0400)))
-
- ;; This is a bit lengthy due to the different methods possible
- ;; for file transfer. First, we check whether the method uses
- ;; an scp program. If so, we call it. Otherwise, both
- ;; encoding and decoding command must be specified. However,
- ;; if the method _also_ specifies an encoding function, then
- ;; that is used for encoding the contents of the tmp file.
- (let* ((size (file-attribute-size (file-attributes tmpfile)))
- (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
- (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
- (cond
- ;; `copy-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (tramp-method-out-of-band-p v size))
- (if (and (not (stringp start))
- (= (or end (point-max)) (point-max))
- (= (or start (point-min)) (point-min))
- (tramp-get-method-parameter
- v 'tramp-copy-keep-tmpfile))
- (progn
- (setq tramp-temp-buffer-file-name tmpfile)
- (condition-case err
- ;; We keep the local file for performance
- ;; reasons, useful for "rsync".
- (copy-file tmpfile filename t)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
- (setq tramp-temp-buffer-file-name nil)
- ;; Don't rename, in order to keep context in SELinux.
+ ;; If `start' is the empty string, it is likely that a temporary
+ ;; file is created. Do it directly.
+ (if (and (stringp start) (string-empty-p start))
+ (tramp-send-command
+ v (format "cat <%s >%s"
+ (tramp-get-remote-null-device v)
+ (tramp-shell-quote-argument localname)))
+
+ ;; Short track: if we are on the local host, we can run directly.
+ (if (and (tramp-local-host-p v)
+ ;; `file-writable-p' calls `file-expand-file-name'. We
+ ;; cannot use `tramp-run-real-handler' therefore.
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))
+ (let ((create-lockfiles (not file-locked)))
+ (write-region start end localname append 'no-message lockname))
+
+ (let* ((modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp
+ ;; file. At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic
+ ;; simpler. We must also set
+ ;; `temporary-file-directory', because it could point
+ ;; to a remote directory.
+ (temporary-file-directory
+ tramp-compat-temporary-file-directory)
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
+
+ ;; If `append' is non-nil, we copy the file locally, and let
+ ;; the native `write-region' implementation do the job.
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
+
+ ;; We say `no-message' here because we don't want the
+ ;; visited file modtime data to be clobbered from the temp
+ ;; file. We call `set-visited-file-modtime' ourselves later
+ ;; on. We must ensure that `file-coding-system-alist'
+ ;; matches `tmpfile'.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist filename tmpfile))
+ create-lockfiles)
+ (condition-case err
+ (write-region start end tmpfile append 'no-message)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Now, `last-coding-system-used' has the right value.
+ ;; Remember it.
+ (setq coding-system-used last-coding-system-used))
+
+ ;; The permissions of the temporary file should be set. If
+ ;; FILENAME does not exist (eq modes nil) it has been
+ ;; renamed to the backup file. This case `save-buffer'
+ ;; handles permissions. Ensure that it is still readable.
+ (when modes
+ (set-file-modes tmpfile (logior (or modes 0) #o0400)))
+
+ ;; This is a bit lengthy due to the different methods
+ ;; possible for file transfer. First, we check whether the
+ ;; method uses an scp program. If so, we call it.
+ ;; Otherwise, both encoding and decoding command must be
+ ;; specified. However, if the method _also_ specifies an
+ ;; encoding function, then that is used for encoding the
+ ;; contents of the tmp file.
+ (let* ((size (file-attribute-size (file-attributes tmpfile)))
+ (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
+ (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
+ (cond
+ ;; `copy-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (tramp-method-out-of-band-p v size))
+ (if (and (not (stringp start))
+ (= (or end (point-max)) (point-max))
+ (= (or start (point-min)) (point-min))
+ (tramp-get-method-parameter
+ v 'tramp-copy-keep-tmpfile))
+ (progn
+ (setq tramp-temp-buffer-file-name tmpfile)
+ (condition-case err
+ ;; We keep the local file for performance
+ ;; reasons, useful for "rsync".
+ (copy-file tmpfile filename t)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
+ (setq tramp-temp-buffer-file-name nil)
+ ;; Don't rename, in order to keep context in SELinux.
+ (unwind-protect
+ (copy-file tmpfile filename t)
+ (delete-file tmpfile))))
+
+ ;; Use inline file transfer.
+ (rem-dec
+ ;; Encode tmpfile.
(unwind-protect
- (copy-file tmpfile filename t)
- (delete-file tmpfile))))
-
- ;; Use inline file transfer.
- (rem-dec
- ;; Encode tmpfile.
- (unwind-protect
- (with-temp-buffer
- (set-buffer-multibyte nil)
- ;; Use encoding function or command.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Encoding local file `%s' using `%s'"
- tmpfile loc-enc)
- (if (functionp loc-enc)
- ;; The following `let' is a workaround for the
- ;; base64.el that comes with pgnus-0.84. If
- ;; both of the following conditions are
- ;; satisfied, it tries to write to a local
- ;; file in default-directory, but at this
- ;; point, default-directory is remote.
- ;; (`call-process-region' can't write to
- ;; remote files, it seems.) The file in
- ;; question is a tmp file anyway.
- (let ((coding-system-for-read 'binary)
- (default-directory
- tramp-compat-temporary-file-directory))
- (insert-file-contents-literally tmpfile)
- (funcall loc-enc (point-min) (point-max)))
-
- (unless (zerop (tramp-call-local-coding-command
- loc-enc tmpfile t))
- (tramp-error
- v 'file-error
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed")
- filename loc-enc))))
-
- ;; Send buffer into remote decoding command which
- ;; writes to remote file. Because this happens on
- ;; the remote host, we cannot use the function.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Decoding remote file `%s' using `%s'"
- filename rem-dec)
- (goto-char (point-max))
- (unless (bolp) (newline))
- (tramp-barf-unless-okay
- v
- (format
- (concat rem-dec " <<'%s'\n%s%s")
- (tramp-shell-quote-argument localname)
- tramp-end-of-heredoc
- (buffer-string)
- tramp-end-of-heredoc)
- "Couldn't write region to `%s', decode using `%s' failed"
- filename rem-dec)
- ;; When `file-precious-flag' is set, the region is
- ;; written to a temporary file. Check that the
- ;; checksum is equal to that from the local tmpfile.
- (when file-precious-flag
- (erase-buffer)
- (and
- ;; cksum runs locally, if possible.
- (zerop (tramp-call-process v "cksum" tmpfile t))
- ;; cksum runs remotely.
- (tramp-send-command-and-check
- v
- (format
- "cksum <%s"
- (tramp-shell-quote-argument localname)))
- ;; ... they are different.
- (not
- (string-equal
- (buffer-string)
- (tramp-get-buffer-string (tramp-get-buffer v))))
- (tramp-error
- v 'file-error
- "Couldn't write region to `%s', decode using `%s'
failed"
- filename rem-dec)))))
-
- ;; Save exit.
- (delete-file tmpfile)))
-
- ;; That's not expected.
- (t
- (tramp-error
- v 'file-error
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program")
- method))))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ ;; Use encoding function or command.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Encoding local file `%s' using `%s'"
+ tmpfile loc-enc)
+ (if (functionp loc-enc)
+ ;; The following `let' is a workaround for
+ ;; the base64.el that comes with pgnus-0.84.
+ ;; If both of the following conditions are
+ ;; satisfied, it tries to write to a local
+ ;; file in default-directory, but at this
+ ;; point, default-directory is remote.
+ ;; (`call-process-region' can't write to
+ ;; remote files, it seems.) The file in
+ ;; question is a tmp file anyway.
+ (let ((coding-system-for-read 'binary)
+ (default-directory
+ tramp-compat-temporary-file-directory))
+ (insert-file-contents-literally tmpfile)
+ (funcall loc-enc (point-min) (point-max)))
+
+ (unless (zerop (tramp-call-local-coding-command
+ loc-enc tmpfile t))
+ (tramp-error
+ v 'file-error
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed")
+ filename loc-enc))))
+
+ ;; Send buffer into remote decoding command which
+ ;; writes to remote file. Because this happens on
+ ;; the remote host, we cannot use the function.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Decoding remote file `%s' using `%s'"
+ filename rem-dec)
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (tramp-barf-unless-okay
+ v (format
+ (concat rem-dec " <<'%s'\n%s%s")
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ (buffer-string)
+ tramp-end-of-heredoc)
+ "Couldn't write region to `%s', decode using `%s' failed"
+ filename rem-dec)
+ ;; When `file-precious-flag' is set, the region
+ ;; is written to a temporary file. Check that
+ ;; the checksum is equal to that from the local
+ ;; tmpfile.
+ (when file-precious-flag
+ (erase-buffer)
+ (and
+ ;; cksum runs locally, if possible.
+ (zerop (tramp-call-process v "cksum" tmpfile t))
+ ;; cksum runs remotely.
+ (tramp-send-command-and-check
+ v (format
+ "cksum <%s" (tramp-shell-quote-argument
localname)))
+ ;; ... they are different.
+ (not
+ (string-equal
+ (buffer-string)
+ (tramp-get-buffer-string (tramp-get-buffer v))))
+ (tramp-error
+ v 'file-error
+ (concat "Couldn't write region to `%s',"
+ " decode using `%s' failed")
+ filename rem-dec)))))
+
+ ;; Save exit.
+ (delete-file tmpfile)))
- ;; Make `last-coding-system-used' have the right value.
- (when coding-system-used
- (setq last-coding-system-used coding-system-used))))))
+ ;; That's not expected.
+ (t
+ (tramp-error
+ v 'file-error
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an scp program")
+ method))))
+
+ ;; Make `last-coding-system-used' have the right value.
+ (when coding-system-used
+ (setq last-coding-system-used coding-system-used)))))))
(defvar tramp-vc-registered-file-names nil
"List used to collect file names, which are checked during `vc-registered'.")
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 29abdb575d..a81a8f1363 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -523,49 +523,49 @@ arguments to pass to the OPERATION."
"tar qx -")))))
(unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates
- ;; always complete paths. We must
- ;; emulate the directory structure, and
- ;; symlink to the real target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname
- (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By
- ;; this, password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put
- p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions
- p v nil tramp-smb-actions-with-tar)
-
- (while (process-live-p p)
- (sleep-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates
+ ;; always complete paths. We must emulate
+ ;; the directory structure, and symlink to
+ ;; the real target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname
+ (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put
+ p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions
+ p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sleep-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string)))))
;; Save exit.
(when t1 (delete-directory tmpdir 'recursive))))
@@ -751,6 +751,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
+(defun tramp-smb-remote-acl-p (_vec)
+ "Check, whether ACL is enabled on the remote host."
+ (and (stringp tramp-smb-acl-program) (executable-find
tramp-smb-acl-program)))
+
(defun tramp-smb-action-get-acl (proc vec)
"Read ACL data from connection buffer."
(unless (process-live-p proc)
@@ -774,7 +778,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(ignore-errors
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-acl"
- (when (executable-find tramp-smb-acl-program)
+ (when (tramp-smb-remote-acl-p v)
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
@@ -799,31 +803,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(concat "2>" (tramp-get-remote-null-device
v)))))
(unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this,
- ;; password can be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil
tramp-smb-actions-get-acl)
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string))))))))))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-get-acl)
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string)))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -1311,32 +1315,32 @@ component is used as the target of the symlink."
;; Call it.
(condition-case nil
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property
- v "process-buffer"
- (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Preserve buffer contents.
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format "cd //%s%s" host
- (tramp-smb-shell-quote-argument
- (file-name-directory localname)))))
- (tramp-smb-send-command v command)
- ;; Preserve command output.
- (narrow-to-region (point-max) (point-max))
- (let ((p (tramp-get-connection-process v)))
- (tramp-smb-send-command v "exit $lasterrorcode")
- (while (process-live-p p)
- (sleep-for 0.1)
- (setq ret (process-exit-status p))))
- (delete-region (point-min) (point-max))
- (widen))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd //%s%s" host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (process-live-p p)
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen)))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
@@ -1356,7 +1360,7 @@ component is used as the target of the symlink."
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer")))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@@ -1427,7 +1431,7 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v localname "file-acl")
- (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
+ (when (and (stringp acl-string) (tramp-smb-remote-acl-p v))
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
@@ -1455,52 +1459,50 @@ component is used as the target of the symlink."
"||" "echo" "tramp_exit_status" "1")))
(unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this, password
- ;; can be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-set-acl)
- ;; This is meant for traces, and returning from
- ;; the function. No error is propagated
- ;; outside, due to the `ignore-errors' closure.
- (unless
- (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
- (tramp-error
- v 'file-error
- "Couldn't find exit status of `%s'"
- tramp-smb-acl-program))
- (skip-chars-forward "^ ")
- (when (zerop (read (current-buffer)))
- ;; Success.
- (tramp-set-file-property
- v localname "file-acl" acl-string)
- t)))))))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-set-acl)
+ ;; This is meant for traces, and returning from
+ ;; the function. No error is propagated outside,
+ ;; due to the `ignore-errors' closure.
+ (unless
+ (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'"
+ tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property v localname "file-acl"
acl-string)
+ t))))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; smbclient chmod does not support nofollow.
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ ;; smbclient chmod does not support nofollow.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-smb-get-cifs-capabilities v)
- (tramp-flush-file-properties v localname)
(unless (tramp-smb-send-command
v
(format "chmod %s %o" (tramp-smb-shell-quote-localname v)
mode))
@@ -1524,38 +1526,38 @@ component is used as the target of the symlink."
(i 0)
p)
(unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- (save-excursion
- (save-restriction
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format
- "cd //%s%s"
- host
- (tramp-smb-shell-quote-argument
- (file-name-directory localname)))))
- (tramp-message v 6 "(%s); exit" command)
- (tramp-send-string v command)))
- (setq p (tramp-get-connection-process v))
- (when program
- (process-put p 'remote-command (cons program args))
- (tramp-set-connection-property
- p "remote-command" (cons program args)))
- ;; Return value.
- p))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (save-excursion
+ (save-restriction
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd //%s%s"
+ host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ (setq p (tramp-get-connection-process v))
+ (when program
+ (process-put p 'remote-command (cons program args))
+ (tramp-set-connection-property
+ p "remote-command" (cons program args)))
+ ;; Return value.
+ p)))
;; Save exit.
;; FIXME: Does `tramp-get-connection-buffer' return the proper value?
@@ -1933,7 +1935,7 @@ If ARGUMENT is non-nil, use it as argument for
tramp-smb-version
(tramp-get-connection-property
vec "smbclient-version" tramp-smb-version))
- (tramp-flush-directory-properties vec "")
+ (tramp-flush-directory-properties vec "/")
(tramp-flush-connection-properties vec))
(tramp-set-connection-property
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index d7c918fbc8..a9225db434 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -333,7 +333,7 @@ arguments to pass to the OPERATION."
;; them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))))))
+ (tramp-flush-directory-properties v "/"))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -355,18 +355,15 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-modes
(tramp-fuse-local-file-name filename) mode flag))))
(defun tramp-sshfs-handle-set-file-times (filename &optional timestamp flag)
"Like `set-file-times' for Tramp files."
- (or (file-exists-p filename) (write-region "" nil filename nil 0))
- (with-parsed-tramp-file-name filename nil
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-times
(tramp-fuse-local-file-name filename) timestamp flag))))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 5ec68e904e..3564a1b7b4 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -484,10 +484,9 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; It is unlikely that "chmod -h" works.
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ ;; It is unlikely that "chmod -h" works.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(unless (tramp-sudoedit-send-command
v "chmod" (format "%o" mode)
(tramp-compat-file-name-unquote localname))
@@ -542,8 +541,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
@@ -730,13 +728,13 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-sudoedit-send-command
- v "chown"
- (format "%d:%d"
- (or uid (tramp-get-remote-uid v 'integer))
- (or gid (tramp-get-remote-gid v 'integer)))
- (tramp-unquote-file-local-name filename))))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
+ (tramp-sudoedit-send-command
+ v "chown"
+ (format "%d:%d"
+ (or uid (tramp-get-remote-uid v 'integer))
+ (or gid (tramp-get-remote-gid v 'integer)))
+ (tramp-unquote-file-local-name filename))))
;; Internal functions.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 426a669f62..4cc4ee0722 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -96,6 +96,7 @@
If it is set to nil, all remote file names are used literally."
:type 'boolean)
+;;;###tramp-autoload
(defcustom tramp-verbose 3
"Verbosity level for Tramp messages.
Any level x includes messages for all levels 1 .. x-1. The levels are
@@ -262,6 +263,7 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
argument if it is supported.
- \"%z\" is replaced by the `tramp-scp-direct-remote-copying'
argument if it is supported.
+ - \"%d\" is replaced by the device detected by `tramp-adb-get-device'.
The existence of `tramp-login-args', combined with the
absence of `tramp-copy-args', is an indication that the
@@ -1440,8 +1442,9 @@ calling HANDLER.")
;; work otherwise when unloading / reloading Tramp. (Bug#50869)
;;;###tramp-autoload(require 'cl-lib)
;;;###tramp-autoload
-(cl-defstruct (tramp-file-name (:type list) :named)
- method user domain host port localname hop)
+(progn
+ (cl-defstruct (tramp-file-name (:type list) :named)
+ method user domain host port localname hop))
(put #'tramp-file-name-method 'tramp-suppress-trace t)
(put #'tramp-file-name-user 'tramp-suppress-trace t)
@@ -1484,13 +1487,22 @@ If nil, return `tramp-default-port'."
(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
-(defun tramp-file-name-unify (vec)
+;;;###tramp-autoload
+(defun tramp-file-name-unify (vec &optional localname)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
+If LOCALNAME is a string, set it as localname.
Objects returned by this function compare `equal' if they refer to the
same connection. Make a copy in order to avoid side effects."
(when (tramp-file-name-p vec)
(setq vec (copy-tramp-file-name vec))
- (setf (tramp-file-name-localname vec) nil
+ (setf (tramp-file-name-localname vec)
+ (and (stringp localname)
+ ;; FIXME: This is a sanity check. When this error
+ ;; doesn't happen for a while, it can be removed.
+ (or (file-name-absolute-p localname)
+ (tramp-error
+ vec 'file-error "File `%s' must be absolute" localname))
+ (tramp-compat-file-name-unquote (directory-file-name localname)))
(tramp-file-name-hop vec) nil))
vec)
@@ -1524,6 +1536,7 @@ entry does not exist, return nil."
"Return unquoted localname component of VEC."
(tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
+;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
"Return t if NAME is a string with Tramp file name syntax."
(and tramp-mode (stringp name)
@@ -1545,6 +1558,7 @@ entry does not exist, return nil."
;; However, it is more performant than `file-local-name', and might be
;; useful where performance matters, like in operations over a bulk
;; list of file names.
+;;;###tramp-autoload
(defun tramp-file-local-name (name)
"Return the local name component of NAME.
This function removes from NAME the specification of the remote
@@ -1636,6 +1650,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in
(put #'tramp-find-host 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure of NAME, a remote file name.
The structure consists of method, user, domain, host, port,
@@ -1746,6 +1761,7 @@ See `tramp-dissect-file-name' for details."
(put #'tramp-buffer-name 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defun tramp-make-tramp-file-name (&rest args)
"Construct a Tramp file name from ARGS.
@@ -1855,6 +1871,7 @@ Unless DONT-CREATE, the buffer is created when it doesn't
exist yet."
(tramp-make-tramp-file-name vec 'noloc))
(current-buffer)))))
+;;;###tramp-autoload
(defun tramp-get-connection-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC.
Unless DONT-CREATE, the buffer is created when it doesn't exist yet.
@@ -1911,8 +1928,7 @@ version, the function does nothing."
"Return `default-directory' of BUFFER."
(buffer-local-value 'default-directory buffer))
-(put #'tramp-get-default-directory 'tramp-suppress-trace t)
-
+;;;###tramp-autoload
(defsubst tramp-get-buffer-string (&optional buffer)
"Return contents of BUFFER.
If BUFFER is not a buffer or a buffer name, return the contents
@@ -1920,8 +1936,6 @@ of `current-buffer'."
(with-current-buffer (or buffer (current-buffer))
(substring-no-properties (buffer-string))))
-(put #'tramp-get-buffer-string 'tramp-suppress-trace t)
-
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC."
(let ((method (tramp-file-name-method vec))
@@ -2033,6 +2047,7 @@ They are completed by \"M-x TAB\" only in Tramp debug
buffers."
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
+;;;###tramp-autoload
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
@@ -2106,10 +2121,12 @@ ARGUMENTS to actually emit the message (if applicable)."
(put #'tramp-debug-message 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defvar tramp-inhibit-progress-reporter nil
"Show Tramp progress reporter in the minibuffer.
This variable is used to disable concurrent progress reporter messages.")
+;;;###tramp-autoload
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
@@ -2162,8 +2179,6 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
arguments))))))
-(put #'tramp-message 'tramp-suppress-trace t)
-
(defsubst tramp-backtrace (&optional vec-or-proc force)
"Dump a backtrace into the debug buffer.
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
@@ -2176,8 +2191,6 @@ This function is meant for debugging purposes."
vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
(with-output-to-temp-buffer "*debug tramp*" (backtrace))))))
-(put #'tramp-backtrace 'tramp-suppress-trace t)
-
(defun tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
VEC-OR-PROC identifies the connection to use, SIGNAL is the
@@ -2245,8 +2258,6 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
-(put #'tramp-error-with-buffer 'tramp-suppress-trace t)
-
;; We must make it a defun, because it is used earlier already.
(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
@@ -2283,8 +2294,6 @@ the resulting error message."
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
-(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
-
;; This macro shall optimize the cases where an `file-exists-p' call
;; is invoked first. Often, the file exists, so the remote command is
;; superfluous.
@@ -2301,8 +2310,6 @@ does not exist, otherwise propagate the error."
(tramp-error ,vec 'file-missing ,filename)
(signal (car ,err) (cdr ,err)))))))
-(put #'tramp-barf-if-file-missing 'tramp-suppress-trace t)
-
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
(cond
@@ -2398,45 +2405,6 @@ without a visible progress reporter."
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
-(defmacro with-tramp-file-property (vec file property &rest body)
- "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
-FILE must be a local file name on a connection identified via VEC."
- (declare (indent 3) (debug t))
- `(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property
- ,vec ,file ,property tramp-cache-undefined)))
- (when (eq value tramp-cache-undefined)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
- ,@body))
-
-(defmacro with-tramp-connection-property (key property &rest body)
- "Check in Tramp for property PROPERTY, otherwise execute BODY and set."
- (declare (indent 2) (debug t))
- `(let ((value (tramp-get-connection-property
- ,key ,property tramp-cache-undefined)))
- (when (eq value tramp-cache-undefined)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
-
-(defmacro with-tramp-saved-connection-property (key property &rest body)
- "Save PROPERTY, run BODY, reset PROPERTY."
- (declare (indent 2) (debug t))
- `(let ((value (tramp-get-connection-property
- ,key ,property tramp-cache-undefined)))
- (unwind-protect (progn ,@body)
- (if (eq value tramp-cache-undefined)
- (tramp-flush-connection-property ,key ,property)
- (tramp-set-connection-property ,key ,property value)))))
-
(defun tramp-drop-volume-letter (name)
"Cut off unnecessary drive letter from file NAME.
The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
@@ -3373,14 +3341,11 @@ Host is always \"localhost\"."
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
- ;; The declaration is not sufficient at runtime, because netrc.el is
- ;; not autoloaded.
- (autoload 'netrc-parse "netrc")
(mapcar
(lambda (item)
(and (assoc "machine" item)
`(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
- (netrc-parse filename)))
+ (tramp-compat-auth-source-netrc-parse-all filename)))
(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
@@ -3423,8 +3388,6 @@ BODY is the backend specific code."
(tramp-dissect-file-name ,directory) 'file-missing ,directory))
,@body))
-(put #'tramp-skeleton-copy-directory 'tramp-suppress-trace t)
-
(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
"Skeleton for `tramp-*-handle-delete-directory'.
BODY is the backend specific code."
@@ -3440,8 +3403,6 @@ BODY is the backend specific code."
,@body)
(tramp-flush-directory-properties v localname)))
-(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
-
(defmacro tramp-skeleton-directory-files
(directory &optional full match nosort count &rest body)
"Skeleton for `tramp-*-handle-directory-files'.
@@ -3473,8 +3434,6 @@ BODY is the backend specific code."
(tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil)))
-(put #'tramp-skeleton-directory-files 'tramp-suppress-trace t)
-
(defmacro tramp-skeleton-directory-files-and-attributes
(directory &optional full match nosort id-format count &rest body)
"Skeleton for `tramp-*-handle-directory-files-and-attributes'.
@@ -3484,7 +3443,6 @@ BODY is the backend specific code."
(with-parsed-tramp-file-name ,directory nil
(tramp-barf-if-file-missing v ,directory
(when (file-directory-p ,directory)
- (setq ,directory (expand-file-name ,directory))
(let ((temp
(copy-tree
(mapcar
@@ -3492,9 +3450,10 @@ BODY is the backend specific code."
(cons
(car x)
(tramp-convert-file-attributes
- v (car x) ,id-format (cdr x))))
+ v (expand-file-name (car x) localname)
+ ,id-format (cdr x))))
(with-tramp-file-property
- v localname ",directory-files-and-attributes"
+ v localname "directory-files-and-attributes"
,@body))))
result item)
@@ -3523,10 +3482,8 @@ BODY is the backend specific code."
(tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil)))
-(put #'tramp-skeleton-directory-files-and-attributes 'tramp-suppress-trace t)
-
(defmacro tramp-skeleton-file-local-copy (filename &rest body)
- "Skeleton for `tramp-*-handle-file-local-copy-files'.
+ "Skeleton for `tramp-*-handle-file-local-copy'.
BODY is the backend specific code."
(declare (indent 1) (debug t))
`(with-parsed-tramp-file-name (file-truename ,filename) nil
@@ -3540,7 +3497,22 @@ BODY is the backend specific code."
;; Trigger the `file-missing' error.
(signal 'error nil)))))
-(put #'tramp-skeleton-file-local-copy 'tramp-suppress-trace t)
+(defmacro tramp-skeleton-set-file-modes-times-uid-gid
+ (filename &rest body)
+ "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug t))
+ `(with-parsed-tramp-file-name ,filename nil
+ (when (not (file-exists-p ,filename))
+ (tramp-error v 'file-missing ,filename))
+ (with-tramp-saved-file-properties
+ v localname
+ ;; We cannot add "file-attributes", "file-executable-p",
+ ;; "file-ownership-preserved-p", "file-readable-p",
+ ;; "file-writable-p".
+ '("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename")
+ (tramp-flush-file-properties v localname))
+ ,@body))
(defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body)
@@ -3601,6 +3573,9 @@ BODY is the backend specific code."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
+ ;; Set the "file-exists-p" file property, because it is
+ ;; likely that it is needed shortly after `write-region'.
+ (tramp-set-file-property v localname "file-exists-p" t)
;; We must protect `last-coding-system-used', now we have
;; set it to its correct value.
@@ -3644,8 +3619,6 @@ BODY is the backend specific code."
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))))
-(put #'tramp-skeleton-write-region 'tramp-suppress-trace t)
-
;;; Common file name handler functions for different backends:
(defvar tramp-handle-file-local-copy-hook nil
@@ -3842,7 +3815,9 @@ Let-bind it when necessary.")
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (not (null (file-attributes filename)))))
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (not (null (file-attributes filename)))))))
(defun tramp-handle-file-in-directory-p (filename directory)
"Like `file-in-directory-p' for Tramp files."
@@ -4734,7 +4709,10 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(signal 'wrong-type-argument (list #'symbolp coding)))
(when (eq connection-type t)
(setq connection-type 'pty))
- (unless (memq connection-type '(nil pipe pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (eq filter t) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -4778,6 +4756,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
;; is different between tramp-sh.el, and tramp-adb.el or
;; tramp-sshfs.el.
(let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
+ (adb-file-name-handler-p (tramp-adb-file-name-p v))
(login-program
(tramp-get-method-parameter v 'tramp-login-program))
;; We don't create the temporary file. In fact, it
@@ -4797,6 +4776,10 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(when sh-file-name-handler-p
(tramp-compat-funcall
'tramp-ssh-controlmaster-options v)))
+ (device
+ (when adb-file-name-handler-p
+ (tramp-compat-funcall
+ 'tramp-adb-get-device v)))
login-args p)
;; Replace `login-args' place holders. Split
@@ -4813,7 +4796,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
v 'tramp-login-args
?h (or host "") ?u (or user "") ?p (or port "")
?c (format-spec (or options "") (format-spec-make ?t tmpfile))
- ?l ""))))
+ ?d (or device "") ?l ""))))
p (make-process
:name name :buffer buffer
:command (append `(,login-program) login-args command)
@@ -5619,7 +5602,7 @@ the remote host use line-endings as defined in the
variable
(when vec
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
- (tramp-flush-directory-properties vec ""))
+ (tramp-flush-directory-properties vec "/"))
(when (buffer-live-p buf)
(with-current-buffer buf
(when (and prompt (tramp-search-regexp (regexp-quote prompt)))
@@ -6048,6 +6031,7 @@ Return the local name of the temporary file."
(let (create-lockfiles)
(cl-letf (((symbol-function 'tramp-remote-acl-p) #'ignore)
((symbol-function 'tramp-remote-selinux-p) #'ignore)
+ ((symbol-function 'tramp-smb-remote-acl-p) #'ignore)
((symbol-function 'tramp-sudoedit-remote-acl-p) #'ignore)
((symbol-function 'tramp-sudoedit-remote-selinux-p) #'ignore))
(tramp-file-local-name
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el
index b88653f79e..0523e8132b 100644
--- a/lisp/nxml/rng-dt.el
+++ b/lisp/nxml/rng-dt.el
@@ -52,7 +52,7 @@ a datatype library.")
(rng-dt-error "The string datatype does not take any parameters")))
((eq name 'token)
(if (null params)
- '(t rng-collapse-space)
+ '(t string-clean-whitespace)
(rng-dt-error "The token datatype does not take any parameters")))
(t
(rng-dt-error "There is no built-in datatype %s" name))))
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index 0fa455cbb5..40332aacd5 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -354,7 +354,7 @@ NS is t if the document has a non-nil, but not otherwise
known namespace."
(or (cdr (assq 'uri props))
(let ((type-id (cdr (assq 'typeId props))))
(and type-id
- (cons (rng-collapse-space type-id) nil)))))
+ (cons (string-clean-whitespace type-id) nil)))))
(defun rng-possible-type-ids-using (file type-ids)
(let ((rules (rng-get-parsed-schema-locating-file file))
@@ -366,7 +366,7 @@ NS is t if the document has a non-nil, but not otherwise
known namespace."
(let ((id (cdr (assq 'id (cdr rule)))))
(when id
(setq type-ids
- (cons (rng-collapse-space id)
+ (cons (string-clean-whitespace id)
type-ids)))))
((eq (car rule) 'include)
(let ((uri (cdr (assq 'rules (cdr rule)))))
@@ -390,7 +390,7 @@ or nil."
(cond ((and (eq (car rule) 'typeId)
(let ((id (assq 'id (cdr rule))))
(and id
- (string= (rng-collapse-space (cdr id)) type-id))))
+ (string= (string-clean-whitespace (cdr id))
type-id))))
(setq schema (rng-match-default-rule (cdr rule))))
((eq (car rule) 'include)
(let ((uri (cdr (assq 'rules (cdr rule)))))
@@ -414,7 +414,7 @@ or nil."
(setq rng-schema-locating-file-alist
(delq cached rng-schema-locating-file-alist)))
nil)
- ((and cached (equal (nth 1 cached) mtime))
+ ((and cached (time-equal-p (nth 1 cached) mtime))
(nth 2 cached))
(t
(setq parsed (rng-parse-schema-locating-file file))
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index e767a9333b..f3549681f2 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -1154,7 +1154,7 @@ list may contain duplicates."
(if (or (rng--ipattern-nullable
(rng-data-deriv child value))
(and (rng--ipattern-nullable child)
- (rng-blank-p value)))
+ (string-blank-p value)))
(rng--ipattern-after ipattern)
rng-not-allowed-ipattern)))
((eq type 'data)
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el
index 76cb94b144..1c08d77f56 100644
--- a/lisp/nxml/rng-parse.el
+++ b/lisp/nxml/rng-parse.el
@@ -62,7 +62,7 @@ be signaled in the same way as when it is not well-formed."
(unless (rng-match-element-value (or text ""))
(cons "Invalid data" (and text 'text))))
((and text
- (not (rng-blank-p text))
+ (not (string-blank-p text))
(not (rng-match-mixed-text)))
(cons "Text not allowed" 'text))
((not start-tag)
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 74f405410a..7ac6db25f4 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -36,8 +36,6 @@
(defconst rng-builtin-datatypes-uri (rng-make-datatypes-uri ""))
-(defun rng-blank-p (str) (string-match "\\`[ \t\n\r]*\\'" str))
-
(defun rng-substq (new old list)
"Replace first member of LIST (if any) that is `eq' to OLD by NEW.
LIST is not modified."
@@ -73,24 +71,15 @@ LIST is not modified."
s
t))
-(defun rng-collapse-space (string)
- (setq string
- (replace-regexp-in-string "[ \t\r\n]+" " " string t t))
- (when (string-match "\\` " string)
- (setq string (substring string 1)))
- (when (string-match " \\'" string)
- (setq string (substring string 0 -1)))
- string)
-
(define-error 'rng-error nil)
-;; Obsolete.
-
(defun rng-uniquify-eq (list)
(declare (obsolete seq-uniq "28.1"))
(seq-uniq list #'eq))
(define-obsolete-function-alias 'rng-uniquify-equal #'seq-uniq "28.1")
+(define-obsolete-function-alias 'rng-blank-p #'string-blank-p "29.1")
+(define-obsolete-function-alias 'rng-collapse-space #'string-clean-whitespace
"29.1")
(provide 'rng-util)
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index b9c980222e..ad5c9c7a15 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -1275,7 +1275,7 @@ Return nil at end of buffer, t otherwise."
(defun rng-segment-blank-p (segment)
(if (car segment)
- (rng-blank-p (car segment))
+ (string-blank-p (car segment))
(apply #'rng-region-blank-p
(cdr segment))))
@@ -1303,7 +1303,7 @@ string between START and END."
((not (or (and whitespace
(or (eq whitespace t)
(if value
- (rng-blank-p value)
+ (string-blank-p value)
(rng-region-blank-p start end))))
(rng-match-mixed-text)))
(rng-mark-invalid "Text not allowed" start (or end (point))))))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/obsolete/autoload.el
similarity index 99%
rename from lisp/emacs-lisp/autoload.el
rename to lisp/obsolete/autoload.el
index eed88b6faf..a56f31629e 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/obsolete/autoload.el
@@ -5,6 +5,7 @@
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
;; Package: emacs
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -28,8 +29,7 @@
;; Lisp source files in various useful ways. To learn more, read the
;; source; if you're going to use this, you'd better be able to.
-;; The functions in this file have been largely superseded by
-;; loaddefs-gen.el.
+;; The functions in this file have been superseded by loaddefs-gen.el.
;;; Code:
@@ -267,12 +267,6 @@ if `autoload-timestamps' is non-nil, otherwise a fixed
fake time is inserted)."
(hack-local-variables))
(current-buffer)))
-(defalias 'autoload-insert-section-header
- #'loaddefs-generate--insert-section-header)
-
-(defvar no-update-autoloads nil
- "File local variable to prevent scanning this file for autoload cookies.")
-
(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name)
(defun generate-file-autoloads (file)
diff --git a/lisp/obsolete/gs.el b/lisp/obsolete/gs.el
index 7bf324ceec..d5a8713129 100644
--- a/lisp/obsolete/gs.el
+++ b/lisp/obsolete/gs.el
@@ -144,7 +144,7 @@ image in pixels."
(defun gs-set-ghostview-colors-window-prop (frame pixel-colors)
"Set the `GHOSTVIEW_COLORS' environment variable depending on FRAME."
- (let ((mode (cond ((x-display-color-p frame) "Color")
+ (let ((mode (cond ((display-color-p frame) "Color")
((x-display-grayscale-p frame) "Grayscale")
(t "Monochrome"))))
(x-change-window-property "GHOSTVIEW_COLORS"
diff --git a/lisp/makesum.el b/lisp/obsolete/makesum.el
similarity index 94%
rename from lisp/makesum.el
rename to lisp/obsolete/makesum.el
index 4084358ca9..3e343c9537 100644
--- a/lisp/makesum.el
+++ b/lisp/obsolete/makesum.el
@@ -4,6 +4,7 @@
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -32,7 +33,6 @@
"Make a summary of current key bindings in the buffer *Summary*.
Previous contents of that buffer are killed first."
(interactive)
- (message "Making command summary...")
;; This puts a description of bindings in a buffer called *Help*.
(save-window-excursion
(describe-bindings))
@@ -68,8 +68,7 @@ Previous contents of that buffer are killed first."
(forward-line -1)
(point)))))
(goto-char (point-min))
- (insert "Emacs command summary, " (substring (current-time-string) 0 10)
- ".\n")
+ (insert "Emacs command summary\n")
;; Delete "key binding" and underlining of dashes.
(delete-region (point) (progn (forward-line 2) (point)))
(forward-line 1) ;Skip blank line
@@ -79,8 +78,7 @@ Previous contents of that buffer are killed first."
(goto-char (point-max)))
(double-column beg (point))
(forward-line 1)))
- (goto-char (point-min)))))
- (message "Making command summary...done"))
+ (goto-char (point-min))))))
(defun double-column (start end)
"Reformat buffer contents from START to END into two columns."
diff --git a/lisp/mh-e/mh-compat.el b/lisp/obsolete/mh-compat.el
similarity index 85%
rename from lisp/mh-e/mh-compat.el
rename to lisp/obsolete/mh-compat.el
index 7a09429e4e..a5be3bd742 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/obsolete/mh-compat.el
@@ -5,6 +5,7 @@
;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -42,22 +43,6 @@
(define-obsolete-function-alias 'mh-assoc-string #'assoc-string "29.1")
(define-obsolete-function-alias 'mh-cancel-timer #'cancel-timer "29.1")
-;; Emacs 24 made flet obsolete and suggested either cl-flet or
-;; cl-letf. This macro is based upon gmm-flet from Gnus.
-(defmacro mh-flet (bindings &rest body)
- "Make temporary overriding function definitions.
-That is, temporarily rebind the functions listed in BINDINGS and then
-execute BODY. BINDINGS is a list containing one or more lists of the
-form (FUNCNAME ARGLIST BODY...), similar to defun."
- (declare (indent 1) (debug ((&rest (sexp sexp &rest form)) &rest form)))
- (if (fboundp 'cl-letf)
- `(cl-letf ,(mapcar (lambda (binding)
- `((symbol-function ',(car binding))
- (lambda ,@(cdr binding))))
- bindings)
- ,@body)
- `(flet ,bindings ,@body)))
-
(define-obsolete-function-alias 'mh-display-color-cells
#'display-color-cells "29.1")
@@ -69,6 +54,7 @@ The optional argument COMMON-SUBSTRING, if non-nil, should be
a string
specifying a common substring for adding the faces
`completions-first-difference' and `completions-common-part' to
the completions."
+ (declare (obsolete nil "29.1"))
`(display-completion-list
(completion-hilit-commonality ,completions
,(length common-substring) nil)))
@@ -98,7 +84,7 @@ the completions."
(define-obsolete-function-alias 'mh-line-end-position
#'line-end-position "29.1")
-(require 'mailabbrev nil t)
+(require 'mailabbrev)
(define-obsolete-function-alias 'mh-mail-abbrev-make-syntax-table
#'mail-abbrev-make-syntax-table "29.1")
@@ -144,7 +130,6 @@ This is taken from RFC 2396.")
(provide 'mh-compat)
;; Local Variables:
-;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
diff --git a/lisp/net/netrc.el b/lisp/obsolete/netrc.el
similarity index 93%
rename from lisp/net/netrc.el
rename to lisp/obsolete/netrc.el
index c272c07e4c..f664a77a9b 100644
--- a/lisp/net/netrc.el
+++ b/lisp/obsolete/netrc.el
@@ -4,6 +4,9 @@
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
+;; Obsolete-since: 29.1
+;;
+;; Instead of using `netrc-parse', use `auth-source-netrc-parse-all'.
;;
;; Modularized by Ted Zlatanov <tzz@lifelogs.com>
;; when it was part of Gnus.
@@ -50,6 +53,7 @@
(defun netrc-parse (&optional file)
"Parse FILE and return a list of all entries in the file."
+ (declare (obsolete auth-source-netrc-parse-all "29.1"))
(interactive "fFile to Parse: ")
(unless file
(setq file netrc-file))
@@ -63,8 +67,9 @@
"port"))
alist elem result pair)
(if (and netrc-cache
- (equal (car netrc-cache) (file-attribute-modification-time
- (file-attributes file))))
+ (time-equal-p (car netrc-cache)
+ (file-attribute-modification-time
+ (file-attributes file))))
(insert (base64-decode-string (rot13-string (cdr netrc-cache))))
(insert-file-contents file)
(when (string-match "\\.gpg\\'" file)
@@ -159,7 +164,8 @@ default ports DEFAULTS to `netrc-machine'.
MODE can be \"login\" or \"password\", suitable for passing to
`netrc-get'."
(let ((authinfo-list (if (stringp authinfo-file-or-list)
- (netrc-parse authinfo-file-or-list)
+ (with-suppressed-warnings ((obsolete netrc-parse))
+ (netrc-parse authinfo-file-or-list))
authinfo-file-or-list))
(ports (or ports '(nil)))
(defaults (or defaults '(nil)))
@@ -222,7 +228,8 @@ MODE can be \"login\" or \"password\", suitable for passing
to
"Return a user name/password pair.
Port specifications will be prioritized in the order they are
listed in the PORTS list."
- (let ((list (netrc-parse))
+ (let ((list (with-suppressed-warnings ((obsolete netrc-parse))
+ (netrc-parse)))
found)
(if (not ports)
(setq found (netrc-machine list machine))
diff --git a/lisp/obsolete/ps-def.el b/lisp/obsolete/ps-def.el
new file mode 100644
index 0000000000..0f7f7609ca
--- /dev/null
+++ b/lisp/obsolete/ps-def.el
@@ -0,0 +1,54 @@
+;;; ps-def.el --- Emacs definitions for ps-print -*- lexical-binding: t -*-
+
+;; Copyright (C) 2007-2022 Free Software Foundation, Inc.
+
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
+;; Keywords: wp, print, PostScript
+;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; Package: ps-print
+;; Obsolete-since: 29.1
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; See ps-print.el for documentation.
+
+;;; Code:
+
+
+;; Emacs Definitions
+
+(defun ps-mark-active-p ()
+ (declare (obsolete mark-active "29.1"))
+ mark-active)
+
+(defun ps-face-foreground-name (face)
+ (declare (obsolete face-foreground "29.1"))
+ (face-foreground face nil t))
+
+(defun ps-face-background-name (face)
+ (declare (obsolete face-background "29.1"))
+ (face-background face nil t))
+
+(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1")
+(define-obsolete-function-alias 'ps-color-device #'display-color-p "29.1")
+(define-obsolete-function-alias 'ps-color-values #'color-values "28.1")
+
+(provide 'ps-def)
+
+;;; ps-def.el ends here
diff --git a/lisp/url/url-about.el b/lisp/obsolete/url-about.el
similarity index 95%
rename from lisp/url/url-about.el
rename to lisp/obsolete/url-about.el
index 3943cae9e5..608df3f2a5 100644
--- a/lisp/url/url-about.el
+++ b/lisp/obsolete/url-about.el
@@ -1,8 +1,9 @@
;;; url-about.el --- Show internal URLs -*- lexical-binding: t; -*-
-;; Copyright (C) 2001, 2004-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2022 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
;;
@@ -38,7 +39,7 @@
(if (string-match "url-\\(.*\\).el$" f)
(push (match-string 1 f) schemes)))
(directory-files d nil "\\`url-.*\\.el\\'")))
- load-path)
+ (seq-filter #'file-exists-p load-path))
(put 'url-extension-protocols 'schemes schemes)
schemes)))))
diff --git a/lisp/url/url-dired.el b/lisp/obsolete/url-dired.el
similarity index 96%
rename from lisp/url/url-dired.el
rename to lisp/obsolete/url-dired.el
index e2c23a8b6d..40057fb174 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/obsolete/url-dired.el
@@ -3,6 +3,7 @@
;; Copyright (C) 1996-1999, 2004-2022 Free Software Foundation, Inc.
;; Keywords: comm, files
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -27,7 +28,7 @@
(defvar-keymap url-dired-minor-mode-map
:doc "Keymap used when browsing directories."
- "C-m" #'url-dired-find-file
+ "RET" #'url-dired-find-file
"<mouse-2>" #'url-dired-find-file-mouse)
(defun url-dired-find-file ()
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 3d159ed38a..3b114703cd 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -488,13 +488,13 @@ arguments, imagine you'd like to set the file name output
of a
latex source block to a sha1 of its contents. We could achieve
this with:
-(defun org-src-sha ()
- (let ((elem (org-element-at-point)))
- (concat (sha1 (org-element-property :value elem)) \".svg\")))
+ (defun org-src-sha ()
+ (let ((elem (org-element-at-point)))
+ (concat (sha1 (org-element-property :value elem)) \".svg\")))
-(setq org-babel-default-header-args:latex
- `((:results . \"file link replace\")
- (:file . (lambda () (org-src-sha)))))
+ (setq org-babel-default-header-args:latex
+ `((:results . \"file link replace\")
+ (:file . (lambda () (org-src-sha)))))
Because the closure is evaluated with point at the source block,
the call to `org-element-at-point' above will always retrieve
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index 15538b5037..dd204d7f6b 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -36,6 +36,7 @@
(declare-function org-show-all "org" (&optional types))
+;; FIXME: Doesn't this rather belong in lilypond-mode.el?
(defalias 'lilypond-mode 'LilyPond-mode)
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index c2da24266a..831c84befc 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -622,7 +622,7 @@ manner suitable for prepending to a user-specified script."
(dolist (img-overlay org-inline-image-overlays)
(when (string= img-file (plist-get (cdr (overlay-get img-overlay
'display)) :file))
(when (file-exists-p img-file)
- (image-refresh (overlay-get img-overlay 'display))))))
+ (image-flush (overlay-get img-overlay 'display))))))
;;-----------------------------------------------------------------------------
;; facade functions
diff --git a/lisp/org/org.el b/lisp/org/org.el
index e62ee3203b..68f522b060 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -82,8 +82,8 @@
(or (eq this-command 'eval-buffer)
(condition-case nil
(load (concat (file-name-directory load-file-name)
- "org-loaddefs.el")
- nil t t t)
+ "org-loaddefs")
+ nil t nil t)
(error
(message "WARNING: No org-loaddefs.el file could be found from where
org.el is loaded.")
(sit-for 3)
@@ -16487,7 +16487,7 @@ INCLUDE-LINKED is passed to
`org-display-inline-images'."
(org-toggle-inline-images)))
;; For without-x builds.
-(declare-function image-refresh "image" (spec &optional frame))
+(declare-function image-flush "image" (spec &optional frame))
(defcustom org-display-remote-inline-images 'skip
"How to display remote inline images.
@@ -16628,7 +16628,7 @@ buffer boundaries with possible narrowing."
(org-element-property :begin link)
'org-image-overlay)))
(if (and (car-safe old) refresh)
- (image-refresh (overlay-get (cdr old) 'display))
+ (image-flush (overlay-get (cdr old) 'display))
(let ((image (org--create-inline-image file width)))
(when image
(let ((ov (make-overlay
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 1bdf4dead8..9a2a69b2c1 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -6479,7 +6479,7 @@ to send the output file through additional processing,
e.g,
(let ((outfile (org-export-output-file-name \".tex\" subtreep)))
(org-export-to-file \\='latex outfile
async subtreep visible-only body-only ext-plist
- #'org-latex-compile)))
+ #\\='org-latex-compile)))
When expressed as an anonymous function, using `lambda',
POST-PROCESS needs to be quoted.
diff --git a/lisp/outline.el b/lisp/outline.el
index 7750f9a75d..bb62c573c4 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -281,7 +281,7 @@ This option is only in effect when
`outline-minor-mode-cycle' is non-nil."
[outline-1 outline-2 outline-3 outline-4
outline-5 outline-6 outline-7 outline-8])
-(defcustom outline-minor-mode-use-buttons '(derived-mode . special-mode)
+(defcustom outline-minor-mode-use-buttons '(derived-mode . help-mode)
"Whether to display clickable buttons on the headings.
The value should be a `buffer-match-p' condition.
@@ -294,16 +294,16 @@ buffers (yet) -- that will be amended in a future
version."
:version "29.1")
(define-icon outline-open button
- '((emoji "▶️")
- (symbol " ⯈ ")
+ '((emoji "🔽")
+ (symbol " ⯆ ")
(text " open "))
"Icon used for buttons for opening a section in outline buffers."
:version "29.1"
:help-echo "Open this section")
(define-icon outline-close button
- '((emoji "🔽")
- (symbol " ⯆ ")
+ '((emoji "▶️")
+ (symbol " ⯈ ")
(text " close "))
"Icon used for buttons for closing a section in outline buffers."
:version "29.1"
@@ -435,7 +435,7 @@ outline font-lock faces to those of major mode."
(goto-char (match-beginning 0))
(not (get-text-property (point) 'face))))
(overlay-put overlay 'face (outline-font-lock-face)))
- (when (outline--use-buttons-p)
+ (when (and (outline--use-buttons-p) (outline-on-heading-p))
(outline--insert-open-button)))
(goto-char (match-end 0))))))
@@ -452,11 +452,10 @@ See the command `outline-mode' for more information on
this mode."
(if outline-minor-mode
(progn
(when outline-minor-mode-highlight
- (if (and global-font-lock-mode (font-lock-specified-p major-mode))
- (progn
- (font-lock-add-keywords nil outline-font-lock-keywords t)
- (font-lock-flush))
- (outline-minor-mode-highlight-buffer)))
+ (when (and global-font-lock-mode (font-lock-specified-p major-mode))
+ (font-lock-add-keywords nil outline-font-lock-keywords t)
+ (font-lock-flush))
+ (outline-minor-mode-highlight-buffer))
;; Turn off this mode if we change major modes.
(add-hook 'change-major-mode-hook
(lambda () (outline-minor-mode -1))
@@ -1011,32 +1010,34 @@ If non-nil, EVENT should be a mouse event."
o))
(defun outline--insert-open-button ()
- (save-excursion
- (beginning-of-line)
- (when (derived-mode-p 'special-mode)
- (let ((inhibit-read-only t))
- (insert " ")
- (beginning-of-line)))
- (let ((o (outline--make-button-overlay 'open)))
- (overlay-put o 'help-echo "Click to hide")
- (overlay-put o 'keymap
- (define-keymap
- "RET" #'outline-hide-subtree
- "<mouse-2>" #'outline-hide-subtree)))))
+ (with-silent-modifications
+ (save-excursion
+ (beginning-of-line)
+ (when (derived-mode-p 'special-mode)
+ (let ((inhibit-read-only t))
+ (insert " ")
+ (beginning-of-line)))
+ (let ((o (outline--make-button-overlay 'open)))
+ (overlay-put o 'help-echo "Click to hide")
+ (overlay-put o 'keymap
+ (define-keymap
+ "RET" #'outline-hide-subtree
+ "<mouse-2>" #'outline-hide-subtree))))))
(defun outline--insert-close-button ()
- (save-excursion
- (beginning-of-line)
- (when (derived-mode-p 'special-mode)
- (let ((inhibit-read-only t))
- (insert " ")
- (beginning-of-line)))
- (let ((o (outline--make-button-overlay 'close)))
- (overlay-put o 'help-echo "Click to show")
- (overlay-put o 'keymap
- (define-keymap
- "RET" #'outline-show-subtree
- "<mouse-2>" #'outline-show-subtree)))))
+ (with-silent-modifications
+ (save-excursion
+ (beginning-of-line)
+ (when (derived-mode-p 'special-mode)
+ (let ((inhibit-read-only t))
+ (insert " ")
+ (beginning-of-line)))
+ (let ((o (outline--make-button-overlay 'close)))
+ (overlay-put o 'help-echo "Click to show")
+ (overlay-put o 'keymap
+ (define-keymap
+ "RET" #'outline-show-subtree
+ "<mouse-2>" #'outline-show-subtree))))))
(defun outline--fix-up-all-buttons (&optional from to)
(when from
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index aefe3c12dc..6dba733b9c 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -761,7 +761,8 @@ It is a vector of the form [ VELOCITY TIME SIGN ]."
(let ((window (mwheel-event-window event))
;; The animations are smoother if the GC threshold is
;; reduced for the duration of the animation.
- (gc-cons-threshold (* gc-cons-threshold 3))
+ (gc-cons-threshold (min most-positive-fixnum
+ (* gc-cons-threshold 3)))
(state nil))
(when (framep window)
(setq window (frame-selected-window window)))
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 8fe72ddf59..fb944f4d76 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -82,13 +82,6 @@
;; Non-customize variables.
-(defmacro 5x5-defvar-local (var value doc)
- "Define VAR to VALUE with documentation DOC and make it buffer local."
- (declare (obsolete defvar-local "28.1"))
- `(progn
- (defvar ,var ,value ,doc)
- (make-variable-buffer-local (quote ,var))))
-
(defvar-local 5x5-grid nil
"5x5 grid contents.")
@@ -930,14 +923,15 @@ lest."
;; Support functions
-(define-obsolete-function-alias '5x5-xor 'xor "27.1")
-
(defun 5x5-y-or-n-p (prompt)
"5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting."
(if 5x5-hassle-me
(y-or-n-p prompt)
t))
+(define-obsolete-function-alias '5x5-xor #'xor "27.1")
+(define-obsolete-function-alias '5x5-defvar-local #'defvar-local "28.1")
+
(provide '5x5)
;;; 5x5.el ends here
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index fcdd2a7ce9..7ede8e358a 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -123,7 +123,8 @@ Emit STARTMSG and ENDMSG before and after. Cache the
result; second
and subsequent calls on the same file won't go to disk."
(setq phrase-file (cookie-check-file phrase-file))
(let ((sym (intern-soft phrase-file cookie-cache)))
- (and sym (not (equal (symbol-function sym)
+ (and sym (not (time-equal-p
+ (symbol-function sym)
(file-attribute-modification-time
(file-attributes phrase-file))))
(yes-or-no-p (concat phrase-file
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index fbff0b1bbb..f87068e113 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -1,7 +1,6 @@
;;; doctor.el --- psychological help for frustrated users -*-
lexical-binding: t -*-
-;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
@@ -136,14 +135,14 @@ Like Text mode with Auto Fill mode
except that RET when point is after a newline, or LFD at any time,
reads the sentence before point, and prints the Doctor's answer."
:interactive nil
- (make-doctor-variables)
+ (doctor-make-variables)
(turn-on-auto-fill)
(doctor-type '(i am the psychotherapist \.
(doc$ doctor--please) (doc$ doctor--describe) your (doc$
doctor--problems) \.
each time you are finished talking\, type \R\E\T twice \.))
(insert "\n"))
-(defun make-doctor-variables ()
+(defun doctor-make-variables ()
(setq-local doctor--typos
(mapcar (lambda (x)
(put (car x) 'doctor-correction (cadr x))
@@ -1620,6 +1619,8 @@ Hack on previous word, setting global variable
DOCTOR-OWNER to correct result."
(defun doctor-chat () (doctor-type (doc$ doctor--chatlst)))
+(define-obsolete-function-alias 'make-doctor-variables #'doctor-make-variables
"29.1")
+
(provide 'doctor)
;;; doctor.el ends here
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index 3bc51f6d68..0973f2bc5f 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -1,6 +1,6 @@
;;; fortune.el --- use fortune to create signatures -*- lexical-binding: t -*-
-;; Copyright (C) 1999, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2022 Free Software Foundation, Inc.
;; Author: Holger Schauer <Holger.Schauer@gmx.de>
;; Keywords: games utils mail
@@ -21,38 +21,48 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
+
;; This utility allows you to automatically cut regions to a fortune
;; file. In case that the region stems from an article buffer (mail or
;; news), it will try to automatically determine the author of the
-;; fortune. It will also allow you to compile your fortune-database
+;; fortune. It will also allow you to compile your fortune database
;; as well as providing a function to extract a fortune for use as your
;; signature.
+;;
;; Of course, it can simply display a fortune, too.
;; Use prefix arguments to specify different fortune databases.
-
+;;
;;; Installation:
-
-;; Please check the customize settings -- you will at least have to
-;; modify the values of `fortune-dir' and `fortune-file'.
-
+;;
+;; Please type `M-x customize-group RET fortune RET' -- you will at
+;; least have to modify the user options `fortune-dir' and
+;; `fortune-file'.
+;;
;; I then use this in my .gnus:
-;;(message "Making new signature: %s" (fortune-to-signature "~/fortunes/"))
+;;
+;; (message "Making new signature: %s"
+;; (fortune-to-signature "~/fortunes/"))
+;;
;; This automagically creates a new signature when starting up Gnus.
-;; Note that the call to fortune-to-signature specifies a directory in which
-;; several fortune-files and their databases are stored.
-
-;; If you like to get a new signature for every message, you can also hook
-;; it into message-mode:
-;; (add-hook 'message-setup-hook 'fortune-to-signature)
-;; This time no fortune-file is specified, so fortune-to-signature would use
-;; the default-file as specified by fortune-file.
-
-;; I have also this in my .gnus:
-;;(add-hook 'gnus-article-mode-hook
-;; (lambda ()
-;; (define-key gnus-article-mode-map "i" 'fortune-from-region)))
+;; Note that the call to `fortune-to-signature' specifies a directory
+;; in which several fortune files and their databases are stored.
+;;
+;; To get a new signature for every message, you can hook it into
+;; `message-mode':
+;;
+;; (add-hook 'message-setup-hook #'fortune-to-signature)
+;;
+;; This time no fortune file is specified, so `fortune-to-signature'
+;; would use the default file as specified by `fortune-file'.
+;;
+;; I also have this in my .gnus:
+;;
+;; (add-hook 'gnus-article-mode-hook
+;; (lambda ()
+;; (define-key gnus-article-mode-map "i"
#'fortune-from-region)))
+;;
;; which allows marking a region and then pressing "i" so that the marked
-;; region will be automatically added to my favorite fortune-file.
+;; region will be automatically added to my favorite fortune file.
;;; Code:
@@ -166,7 +176,7 @@ If INTERACTIVE is non-nil, don't compile the fortune file
afterwards."
(fortune-compile file)))))
(defun fortune-ask-file ()
- "Asks the user for a file-name."
+ "Ask the user for the file name of the fortune file."
(expand-file-name
(read-file-name
"Fortune file to use: "
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index 227dd790af..58fb82b6ed 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -73,7 +73,7 @@
"Non-nil means that hanoi poles are oriented horizontally."
:type 'boolean)
-(defcustom hanoi-move-period 1.0
+(defcustom hanoi-move-period 1
"Time, in seconds, for each pole-to-pole move of a ring.
If nil, move rings as fast as possible while displaying all
intermediate positions."
@@ -112,35 +112,32 @@ intermediate positions."
(prefix-numeric-value current-prefix-arg))))
(if (< nrings 0)
(error "Negative number of rings"))
- (hanoi-internal nrings (make-list nrings 0) (float-time)))
+ (hanoi-internal nrings (make-list nrings 0) (time-convert nil 'integer)))
;;;###autoload
(defun hanoi-unix ()
- "Towers of Hanoi, UNIX doomsday version.
-Displays 32-ring towers that have been progressing at one move per
-second since 1970-01-01 00:00:00 GMT.
+ "Towers of Hanoi, 32-bit UNIX doomsday version.
+Display 32-ring towers that have been progressing at one move per
+second since 1970-01-01 00:00:00 UTC.
Repent before ring 31 moves."
(interactive)
- (let* ((start (ftruncate (float-time)))
- (bits (cl-loop repeat 32
- for x = (/ start (expt 2.0 31)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
- (hanoi-move-period 1.0))
+ (let* ((start (time-convert nil 'integer))
+ (bits (nreverse (cl-loop repeat 32
+ for x = start then (ash x -1)
+ collect (logand x 1))))
+ (hanoi-move-period 1))
(hanoi-internal 32 bits start)))
;;;###autoload
(defun hanoi-unix-64 ()
- "Like `hanoi-unix', but pretend to have a 64-bit clock.
-This is, necessarily (as of Emacs 20.3), a crock. When the
-`current-time' interface is made s2G-compliant, hanoi.el will need
-to be updated."
+ "Like `hanoi-unix', but with a 64-bit clock."
(interactive)
- (let* ((start (ftruncate (float-time)))
- (bits (cl-loop repeat 64
- for x = (/ start (expt 2.0 63)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
- (hanoi-move-period 1.0))
+ (let* ((start (time-convert nil 'integer))
+ (bits (nreverse (cl-loop repeat 64
+ for x = start then (ash x -1)
+ collect (logand x 1))))
+ (hanoi-move-period 1))
(hanoi-internal 64 bits start)))
(defun hanoi-internal (nrings bits start-time)
@@ -378,9 +375,10 @@ BITS must be of length nrings. Start at START-TIME."
(/ (- tick flyward-ticks fly-ticks)
ticks-per-pole-step))))))))
(if hanoi-move-period
- (cl-loop for elapsed = (- (float-time) start-time)
- while (< elapsed hanoi-move-period)
- with tick-period = (/ (float hanoi-move-period) total-ticks)
+ (cl-loop for elapsed = (float-time (time-subtract nil start-time))
+ while (time-less-p elapsed hanoi-move-period)
+ with tick-period = (/ (float-time hanoi-move-period)
+ total-ticks)
for tick = (ceiling elapsed tick-period) do
(hanoi-ring-to-pos ring (funcall tick-to-pos tick))
(hanoi-sit-for (- (* tick tick-period) elapsed)))
@@ -389,7 +387,7 @@ BITS must be of length nrings. Start at START-TIME."
(hanoi-sit-for 0)))
;; Always make last move to keep pole and ring data consistent
(hanoi-ring-to-pos ring (car to))
- (if hanoi-move-period (+ start-time hanoi-move-period))))
+ (if hanoi-move-period (time-add start-time hanoi-move-period))))
;; update display and pause, quitting with a pithy comment if the user
;; hits a key.
diff --git a/lisp/printing.el b/lisp/printing.el
index b9bc3581c4..534b45c772 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -4,16 +4,9 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
-;; Version: 6.9.3
+;; Old-Version: 6.9.3
;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-(defconst pr-version "6.9.3"
- "printing.el, v 6.9.3 <2007/12/09 vinicius>
-
-Please send all bug fixes and enhancements to
- bug-gnu-emacs@gnu.org and Vinicius Jose Latorre
<viniciusjl.gnu@gmail.com>
-")
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -63,10 +56,6 @@ Please send all bug fixes and enhancements to
;; spool and to despool PostScript buffer. So, `printing' provides an
;; interface to ps-print package and it also provides some extra stuff.
;;
-;; To download the latest ps-print package see
-;; `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'.
-;; Please, see README file for ps-print installation instructions.
-;;
;; `printing' was inspired by:
;;
;; print-nt.el Frederic Corne <frederic.corne@erli.fr>
@@ -942,11 +931,6 @@ Please send all bug fixes and enhancements to
;;
;; Below are some URL where you can find good utilities.
;;
-;; * For `printing' package:
-;;
-;; printing `https://www.emacswiki.org/cgi-bin/emacs/download/printing.el'
-;; ps-print `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'
-;;
;; * For GNU or Unix system:
;;
;; gs, gv
`https://www.gnu.org/software/ghostscript/ghostscript.html'
@@ -1015,10 +999,6 @@ Please send all bug fixes and enhancements to
(require 'lpr)
(require 'ps-print)
-(and (string< ps-print-version "6.6.4")
- (error "`printing' requires `ps-print' package version 6.6.4 or later"))
-
-
(defconst pr-cygwin-system
(and lpr-windows-system (getenv "OSTYPE")
(string-match "cygwin" (getenv "OSTYPE"))))
@@ -2782,7 +2762,7 @@ See `pr-ps-printer-alist'.")
["4-up" (pr-ps-buffer-preview 4 t) t]
["Other..." (pr-ps-buffer-preview nil t)
:keys "\\[pr-ps-buffer-preview]"])
- ("Region" :active (and (not pr-spool-p) (ps-mark-active-p))
+ ("Region" :active (and (not pr-spool-p) mark-active)
["1-up" (pr-ps-region-preview 1 t) t]
["2-up" (pr-ps-region-preview 2 t) t]
["4-up" (pr-ps-region-preview 4 t) t]
@@ -2837,7 +2817,7 @@ See `pr-ps-printer-alist'.")
["4-up" (pr-ps-buffer-ps-print 4 t) t]
["Other..." (pr-ps-buffer-ps-print nil t)
:keys "\\[pr-ps-buffer-ps-print]"])
- ("Region" :active (ps-mark-active-p)
+ ("Region" :active mark-active
["1-up" (pr-ps-region-ps-print 1 t) t]
["2-up" (pr-ps-region-ps-print 2 t) t]
["4-up" (pr-ps-region-ps-print 4 t) t]
@@ -2887,12 +2867,12 @@ See `pr-ps-printer-alist'.")
"Replace non-printing chars with printable representations."
["Directory" pr-printify-directory t]
["Buffer" pr-printify-buffer t]
- ["Region" pr-printify-region (ps-mark-active-p)])
+ ["Region" pr-printify-region mark-active])
("Print" :included (pr-visible-p 'text)
:help "Send text to printer"
["Directory" pr-txt-directory t]
["Buffer" pr-txt-buffer t]
- ["Region" pr-txt-region (ps-mark-active-p)]
+ ["Region" pr-txt-region mark-active]
["Mode" pr-txt-mode (pr-mode-alist-p)])
["Text Printers" pr-update-menus
:active pr-txt-printer-alist :included (pr-visible-p 'text)
@@ -3007,9 +2987,7 @@ Calls `pr-update-menus' to adjust menus."
(defconst pr-help-message
- (concat "printing.el version " pr-version
- " ps-print.el version " ps-print-version
- "\n\n
+ "\
Menu Layout
-----------
@@ -3215,14 +3193,12 @@ VI. Customization:
23. Show current settings for `printing', `ps-print' or `lpr'.
24. Quick help for printing menu layout.
-")
+"
"Printing help message.")
(defconst pr-interface-help-message
- (concat "printing.el version " pr-version
- " ps-print.el version " ps-print-version
- "\n\n
+ "\
The printing interface buffer has the same functionality as the printing menu.
The major difference is that the states (like sending PostScript generated to a
file, n-up printing, etc.) are set and saved between printing buffer
@@ -3449,7 +3425,7 @@ The printing interface buffer has the following sections:
Quick help for printing interface buffer and printing menu layout. You can
also quit the printing interface buffer or kill all printing help buffer.
-")
+"
"Printing buffer interface help message.")
@@ -4402,7 +4378,6 @@ Or choose the menu option Printing/Show
Settings/printing."
(mapconcat
#'ps-print-quote
(list
- (concat "\n;;; printing.el version " pr-version "\n")
";; internal vars"
(ps-comment-string "emacs-version " emacs-version)
(ps-comment-string "pr-txt-command " pr-txt-command)
@@ -5585,7 +5560,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defun pr-create-interface ()
"Create the front end for printing package."
(setq pr-i-buffer (buffer-name (current-buffer))
- pr-i-region (ps-mark-active-p)
+ pr-i-region mark-active
pr-i-mode (pr-mode-alist-p)
pr-i-window-configuration (current-window-configuration))
@@ -5597,9 +5572,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(switch-to-buffer (get-buffer-create pr-buffer-name))
;; header
- (let ((versions (concat "printing v" pr-version
- " ps-print v" ps-print-version)))
- (widget-insert (make-string (- 79 (length versions)) ?\ ) versions))
(pr-insert-italic "\nCurrent Directory : " 1)
(pr-insert-italic default-directory)
@@ -5651,11 +5623,11 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(nreverse choices))
" Buffer : " nil
(lambda ()
- (pr-interface-save
- (setq pr-i-region (ps-mark-active-p)
- pr-i-mode (pr-mode-alist-p)))
- (pr-update-checkbox 'pr-i-region)
- (pr-update-checkbox 'pr-i-mode)))
+ (pr-interface-save
+ (setq pr-i-region mark-active
+ pr-i-mode (pr-mode-alist-p)))
+ (pr-update-checkbox 'pr-i-region)
+ (pr-update-checkbox 'pr-i-mode)))
;; 1a. Buffer: Region
(put 'pr-i-region 'pr-widget
(pr-insert-checkbox
@@ -5663,7 +5635,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
'pr-i-region
(lambda (widget &rest _ignore)
(let ((region-p (pr-interface-save
- (ps-mark-active-p))))
+ mark-active)))
(cond ((null (widget-value widget)) ; widget is nil
(setq pr-i-region nil))
(region-p ; widget is true and there is a region
@@ -6213,6 +6185,12 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defconst pr-version "6.9.3"
+ "printing.el, v 6.9.3 <2007/12/09 vinicius>
+
+Please send all bug fixes and enhancements to
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>")
+(make-obsolete-variable 'pr-version 'emacs-version "29.1")
(provide 'printing)
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index d6e2ab8a87..5002a3bbfa 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -66,8 +66,6 @@
;;; Installation:
-;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode.
-
;; If antlr-mode is not part of your distribution, put this file into your
;; load-path and the following into your init file:
;; (autoload 'antlr-mode "antlr-mode" nil t)
@@ -75,9 +73,6 @@
;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el
;; (lambda () (speedbar-add-supported-extension ".g")))
-;; I strongly recommend to use font-lock with a support mode like
-;; jit-lock (Emacs) / lazy-shot (XEmacs).
-
;; To customize, use menu item "Antlr" -> "Customize Antlr".
;;; Code:
@@ -894,7 +889,7 @@ Used for `antlr-slow-syntactic-context'.")
;;;===========================================================================
-;;; Syntax functions -- Emacs vs XEmacs dependent, part 1
+;;; Syntax functions
;;;===========================================================================
;;;===========================================================================
@@ -2431,8 +2426,6 @@ the default language."
comment-start-skip "/\\*+ *\\|// *")
;; various -----------------------------------------------------------------
(set (make-local-variable 'font-lock-defaults) antlr-font-lock-defaults)
- (when (featurep 'xemacs)
- (easy-menu-add antlr-mode-menu))
(set (make-local-variable 'imenu-create-index-function)
#'antlr-imenu-create-index-function)
(set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 625010b04b..2495d21a10 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -285,6 +285,7 @@
(byte-compile
`(lambda (limit)
(let (res)
+ (c-skip-comments-and-strings limit)
(while (and (setq res (re-search-forward ,regexp limit t))
(progn
(goto-char (match-beginning 0))
@@ -300,43 +301,45 @@
;; with HIGHLIGHTS, a list of highlighters as specified on page
;; "Search-based Fontification" in the elisp manual. If CHECK-POINT
;; is non-nil, we will check (< (point) limit) in the main loop.
- `(while
- ,(if check-point
- `(and (< (point) limit)
- (re-search-forward ,regexp limit t))
- `(re-search-forward ,regexp limit t))
- (unless (progn
- (goto-char (match-beginning 0))
- (c-skip-comments-and-strings limit))
- (goto-char (match-end 0))
- ,@(mapcar
- (lambda (highlight)
- (if (integerp (car highlight))
- ;; e.g. highlight is (1 font-lock-type-face t)
- (progn
- (unless (eq (nth 2 highlight) t)
- (error
- "The override flag must currently be t in %s"
- highlight))
- (when (nth 3 highlight)
- (error
- "The laxmatch flag may currently not be set in %s"
- highlight))
- `(save-match-data
- (c-put-font-lock-face
- (match-beginning ,(car highlight))
- (match-end ,(car highlight))
- ,(elt highlight 1))))
- ;; highlight is an "ANCHORED HIGHLIGHTER" of the form
- ;; (ANCHORED-MATCHER PRE-FORM POST-FORM SUBEXP-HIGHLIGHTERS...)
- (when (nth 3 highlight)
- (error "Match highlights currently not supported in %s"
+ `(progn
+ (c-skip-comments-and-strings limit)
+ (while
+ ,(if check-point
+ `(and (< (point) limit)
+ (re-search-forward ,regexp limit t))
+ `(re-search-forward ,regexp limit t))
+ (unless (progn
+ (goto-char (match-beginning 0))
+ (c-skip-comments-and-strings limit))
+ (goto-char (match-end 0))
+ ,@(mapcar
+ (lambda (highlight)
+ (if (integerp (car highlight))
+ ;; e.g. highlight is (1 font-lock-type-face t)
+ (progn
+ (unless (eq (nth 2 highlight) t)
+ (error
+ "The override flag must currently be t in %s"
+ highlight))
+ (when (nth 3 highlight)
+ (error
+ "The laxmatch flag may currently not be set in %s"
highlight))
- `(progn
- ,(nth 1 highlight)
- (save-match-data ,(car highlight))
- ,(nth 2 highlight))))
- highlights))))
+ `(save-match-data
+ (c-put-font-lock-face
+ (match-beginning ,(car highlight))
+ (match-end ,(car highlight))
+ ,(elt highlight 1))))
+ ;; highlight is an "ANCHORED HIGHLIGHTER" of the form
+ ;; (ANCHORED-MATCHER PRE-FORM POST-FORM
SUBEXP-HIGHLIGHTERS...)
+ (when (nth 3 highlight)
+ (error "Match highlights currently not supported in %s"
+ highlight))
+ `(progn
+ ,(nth 1 highlight)
+ (save-match-data ,(car highlight))
+ ,(nth 2 highlight))))
+ highlights)))))
(defun c-make-font-lock-search-function (regexp &rest highlights)
;; This function makes a byte compiled function that works much like
@@ -416,6 +419,8 @@
;; lambda more easily.
(byte-compile
`(lambda (limit)
+ (let ((lit-start (c-literal-start)))
+ (when lit-start (goto-char lit-start)))
(let ( ;; The font-lock package in Emacs is known to clobber
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index c5964165c8..75f1660f22 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -850,7 +850,7 @@ This is of the form that fits inside [ ] in a regexp."
"Regexp matching identifiers and keywords (with submatch 0). Assumed
to match if `c-symbol-start' matches on the same position."
t (concat (c-lang-const c-symbol-start)
- "[" (c-lang-const c-symbol-chars) "]*")
+ "[" (c-lang-const c-symbol-chars) "]\\{,1000\\}")
pike (concat
;; Use the value from C here since the operator backquote is
;; covered by the other alternative.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 70fc1cb73a..027fd8f42f 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1518,7 +1518,12 @@ Note that the style variables are always made local to
the buffer."
;; Move to end of logical line (as it will be after the change, or as it
;; was before unescaping a NL.)
- (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
+ (while
+ (progn (end-of-line)
+ (and
+ (eq (char-before) ?\\)
+ (not (eobp))))
+ (forward-line))
;; We're at an EOLL or point-max.
(if (equal (c-get-char-property (point) 'syntax-table) '(15))
(if (memq (char-after) '(?\n ?\r))
@@ -1636,8 +1641,12 @@ Note that the style variables are always made local to
the buffer."
(min (1+ end) ; 1+, if we're inside an escaped NL.
(point-max))
end))
- (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
- nil t)
+ (while
+ (progn (end-of-line)
+ (and
+ (eq (char-before) ?\\)
+ (not (eobp))))
+ (forward-line))
(point))
c-new-END))
s)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ab70d574c5..91c00ad048 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -98,7 +98,7 @@
(let (answer)
(while list
(or answer
- (if (or (x-color-defined-p (car list))
+ (if (or (color-defined-p (car list))
(null (cdr list)))
(setq answer (car list))))
(setq list (cdr list)))
@@ -8415,10 +8415,12 @@ the appropriate statement modifier."
(interactive)
(cperl-perldoc (cperl-word-at-point)))
-(defcustom pod2man-program "pod2man"
+(define-obsolete-variable-alias 'pod2man-program 'cperl-pod2man-program "29.1")
+(defcustom cperl-pod2man-program "pod2man"
"File name for `pod2man'."
:type 'file
- :group 'cperl)
+ :group 'cperl
+ :version "29.1")
;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes)
(defun cperl-pod-to-manpage ()
@@ -8437,7 +8439,6 @@ the appropriate statement modifier."
(format (cperl-pod2man-build-command) pod2man-args))
'Man-bgproc-sentinel)))))
-;; Updated version by him too
(defun cperl-build-manpage ()
"Create a virtual manpage in Emacs from the POD in the file."
(interactive)
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 96cbcba9be..f369379777 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -4,7 +4,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
-;; Version: 4.4
+;; Old-Version: 4.4
;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
@@ -22,16 +22,6 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-(defconst ebnf-version "4.4"
- "ebnf2ps.el, v 4.4 <2007/02/12 vinicius>
-
-Vinicius's last change version. When reporting bugs, please also
-report the version of Emacs, if any, that ebnf2ps was running with.
-
-Please send all bug fixes and enhancements to
- Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.")
-
-
;;; Commentary:
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1154,9 +1144,6 @@ Please send all bug fixes and enhancements to
(require 'ps-print)
(eval-when-compile (require 'cl-lib))
-(and (string< ps-print-version "5.2.3")
- (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:
@@ -2037,7 +2024,6 @@ It must be a float between 0.0 (top) and 1.0 (bottom)."
:group 'ebnf2ps)
-;; Printing color requires x-color-values.
(defcustom ebnf-color-p t
"Non-nil means use color."
:type 'boolean
@@ -2456,8 +2442,6 @@ See also `ebnf-syntax-buffer'."
"Return the current ebnf2ps setup."
(format
"
-;;; ebnf2ps.el version %s
-
;;; Emacs version %S
\(setq ebnf-special-show-delimiter %S
@@ -2526,7 +2510,6 @@ See also `ebnf-syntax-buffer'."
;;; ebnf2ps.el - end of settings
"
- ebnf-version
emacs-version
ebnf-special-show-delimiter
(ps-print-quote ebnf-special-font)
@@ -2959,7 +2942,7 @@ See section \"Actions in Comments\" in ebnf2ps
documentation.")
(defvar ebnf-eps-file-alist nil
-"Alist associating file name with EPS header and footer.
+ "Alist associating file name with EPS header and footer.
Each element has the following form:
@@ -4524,7 +4507,7 @@ end
(defun ebnf-generate-eps (tree)
(let* ((ebnf-tree tree)
- (ps-color-p (and ebnf-color-p (ps-color-device)))
+ (ps-color-p (and ebnf-color-p (display-color-p)))
(ps-print-color-scale (if ps-color-p
(float (car (color-values "white")))
1.0))
@@ -4626,7 +4609,7 @@ end
(defun ebnf-generate (tree)
(let* ((ebnf-tree tree)
- (ps-color-p (and ebnf-color-p (ps-color-device)))
+ (ps-color-p (and ebnf-color-p (display-color-p)))
(ps-print-color-scale (if ps-color-p
(float (car (color-values "white")))
1.0))
@@ -5243,11 +5226,7 @@ killed after process termination."
(not (search-forward "& ebnf2ps v"
(line-end-position)
t))
- (progn
- ;; adjust creator comment
- (end-of-line)
- ;; (backward-char)
- (insert " & ebnf2ps v" ebnf-version)
+ (progn
;; insert ebnf settings & engine
(goto-char (point-max))
(search-backward "\n%%EndProlog\n")
@@ -5273,7 +5252,7 @@ killed after process termination."
(format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
"\n%%Title: " filename
"\n%%CreationDate: " (format-time-string "%T %b %d %Y")
- "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
+ "\n%%Creator: " (user-full-name) " (using GNU Emacs " emacs-version ")"
"\n%%DocumentNeededResources: font "
(or ebnf-fonts-required
(setq ebnf-fonts-required
@@ -6351,6 +6330,15 @@ killed after process termination."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defconst ebnf-version "4.4"
+ "ebnf2ps.el, v 4.4 <2007/02/12 vinicius>
+
+Vinicius's last change version. When reporting bugs, please also
+report the version of Emacs, if any, that ebnf2ps was running with.
+
+Please send all bug fixes and enhancements to
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.")
+(make-obsolete-variable 'ebnf-version 'emacs-version "29.1")
(provide 'ebnf2ps)
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 786c5ae804..58d7a2026e 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1117,7 +1117,7 @@ Auto-indent does not happen if a numeric ARG is used."
(eq ?\t (char-after (line-beginning-position)))
(not (or (eq last-command 'fortran-indent-line)
(eq last-command
- 'fortran-indent-new-line))))
+ 'reindent-then-newline-and-indent))))
(save-excursion
(re-search-backward "[^ \t0-9]"
(line-beginning-position)
@@ -1586,10 +1586,6 @@ Return point or nil."
(if (< (current-column) cfi)
(move-to-column cfi)))))
-;; Historically this was a separate function which advertised itself
-;; as reindenting but only did so where `most likely to be necessary'.
-(defalias 'fortran-indent-new-line 'reindent-then-newline-and-indent)
-
(defun fortran-indent-subprogram ()
"Properly indent the Fortran subprogram containing point."
(interactive "*")
@@ -1926,9 +1922,6 @@ If ALL is nil, only match comments that start in column >
0."
;; Result.
(nth 3 parse-state))))))
-;; From old version.
-(defalias 'fortran-auto-fill-mode 'auto-fill-mode)
-
(defun fortran-fill ()
"Fill the current line at an appropriate point(s)."
(let* ((auto-fill-function #'fortran-auto-fill)
@@ -2215,6 +2208,9 @@ arg DO-SPACE prevents stripping the whitespace."
:active (not (lookup-key (current-local-map) [menu-bar index]))
:help "Add an index menu to the menu-bar"]))
+(define-obsolete-function-alias 'fortran-indent-new-line
#'reindent-then-newline-and-indent "29.1")
+(define-obsolete-function-alias 'fortran-auto-fill-mode #'auto-fill-mode
"29.1")
+
(provide 'fortran)
;;; fortran.el ends here
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 940710f7c5..6f67eff31a 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -92,6 +92,7 @@
(require 'cl-seq)
(require 'bindat)
(eval-when-compile (require 'pcase))
+(require 'subr-x) ; `string-pad'
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
@@ -126,9 +127,9 @@ Possible value: main, $rsp, x+3.")
"Address of memory display.")
(defvar-local gdb-memory-last-address nil
"Last successfully accessed memory address.")
-(defvar gdb-memory-next-page nil
+(defvar gdb-memory-next-page nil
"Address of next memory page for program memory buffer.")
-(defvar gdb-memory-prev-page nil
+(defvar gdb-memory-prev-page nil
"Address of previous memory page for program memory buffer.")
(defvar-local gdb--memory-display-warning nil
"Display warning on memory header if t.
@@ -2943,7 +2944,8 @@ Return position where LINE begins."
start-posn)))
(defun gdb-pad-string (string padding)
- (format (concat "%" (number-to-string padding) "s") string))
+ (declare (obsolete string-pad "29.1"))
+ (string-pad string padding nil t))
;; gdb-table struct is a way to programmatically construct simple
;; tables. It help to reliably align columns of data in GDB buffers
@@ -2985,13 +2987,13 @@ calling `gdb-table-string'."
"Return TABLE as a string with columns separated with SEP."
(let ((column-sizes (gdb-table-column-sizes table)))
(mapconcat
- 'identity
+ #'identity
(cl-mapcar
(lambda (row properties)
- (apply 'propertize
- (mapconcat 'identity
- (cl-mapcar (lambda (s x) (gdb-pad-string s x))
- row column-sizes)
+ (apply #'propertize
+ (mapconcat #'identity
+ (cl-mapcar (lambda (s x) (string-pad s x nil t))
+ row column-sizes)
sep)
properties))
(gdb-table-rows table)
@@ -3688,10 +3690,11 @@ in `gdb-memory-format'."
(dolist (row memory)
(insert (concat (gdb-mi--field row 'addr) ":"))
(dolist (column (gdb-mi--field row 'data))
- (insert (gdb-pad-string column
- (+ 2 (gdb-memory-column-width
- gdb-memory-unit
- gdb-memory-format)))))
+ (insert (string-pad column
+ (+ 2 (gdb-memory-column-width
+ gdb-memory-unit
+ gdb-memory-format))
+ nil t)))
(newline)))
;; Show last page instead of empty buffer when out of bounds
(when gdb-memory-last-address
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index f2ada676ab..d09e1f4cdf 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -2521,8 +2521,7 @@ Turn off hiding by calling `show-ifdefs'."
(or hide-ifdef-read-only hif-outside-read-only))
(and hide-ifdef-verbose
(message "Hiding done, %.1f seconds elapsed"
- (float-time (time-subtract (current-time)
- hide-start-time)))))))
+ (float-time (time-subtract nil hide-start-time)))))))
(defun show-ifdefs (&optional start end)
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index b3dc3cac76..b290854e1b 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -8811,7 +8811,7 @@ to reset the variable `idlwave-true-path-alist' to nil."
;; ----------------------------------------------------------------------------
;;
-;; Additions for use with imenu.el and func-menu.el
+;; Additions for use with imenu.el
;; (pop-up a list of IDL units in the current file).
;;
@@ -8835,16 +8835,7 @@ Assumes that point is at the beginning of the unit as
found by
"[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")
(buffer-substring-no-properties begin (point))))
-(defalias 'idlwave-function-menu
- (condition-case nil
- (progn
- (require 'func-menu)
- 'function-menu)
- (error (condition-case nil
- (progn
- (require 'imenu)
- 'imenu)
- (error nil)))))
+(define-obsolete-function-alias 'idlwave-function-menu #'imenu "29.1")
(defun idlwave-edit-in-idlde ()
"Edit the current file in IDL Development environment."
@@ -8864,7 +8855,7 @@ Assumes that point is at the beginning of the unit as
found by
;; Menus - using easymenu.el
(defvar idlwave-mode-menu-def
'("IDLWAVE"
- ["PRO/FUNC menu" idlwave-function-menu t]
+ ["PRO/FUNC menu" imenu t]
("Motion"
["Subprogram Start" idlwave-beginning-of-subprogram t]
["Subprogram End" idlwave-end-of-subprogram t]
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index eb2a1e4fcc..d2c24a7581 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -307,9 +307,6 @@ Match group 1 is the name of the macro.")
(defconst js--font-lock-keywords-2
(append js--font-lock-keywords-1
(list (list js--keyword-re 1 font-lock-keyword-face)
- (list "\\_<for\\_>"
- "\\s-+\\(each\\)\\_>" nil nil
- (list 1 'font-lock-keyword-face))
(cons js--basic-type-re font-lock-type-face)
(cons js--constant-re font-lock-constant-face)))
"Level two font lock keywords for `js-mode'.")
@@ -1830,22 +1827,23 @@ context."
(defun js--class-decl-matcher (limit)
"Font lock function used by `js-mode'.
This performs fontification according to `js--class-styles'."
- (cl-loop initially (js--ensure-cache limit)
- while (re-search-forward js--quick-match-re limit t)
- for orig-end = (match-end 0)
- do (goto-char (match-beginning 0))
- if (cl-loop for style in js--class-styles
- for decl-re = (plist-get style :class-decl)
- if (and (memq (plist-get style :framework)
- js-enabled-frameworks)
- (memq (js-syntactic-context)
- (plist-get style :contexts))
- decl-re
- (looking-at decl-re))
- do (goto-char (match-end 0))
- and return t)
- return t
- else do (goto-char orig-end)))
+ (when js-enabled-frameworks
+ (cl-loop initially (js--ensure-cache limit)
+ while (re-search-forward js--quick-match-re limit t)
+ for orig-end = (match-end 0)
+ do (goto-char (match-beginning 0))
+ if (cl-loop for style in js--class-styles
+ for decl-re = (plist-get style :class-decl)
+ if (and (memq (plist-get style :framework)
+ js-enabled-frameworks)
+ (memq (js-syntactic-context)
+ (plist-get style :contexts))
+ decl-re
+ (looking-at decl-re))
+ do (goto-char (match-end 0))
+ and return t)
+ return t
+ else do (goto-char orig-end))))
(defconst js--font-lock-keywords
'(js--font-lock-keywords-3 js--font-lock-keywords-1
@@ -3490,6 +3488,12 @@ This function is intended for use in
`after-change-functions'."
;;(syntax-propertize (point-max))
)
+;;;###autoload
+(define-derived-mode js-json-mode js-mode "JSON"
+ ;; JSON files can be big. Speed up syntax-ppss.
+ (setq-local syntax-propertize-function nil)
+ (setq-local js-enabled-frameworks nil))
+
;; Since we made JSX support available and automatically-enabled in
;; the base `js-mode' (for ease of use), now `js-jsx-mode' simply
;; serves as one other interface to unconditionally enable JSX in
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index f0fd23f3bc..30d37cf7ec 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -156,14 +156,14 @@
(cons (concat "\\<" type-keywords "\\>"
"\\([ \t\f]+\\(\\sw+\\)\\)*")
'((1 font-lock-type-face)
- (font-lock-match-meta-declaration-item-and-skip-to-next
+ (meta-font-lock-match-declaration-item-and-skip-to-next
(goto-char (match-end 1)) nil
(1 font-lock-variable-name-face nil t))))
;; argument declarations: expr, suffix, text, ...
(cons (concat "\\<" args-keywords "\\>"
"\\([ \t\f]+\\(\\sw+\\|\\s_+\\)\\)*")
'((1 font-lock-type-face)
- (font-lock-match-meta-declaration-item-and-skip-to-next
+ (meta-font-lock-match-declaration-item-and-skip-to-next
(goto-char (match-end 1)) nil
(1 font-lock-variable-name-face nil t))))
;; special case of arguments: expr x of y
@@ -193,8 +193,7 @@
))
"Default expressions to highlight in Metafont or MetaPost mode.")
-
-(defun font-lock-match-meta-declaration-item-and-skip-to-next (limit)
+(defun meta-font-lock-match-declaration-item-and-skip-to-next (limit)
;; Match and move over Metafont/MetaPost declaration item after point.
;;
;; The expected syntax of an item is either "word" or "symbol",
@@ -803,11 +802,6 @@ The environment marked is the one that contains point or
follows point."
(defvar meta-common-mode-map
(let ((map (make-sparse-keymap)))
- ;; Comment Paragraphs:
- ;; (define-key map "\M-a" 'backward-sentence)
- ;; (define-key map "\M-e" 'forward-sentence)
- ;; (define-key map "\M-h" 'mark-paragraph)
- ;; (define-key map "\M-q" 'fill-paragraph)
;; Navigation:
(define-key map "\M-\C-a" 'meta-beginning-of-defun)
(define-key map "\M-\C-e" 'meta-end-of-defun)
@@ -824,10 +818,6 @@ The environment marked is the one that contains point or
follows point."
(define-key map "\C-c:" 'meta-uncomment-region)
;; Symbol Completion:
(define-key map "\M-\t" 'completion-at-point)
- ;; Shell Commands:
- ;; (define-key map "\C-c\C-c" 'meta-command-file)
- ;; (define-key map "\C-c\C-k" 'meta-kill-job)
- ;; (define-key map "\C-c\C-l" 'meta-recenter-output)
map)
"Keymap used in Metafont or MetaPost mode.")
@@ -852,10 +842,6 @@ The environment marked is the one that contains point or
follows point."
:active mark-active]
"--"
["Complete Symbol" completion-at-point t]
-; "--"
-; ["Command on Buffer" meta-command-file t]
-; ["Kill Job" meta-kill-job t]
-; ["Recenter Output Buffer" meta-recenter-output-buffer t]
))
@@ -936,6 +922,10 @@ The environment marked is the one that contains point or
follows point."
(list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
(list "" 'ispell-complete-word))))
+(define-obsolete-function-alias
+ 'font-lock-match-meta-declaration-item-and-skip-to-next
+ #'meta-font-lock-match-declaration-item-and-skip-to-next "29.1")
+
(provide 'meta-mode)
(run-hooks 'meta-mode-load-hook)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 92b47ce88f..70cb460568 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -1120,7 +1120,6 @@ Returns (parse-state) if line starts inside a string."
(t (forward-char -1) (forward-comment (- (point))) t)))))
;; note: this may be slower than the c-mode version, but I can understand it.
-(defalias 'indent-perl-exp 'perl-indent-exp)
(defun perl-indent-exp ()
"Indent each line of the Perl grouping following point."
(interactive)
@@ -1220,7 +1219,6 @@ With argument, repeat that many times; negative args move
backward."
(goto-char (point-min)))))
(setq arg (1+ arg)))))
-(defalias 'mark-perl-function 'perl-mark-function)
(defun perl-mark-function ()
"Put mark at end of Perl function, point at beginning."
(interactive)
@@ -1230,6 +1228,9 @@ With argument, repeat that many times; negative args move
backward."
(perl-beginning-of-function)
(backward-paragraph))
+(define-obsolete-function-alias 'indent-perl-exp #'perl-indent-exp "29.1")
+(define-obsolete-function-alias 'mark-perl-function #'perl-mark-function
"29.1")
+
(provide 'perl-mode)
;;; perl-mode.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index e3ddf28bbb..6437bbd4c1 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -84,14 +84,6 @@
;; You can also customize the variable
;; `prolog-program-name' (in the group `prolog-inferior') and provide
;; a full path for your Prolog system (swi, scitus, etc.).
-;;
-;; Note: I (Stefan, the current maintainer) work under XEmacs. Future
-;; developments will thus be biased towards XEmacs (OK, I admit it,
-;; I am biased towards XEmacs in general), though I will do my best
-;; to keep the GNU Emacs compatibility. So if you work under Emacs
-;; and see something that does not work do drop me a line, as I have
-;; a smaller chance to notice this kind of bugs otherwise.
-; [The above comment dates from 2011.]
;; Changelog:
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index b8fc7d4c54..96f9d14832 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -427,7 +427,19 @@ This variant of `rx' supports common Python named REGEXPS."
(: "vim:" (* space) "set" (+ space)
"fileencoding" (* space) ?= (* space)
(group-n 1 (+ (or word ?-)))
- (* space) ":")))))
+ (* space) ":"))))
+ (bytes-escape-sequence
+ (seq (not "\\")
+ (group (or "\\\\" "\\'" "\\a" "\\b" "\\f"
+ "\\n" "\\r" "\\t" "\\v"
+ (seq "\\" (** 1 3 (in "0-7")))
+ (seq "\\x" hex hex)))))
+ (string-escape-sequence
+ (or bytes-escape-sequence
+ (seq (not "\\")
+ (or (group-n 1 "\\u" (= 4 hex))
+ (group-n 1 "\\U" (= 8 hex))
+ (group-n 1 "\\N{" (*? anychar) "}"))))))
(rx ,@regexps)))
@@ -539,6 +551,37 @@ the {...} holes that appear within f-strings."
(goto-char (min limit (1+ send)))
(setq ppss (syntax-ppss))))))
+(defconst python--not-raw-bytes-literal-start-regexp
+ (rx (or bos (not alnum)) (or "b" "B") (or "\"" "\"\"\"" "'" "'''") eos)
+ "A regular expression matching the start of a not-raw bytes literal.")
+
+(defconst python--not-raw-string-literal-start-regexp
+ (rx bos (or
+ ;; Multi-line string literals
+ (seq (? (? (not alnum)) (or "u" "U" "F" "f")) (or "\"\"\"" "'''"))
+ (seq (? anychar) (not alnum) (or "\"\"\"" "'''"))
+ ;; Single line string literals
+ (seq (? (** 0 2 anychar) (not alnum)) (or "u" "U" "F" "f") (or "'"
"\""))
+ (seq (? (** 0 3 anychar) (not (any "'\"" alnum))) (or "'" "\"")))
+ eos)
+ "A regular expression matching the start of a not-raw string literal.")
+
+(defun python--string-bytes-literal-matcher (regexp start-regexp)
+ "Match REGEXP within a string or bytes literal whose start matches
START-REGEXP."
+ (lambda (limit)
+ (cl-loop for result = (re-search-forward regexp limit t)
+ for result-valid = (and
+ result
+ (when-let* ((pos (nth 8 (syntax-ppss)))
+ (before-quote
+ (buffer-substring-no-properties
+ (max (- pos 4) (point-min))
+ (min (+ pos 1) (point-max)))))
+ (backward-char)
+ (string-match-p start-regexp before-quote)))
+ until (or (not result) result-valid)
+ finally return (and result-valid result))))
+
(defvar python-font-lock-keywords-level-1
`((,(python-rx symbol-start "def" (1+ space) (group symbol-name))
(1 font-lock-function-name-face))
@@ -716,7 +759,24 @@ sign in chained assignment."
grouped-assignment-target (* space)
(or ")" "]") (* space)
assignment-operator))
- (1 font-lock-variable-name-face)))
+ (1 font-lock-variable-name-face))
+ ;; escape sequences within bytes literals
+ ;; "\\" "\'" "\a" "\b" "\f" "\n" "\r" "\t" "\v"
+ ;; "\ooo" character with octal value ooo
+ ;; "\xhh" character with hex value hh
+ (,(python--string-bytes-literal-matcher
+ (python-rx bytes-escape-sequence)
+ python--not-raw-bytes-literal-start-regexp)
+ (1 font-lock-constant-face t))
+ ;; escape sequences within string literals, the same as appear in bytes
+ ;; literals in addition to:
+ ;; "\uxxxx" Character with 16-bit hex value xxxx
+ ;; "\Uxxxxxxxx" Character with 32-bit hex value xxxxxxxx
+ ;; "\N{name}" Character named name in the Unicode database
+ (,(python--string-bytes-literal-matcher
+ (python-rx string-escape-sequence)
+ python--not-raw-string-literal-start-regexp)
+ (1 'font-lock-constant-face t)))
"Font lock keywords to use in `python-mode' for maximum decoration.
This decoration level includes everything in
@@ -1709,16 +1769,16 @@ backward to previous statement."
"Move to start of current block."
(interactive "^")
(let ((starting-pos (point)))
+ ;; Go to first line beginning a statement
+ (while (and (not (bobp))
+ (or (and (python-nav-beginning-of-statement) nil)
+ (python-info-current-line-comment-p)
+ (python-info-current-line-empty-p)))
+ (forward-line -1))
(if (progn
(python-nav-beginning-of-statement)
(looking-at (python-rx block-start)))
(point-marker)
- ;; Go to first line beginning a statement
- (while (and (not (bobp))
- (or (and (python-nav-beginning-of-statement) nil)
- (python-info-current-line-comment-p)
- (python-info-current-line-empty-p)))
- (forward-line -1))
(let ((block-matching-indent
(- (current-indentation) python-indent-offset)))
(while
@@ -5800,11 +5860,6 @@ REPORT-FN is Flymake's callback function."
(add-hook 'flymake-diagnostic-functions #'python-flymake nil t))
-
(provide 'python)
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
-
;;; python.el ends here
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 2e8e8d2319..4fe4edc164 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -61,6 +61,9 @@
;;; Code:
+;; So that we can use the edebug spec in `lisp-current-defun-name'.
+(require 'edebug)
+
;; Variables for customization
;; ---------------------------
;;
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 6e21131e4a..4fb543a3bf 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -1,7 +1,6 @@
;;; xscheme.el --- run MIT Scheme under Emacs -*- lexical-binding: t;
-*-
-;; Copyright (C) 1986-1987, 1989-1990, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1986-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, lisp
@@ -71,7 +70,9 @@ by the scheme process, so additional control-g's are to be
ignored.")
(defvar xscheme-string-receiver nil
"Procedure to send the string argument from the scheme process.")
-(defconst default-xscheme-runlight
+(define-obsolete-variable-alias 'default-xscheme-runlight
+ 'xscheme-default-runlight "29.1")
+(defconst xscheme-default-runlight
'(": " xscheme-runlight-string)
"Default global (shared) xscheme-runlight mode line format.")
@@ -240,7 +241,7 @@ With argument, asks for a command line."
(list (read-buffer "Scheme interaction buffer: "
xscheme-buffer-name
t)))
- (let ((process-name (verify-xscheme-buffer buffer-name nil)))
+ (let ((process-name (xscheme-verify-buffer buffer-name nil)))
(setq-default xscheme-buffer-name buffer-name)
(setq-default xscheme-process-name process-name)
(setq-default xscheme-runlight-string
@@ -248,8 +249,8 @@ With argument, asks for a command line."
xscheme-runlight-string))
(setq-default xscheme-runlight
(if (eq (process-status process-name) 'run)
- default-xscheme-runlight
- ""))))
+ xscheme-default-runlight
+ ""))))
(defun local-set-scheme-interaction-buffer (buffer-name)
"Set the scheme interaction buffer for the current buffer."
@@ -257,7 +258,7 @@ With argument, asks for a command line."
(list (read-buffer "Scheme interaction buffer: "
xscheme-buffer-name
t)))
- (let ((process-name (verify-xscheme-buffer buffer-name t)))
+ (let ((process-name (xscheme-verify-buffer buffer-name t)))
(setq-local xscheme-buffer-name buffer-name)
(setq-local xscheme-process-name process-name)
(setq-local xscheme-runlight
@@ -273,7 +274,7 @@ With argument, asks for a command line."
(kill-local-variable 'xscheme-process-name)
(kill-local-variable 'xscheme-runlight))
-(defun verify-xscheme-buffer (buffer-name localp)
+(defun xscheme-verify-buffer (buffer-name localp)
(if (and localp (xscheme-process-buffer-current-p))
(error "Cannot change the interaction buffer of an interaction buffer"))
(let* ((buffer (get-buffer buffer-name))
@@ -921,8 +922,8 @@ the remaining input.")
(setq scheme-mode-line-process '(": " xscheme-runlight-string))
(xscheme-mode-line-initialize name)
(if (equal name (default-value 'xscheme-buffer-name))
- (setq-default xscheme-runlight default-xscheme-runlight))))
- (if (or (eq xscheme-runlight default-xscheme-runlight)
+ (setq-default xscheme-runlight xscheme-default-runlight))))
+ (if (or (eq xscheme-runlight xscheme-default-runlight)
(equal xscheme-runlight ""))
(setq xscheme-runlight (list ": " 'xscheme-buffer-name ": " "?")))
(rplaca (nthcdr 3 xscheme-runlight)
@@ -1180,6 +1181,8 @@ the remaining input.")
(if (nth 2 state) 'many 'one)))))
(set-syntax-table old-syntax-table)))))
+(define-obsolete-function-alias 'verify-xscheme-buffer #'xscheme-verify-buffer
"29.1")
+
(provide 'xscheme)
;;; xscheme.el ends here
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
deleted file mode 100644
index 8c5187ca8b..0000000000
--- a/lisp/ps-def.el
+++ /dev/null
@@ -1,134 +0,0 @@
-;;; ps-def.el --- Emacs definitions for ps-print -*- lexical-binding: t -*-
-
-;; Copyright (C) 2007-2022 Free Software Foundation, Inc.
-
-;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
-;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
-;; Keywords: wp, print, PostScript
-;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-;; Package: ps-print
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; See ps-print.el for documentation.
-
-;;; Code:
-
-(declare-function ps-plot-with-face "ps-print" (from to face))
-(declare-function ps-plot-string "ps-print" (string))
-
-(defvar ps-bold-faces) ; in ps-print.el
-(defvar ps-italic-faces)
-
-
-
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Emacs Definitions
-
-
-(defun ps-mark-active-p ()
- mark-active)
-
-
-(defun ps-face-foreground-name (face)
- (face-foreground face nil t))
-
-
-(defun ps-face-background-name (face)
- (face-background face nil t))
-
-
-(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1")
-
-;; Return t if the device (which can be changed during an emacs session) can
-;; handle colors.
-(defun ps-color-device ()
- (color-values "Green"))
-
-(define-obsolete-function-alias 'ps-color-values #'color-values "28.1")
-
-
-(defun ps-face-bold-p (face)
- (or (face-bold-p face)
- (memq face ps-bold-faces)))
-
-
-(defun ps-face-italic-p (face)
- (or (face-italic-p face)
- (memq face ps-italic-faces)))
-
-
-(defun ps-face-strikeout-p (face)
- (eq (face-attribute face :strike-through) t))
-
-
-(defun ps-face-overline-p (face)
- (eq (face-attribute face :overline) t))
-
-
-(defun ps-face-box-p (face)
- (not (memq (face-attribute face :box) '(nil unspecified))))
-
-
-;; Emacs understands the %f format; we'll use it to limit color RGB values
-;; to three decimals to cut down some on the size of the PostScript output.
-(defvar ps-color-format "%0.3f %0.3f %0.3f")
-(defvar ps-float-format "%0.3f ")
-
-
-(defun ps-generate-postscript-with-faces1 (from to)
- ;; Generate some PostScript.
- (let ((face 'default)
- (position to)
- ;; Emacs
- (property-change from)
- (overlay-change from)
- before-string after-string)
- (while (< from to)
- (and (< property-change to) ; Don't search for property change
- ; unless previous search succeeded.
- (setq property-change (next-property-change from nil to)))
- (and (< overlay-change to) ; Don't search for overlay change
- ; unless previous search succeeded.
- (setq overlay-change (min (next-overlay-change from)
- to)))
- (setq position (min property-change overlay-change)
- before-string nil
- after-string nil)
- (setq face
- (cond ((invisible-p from)
- 'emacs--invisible--face)
- ((get-char-property from 'face))
- (t 'default)))
- ;; Plot up to this record.
- (and before-string
- (ps-plot-string before-string))
- (ps-plot-with-face from position face)
- (and after-string
- (ps-plot-string after-string))
- (setq from position))
- (ps-plot-with-face from to face)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(provide 'ps-def)
-
-;;; ps-def.el ends here
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 885aa3cc7c..c7d94b129b 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -8,21 +8,9 @@
;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
-;; Version: 7.3.5
+;; Old-Version: 7.3.5
;; URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-(eval-when-compile (require 'cl-lib))
-
-(defconst ps-print-version "7.3.5"
- "ps-print.el, v 7.3.5 <2009/12/23 vinicius>
-
-Vinicius's last change version -- this file may have been edited as part of
-Emacs without changes to the version number. When reporting bugs, please also
-report the version of Emacs, if any, that ps-print was distributed with.
-
-Please send all bug fixes and enhancements to
- bug-gnu-emacs@gnu.org and Vinicius Jose Latorre
<viniciusjl.gnu@gmail.com>.")
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -1450,11 +1438,8 @@ Please send all bug fixes and enhancements to
;;; Code:
-
(require 'lpr)
-
-;; Load Emacs definitions
-(require 'ps-def)
+(eval-when-compile (require 'cl-lib))
;; autoloads for secondary file
(require 'ps-print-loaddefs)
@@ -2930,9 +2915,8 @@ Either a float or a cons of floats (LANDSCAPE-SIZE .
PORTRAIT-SIZE)."
;;; Colors
-;; Printing color requires x-color-values.
;;;###autoload
-(defcustom ps-print-color-p (fboundp 'x-color-values)
+(defcustom ps-print-color-p t
"Specify how buffer's text color is printed.
Valid values are:
@@ -3601,7 +3585,6 @@ The table depends on the current ps-print setup."
(mapconcat
#'ps-print-quote
(list
- (concat "\n;;; (Emacs) ps-print version " ps-print-version "\n")
";; internal vars"
(ps-comment-string "emacs-version " emacs-version)
(ps-comment-string "lpr-windows-system" lpr-windows-system)
@@ -4510,7 +4493,7 @@ page-height == ((floor print-height ((th + ls) * zh)) *
((th + ls) * zh)) - th
(defun ps-print-preprint-region (prefix)
- (or (ps-mark-active-p)
+ (or mark-active
(error "The mark is not set now"))
(list (point) (mark) (ps-print-preprint prefix)))
@@ -4733,6 +4716,10 @@ page-height == ((floor print-height ((th + ls) * zh)) *
((th + ls) * zh)) - th
(defun ps-output-boolean (name bool)
(ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
+;; Limit color RGB values to three decimals to cut down some on the
+;; size of the PostScript output.
+(defvar ps-color-format "%0.3f %0.3f %0.3f")
+(defvar ps-float-format "%0.3f ")
(defun ps-output-frame-properties (name alist)
(ps-output "/" name " ["
@@ -5348,7 +5335,7 @@ XSTART YSTART are the relative position for the first
page in a sheet.")
ps-adobe-tag
"%%Title: " (buffer-name) ; Take job name from name of
; first buffer printed
- "\n%%Creator: ps-print v" ps-print-version
+ "\n%%Creator: GNU Emacs " emacs-version
"\n%%For: " (user-full-name) ;FIXME: may need encoding!
"\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding!
"\n%%Orientation: "
@@ -5749,7 +5736,7 @@ XSTART YSTART are the relative position for the first
page in a sheet.")
;; Set the color scale. We do it here instead of in the defvar so
;; that ps-print can be dumped into emacs. This expression can't be
;; evaluated at dump-time because X isn't initialized.
- ps-color-p (and ps-print-color-p (ps-color-device))
+ ps-color-p (and ps-print-color-p (display-color-p))
ps-print-color-scale (if ps-color-p
(float (car (color-values "white")))
1.0)
@@ -5762,7 +5749,7 @@ XSTART YSTART are the relative position for the first
page in a sheet.")
((eq ps-default-bg 'frame-parameter)
(frame-parameter nil 'background-color))
((eq ps-default-bg t)
- (ps-face-background-name 'default))
+ (face-background 'default nil t))
(t
ps-default-bg))
"unspecified-bg"
@@ -5776,7 +5763,7 @@ XSTART YSTART are the relative position for the first
page in a sheet.")
((eq ps-default-fg 'frame-parameter)
(frame-parameter nil 'foreground-color))
((eq ps-default-fg t)
- (ps-face-foreground-name 'default))
+ (face-foreground 'default nil t))
(t
ps-default-fg))
"unspecified-fg"
@@ -6312,6 +6299,22 @@ If FACE is not a valid face name, use default face."
(setq ps-print-face-alist (cons face-map ps-print-face-alist)))
face-map))
+(defun ps-face-bold-p (face)
+ (or (face-bold-p face)
+ (memq face ps-bold-faces)))
+
+(defun ps-face-italic-p (face)
+ (or (face-italic-p face)
+ (memq face ps-italic-faces)))
+
+(defun ps-face-strikeout-p (face)
+ (eq (face-attribute face :strike-through) t))
+
+(defun ps-face-overline-p (face)
+ (eq (face-attribute face :overline) t))
+
+(defun ps-face-box-p (face)
+ (not (memq (face-attribute face :box) '(nil unspecified))))
(defun ps-screen-to-bit-face (face)
(cons face
@@ -6321,9 +6324,41 @@ If FACE is not a valid face name, use default face."
(if (ps-face-strikeout-p face) 8 0) ; strikeout
(if (ps-face-overline-p face) 16 0) ; overline
(if (ps-face-box-p face) 64 0)) ; box
- (ps-face-foreground-name face)
- (ps-face-background-name face))))
+ (face-foreground face nil t)
+ (face-background face nil t))))
+
+(defun ps-generate-postscript-with-faces1 (from to)
+ ;; Generate some PostScript.
+ (let ((face 'default)
+ (position to)
+ (property-change from)
+ (overlay-change from)
+ before-string after-string)
+ (while (< from to)
+ (and (< property-change to) ; Don't search for property change
+ ; unless previous search succeeded.
+ (setq property-change (next-property-change from nil to)))
+ (and (< overlay-change to) ; Don't search for overlay change
+ ; unless previous search succeeded.
+ (setq overlay-change (min (next-overlay-change from)
+ to)))
+ (setq position (min property-change overlay-change)
+ before-string nil
+ after-string nil)
+ (setq face
+ (cond ((invisible-p from)
+ 'emacs--invisible--face)
+ ((get-char-property from 'face))
+ (t 'default)))
+ ;; Plot up to this record.
+ (and before-string
+ (ps-plot-string before-string))
+ (ps-plot-with-face from position face)
+ (and after-string
+ (ps-plot-string after-string))
+ (setq from position))
+ (ps-plot-with-face from to face)))
(defun ps-generate-postscript-with-faces (from to)
;; Some initialization...
@@ -6501,6 +6536,17 @@ If FACE is not a valid face name, use default face."
(unless noninteractive
(add-hook 'kill-emacs-query-functions #'ps-kill-emacs-check))
+(defconst ps-print-version "7.3.5"
+ "ps-print.el, v 7.3.5 <2009/12/23 vinicius>
+
+Vinicius's last change version -- this file may have been edited as part of
+Emacs without changes to the version number. When reporting bugs, please also
+report the version of Emacs, if any, that ps-print was distributed with.
+
+Please send all bug fixes and enhancements to
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.")
+(make-obsolete-variable 'ps-print-version 'emacs-version "29.1")
+
(define-obsolete-function-alias 'ps-print-ensure-fontified #'font-lock-ensure
"29.1")
(provide 'ps-print)
diff --git a/lisp/rect.el b/lisp/rect.el
index eebbf999d4..6babd04605 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -407,7 +407,7 @@ no text on the right side of the rectangle."
(point))))))
;;;###autoload
-(defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name
+(define-obsolete-function-alias 'close-rectangle #'delete-whitespace-rectangle
"29.1")
;;;###autoload
(defun delete-whitespace-rectangle (start end &optional fill)
@@ -536,7 +536,7 @@ Called from a program, takes three args; START, END and
STRING."
(apply-on-rectangle 'string-rectangle-line start end string t)))
;;;###autoload
-(defalias 'replace-rectangle 'string-rectangle)
+(define-obsolete-function-alias 'replace-rectangle #'string-rectangle "29.1")
;;;###autoload
(defun string-insert-rectangle (start end string)
diff --git a/lisp/replace.el b/lisp/replace.el
index ab9ac17ed9..2bb9c1b90d 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -664,7 +664,10 @@ which will run faster and will not set the mark or print
anything.
\(You may need a more complex loop if FROM-STRING can match the null string
and TO-STRING is also null.)"
(declare (interactive-only
- "use `search-forward' and `replace-match' instead."))
+ "use `search-forward' and `replace-match' instead.")
+ (interactive-args
+ (start (use-region-beginning))
+ (end (use-region-end))))
(interactive
(let ((common
(query-replace-read-args
@@ -676,8 +679,7 @@ and TO-STRING is also null.)"
(if (use-region-p) " in region" ""))
nil)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
- (if (use-region-p) (region-beginning))
- (if (use-region-p) (region-end))
+ (use-region-beginning) (use-region-end)
(nth 3 common)
(if (use-region-p) (region-noncontiguous-p)))))
(perform-replace from-string to-string nil nil delimited nil nil start end
backward region-noncontiguous-p))
@@ -2741,7 +2743,9 @@ to a regexp that is actually used for the search.")
(isearch-case-fold-search case-fold)
(isearch-forward (not backward))
(isearch-other-end match-beg)
- (isearch-error nil))
+ (isearch-error nil)
+ (isearch-lazy-count nil)
+ (lazy-highlight-buffer nil))
(isearch-lazy-highlight-new-loop range-beg range-end))))
(defun replace-dehighlight ()
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index 3830e4b16c..4b13331312 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -191,7 +191,7 @@ file names."
;; First check to make sure alist has been loaded in from the master
;; file. If not, do so, then feel free to modify the alist. It
;; will be saved again when Emacs is killed.
- (or save-place-loaded (load-save-place-alist-from-file))
+ (or save-place-loaded (save-place-load-alist-from-file))
(let* ((directory (and (derived-mode-p 'dired-mode)
(boundp 'dired-subdir-alist)
dired-subdir-alist
@@ -278,7 +278,7 @@ may have changed) back to `save-place-alist'."
(file-error (message "Saving places: can't write %s" file)))
(kill-buffer (current-buffer))))))
-(defun load-save-place-alist-from-file ()
+(defun save-place-load-alist-from-file ()
(if (not save-place-loaded)
(progn
(setq save-place-loaded t)
@@ -352,7 +352,7 @@ may have changed) back to `save-place-alist'."
(defun save-place-find-file-hook ()
"Function added to `find-file-hook' by `save-place-mode'.
It runs the hook `save-place-after-find-file-hook'."
- (or save-place-loaded (load-save-place-alist-from-file))
+ (or save-place-loaded (save-place-load-alist-from-file))
(let ((cell (assoc buffer-file-name save-place-alist)))
(if cell
(progn
@@ -367,7 +367,7 @@ It runs the hook `save-place-after-find-file-hook'."
(defun save-place-dired-hook ()
"Position the point in a Dired buffer."
- (or save-place-loaded (load-save-place-alist-from-file))
+ (or save-place-loaded (save-place-load-alist-from-file))
(let* ((directory (and (derived-mode-p 'dired-mode)
(boundp 'dired-subdir-alist)
dired-subdir-alist
@@ -396,5 +396,8 @@ It runs the hook `save-place-after-find-file-hook'."
(if save-place-loaded
(save-place-alist-to-file)))
+(define-obsolete-function-alias 'load-save-place-alist-from-file
+ #'save-place-load-alist-from-file "29.1")
+
(provide 'saveplace)
;;; saveplace.el ends here
diff --git a/lisp/select.el b/lisp/select.el
index 019be9cb23..e407c22436 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -85,9 +85,6 @@ other programs (X Windows clients or MS Windows programs).
But, if this
variable is set, it is used for the next communication only.
After the communication, this variable is set to nil.")
-;; Only declared obsolete in 23.3.
-(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34")
-
(define-obsolete-variable-alias 'x-select-enable-clipboard
'select-enable-clipboard "25.1")
(defcustom select-enable-clipboard t
diff --git a/lisp/simple.el b/lisp/simple.el
index 2ef8a3cf00..a4ea345ca5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3543,10 +3543,7 @@ Return what remains of the list."
(setq visited-file-time
(with-current-buffer (buffer-base-buffer)
(visited-file-modtime))))
- (when (or (equal time visited-file-time)
- (and (consp time)
- (equal (list (car time) (cdr time))
- visited-file-time)))
+ (when (time-equal-p time visited-file-time)
(unlock-buffer)
(set-buffer-modified-p nil))))
;; Element (nil PROP VAL BEG . END) is property change.
@@ -6866,6 +6863,14 @@ point otherwise."
:version "23.1"
:group 'editing-basics)
+(defun use-region-beginning ()
+ "Return the start of the region if `use-region-p'."
+ (and (use-region-p) (region-beginning)))
+
+(defun use-region-end ()
+ "Return the end of the region if `use-region-p'."
+ (and (use-region-p) (region-end)))
+
(defun use-region-p ()
"Return t if the region is active and it is appropriate to act on it.
This is used by commands that act specially on the region under
@@ -6876,7 +6881,11 @@ mark is active; furthermore, if
`use-empty-active-region' is nil,
the region must not be empty. Otherwise, the return value is nil.
For some commands, it may be appropriate to ignore the value of
-`use-empty-active-region'; in that case, use `region-active-p'."
+`use-empty-active-region'; in that case, use `region-active-p'.
+
+Also see the convenience functions `use-region-beginning' and
+`use-region-end', which may be handy when writing `interactive'
+specs."
(and (region-active-p)
(or use-empty-active-region (> (region-end) (region-beginning)))
t))
diff --git a/lisp/subr.el b/lisp/subr.el
index 1a16d78117..4b1fc832da 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1857,6 +1857,7 @@ be a list of the form returned by `event-start' and
`event-end'."
(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame)
"24.3")
(set-advertised-calling-convention 'libxml-parse-xml-region '(start end
&optional base-url) "27.1")
(set-advertised-calling-convention 'libxml-parse-html-region '(start end
&optional base-url) "27.1")
+(set-advertised-calling-convention 'time-convert '(time form) "29.1")
;;;; Obsolescence declarations for variables, and aliases.
@@ -2700,18 +2701,44 @@ This is to `put' what `defalias' is to `fset'."
(setcdr ps (cons symbol (cdr ps))))))
(put symbol prop val))
-(defun symbol-file (symbol &optional type)
+(defvar comp-native-version-dir)
+(defvar native-comp-eln-load-path)
+(declare-function subr-native-elisp-p "data.c")
+(declare-function native-comp-unit-file "data.c")
+(declare-function subr-native-comp-unit "data.c")
+(declare-function comp-el-to-eln-rel-filename "comp.c")
+
+(defun locate-eln-file (eln-file)
+ "Locate a natively-compiled ELN-FILE by searching its load path.
+This function looks in directories named by `native-comp-eln-load-path'."
+ (or (locate-file-internal (concat comp-native-version-dir "/" eln-file)
+ native-comp-eln-load-path)
+ (locate-file-internal
+ ;; Preloaded *.eln files live in the preloaded/ subdirectory of
+ ;; the last entry in `native-comp-eln-load-path'.
+ (concat comp-native-version-dir "/preloaded/" eln-file)
+ (last native-comp-eln-load-path))))
+
+(defun symbol-file (symbol &optional type native-p)
"Return the name of the file that defined SYMBOL.
The value is normally an absolute file name. It can also be nil,
if the definition is not associated with any file. If SYMBOL
specifies an autoloaded function, the value can be a relative
file name without extension.
-If TYPE is nil, then any kind of definition is acceptable. If
-TYPE is `defun', `defvar', or `defface', that specifies function
+If TYPE is nil, then any kind of SYMBOL's definition is acceptable.
+If TYPE is `defun', `defvar', or `defface', that specifies function
definition, variable definition, or face definition only.
Otherwise TYPE is assumed to be a symbol property.
+If NATIVE-P is non-nil, and SYMBOL was loaded from a .eln file,
+this function will return the absolute file name of that .eln file,
+if found. Note that if the .eln file is older than its source .el
+file, Emacs won't load such an outdated .eln file, and this function
+will not return it. If the .eln file couldn't be found, or is
+outdated, the function returns the corresponding .elc or .el file
+instead.
+
This function only works for symbols defined in Lisp files. For
symbols that are defined in C files, use `help-C-file-name'
instead."
@@ -2719,24 +2746,59 @@ instead."
(symbolp symbol)
(autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
- (catch 'found
- (pcase-dolist (`(,file . ,elems) load-history)
- (when (if type
- (if (eq type 'defvar)
- ;; Variables are present just as their names.
- (member symbol elems)
- ;; Many other types are represented as (TYPE . NAME).
- (or (member (cons type symbol) elems)
- (memq symbol (alist-get type
- (alist-get 'define-symbol-props
- elems)))))
- ;; We accept all types, so look for variable def
- ;; and then for any other kind.
- (or (member symbol elems)
- (let ((match (rassq symbol elems)))
- (and match
- (not (eq 'require (car match)))))))
- (throw 'found file))))))
+ (if (and native-p (or (null type) (eq type 'defun))
+ (symbolp symbol)
+ (native-comp-available-p)
+ ;; If it's a defun, we have a shortcut.
+ (subr-native-elisp-p (symbol-function symbol)))
+ ;; native-comp-unit-file returns unnormalized file names.
+ (expand-file-name (native-comp-unit-file (subr-native-comp-unit
+ (symbol-function symbol))))
+ (let ((elc-file
+ (catch 'found
+ (pcase-dolist (`(,file . ,elems) load-history)
+ (when (if type
+ (if (eq type 'defvar)
+ ;; Variables are present just as their
+ ;; names.
+ (member symbol elems)
+ ;; Many other types are represented as
+ ;; (TYPE . NAME).
+ (or (member (cons type symbol) elems)
+ (memq
+ symbol
+ (alist-get type
+ (alist-get 'define-symbol-props
+ elems)))))
+ ;; We accept all types, so look for variable def
+ ;; and then for any other kind.
+ (or (member symbol elems)
+ (let ((match (rassq symbol elems)))
+ (and match
+ (not (eq 'require (car match)))))))
+ (throw 'found file))))))
+ ;; If they asked for the .eln file, try to find it.
+ (or (and elc-file
+ native-p
+ (native-comp-available-p)
+ (let* ((sans-ext (file-name-sans-extension elc-file))
+ (el-file
+ (and (fboundp 'zlib-available-p)
+ (zlib-available-p)
+ (concat sans-ext ".el.gz")))
+ (el-file-backup (concat sans-ext ".el")))
+ (or (and el-file (file-exists-p el-file))
+ (and (file-exists-p el-file-backup)
+ (setq el-file el-file-backup))
+ (setq el-file nil))
+ (when (stringp el-file)
+ (let ((eln-file (locate-eln-file
+ (comp-el-to-eln-rel-filename el-file))))
+ ;; Emacs will not load an outdated .eln file,
+ ;; so we mimic this behavior here.
+ (if (file-newer-than-file-p eln-file el-file)
+ eln-file)))))
+ elc-file)))))
(declare-function read-library-name "find-func" nil)
@@ -6577,7 +6639,7 @@ Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as
snapshot versions."
(version-list-= (version-to-list v1) (version-to-list v2)))
(defvar package--builtin-versions
- ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
+ ;; Mostly populated by loaddefs.el.
(purecopy `((emacs . ,(version-to-list emacs-version))))
"Alist giving the version of each versioned builtin package.
I.e. each element of the list is of the form (NAME . VERSION) where
@@ -6820,7 +6882,7 @@ This means that OBJECT can be printed out and then read
back
again by the Lisp reader. This function returns nil if OBJECT is
unreadable, and the printed representation (from `prin1') of
OBJECT if it is readable."
- (declare (side-effect-free t))
+ (declare (side-effect-free error-free))
(catch 'unreadable
(let ((print-unreadable-function
(lambda (_object _escape)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index d7a0978969..20ad6e1e46 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -1377,7 +1377,7 @@ to make your changes permanent."
;; Maybe update the datestamp.
(when tar-update-datestamp
(tar-alter-one-field tar-time-offset
- (concat (tar-octal-time (current-time)) " "))))
+ (concat (tar-octal-time nil) " "))))
;; After doing the insertion, add any necessary final padding.
(tar-pad-to-blocksize))
(set-buffer-modified-p t) ; mark the tar file as modified
diff --git a/lisp/term.el b/lisp/term.el
index a28d8c5d76..11c2d2aaa1 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -78,7 +78,7 @@
;; directory/username/host tracking: the only drawback is that you will
;; have to modify your shell start-up script. It's worth it, believe me :).
;;
-;; When you rlogin/su/telnet and the account you access has a modified
+;; When you ssh/sudo/su and the account you access has a modified
;; startup script, you will be able to access the remote files as usual
;; with C-x C-f, if it's needed you will have to enter a password,
;; otherwise the file should get loaded straight away.
diff --git a/lisp/textmodes/emacs-news-mode.el
b/lisp/textmodes/emacs-news-mode.el
index af0aa2ddea..e6e1f03728 100644
--- a/lisp/textmodes/emacs-news-mode.el
+++ b/lisp/textmodes/emacs-news-mode.el
@@ -56,10 +56,12 @@
"C-c C-g" #'emacs-news-goto-section
"C-c C-j" #'emacs-news-find-heading
"C-c C-e" #'emacs-news-count-untagged-entries
+ "C-x C-q" #'emacs-news-view-mode
"<remap> <open-line>" #'emacs-news-open-line)
(defvar-keymap emacs-news-view-mode-map
- :parent emacs-news-common-map)
+ :parent emacs-news-common-map
+ "C-x C-q" #'emacs-news-mode)
(defvar emacs-news-mode-font-lock-keywords
`(("^---$" 0 'emacs-news-does-not-need-documentation)
@@ -67,17 +69,20 @@
(defun emacs-news--mode-common ()
(setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t))
- (setq-local outline-regexp "\\*+ "
+ (setq-local outline-regexp "\\(:? +\\)?\\(\\*+\\) "
outline-minor-mode-cycle t
- ;; We subtract one from the level, because we have a
- ;; space after the asterisks.
- outline-level (lambda () (1- (length (match-string 0))))
+ outline-level (lambda () (length (match-string 2)))
outline-minor-mode-highlight 'append)
(outline-minor-mode))
;;;###autoload
(define-derived-mode emacs-news-mode text-mode "NEWS"
"Major mode for editing the Emacs NEWS file."
+ ;; Disable buttons.
+ (button-mode nil)
+ ;; And make the buffer writable. This is used when toggling
+ ;; emacs-news-mode.
+ (setq buffer-read-only nil)
(setq-local fill-paragraph-function #'emacs-news--fill-paragraph)
(emacs-news--mode-common))
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 2c5e30fecd..2ee20ef1d4 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -854,6 +854,9 @@ Mostly we check word delimiters."
((get this-command 'flyspell-deplacement)
(not (eq flyspell-previous-command this-command)))
((get this-command 'flyspell-delayed)
+ ;; In case we're using `delete-selection-mode', make the
+ ;; region be updated immediately.
+ (deactivate-mark)
;; The current command is not delayed, that
;; is that we must check the word now.
(and (not unread-command-events)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 8c8522a6e5..f85d0aba9c 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -4235,17 +4235,10 @@ Both should not be used to define a buffer-local
dictionary."
;;; LOCAL VARIABLES AND BUFFER-LOCAL VALUE EXAMPLES.
-;; Local Variable options:
-;; mode: name(-mode)
-;; eval: expression
-;; local-variable: value
-
;; The following sets the buffer local dictionary to `american' English
;; and spell checks only comments.
;; Local Variables:
-;; mode: emacs-lisp
-;; comment-column: 40
;; ispell-check-comments: exclusive
;; ispell-local-dictionary: "american"
;; End:
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 17d9483f68..e8c1e6b14f 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -641,7 +641,6 @@ Leaves the region surrounding the rectangle."
(define-key map [remap move-end-of-line] 'picture-end-of-line)
(define-key map [remap mouse-set-point] 'picture-mouse-set-point)
(define-key map "\C-c\C-d" 'picture-delete-char)
- (define-key map "\e\t" 'picture-toggle-tab-state)
(define-key map "\t" 'picture-tab)
(define-key map "\e\t" 'picture-tab-search)
(define-key map "\C-c\t" 'picture-set-tab-stops)
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 26b14ebc79..f3f95627af 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -1116,10 +1116,10 @@ recommended for follow mode. It works OK for
individual lookups."
(setq bibtype (reftex-bib-or-thebib))
(cond
((eq bibtype 'bib)
-; ((assq 'bib (symbol-value reftex-docstruct-symbol))
+ ;; ((assq 'bib (symbol-value reftex-docstruct-symbol))
(setq bibfile-list (reftex-get-bibfile-list)))
((eq bibtype 'thebib)
-; ((assq 'thebib (symbol-value reftex-docstruct-symbol))
+ ;; ((assq 'thebib (symbol-value reftex-docstruct-symbol))
(setq bibfile-list
(reftex-uniquify
(mapcar #'cdr
@@ -1142,8 +1142,35 @@ recommended for follow mode. It works OK for individual
lookups."
;;; Global BibTeX file
(defun reftex-all-used-citation-keys ()
+ "Return a list of all citation keys used in document."
(reftex-access-scan-info)
- (let ((files (reftex-all-document-files)) file keys kk k)
+ ;; FIXME: multicites macros provided by biblatex
+ ;; are not covered in this function.
+ (let ((files (reftex-all-document-files))
+ (re (concat "\\\\"
+ "\\(?:"
+ ;; biblatex volcite macros take these args:
+ ;; \volcite[prenote]{volume}[pages]{key}
+ ;; so cater for the first 3 args:
+ (regexp-opt '("volcite" "Volcite"
+ "pvolcite" "Pvolcite"
+ "fvolcite" "ftvolcite"
+ "svolcite" "Svolcite"
+ "tvolcite" "Tvolcite"
+ "avolcite" "Avolcite"))
+ "\\(?:\\[[^]]*\\]\\)?"
+ "{[^}]*}"
+ "\\(?:\\[[^]]*\\]\\)?"
+ "\\|"
+ ;; Other cite macros usually go like:
+ ;; \cite[prenote][postnote]{key}
+ ;; so cater for the optional args:
+ "\\(?:bibentry\\|[a-zA-Z]*[Cc]ite[a-zA-Z*]*\\)"
+ "\\(?:\\[[^]]*\\]\\)\\{0,2\\}"
+ "\\)"
+ ;; Now match the key:
+ "{\\([^}]+\\)}"))
+ file keys kk k)
(save-current-buffer
(while (setq file (pop files))
(set-buffer (reftex-get-file-buffer-force file 'mark))
@@ -1151,14 +1178,17 @@ recommended for follow mode. It works OK for
individual lookups."
(save-restriction
(widen)
(goto-char (point-min))
- (while (re-search-forward
"\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^]]*\\]\\)?{\\([^}]+\\)}"
nil t)
- (setq kk (match-string-no-properties 3))
- (while (string-match "%.*\n?" kk)
- (setq kk (replace-match "" t t kk)))
- (setq kk (split-string kk "[, \t\r\n]+"))
- (while (setq k (pop kk))
- (or (member k keys)
- (setq keys (cons k keys)))))))))
+ (while (re-search-forward re nil t)
+ ;; Make sure we're not inside a comment:
+ (unless (save-match-data
+ (nth 4 (syntax-ppss)))
+ (setq kk (match-string-no-properties 1))
+ (while (string-match "%.*\n?" kk)
+ (setq kk (replace-match "" t t kk)))
+ (setq kk (split-string kk "[, \t\r\n]+"))
+ (while (setq k (pop kk))
+ (or (member k keys)
+ (setq keys (cons k keys))))))))))
(reftex-kill-temporary-buffers)
keys))
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index b517cc1663..075ad666b3 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -275,10 +275,8 @@ will prompt for other arguments."
(define-key map [(mouse-2)] #'reftex-index-mouse-goto-line-and-hide)
(define-key map [follow-link] 'mouse-face)
- (substitute-key-definition
- #'next-line #'reftex-index-next map global-map)
- (substitute-key-definition
- #'previous-line #'reftex-index-previous map global-map)
+ (define-key map [remap next-line] #'reftex-index-next)
+ (define-key map [remap previous-line] #'reftex-index-previous)
(define-key map "n" #'reftex-index-next)
(define-key map "p" #'reftex-index-previous)
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 3fe7a79a27..fead734be7 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -294,14 +294,12 @@ also applies `reftex-translate-to-ascii-function' to the
string."
(defun reftex-latin1-to-ascii (string)
;; Translate the upper 128 chars in the Latin-1 charset to ASCII equivalents
- (let ((tab "@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@
icLxY|S\"ca<--R-o|23'uq..1o>423?AAAAAAACEEEEIIIIDNOOOOOXOUUUUYP3aaaaaaaceeeeiiiidnooooo:ouuuuypy")
- (emacsp (not (featurep 'xemacs))))
+ (let ((tab "@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@
icLxY|S\"ca<--R-o|23'uq..1o>423?AAAAAAACEEEEIIIIDNOOOOOXOUUUUYP3aaaaaaaceeeeiiiidnooooo:ouuuuypy"))
(mapconcat
(lambda (c)
(cond ((and (> c 127) (< c 256)) ; 8 bit Latin-1
(char-to-string (aref tab (- c 128))))
- ((and emacsp ; Not for XEmacs
- (> c 2175) (< c 2304)) ; Mule Latin-1
+ ((and (> c 2175) (< c 2304)) ; Mule Latin-1
(char-to-string (aref tab (- c 2176))))
(t (char-to-string c))))
string "")))
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index 5942801a8a..80c01948e5 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -33,14 +33,10 @@
(defvar reftex-select-shared-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
- (substitute-key-definition
- #'next-line #'reftex-select-next map global-map)
- (substitute-key-definition
- #'previous-line #'reftex-select-previous map global-map)
- (substitute-key-definition
- #'keyboard-quit #'reftex-select-keyboard-quit map global-map)
- (substitute-key-definition
- #'newline #'reftex-select-accept map global-map)
+ (define-key map [remap next-line] #'reftex-select-next)
+ (define-key map [remap previous-line] #'reftex-select-previous)
+ (define-key map [remap keyboard-quit] #'reftex-select-keyboard-quit)
+ (define-key map [remap newline] #'reftex-select-accept)
(define-key map " " #'reftex-select-callback)
(define-key map "n" #'reftex-select-next)
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 5599eaee02..a7f3a9452a 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -34,10 +34,8 @@
(define-key map [(mouse-2)] #'reftex-toc-mouse-goto-line-and-hide)
(define-key map [follow-link] 'mouse-face)
- (substitute-key-definition
- 'next-line 'reftex-toc-next map global-map)
- (substitute-key-definition
- 'previous-line 'reftex-toc-previous map global-map)
+ (define-key map [remap next-line] #'reftex-toc-next)
+ (define-key map [remap previous-line] #'reftex-toc-previous)
(define-key map "n" #'reftex-toc-next)
(define-key map "p" #'reftex-toc-previous)
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 9ec7517418..c7a9f20ea2 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -556,7 +556,7 @@ If this is nil, then `diary-file' will be used instead."
map)
"Keymap used in `remember-mode'.")
-(define-derived-mode remember-mode indented-text-mode "Remember"
+(define-derived-mode remember-mode text-mode "Remember"
"Major mode for output from \\[remember].
This buffer is used to collect data that you want to remember.
\\<remember-mode-map>
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index ba0a94b4a1..7d691430ec 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1913,7 +1913,7 @@ This takes effect when first loading the library.")
(valign '(("top") ("middle") ("bottom") ("baseline")))
(rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
(href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
- ("mailto:";) ("news:";) ("rlogin:") ("telnet:") ("tn3270:")
+ ("https:") ("mailto:";) ("news:";) ("rlogin:") ("telnet:")
("tn3270:")
("wais:") ("/cgi-bin/")))
(name '("name"))
(link `(,href
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 1ac59ddc5f..7a654f72ab 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -235,9 +235,6 @@ Subexpression 1 is what goes into the corresponding `@end'
statement.")
(define-key keymap "\C-c\C-t\C-r" #'texinfo-tex-region)
(define-key keymap "\C-c\C-t\C-b" #'texinfo-tex-buffer))
-;; Mode documentation displays commands in reverse order
-;; from how they are listed in the texinfo-mode-map.
-
(defvar texinfo-mode-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 076f8dd98f..9e8f3747c5 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -67,13 +67,11 @@
st)
"Syntax table used while in `text-mode'.")
-(defvar text-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\e\t" #'ispell-complete-word)
- map)
- "Keymap for `text-mode'.
-Many other modes, such as `mail-mode', `outline-mode' and `indented-text-mode',
-inherit all the commands defined in this map.")
+(defvar-keymap text-mode-map
+ :doc "Keymap for `text-mode'.
+Many other modes, such as `mail-mode' and `outline-mode', inherit
+all the commands defined in this map."
+ "C-M-i" #'ispell-complete-word)
(easy-menu-define text-mode-menu text-mode-map
"Menu for `text-mode'."
@@ -164,8 +162,6 @@ Turning on Paragraph-Indent minor mode runs the normal hook
(remove-function (local 'indent-line-function)
#'indent-to-left-margin)))
-(defalias 'indented-text-mode #'text-mode)
-
;; This can be made a no-op once all modes that use text-mode-hook
;; are "derived" from text-mode. (As of 2015/04, and probably well before,
;; the only one I can find that doesn't so derive is rmail-edit-mode.)
@@ -245,6 +241,8 @@ The argument NLINES says how many lines to center."
(setq nlines (1+ nlines))
(forward-line -1)))))
+(define-obsolete-function-alias 'indented-text-mode #'text-mode "29.1")
+
(provide 'text-mode)
;;; text-mode.el ends here
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index a7c86fb24f..462f87d3c1 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -74,7 +74,7 @@ question.
\"things\" include `symbol', `list', `sexp', `defun', `filename',
`existing-filename', `url', `email', `uuid', `word', `sentence',
-`whitespace', `line', and `page'.")
+`whitespace', `line', `face' and `page'.")
;; Basic movement
@@ -166,7 +166,7 @@ positions of the thing found."
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `existing-filename', `url', `email', `uuid', `word',
-`sentence', `whitespace', `line', `number', and `page'.
+`sentence', `whitespace', `line', `number', `face' and `page'.
When the optional argument NO-PROPERTIES is non-nil,
strip text properties from the return value.
@@ -361,6 +361,15 @@ E.g.:
(put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point)
+;; Faces
+
+(defun thing-at-point-face-at-point (&optional _lax _bounds)
+ "Return the name of the face at point as a symbol."
+ (when-let ((face (thing-at-point 'symbol)))
+ (and (facep face) (intern face))))
+
+(put 'face 'thing-at-point 'thing-at-point-face-at-point)
+
;; URIs
(defvar thing-at-point-beginning-of-url-regexp nil
diff --git a/lisp/transient.el b/lisp/transient.el
index 8c41706f15..a415858970 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -1,16 +1,18 @@
-;;; transient.el --- Transient commands -*- lexical-binding: t; -*-
+;;; transient.el --- Transient commands -*- lexical-binding:t -*-
;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; URL: https://github.com/magit/transient
-;; Keywords: bindings
+;; Keywords: extensions
-;; Package-Requires: ((emacs "25.1"))
;; Package-Version: 0.3.7
+;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
+;; 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,
@@ -24,8 +26,6 @@
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-;; This file is part of GNU Emacs.
-
;;; Commentary:
;; Taking inspiration from prefix keys and prefix arguments, Transient
@@ -58,14 +58,14 @@
(require 'format-spec)
(require 'seq)
-(eval-when-compile
- (require 'subr-x))
+(eval-when-compile (require 'subr-x))
-(declare-function info "info")
-(declare-function Man-find-section "man")
-(declare-function Man-next-section "man")
-(declare-function Man-getpage-in-background "man")
+(declare-function info "info" (&optional file-or-node buffer))
+(declare-function Man-find-section "man" (section))
+(declare-function Man-next-section "man" (n))
+(declare-function Man-getpage-in-background "man" (topic))
+(defvar display-line-numbers) ; since Emacs 26.1
(defvar Man-notify-method)
(define-obsolete-function-alias 'define-transient-command
@@ -77,6 +77,8 @@
(define-obsolete-function-alias 'define-infix-argument
#'transient-define-argument "Transient 0.3.0")
+(define-obsolete-variable-alias 'transient--source-buffer
+ 'transient--original-buffer "Transient 0.2.0")
(define-obsolete-variable-alias 'current-transient-prefix
'transient-current-prefix "Transient 0.3.0")
(define-obsolete-variable-alias 'current-transient-command
@@ -107,21 +109,20 @@
(defcustom transient-show-popup t
"Whether to show the current transient in a popup buffer.
-
+\\<transient-map>
- If t, then show the popup as soon as a transient prefix command
is invoked.
- If nil, then do not show the popup unless the user explicitly
- requests it, by pressing an incomplete prefix key sequence.
+ requests it, by pressing \\[transient-show] or a prefix key.
- If a number, then delay displaying the popup and instead show
a brief one-line summary. If zero or negative, then suppress
even showing that summary and display the pressed key only.
Show the popup when the user explicitly requests it by pressing
- an incomplete prefix key sequence. Unless zero, then also show
- the popup after that many seconds of inactivity (using the
- absolute value)."
+ \\[transient-show] or a prefix key. Unless zero, then also show the popup
+ after that many seconds of inactivity (using the absolute value)."
:package-version '(transient . "0.1.0")
:group 'transient
:type '(choice (const :tag "instantly" t)
@@ -129,20 +130,32 @@
(const :tag "on demand (no summary)" 0)
(number :tag "after delay" 1)))
-(defcustom transient-enable-popup-navigation nil
+(defcustom transient-enable-popup-navigation t
"Whether navigation commands are enabled in the transient popup.
While a transient is active the transient popup buffer is not the
current buffer, making it necessary to use dedicated commands to
-act on that buffer itself. If this non-nil, then the following
-features are available:
-
-- \"<up>\" moves the cursor to the previous suffix.
- \"<down>\" moves the cursor to the next suffix.
- \"RET\" invokes the suffix the cursor is on.
-- \"<mouse-1>\" invokes the clicked on suffix.
-- \"C-s\" and \"C-r\" start isearch in the popup buffer."
- :package-version '(transient . "0.2.0")
+act on that buffer itself. If this is non-nil, then the following
+bindings are available:
+
+\\<transient-popup-navigation-map>\
+- \\[transient-backward-button] moves the cursor to the previous suffix.
+- \\[transient-forward-button] moves the cursor to the next suffix.
+- \\[transient-push-button] invokes the suffix the cursor is on.
+\\<transient-button-map>\
+- \\`<mouse-1>' and \\`<mouse-2>' invoke the clicked on suffix.
+\\<transient-popup-navigation-map>\
+- \\[transient-isearch-backward]\
+ and \\[transient-isearch-forward] start isearch in the popup buffer.
+
+\\`<mouse-1>' and \\`<mouse-2>' are bound in `transient-push-button'.
+All other bindings are in `transient-popup-navigation-map'.
+
+By default \\`M-RET' is bound to `transient-push-button', instead of
+\\`RET', because if a transient allows the invocation of non-suffixes
+then it is likely that you would want \\`RET' to do what it would do
+if no transient were active."
+ :package-version '(transient . "0.4.0")
:group 'transient
:type 'boolean)
@@ -244,7 +257,7 @@ arguments. When this option is non-nil, then the key
binding
for infix argument are highlighted when only a long argument
\(e.g. \"--verbose\") is specified but no shor-thand (e.g \"-v\").
In the rare case that a short-hand is specified but does not
-match the key binding, then it is highlighed differently.
+match the key binding, then it is highlighted differently.
The highlighting is done using `transient-mismatched-key'
and `transient-nonstandard-key'."
@@ -317,13 +330,32 @@ used."
:group 'transient
:type 'boolean)
+(defcustom transient-align-variable-pitch nil
+ "Whether to align columns pixel-wise in the popup buffer.
+
+If this is non-nil, then columns are aligned pixel-wise to
+support variable-pitch fonts. Keys are not aligned, so you
+should use a fixed-pitch font for the `transient-key' face.
+Other key faces inherit from that face unless a theme is
+used that breaks that relationship.
+
+This option is intended for users who use a variable-pitch
+font for the `default' face.
+
+Also see `transient-force-fixed-pitch'."
+ :package-version '(transient . "0.4.0")
+ :group 'transient
+ :type 'boolean)
+
(defcustom transient-force-fixed-pitch nil
"Whether to force use of monospaced font in the popup buffer.
Even if you use a proportional font for the `default' face,
you might still want to use a monospaced font in transient's
popup buffer. Setting this option to t causes `default' to
-be remapped to `fixed-pitch' in that buffer."
+be remapped to `fixed-pitch' in that buffer.
+
+Also see `transient-align-variable-pitch'."
:package-version '(transient . "0.2.0")
:group 'transient
:type 'boolean)
@@ -337,6 +369,12 @@ text and might otherwise have to scroll in two dimensions."
:group 'transient
:type 'boolean)
+(defcustom transient-hide-during-minibuffer-read nil
+ "Whether to hide the transient buffer while reading in the minibuffer."
+ :package-version '(transient . "0.4.0")
+ :group 'transient
+ :type 'boolean)
+
(defconst transient--default-child-level 1)
(defconst transient--default-prefix-level 4)
@@ -375,21 +413,21 @@ give you as many additional suffixes as you hoped.)"
(const :tag "7 - most suffixes" 7)))
(defcustom transient-levels-file
- (locate-user-emacs-file (convert-standard-filename "transient/levels.el"))
+ (locate-user-emacs-file "transient/levels.el")
"File used to save levels of transients and their suffixes."
:package-version '(transient . "0.1.0")
:group 'transient
:type 'file)
(defcustom transient-values-file
- (locate-user-emacs-file (convert-standard-filename "transient/values.el"))
+ (locate-user-emacs-file "transient/values.el")
"File used to save values of transients."
:package-version '(transient . "0.1.0")
:group 'transient
:type 'file)
(defcustom transient-history-file
- (locate-user-emacs-file (convert-standard-filename "transient/history.el"))
+ (locate-user-emacs-file "transient/history.el")
"File used to save history of transients and their infixes."
:package-version '(transient . "0.1.0")
:group 'transient
@@ -445,7 +483,7 @@ give you as many additional suffixes as you hoped.)"
"Face used for the infix for which the value is being read."
:group 'transient-faces)
-(defface transient-unreachable-key '((t :inherit shadow))
+(defface transient-unreachable-key '((t :inherit (transient-key shadow)))
"Face used for keys unreachable from the current prefix sequence."
:group 'transient-faces)
@@ -524,6 +562,15 @@ These faces are only used if `transient-semantic-coloring'
"Face used for teal prefixes."
:group 'transient-color-faces)
+(defface transient-purple
+ '((t :inherit transient-key :foreground "#a020f0"))
+ "Face used for purple prefixes.
+
+This is an addition to the colors supported by Hydra. It is
+used by suffixes that quit the current prefix but return to
+the previous prefix."
+ :group 'transient-color-faces)
+
;;; Persistence
(defun transient--read-file-contents (file)
@@ -825,11 +872,11 @@ to the setup function:
(transient-setup \\='NAME nil nil :scope SCOPE)
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])"
- (declare (debug (&define name lambda-list
- [&optional lambda-doc]
- [&rest keywordp sexp]
- [&rest vectorp]
- [&optional ("interactive" interactive) def-body]))
+ (declare (debug ( &define name lambda-list
+ [&optional lambda-doc]
+ [&rest keywordp sexp]
+ [&rest vectorp]
+ [&optional ("interactive" interactive) def-body]))
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
@@ -866,11 +913,11 @@ ARGLIST. The infix arguments are usually accessed by
using
`transient-args' inside `interactive'.
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... BODY...)"
- (declare (debug (&define name lambda-list
- [&optional lambda-doc]
- [&rest keywordp sexp]
- ("interactive" interactive)
- def-body))
+ (declare (debug ( &define name lambda-list
+ [&optional lambda-doc]
+ [&rest keywordp sexp]
+ ("interactive" interactive)
+ def-body))
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,_ ,docstr ,body)
@@ -912,14 +959,14 @@ functions. Different infix commands behave differently
because
the concrete methods are different for different infix command
classes. In rare case the above command function might not be
suitable, even if you define your own infix command class. In
-that case you have to use `transient-suffix-command' to define
+that case you have to use `transient-define-suffix' to define
the infix command and use t as the value of the `:transient'
keyword.
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)"
- (declare (debug (&define name lambda-list
- [&optional lambda-doc]
- [&rest keywordp sexp]))
+ (declare (debug ( &define name lambda-list
+ [&optional lambda-doc]
+ [&rest keywordp sexp]))
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,_ ,docstr ,_)
@@ -927,6 +974,7 @@ keyword.
`(progn
(defalias ',name ,(transient--default-infix-command))
(put ',name 'interactive-only t)
+ (put ',name 'command-modes (list 'not-a-mode))
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--suffix
(,(or class 'transient-switch) :command ',name ,@slots)))))
@@ -952,8 +1000,9 @@ example, sets a variable use `transient-define-infix'
instead.
(push k keys)
(push v keys))))
(while (let ((arg (car args)))
- (or (vectorp arg)
- (and arg (symbolp arg))))
+ (if (vectorp arg)
+ (setcar args (eval (cdr (backquote-process arg))))
+ (and arg (symbolp arg))))
(push (pop args) suffixes))
(list (if (eq (car-safe class) 'quote)
(cadr class)
@@ -971,8 +1020,8 @@ example, sets a variable use `transient-define-infix'
instead.
(vectorp (car value))))
(cl-mapcan (lambda (s) (transient--parse-child prefix s))
value)
(transient--parse-child prefix value))))
- (vector (when-let ((c (transient--parse-group prefix spec))) (list c)))
- (list (when-let ((c (transient--parse-suffix prefix spec))) (list c)))
+ (vector (and-let* ((c (transient--parse-group prefix spec))) (list c)))
+ (list (and-let* ((c (transient--parse-suffix prefix spec))) (list c)))
(string (list spec))))
(defun transient--parse-group (prefix spec)
@@ -1092,7 +1141,7 @@ example, sets a variable use `transient-define-infix'
instead.
;;; Edit
-(defun transient--insert-suffix (prefix loc suffix action)
+(defun transient--insert-suffix (prefix loc suffix action &optional keep-other)
(let* ((suf (cl-etypecase suffix
(vector (transient--parse-group prefix suffix))
(list (transient--parse-suffix prefix suffix))
@@ -1110,25 +1159,18 @@ example, sets a variable use `transient-define-infix'
instead.
suffix prefix loc
"suffixes and groups cannot be siblings"))
(t
- (when (and (listp suffix)
- (listp elt))
- ;; Both suffixes are key bindings; not heading strings.
- (let ((key (transient--spec-key suf)))
- (if (equal (transient--kbd key)
- (transient--kbd (transient--spec-key elt)))
- ;; We must keep `mem' until after we have inserted
- ;; behind it, which `transient-remove-suffix' does
- ;; not allow us to do.
- (let ((spred (transient--suffix-predicate suf))
- (epred (transient--suffix-predicate elt)))
- ;; If both suffixes have a predicate and they
- ;; are not identical, then there is a high
- ;; probability that we want to keep both.
- (when (or (not spred)
- (not epred)
- (equal spred epred))
- (setq action 'replace)))
- (transient-remove-suffix prefix key))))
+ (when-let* ((bindingp (listp suf))
+ (key (transient--spec-key suf))
+ (conflict (car (transient--layout-member key prefix)))
+ (conflictp
+ (and (not (and (eq action 'replace)
+ (eq conflict elt)))
+ (or (not keep-other)
+ (eq (plist-get (nth 2 suf) :command)
+ (plist-get (nth 2 conflict) :command)))
+ (equal (transient--suffix-predicate suf)
+ (transient--suffix-predicate conflict)))))
+ (transient-remove-suffix prefix key))
(cl-ecase action
(insert (setcdr mem (cons elt (cdr mem)))
(setcar mem suf))
@@ -1136,7 +1178,7 @@ example, sets a variable use `transient-define-infix'
instead.
(replace (setcar mem suf)))))))
;;;###autoload
-(defun transient-insert-suffix (prefix loc suffix)
+(defun transient-insert-suffix (prefix loc suffix &optional keep-other)
"Insert a SUFFIX into PREFIX before LOC.
PREFIX is a prefix command, a symbol.
SUFFIX is a suffix command or a group specification (of
@@ -1144,12 +1186,14 @@ SUFFIX is a suffix command or a group specification (of
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
+Remove a conflicting binding unless optional KEEP-OTHER is
+ non-nil.
See info node `(transient)Modifying Existing Transients'."
(declare (indent defun))
- (transient--insert-suffix prefix loc suffix 'insert))
+ (transient--insert-suffix prefix loc suffix 'insert keep-other))
;;;###autoload
-(defun transient-append-suffix (prefix loc suffix)
+(defun transient-append-suffix (prefix loc suffix &optional keep-other)
"Insert a SUFFIX into PREFIX after LOC.
PREFIX is a prefix command, a symbol.
SUFFIX is a suffix command or a group specification (of
@@ -1157,9 +1201,11 @@ SUFFIX is a suffix command or a group specification (of
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
+Remove a conflicting binding unless optional KEEP-OTHER is
+ non-nil.
See info node `(transient)Modifying Existing Transients'."
(declare (indent defun))
- (transient--insert-suffix prefix loc suffix 'append))
+ (transient--insert-suffix prefix loc suffix 'append keep-other))
;;;###autoload
(defun transient-replace-suffix (prefix loc suffix)
@@ -1269,7 +1315,7 @@ See info node `(transient)Modifying Existing Transients'."
(plist-get plist :command)))))
(defun transient--command-key (cmd)
- (when-let ((obj (get cmd 'transient--suffix)))
+ (and-let* ((obj (get cmd 'transient--suffix)))
(cond ((slot-boundp obj 'key)
(oref obj key))
((slot-exists-p obj 'shortarg)
@@ -1290,7 +1336,7 @@ This is an object representing that transient, use
(defvar transient-current-command nil
"The transient from which this suffix command was invoked.
This is a symbol representing that transient, use
-`current-transient-object' to get the respective object.")
+`transient-current-prefix' to get the respective object.")
(defvar transient-current-suffixes nil
"The suffixes of the transient from which this suffix command was invoked.
@@ -1320,6 +1366,8 @@ variable instead.")
(defvar transient--stack nil)
+(defvar transient--minibuffer-depth 0)
+
(defvar transient--buffer-name " *transient*"
"Name of the transient buffer.")
@@ -1330,9 +1378,6 @@ variable instead.")
"The window that was selected before the transient was invoked.
Usually it remains selected while the transient is active.")
-(define-obsolete-variable-alias 'transient--source-buffer
- 'transient--original-buffer "Transient 0.2.0")
-
(defvar transient--original-buffer nil
"The buffer that was current before the transient was invoked.
Usually it remains current while the transient is active.")
@@ -1341,6 +1386,17 @@ Usually it remains current while the transient is
active.")
(defvar transient--history nil)
+(defvar transient--abort-commands
+ '(abort-minibuffers ; (minibuffer-quit-recursive-edit)
+ abort-recursive-edit ; (throw 'exit t)
+ exit-recursive-edit ; (throw 'exit nil)
+ keyboard-escape-quit ; dwim
+ keyboard-quit ; (signal 'quit nil)
+ minibuffer-keyboard-quit ; (abort-minibuffers)
+ minibuffer-quit-recursive-edit ; (throw 'exit (lambda ()
+ ; (signal 'minibuffer-quit nil)))
+ top-level)) ; (throw 'top-level nil)
+
(defvar transient--scroll-commands
'(transient-scroll-up
transient-scroll-down
@@ -1392,11 +1448,12 @@ probably use this instead:
transient-current-prefix)
(cl-find-if (lambda (obj)
(eq (transient--suffix-command obj)
- (or command this-original-command)))
+ (or command this-command)))
(or transient--suffixes
transient-current-suffixes))
- (when-let ((obj (get (or command this-command) 'transient--suffix))
- (obj (clone obj)))
+ (when-let* ((obj (get (or command this-command) 'transient--suffix))
+ (obj (clone obj)))
+ ;; Cannot use and-let* because of debbugs#31840.
(transient-init-scope obj)
(transient-init-value obj)
obj)))
@@ -1500,13 +1557,15 @@ to `transient-predicate-map'. Also see
`transient-base-map'.")
'transient--layout
(cl-mapcan
(lambda (s) (transient--parse-child 'transient-common-commands s))
- '([:hide (lambda ()
- (and (not (memq (car transient--redisplay-key)
- transient--common-command-prefixes))
- (not transient-show-common-commands)))
+ `([:hide ,(lambda ()
+ (and (not (memq (car (bound-and-true-p
+ transient--redisplay-key))
+ transient--common-command-prefixes))
+ (not transient-show-common-commands)))
["Value commands"
("C-x s " "Set" transient-set)
("C-x C-s" "Save" transient-save)
+ ("C-x C-k" "Reset" transient-reset)
("C-x p " "Previous value" transient-history-prev)
("C-x n " "Next value" transient-history-next)]
["Sticky commands"
@@ -1517,22 +1576,41 @@ to `transient-predicate-map'. Also see
`transient-base-map'.")
("C-z" "Suspend transient stack" transient-suspend)]
["Customize"
("C-x t" transient-toggle-common
- :description (lambda ()
- (if transient-show-common-commands
- "Hide common commands"
- "Show common permanently")))
+ :description ,(lambda ()
+ (if transient-show-common-commands
+ "Hide common commands"
+ "Show common permanently")))
("C-x l" "Show/hide suffixes" transient-set-level)]])))
+(defvar transient-popup-navigation-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<down-mouse-1>") #'transient-noop)
+ (define-key map (kbd "<up>") #'transient-backward-button)
+ (define-key map (kbd "<down>") #'transient-forward-button)
+ (define-key map (kbd "C-r") #'transient-isearch-backward)
+ (define-key map (kbd "C-s") #'transient-isearch-forward)
+ (define-key map (kbd "M-RET") #'transient-push-button)
+ map)
+ "One of the keymaps used when popup navigation is enabled.
+See `transient-enable-popup-navigation'.")
+
+(defvar transient-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<mouse-1>") #'transient-push-button)
+ (define-key map (kbd "<mouse-2>") #'transient-push-button)
+ map)
+ "One of the keymaps used when popup navigation is enabled.
+See `transient-enable-popup-navigation'.")
+
(defvar transient-predicate-map
(let ((map (make-sparse-keymap)))
- (define-key map [handle-switch-frame] #'transient--do-suspend)
(define-key map [transient-suspend] #'transient--do-suspend)
(define-key map [transient-help] #'transient--do-stay)
(define-key map [transient-set-level] #'transient--do-stay)
(define-key map [transient-history-prev] #'transient--do-stay)
(define-key map [transient-history-next] #'transient--do-stay)
(define-key map [universal-argument] #'transient--do-stay)
- (define-key map [negative-argument] #'transient--do-stay)
+ (define-key map [negative-argument] #'transient--do-minus)
(define-key map [digit-argument] #'transient--do-stay)
(define-key map [transient-quit-all] #'transient--do-quit-all)
(define-key map [transient-quit-one] #'transient--do-quit-one)
@@ -1542,6 +1620,7 @@ to `transient-predicate-map'. Also see
`transient-base-map'.")
(define-key map [transient-toggle-common] #'transient--do-stay)
(define-key map [transient-set] #'transient--do-call)
(define-key map [transient-save] #'transient--do-call)
+ (define-key map [transient-reset] #'transient--do-call)
(define-key map [describe-key-briefly] #'transient--do-stay)
(define-key map [describe-key] #'transient--do-stay)
(define-key map [transient-scroll-up] #'transient--do-stay)
@@ -1550,11 +1629,16 @@ to `transient-predicate-map'. Also see
`transient-base-map'.")
(define-key map [scroll-bar-toolkit-scroll] #'transient--do-stay)
(define-key map [transient-noop] #'transient--do-noop)
(define-key map [transient-mouse-push-button] #'transient--do-move)
- (define-key map [transient-push-button] #'transient--do-move)
+ (define-key map [transient-push-button] #'transient--do-push-button)
(define-key map [transient-backward-button] #'transient--do-move)
(define-key map [transient-forward-button] #'transient--do-move)
(define-key map [transient-isearch-backward] #'transient--do-move)
(define-key map [transient-isearch-forward] #'transient--do-move)
+ ;; If a valid but incomplete prefix sequence is followed by
+ ;; an unbound key, then Emacs calls the `undefined' command
+ ;; but does not set `this-command', `this-original-command'
+ ;; or `real-this-command' accordingly. Instead they are nil.
+ (define-key map [nil] #'transient--do-warn)
map)
"Base keymap used to map common commands to their transient behavior.
@@ -1574,22 +1658,24 @@ For transient commands that are bound in individual
transients,
the transient behavior is specified using the `:transient' slot
of the corresponding object.")
-(defvar transient-popup-navigation-map)
-
(defvar transient--transient-map nil)
(defvar transient--predicate-map nil)
(defvar transient--redisplay-map nil)
(defvar transient--redisplay-key nil)
-(defun transient--push-keymap (map)
- (transient--debug " push %s%s" map (if (symbol-value map) "" " VOID"))
- (with-demoted-errors "transient--push-keymap: %S"
- (internal-push-keymap (symbol-value map) 'overriding-terminal-local-map)))
+(defun transient--push-keymap (var)
+ (let ((map (symbol-value var)))
+ (transient--debug " push %s%s" var (if map "" " VOID"))
+ (when map
+ (with-demoted-errors "transient--push-keymap: %S"
+ (internal-push-keymap map 'overriding-terminal-local-map)))))
-(defun transient--pop-keymap (map)
- (transient--debug " pop %s%s" map (if (symbol-value map) "" " VOID"))
- (with-demoted-errors "transient--pop-keymap: %S"
- (internal-pop-keymap (symbol-value map) 'overriding-terminal-local-map)))
+(defun transient--pop-keymap (var)
+ (let ((map (symbol-value var)))
+ (transient--debug " pop %s%s" var (if map "" " VOID"))
+ (when map
+ (with-demoted-errors "transient--pop-keymap: %S"
+ (internal-pop-keymap map 'overriding-terminal-local-map)))))
(defun transient--make-transient-map ()
(let ((map (make-sparse-keymap)))
@@ -1614,17 +1700,27 @@ of the corresponding object.")
(string-trim key)
cmd conflict)))
(define-key map kbd cmd))))
+ (when-let ((b (lookup-key map "-"))) (define-key map [kp-subtract] b))
+ (when-let ((b (lookup-key map "="))) (define-key map [kp-equal] b))
+ (when-let ((b (lookup-key map "+"))) (define-key map [kp-add] b))
(when transient-enable-popup-navigation
- (setq map
- (make-composed-keymap (list map transient-popup-navigation-map))))
+ ;; `transient--make-redisplay-map' maps only over bindings that are
+ ;; directly in the base keymap, so that cannot be a composed keymap.
+ (set-keymap-parent
+ map (make-composed-keymap
+ (keymap-parent map)
+ transient-popup-navigation-map)))
map))
(defun transient--make-predicate-map ()
(let ((map (make-sparse-keymap)))
(set-keymap-parent map transient-predicate-map)
+ (when (memq (oref transient--prefix transient-non-suffix)
+ '(nil transient--do-warn transient--do-noop))
+ (define-key map [handle-switch-frame] #'transient--do-suspend))
(dolist (obj transient--suffixes)
(let* ((cmd (oref obj command))
- (sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix)))
+ (sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix) t))
(sym (transient--suffix-symbol cmd)))
(cond
((oref obj inapt)
@@ -1632,13 +1728,14 @@ of the corresponding object.")
((slot-boundp obj 'transient)
(define-key map (vector sym)
(let ((do (oref obj transient)))
- (pcase do
- (`t (cond (sub-prefix #'transient--do-replace)
- ((cl-typep obj 'transient-infix)
- #'transient--do-stay)
- (t #'transient--do-call)))
- (`nil 'transient--do-exit)
- (_ do)))))
+ (pcase (list do sub-prefix)
+ ('(t t) #'transient--do-recurse)
+ ('(t nil) (if (cl-typep obj 'transient-infix)
+ #'transient--do-stay
+ #'transient--do-call))
+ ('(nil t) #'transient--do-replace)
+ ('(nil nil) #'transient--do-exit)
+ (_ do)))))
((not (lookup-key transient-predicate-map (vector sym)))
(define-key map (vector sym)
(if sub-prefix
@@ -1674,7 +1771,10 @@ of the corresponding object.")
(define-key topmap (vconcat transient--redisplay-key (list key))
#'transient-update)))
(if transient--redisplay-key
- (lookup-key transient--transient-map (vconcat
transient--redisplay-key))
+ (let ((key (vconcat transient--redisplay-key)))
+ (or (lookup-key transient--transient-map key)
+ (and-let* ((regular (lookup-key local-function-key-map key)))
+ (lookup-key transient--transient-map (vconcat regular)))))
transient--transient-map))
topmap))
@@ -1691,8 +1791,6 @@ be nil and PARAMS may be (but usually is not) used to set
e.g. the
This function is also called internally in which case LAYOUT and
EDIT may be non-nil."
(transient--debug 'setup)
- (when (> (minibuffer-depth) 0)
- (user-error "Cannot invoke transient %s while minibuffer is active" name))
(transient--with-emergency-exit
(cond
((not name)
@@ -1720,6 +1818,7 @@ EDIT may be non-nil."
(setq transient--redisplay-map (transient--make-redisplay-map))
(setq transient--original-window (selected-window))
(setq transient--original-buffer (current-buffer))
+ (setq transient--minibuffer-depth (minibuffer-depth))
(transient--redisplay)
(transient--init-transient)
(transient--suspend-which-key-mode)))
@@ -1745,6 +1844,7 @@ value. Otherwise return CHILDREN as is."
:level (or (alist-get t (alist-get name
transient-levels))
transient-default-level)
params))))
+ (transient--setup-recursion obj)
(transient-init-value obj)
obj))
@@ -1758,13 +1858,13 @@ value. Otherwise return CHILDREN as is."
(defun transient--flatten-suffixes (layout)
(cl-labels ((s (def)
- (cond
- ((stringp def) nil)
- ((listp def) (cl-mapcan #'s def))
- ((transient-group--eieio-childp def)
- (cl-mapcan #'s (oref def suffixes)))
- ((transient-suffix--eieio-childp def)
- (list def)))))
+ (cond
+ ((stringp def) nil)
+ ((listp def) (cl-mapcan #'s def))
+ ((transient-group--eieio-childp def)
+ (cl-mapcan #'s (oref def suffixes)))
+ ((transient-suffix--eieio-childp def)
+ (list def)))))
(cl-mapcan #'s layout)))
(defun transient--init-child (levels spec)
@@ -1775,14 +1875,14 @@ value. Otherwise return CHILDREN as is."
(defun transient--init-group (levels spec)
(pcase-let ((`(,level ,class ,args ,children) (append spec nil)))
- (when (transient--use-level-p level)
- (let ((obj (apply class :level level args)))
- (when (transient--use-suffix-p obj)
- (when-let ((suffixes
- (cl-mapcan (lambda (c) (transient--init-child levels c))
- (transient-setup-children obj children))))
- (oset obj suffixes suffixes)
- (list obj)))))))
+ (when-let* ((- (transient--use-level-p level))
+ (obj (apply class :level level args))
+ (- (transient--use-suffix-p obj))
+ (suffixes (cl-mapcan (lambda (c) (transient--init-child levels
c))
+ (transient-setup-children obj children))))
+ ;; Cannot use and-let* because of debbugs#31840.
+ (oset obj suffixes suffixes)
+ (list obj))))
(defun transient--init-suffix (levels spec)
(pcase-let* ((`(,level ,class ,args) spec)
@@ -1878,7 +1978,7 @@ value. Otherwise return CHILDREN as is."
(defun transient--suffix-predicate (spec)
(let ((plist (nth 2 spec)))
(seq-some (lambda (prop)
- (when-let ((pred (plist-get plist prop)))
+ (and-let* ((pred (plist-get plist prop)))
(list prop pred)))
'( :if :if-not
:if-nil :if-non-nil
@@ -1895,11 +1995,8 @@ value. Otherwise return CHILDREN as is."
(transient--debug 'init-transient)
(transient--push-keymap 'transient--transient-map)
(transient--push-keymap 'transient--redisplay-map)
- (add-hook 'pre-command-hook #'transient--pre-command)
- (add-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
- (add-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
- (add-hook 'post-command-hook #'transient--post-command)
- (advice-add 'abort-recursive-edit :after #'transient--minibuffer-exit)
+ (add-hook 'pre-command-hook #'transient--pre-command)
+ (add-hook 'post-command-hook #'transient--post-command)
(when transient--exitp
;; This prefix command was invoked as the suffix of another.
;; Prevent `transient--post-command' from removing the hooks
@@ -1908,46 +2005,62 @@ value. Otherwise return CHILDREN as is."
(defun transient--pre-command ()
(transient--debug 'pre-command)
- (cond
- ((memq this-command '(transient-update transient-quit-seq))
- (transient--pop-keymap 'transient--redisplay-map))
- ((and transient--helpp
- (not (memq this-command '(transient-quit-one
- transient-quit-all))))
+ (transient--with-emergency-exit
+ ;; The use of `overriding-terminal-local-map' does not prevent the
+ ;; lookup of command remappings in the overridden maps, which can
+ ;; lead to a suffix being remapped to a non-suffix. We have to undo
+ ;; the remapping in that case. However, remapping a non-suffix to
+ ;; another should remain possible.
+ (when (and (transient--get-predicate-for this-original-command 'suffix)
+ (not (transient--get-predicate-for this-command 'suffix)))
+ (setq this-command this-original-command))
(cond
- ((transient-help)
- (transient--do-suspend)
- (setq this-command 'transient-suspend)
- (transient--pre-exit))
- ((not (transient--edebug-command-p))
- (setq this-command 'transient-undefined))))
- ((and transient--editp
- (transient-suffix-object)
- (not (memq this-command '(transient-quit-one
- transient-quit-all
- transient-help))))
- (setq this-command 'transient-set-level))
- (t
- (setq transient--exitp nil)
- (when (eq (if-let ((fn (transient--get-predicate-for
- this-original-command)))
- (let ((action (funcall fn)))
- (when (eq action transient--exit)
- (setq transient--exitp (or transient--exitp t)))
- action)
- (if (let ((keys (this-command-keys-vector)))
- (eq (aref keys (1- (length keys))) ?\C-g))
- (setq this-command 'transient-noop)
- (unless (transient--edebug-command-p)
- (setq this-command 'transient-undefined)))
- transient--stay)
- transient--exit)
- (transient--pre-exit)))))
-
-(defun transient--get-predicate-for (cmd)
- (or (lookup-key transient--predicate-map
- (vector (transient--suffix-symbol cmd)))
- (oref transient--prefix transient-non-suffix)))
+ ((memq this-command '(transient-update transient-quit-seq))
+ (transient--pop-keymap 'transient--redisplay-map))
+ ((and transient--helpp
+ (not (memq this-command '(transient-quit-one
+ transient-quit-all))))
+ (cond
+ ((transient-help)
+ (transient--do-suspend)
+ (setq this-command 'transient-suspend)
+ (transient--pre-exit))
+ ((not (transient--edebug-command-p))
+ (setq this-command 'transient-undefined))))
+ ((and transient--editp
+ (transient-suffix-object)
+ (not (memq this-command '(transient-quit-one
+ transient-quit-all
+ transient-help))))
+ (setq this-command 'transient-set-level))
+ (t
+ (setq transient--exitp nil)
+ (when (eq (transient--do-pre-command) transient--exit)
+ (transient--pre-exit))))))
+
+(defun transient--do-pre-command ()
+ (if-let ((fn (transient--get-predicate-for this-command)))
+ (let ((action (funcall fn)))
+ (when (eq action transient--exit)
+ (setq transient--exitp (or transient--exitp t)))
+ action)
+ (if (let ((keys (this-command-keys-vector)))
+ (eq (aref keys (1- (length keys))) ?\C-g))
+ (setq this-command 'transient-noop)
+ (unless (transient--edebug-command-p)
+ (setq this-command 'transient-undefined)))
+ transient--stay))
+
+(defun transient--get-predicate-for (cmd &optional suffix-only)
+ (or (ignore-errors
+ (lookup-key transient--predicate-map
+ (vector (transient--suffix-symbol cmd))))
+ (and (not suffix-only)
+ (let ((pred (oref transient--prefix transient-non-suffix)))
+ (pcase pred
+ ('t #'transient--do-stay)
+ ('nil #'transient--do-warn)
+ (_ pred))))))
(defun transient--pre-exit ()
(transient--debug 'pre-exit)
@@ -1955,7 +2068,6 @@ value. Otherwise return CHILDREN as is."
(transient--timer-cancel)
(transient--pop-keymap 'transient--transient-map)
(transient--pop-keymap 'transient--redisplay-map)
- (remove-hook 'pre-command-hook #'transient--pre-command)
(unless transient--showp
(let ((message-log-max nil))
(message "")))
@@ -1963,7 +2075,6 @@ value. Otherwise return CHILDREN as is."
(setq transient--predicate-map nil)
(setq transient--redisplay-map nil)
(setq transient--redisplay-key nil)
- (setq transient--showp nil)
(setq transient--helpp nil)
(setq transient--editp nil)
(setq transient--prefix nil)
@@ -1975,12 +2086,17 @@ value. Otherwise return CHILDREN as is."
(defun transient--delete-window ()
(when (window-live-p transient--window)
- (let ((buf (window-buffer transient--window)))
+ (let ((remain-in-minibuffer-window
+ (and (minibuffer-selected-window)
+ (selected-window)))
+ (buf (window-buffer transient--window)))
;; Only delete the window if it never showed another buffer.
(unless (eq (car (window-parameter transient--window 'quit-restore))
'other)
(with-demoted-errors "Error while exiting transient: %S"
(delete-window transient--window)))
- (kill-buffer buf))))
+ (kill-buffer buf)
+ (when remain-in-minibuffer-window
+ (select-window remain-in-minibuffer-window)))))
(defun transient--export ()
(setq transient-current-prefix transient--prefix)
@@ -1988,80 +2104,155 @@ value. Otherwise return CHILDREN as is."
(setq transient-current-suffixes transient--suffixes)
(transient--history-push transient--prefix))
-(defun transient--minibuffer-setup ()
- (transient--debug 'minibuffer-setup)
- (unless (> (minibuffer-depth) 1)
- (unless transient--exitp
- (transient--pop-keymap 'transient--transient-map)
- (transient--pop-keymap 'transient--redisplay-map)
- (remove-hook 'pre-command-hook #'transient--pre-command))
- (remove-hook 'post-command-hook #'transient--post-command)))
-
-(defun transient--minibuffer-exit ()
- (transient--debug 'minibuffer-exit)
- (unless (> (minibuffer-depth) 1)
- (unless transient--exitp
- (transient--push-keymap 'transient--transient-map)
- (transient--push-keymap 'transient--redisplay-map)
- (add-hook 'pre-command-hook #'transient--pre-command))
- (add-hook 'post-command-hook #'transient--post-command)))
-
-(defun transient--suspend-override (&optional minibuffer-hooks)
+(defun transient--suspend-override (&optional nohide)
(transient--debug 'suspend-override)
+ (transient--timer-cancel)
+ (cond ((and (not nohide) transient-hide-during-minibuffer-read)
+ (transient--delete-window))
+ ((and transient--prefix transient--redisplay-key)
+ (setq transient--redisplay-key nil)
+ (when transient--showp
+ (transient--show))))
(transient--pop-keymap 'transient--transient-map)
(transient--pop-keymap 'transient--redisplay-map)
(remove-hook 'pre-command-hook #'transient--pre-command)
- (remove-hook 'post-command-hook #'transient--post-command)
- (when minibuffer-hooks
- (remove-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
- (remove-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
- (advice-remove 'abort-recursive-edit #'transient--minibuffer-exit)))
+ (remove-hook 'post-command-hook #'transient--post-command))
-(defun transient--resume-override (&optional minibuffer-hooks)
+(defun transient--resume-override ()
(transient--debug 'resume-override)
+ (when (and transient--showp transient-hide-during-minibuffer-read)
+ (transient--show))
(transient--push-keymap 'transient--transient-map)
(transient--push-keymap 'transient--redisplay-map)
(add-hook 'pre-command-hook #'transient--pre-command)
- (add-hook 'post-command-hook #'transient--post-command)
- (when minibuffer-hooks
- (add-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
- (add-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
- (advice-add 'abort-recursive-edit :after #'transient--minibuffer-exit)))
+ (add-hook 'post-command-hook #'transient--post-command))
+
+(defmacro transient--with-suspended-override (&rest body)
+ (let ((depth (make-symbol "depth"))
+ (setup (make-symbol "setup"))
+ (exit (make-symbol "exit")))
+ `(if (and transient--transient-map
+ (memq transient--transient-map
+ overriding-terminal-local-map))
+ (let ((,depth (1+ (minibuffer-depth))) ,setup ,exit)
+ (setq ,setup
+ (lambda () "@transient--with-suspended-override"
+ (transient--debug 'minibuffer-setup)
+ (remove-hook 'minibuffer-setup-hook ,setup)
+ (transient--suspend-override)))
+ (setq ,exit
+ (lambda () "@transient--with-suspended-override"
+ (transient--debug 'minibuffer-exit)
+ (when (= (minibuffer-depth) ,depth)
+ (transient--resume-override))))
+ (unwind-protect
+ (progn
+ (add-hook 'minibuffer-setup-hook ,setup)
+ (add-hook 'minibuffer-exit-hook ,exit)
+ ,@body)
+ (remove-hook 'minibuffer-setup-hook ,setup)
+ (remove-hook 'minibuffer-exit-hook ,exit)))
+ ,@body)))
+
+(defun transient--post-command-hook ()
+ (run-hooks 'transient--post-command-hook))
+
+(add-hook 'post-command-hook #'transient--post-command-hook)
+
+(defun transient--delay-post-command (&optional abort-only)
+ (transient--debug 'delay-post-command)
+ (let ((depth (minibuffer-depth))
+ (command this-command)
+ (delayed (if transient--exitp
+ (apply-partially #'transient--post-exit this-command)
+ #'transient--resume-override))
+ post-command abort-minibuffer)
+ (unless abort-only
+ (setq post-command
+ (lambda () "@transient--delay-post-command"
+ (let ((act (and (not (eq (this-command-keys-vector) []))
+ (or (eq this-command command)
+ ;; `execute-extended-command' was
+ ;; used to call another command
+ ;; that also uses the minibuffer.
+ (equal
+ (string-to-multibyte (this-command-keys))
+ (format "\M-x%s\r" this-command))))))
+ (transient--debug 'post-command-hook "act: %s" act)
+ (when act
+ (remove-hook 'transient--post-command-hook post-command)
+ (remove-hook 'minibuffer-exit-hook abort-minibuffer)
+ (funcall delayed)))))
+ (add-hook 'transient--post-command-hook post-command))
+ (setq abort-minibuffer
+ (lambda () "@transient--delay-post-command"
+ (let ((act (and (or (memq this-command transient--abort-commands)
+ (equal (this-command-keys) ""))
+ (= (minibuffer-depth) depth))))
+ (transient--debug
+ 'abort-minibuffer
+ "mini: %s|%s, act %s" (minibuffer-depth) depth act)
+ (when act
+ (remove-hook 'transient--post-command-hook post-command)
+ (remove-hook 'minibuffer-exit-hook abort-minibuffer)
+ (funcall delayed)))))
+ (add-hook 'minibuffer-exit-hook abort-minibuffer)))
(defun transient--post-command ()
(transient--debug 'post-command)
- (unless this-command
- (transient--debug "-- force pre-exit from post-command")
- (message "Quit transient!")
- (transient--pre-exit)
- (setq transient--exitp t))
- (if transient--exitp
- (progn
- (unless (and (eq transient--exitp 'replace)
- (or transient--prefix
- ;; The current command could act as a prefix,
- ;; but decided not to call `transient-setup'.
- (prog1 nil (transient--stack-zap))))
- (remove-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
- (remove-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
- (advice-remove 'abort-recursive-edit #'transient--minibuffer-exit)
- (remove-hook 'post-command-hook #'transient--post-command))
- (setq transient-current-prefix nil)
- (setq transient-current-command nil)
- (setq transient-current-suffixes nil)
- (let ((resume (and transient--stack
- (not (memq transient--exitp '(replace suspend))))))
- (setq transient--exitp nil)
- (setq transient--helpp nil)
- (setq transient--editp nil)
- (run-hooks 'transient-exit-hook)
- (when resume
- (transient--stack-pop))))
- (transient--pop-keymap 'transient--redisplay-map)
- (setq transient--redisplay-map (transient--make-redisplay-map))
- (transient--push-keymap 'transient--redisplay-map)
- (unless (eq this-command (oref transient--prefix command))
- (transient--redisplay))))
+ (transient--with-emergency-exit
+ (cond
+ ((and (eq (this-command-keys-vector) [])
+ (= (minibuffer-depth)
+ (1+ transient--minibuffer-depth)))
+ (transient--suspend-override)
+ (transient--delay-post-command (eq transient--exitp 'replace)))
+ (transient--exitp
+ (transient--post-exit))
+ ((eq this-command (oref transient--prefix command)))
+ (t
+ (let ((old transient--redisplay-map)
+ (new (transient--make-redisplay-map)))
+ (unless (equal old new)
+ (transient--pop-keymap 'transient--redisplay-map)
+ (setq transient--redisplay-map new)
+ (transient--push-keymap 'transient--redisplay-map)))
+ (transient--redisplay)))))
+
+(defun transient--post-exit (&optional command)
+ (transient--debug 'post-exit)
+ (unless (and (eq transient--exitp 'replace)
+ (or transient--prefix
+ ;; The current command could act as a prefix,
+ ;; but decided not to call `transient-setup',
+ ;; or it is prevented from doing so because it
+ ;; uses the minibuffer and the user aborted
+ ;; that.
+ (prog1 nil
+ (if (let ((obj (transient-suffix-object command)))
+ (and (slot-boundp obj 'transient)
+ (oref obj transient)))
+ ;; This sub-prefix is a transient suffix;
+ ;; go back to outer prefix, by calling
+ ;; `transient--stack-pop' further down.
+ (setq transient--exitp nil)
+ (transient--stack-zap)))))
+ (remove-hook 'pre-command-hook #'transient--pre-command)
+ (remove-hook 'post-command-hook #'transient--post-command))
+ (setq transient-current-prefix nil)
+ (setq transient-current-command nil)
+ (setq transient-current-suffixes nil)
+ (let ((resume (and transient--stack
+ (not (memq transient--exitp '(replace suspend))))))
+ (unless (or resume (eq transient--exitp 'replace))
+ (setq transient--showp nil))
+ (setq transient--exitp nil)
+ (setq transient--helpp nil)
+ (setq transient--editp nil)
+ (setq transient--minibuffer-depth 0)
+ (run-hooks 'transient-exit-hook)
+ (when resume
+ (transient--stack-pop))))
(defun transient--stack-push ()
(transient--debug 'stack-push)
@@ -2083,7 +2274,14 @@ value. Otherwise return CHILDREN as is."
(defun transient--redisplay ()
(if (or (eq transient-show-popup t)
transient--showp)
- (unless (memq this-command transient--scroll-commands)
+ (unless
+ (or (memq this-command transient--scroll-commands)
+ (and (or (memq this-command '(mouse-drag-region
+ mouse-set-region))
+ (equal (key-description (this-command-keys-vector))
+ "<mouse-movement>"))
+ (and (eq (current-buffer)
+ (get-buffer transient--buffer-name)))))
(transient--show))
(when (and (numberp transient-show-popup)
(not (zerop transient-show-popup))
@@ -2107,14 +2305,22 @@ value. Otherwise return CHILDREN as is."
(defun transient--debug (arg &rest args)
(when transient--debug
- (if (symbolp arg)
- (message "-- %-16s (cmd: %s, event: %S, exit: %s)"
- arg
- (or (transient--suffix-symbol this-command)
- (list this-command this-original-command last-command))
- (key-description (this-command-keys-vector))
- transient--exitp)
- (apply #'message arg args))))
+ (let ((inhibit-message (not (eq transient--debug 'message))))
+ (if (symbolp arg)
+ (message "-- %-18s (cmd: %s, event: %S, exit: %s%s)"
+ arg
+ (or (ignore-errors (transient--suffix-symbol this-command))
+ (if (byte-code-function-p this-command)
+ "#[...]"
+ this-command))
+ (key-description (this-command-keys-vector))
+ transient--exitp
+ (cond ((stringp (car args))
+ (concat ", " (apply #'format args)))
+ (args
+ (concat ", " (apply (car args) (cdr args))))
+ (t "")))
+ (apply #'message arg args)))))
(defun transient--emergency-exit ()
"Exit the current transient command after an error occurred.
@@ -2125,7 +2331,7 @@ nil) then do nothing."
(setq transient--stack nil)
(setq transient--exitp t)
(transient--pre-exit)
- (transient--post-command)))
+ (transient--post-exit)))
;;; Pre-Commands
@@ -2153,12 +2359,49 @@ nil) then do nothing."
(transient--export)
transient--stay)
+(defun transient--do-return ()
+ "Call the command after exporting variables and return to parent prefix.
+If there is no parent prefix, then behave like `transient--do-exit'."
+ (if (not transient--stack)
+ (transient--do-exit)
+ (transient--export)
+ transient--exit))
+
(defun transient--do-exit ()
"Call the command after exporting variables and exit the transient."
(transient--export)
(transient--stack-zap)
transient--exit)
+(defun transient--do-push-button ()
+ "Call the command represented by the activated button.
+Use that command's pre-command to determine transient behavior."
+ (if (and (mouse-event-p last-command-event)
+ (not (eq (posn-window (event-start last-command-event))
+ transient--window)))
+ transient--stay
+ (setq this-command
+ (with-selected-window transient--window
+ (get-text-property (if (mouse-event-p last-command-event)
+ (posn-point (event-start
last-command-event))
+ (point))
+ 'command)))
+ (transient--do-pre-command)))
+
+(defun transient--do-recurse ()
+ "Call the transient prefix command, preparing for return to active transient.
+If there is no parent prefix, then just call the command."
+ (transient--do-replace))
+
+(defun transient--setup-recursion (prefix-obj)
+ (when transient--stack
+ (let ((command (oref prefix-obj command)))
+ (when-let ((suffix-obj (transient-suffix-object command)))
+ (when (and (slot-boundp suffix-obj 'transient)
+ (memq (oref suffix-obj transient)
+ (list t #'transient--do-recurse)))
+ (oset prefix-obj transient-suffix 'transient--do-return))))))
+
(defun transient--do-replace ()
"Call the transient prefix command, replacing the active transient."
(transient--export)
@@ -2196,17 +2439,28 @@ to `transient--do-warn'."
(setq this-command 'transient-popup-navigation-help))
transient--stay)
+(defun transient--do-minus ()
+ "Call `negative-argument' or pivot to `transient-update'.
+If `negative-argument' is invoked using \"-\" then preserve the
+prefix argument and pivot to `transient-update'."
+ (when (equal (this-command-keys) "-")
+ (setq this-command 'transient-update))
+ transient--stay)
+
(put 'transient--do-stay 'transient-color 'transient-red)
(put 'transient--do-noop 'transient-color 'transient-red)
(put 'transient--do-warn 'transient-color 'transient-red)
(put 'transient--do-warn-inapt 'transient-color 'transient-red)
(put 'transient--do-call 'transient-color 'transient-red)
+(put 'transient--do-return 'transient-color 'transient-purple)
(put 'transient--do-exit 'transient-color 'transient-blue)
+(put 'transient--do-recurse 'transient-color 'transient-red)
(put 'transient--do-replace 'transient-color 'transient-blue)
(put 'transient--do-suspend 'transient-color 'transient-blue)
(put 'transient--do-quit-one 'transient-color 'transient-blue)
(put 'transient--do-quit-all 'transient-color 'transient-blue)
(put 'transient--do-move 'transient-color 'transient-red)
+(put 'transient--do-minus 'transient-color 'transient-red)
;;; Commands
@@ -2232,6 +2486,8 @@ to `transient--do-warn'."
'face 'font-lock-warning-face)
(propertize "C-g" 'face 'transient-key)
(propertize "?" 'face 'transient-key)
+ ;; `this-command' is `transient--undefined' or similar at this
+ ;; point. Show the command the user actually tried to invoke.
(propertize (symbol-name (transient--suffix-symbol
this-original-command))
'face 'font-lock-warning-face))
@@ -2272,7 +2528,9 @@ transient is active."
(defun transient-update ()
"Redraw the transient's state in the popup buffer."
- (interactive))
+ (interactive)
+ (when (equal this-original-command 'negative-argument)
+ (setq prefix-arg current-prefix-arg)))
(defun transient-show ()
"Show the transient's state in the popup buffer."
@@ -2337,7 +2595,8 @@ transient is active."
(oset (transient-suffix-object command) level level))
(setf (alist-get sym alist) level)
(setf (alist-get prefix transient-levels) alist))
- (transient-save-levels))
+ (transient-save-levels)
+ (transient--show))
(t
(transient-undefined))))
@@ -2351,6 +2610,11 @@ transient is active."
(interactive)
(transient-save-value (or transient--prefix transient-current-prefix)))
+(defun transient-reset ()
+ "Clear the set and saved values of the active transient."
+ (interactive)
+ (transient-reset-value (or transient--prefix transient-current-prefix)))
+
(defun transient-history-next ()
"Switch to the next value used for the active transient."
(interactive)
@@ -2392,6 +2656,10 @@ around `scroll-down-command' (which see)."
(with-selected-window transient--window
(scroll-down-command arg)))
+(defun transient-push-button ()
+ "Invoke the suffix command represented by this button."
+ (interactive))
+
(defun transient-resume ()
"Resume a previously suspended stack of transients."
(interactive)
@@ -2461,12 +2729,7 @@ Otherwise call the primary method according to object's
class."
(oset obj value
(if-let ((saved (assq (oref obj command) transient-values)))
(cdr saved)
- (if-let ((default (and (slot-boundp obj 'default-value)
- (oref obj default-value))))
- (if (functionp default)
- (funcall default)
- default)
- nil)))))
+ (transient-default-value obj)))))
(cl-defmethod transient-init-value ((obj transient-argument))
(oset obj value
@@ -2474,6 +2737,7 @@ Otherwise call the primary method according to object's
class."
(argument (and (slot-boundp obj 'argument)
(oref obj argument)))
(multi-value (oref obj multi-value))
+ (case-fold-search nil)
(regexp (if (slot-exists-p obj 'argument-regexp)
(oref obj argument-regexp)
(format "\\`%s\\(.*\\)" (oref obj argument)))))
@@ -2492,6 +2756,20 @@ Otherwise call the primary method according to object's
class."
(car (member (oref obj argument)
(oref transient--prefix value)))))
+;;;; Default
+
+(cl-defgeneric transient-default-value (_)
+ "Return the default value."
+ nil)
+
+(cl-defmethod transient-default-value ((obj transient-prefix))
+ (if-let ((default (and (slot-boundp obj 'default-value)
+ (oref obj default-value))))
+ (if (functionp default)
+ (funcall default)
+ default)
+ nil))
+
;;;; Read
(cl-defgeneric transient-infix-read (obj)
@@ -2512,13 +2790,24 @@ on the previous value.")
(cl-defmethod transient-infix-read :around ((obj transient-infix))
"Highlight the infix in the popup buffer.
-Also arrange for the transient to be exited in case of an error
-because otherwise Emacs would get stuck in an inconsistent state,
-which might make it necessary to kill it from the outside."
+This also wraps the call to `cl-call-next-method' with two
+macros.
+
+`transient--with-suspended-override' is necessary to allow
+reading user input using the minibuffer.
+
+`transient--with-emergency-exit' arranges for the transient to
+be exited in case of an error because otherwise Emacs would get
+stuck in an inconsistent state, which might make it necessary to
+kill it from the outside.
+
+If you replace this method, then you must make sure to always use
+the latter macro and most likely also the former."
(let ((transient--active-infix obj))
(transient--show))
(transient--with-emergency-exit
- (cl-call-next-method obj)))
+ (transient--with-suspended-override
+ (cl-call-next-method obj))))
(cl-defmethod transient-infix-read ((obj transient-infix))
"Read a value while taking care of history.
@@ -2542,7 +2831,7 @@ it\", in which case it is pointless to preserve history.)"
(not always-read)
transient--prefix)
(oset obj value nil)
- (let* ((overriding-terminal-local-map nil)
+ (let* ((enable-recursive-minibuffers t)
(reader (oref obj reader))
(prompt (transient-prompt obj))
(value (if multi-value (mapconcat #'identity value ",") value))
@@ -2678,11 +2967,11 @@ prompt."
(if (stringp prompt)
prompt
"(BUG: no prompt): "))
- (or (when-let ((arg (and (slot-boundp obj 'argument) (oref obj argument))))
+ (or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument))))
(if (and (stringp arg) (string-suffix-p "=" arg))
arg
(concat arg ": ")))
- (when-let ((var (and (slot-boundp obj 'variable) (oref obj variable))))
+ (and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable))))
(and (stringp var)
(concat var ": ")))
"(BUG: no prompt): ")))
@@ -2720,12 +3009,18 @@ prompt."
(transient-infix-set obj nil)))))
(cl-call-next-method obj value))))
+(cl-defgeneric transient-set-value (obj)
+ "Set the value of the transient prefix OBJ.")
+
(cl-defmethod transient-set-value ((obj transient-prefix))
(oset (oref obj prototype) value (transient-get-value))
(transient--history-push obj))
;;;; Save
+(cl-defgeneric transient-save-value (obj)
+ "Save the value of the transient prefix OBJ.")
+
(cl-defmethod transient-save-value ((obj transient-prefix))
(let ((value (transient-get-value)))
(oset (oref obj prototype) value value)
@@ -2733,6 +3028,20 @@ prompt."
(transient-save-values))
(transient--history-push obj))
+;;;; Reset
+
+(cl-defgeneric transient-reset-value (obj)
+ "Clear the set and saved values of the transient prefix OBJ.")
+
+(cl-defmethod transient-reset-value ((obj transient-prefix))
+ (let ((value (transient-default-value obj)))
+ (oset obj value value)
+ (oset (oref obj prototype) value value)
+ (setf (alist-get (oref obj command) transient-values nil 'remove) nil)
+ (transient-save-values))
+ (transient--history-push obj)
+ (mapc #'transient-init-value transient--suffixes))
+
;;;; Get
(defun transient-args (prefix)
@@ -2760,7 +3069,7 @@ the set, saved or default value for PREFIX."
transient-current-suffixes)))
(defun transient--get-wrapped-value (obj)
- (when-let ((value (transient-infix-value obj)))
+ (and-let* ((value (transient-infix-value obj)))
(cl-ecase (and (slot-exists-p obj 'multi-value)
(oref obj multi-value))
((nil) (list value))
@@ -2798,7 +3107,7 @@ does nothing." nil)
(cl-defmethod transient-infix-value ((obj transient-option))
"Return ARGUMENT and VALUE as a unit or nil if the latter is nil."
- (when-let ((value (oref obj value)))
+ (and-let* ((value (oref obj value)))
(let ((arg (oref obj argument)))
(cl-ecase (oref obj multi-value)
((nil) (concat arg value))
@@ -2821,9 +3130,10 @@ contribute to the value of the transient."
For a switch return a boolean. For an option return the value as
a string, using the empty string for the empty value, or nil if
the option does not appear in ARGS."
- (if (string-match-p "=\\'" arg)
+ (if (string-suffix-p "=" arg)
(save-match-data
- (when-let ((match (let ((re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'"
+ (and-let* ((match (let ((case-fold-search nil)
+ (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'"
(substring arg 0 -1))))
(cl-find-if (lambda (a)
(and (stringp a)
@@ -2906,6 +3216,7 @@ have a history of their own.")
(setq window-size-fixed t)
(when (bound-and-true-p tab-line-format)
(setq tab-line-format nil))
+ (setq header-line-format nil)
(setq mode-line-format (if (eq transient-mode-line-format 'line)
nil
transient-mode-line-format))
@@ -2939,9 +3250,9 @@ have a history of their own.")
(goto-char (point-min))
(when transient-enable-popup-navigation
(transient--goto-button focus))
- (magit--fit-window-to-buffer transient--window)))))
+ (transient--fit-window-to-buffer transient--window)))))
-(defun magit--fit-window-to-buffer (window)
+(defun transient--fit-window-to-buffer (window)
(let ((window-resize-pixelwise t)
(window-size-fixed nil))
(if (eq (car (window-parameter window 'quit-restore)) 'other)
@@ -2963,13 +3274,18 @@ have a history of their own.")
(when groups
(insert ?\n)))))
+(defvar transient--max-group-level 1)
+
(cl-defgeneric transient--insert-group (group)
"Format GROUP and its elements and insert the result.")
-(cl-defmethod transient--insert-group :before ((group transient-group))
+(cl-defmethod transient--insert-group :around ((group transient-group))
"Insert GROUP's description, if any."
(when-let ((desc (transient-format-description group)))
- (insert desc ?\n)))
+ (insert desc ?\n))
+ (let ((transient--max-group-level
+ (max (oref group level) transient--max-group-level)))
+ (cl-call-next-method group)))
(cl-defmethod transient--insert-group ((group transient-row))
(transient--maybe-pad-keys group)
@@ -2994,9 +3310,10 @@ have a history of their own.")
(let ((rows (mapcar #'transient-format (oref column suffixes))))
(when-let ((desc (transient-format-description column)))
(push desc rows))
- rows))
+ (flatten-tree rows)))
(oref group suffixes)))
- (vp (oref transient--prefix variable-pitch))
+ (vp (or (oref transient--prefix variable-pitch)
+ transient-align-variable-pitch))
(rs (apply #'max (mapcar #'length columns)))
(cs (length columns))
(cw (mapcar (lambda (col)
@@ -3096,7 +3413,7 @@ Optional support for popup buttons is also implemented
here."
(add-face-text-property 0 (length str) 'transient-inapt-suffix nil str))
(if transient-enable-popup-navigation
(make-text-button str nil
- 'type 'transient-button
+ 'type 'transient
'command (transient--suffix-command obj))
str)))
@@ -3129,27 +3446,33 @@ Optional support for popup buttons is also implemented
here."
(let ((len (length transient--redisplay-key))
(seq (cl-coerce (edmacro-parse-keys key t) 'list)))
(cond
- ((equal (seq-take seq len) transient--redisplay-key)
+ ((member (seq-take seq len)
+ (list transient--redisplay-key
+ (thread-last transient--redisplay-key
+ (cl-substitute ?- 'kp-subtract)
+ (cl-substitute ?= 'kp-equal)
+ (cl-substitute ?+ 'kp-add))))
(let ((pre (key-description (vconcat (seq-take seq len))))
(suf (key-description (vconcat (seq-drop seq len)))))
- (setq pre (replace-regexp-in-string "RET" "C-m" pre t))
- (setq pre (replace-regexp-in-string "TAB" "C-i" pre t))
- (setq suf (replace-regexp-in-string "RET" "C-m" suf t))
- (setq suf (replace-regexp-in-string "TAB" "C-i" suf t))
+ (setq pre (string-replace "RET" "C-m" pre))
+ (setq pre (string-replace "TAB" "C-i" pre))
+ (setq suf (string-replace "RET" "C-m" suf))
+ (setq suf (string-replace "TAB" "C-i" suf))
;; We use e.g. "-k" instead of the more correct "- k",
;; because the former is prettier. If we did that in
;; the definition, then we want to drop the space that
;; is reinserted above. False-positives are possible
;; for silly bindings like "-C-c C-c".
- (unless (string-match-p " " key)
- (setq pre (replace-regexp-in-string " " "" pre))
- (setq suf (replace-regexp-in-string " " "" suf)))
- (concat (propertize pre 'face 'default)
+ (unless (string-search " " key)
+ (setq pre (string-replace " " "" pre))
+ (setq suf (string-replace " " "" suf)))
+ (concat (propertize pre 'face 'transient-unreachable-key)
(and (string-prefix-p (concat pre " ") key) " ")
(transient--colorize-key suf cmd)
(save-excursion
- (when (string-match " +\\'" key)
- (match-string 0 key))))))
+ (and (string-match " +\\'" key)
+ (propertize (match-string 0 key)
+ 'face 'fixed-pitch))))))
((transient--lookup-key transient-sticky-map (kbd key))
(transient--colorize-key key cmd))
(t
@@ -3180,7 +3503,7 @@ Optional support for popup buttons is also implemented
here."
"The `description' slot may be a function, in which case that is
called inside the correct buffer (see `transient-insert-group')
and its value is returned to the caller."
- (when-let ((desc (oref obj description)))
+ (and-let* ((desc (oref obj description)))
(if (functionp desc)
(with-current-buffer transient--original-buffer
(funcall desc))
@@ -3190,7 +3513,7 @@ and its value is returned to the caller."
"Format the description by calling the next method. If the result
doesn't use the `face' property at all, then apply the face
`transient-heading' to the complete string."
- (when-let ((desc (cl-call-next-method obj)))
+ (and-let* ((desc (cl-call-next-method obj)))
(if (text-property-not-all 0 (length desc) 'face nil desc)
desc
(propertize desc 'face 'transient-heading))))
@@ -3208,7 +3531,8 @@ If the OBJ's `key' is currently unreachable, then apply
the face
(cond ((transient--key-unreachable-p obj)
(propertize desc 'face 'transient-unreachable))
((and transient-highlight-higher-levels
- (> (oref obj level) transient--default-prefix-level))
+ (> (max (oref obj level) transient--max-group-level)
+ transient--default-prefix-level))
(add-face-text-property
0 (length desc) 'transient-higher-level nil desc)
desc)
@@ -3344,9 +3668,24 @@ manpage, then try to jump to the correct location."
(transient--describe-function cmd))
(defun transient--describe-function (fn)
- (describe-function fn)
+ (describe-function (if (symbolp fn) fn 'transient--anonymous-infix-argument))
(select-window (get-buffer-window (help-buffer))))
+(defun transient--anonymous-infix-argument ()
+ "Cannot show any documentation for this anonymous infix command.
+
+The infix command in question was defined anonymously, i.e.,
+it was define when the prefix command that it belongs to was
+defined, which means that it gets no docstring and also that
+no symbol is bound to it.
+
+When you request help for an infix command, then we usually
+show the respective man-page and jump to the location where
+the respective argument is being described.
+
+Because the containing prefix command does not specify any
+man-page, we cannot do that in this case. Sorry about that.")
+
(defun transient--show-manual (manual)
(info manual))
@@ -3454,8 +3793,14 @@ resumes the suspended transient.")
(define-minor-mode transient-resume-mode
"Auxiliary minor-mode used to resume a transient after viewing help.")
-;;; Compatibility
-;;;; Popup Navigation
+(defun transient-toggle-debug ()
+ "Toggle debugging statements for transient commands."
+ (interactive)
+ (setq transient--debug (not transient--debug))
+ (message "Debugging transient %s"
+ (if transient--debug "enabled" "disabled")))
+
+;;; Popup Navigation
(defun transient-popup-navigation-help ()
"Inform the user how to enable popup navigation commands."
@@ -3463,39 +3808,9 @@ resumes the suspended transient.")
(message "This command is only available if `%s' is non-nil"
'transient-enable-popup-navigation))
-(define-button-type 'transient-button
+(define-button-type 'transient
'face nil
- 'action (lambda (button)
- (let ((command (button-get button 'command)))
- ;; Yes, I know that this is wrong(tm).
- ;; Unfortunately it is also necessary.
- (setq this-original-command command)
- (transient--pre-command)
- (call-interactively command))))
-
-(defvar transient-popup-navigation-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "<down-mouse-1>") #'transient-noop)
- (define-key map (kbd "<mouse-1>") #'transient-mouse-push-button)
- (define-key map (kbd "RET") #'transient-push-button)
- (define-key map (kbd "<up>") #'transient-backward-button)
- (define-key map (kbd "C-p") #'transient-backward-button)
- (define-key map (kbd "<down>") #'transient-forward-button)
- (define-key map (kbd "C-n") #'transient-forward-button)
- (define-key map (kbd "C-r") #'transient-isearch-backward)
- (define-key map (kbd "C-s") #'transient-isearch-forward)
- map))
-
-(defun transient-mouse-push-button (&optional pos)
- "Invoke the suffix the user clicks on."
- (interactive (list last-command-event))
- (push-button pos))
-
-(defun transient-push-button ()
- "Invoke the selected suffix command."
- (interactive)
- (with-selected-window transient--window
- (push-button)))
+ 'keymap transient-button-map)
(defun transient-backward-button (n)
"Move to the previous button in the transient popup buffer.
@@ -3530,6 +3845,7 @@ See `forward-button' for information about N."
beg (next-single-property-change
beg 'face nil (line-end-position))))))
+;;; Compatibility
;;;; Popup Isearch
(defvar transient--isearch-mode-map
@@ -3578,7 +3894,7 @@ search instead."
(defun transient--isearch-setup ()
(select-window transient--window)
- (transient--suspend-override))
+ (transient--suspend-override t))
(defun transient--isearch-exit ()
(select-window transient--original-window)
@@ -3607,11 +3923,12 @@ search instead."
'transient-red
'transient-blue))))
(pcase (list suffix nonsuf)
- (`(transient-red disallow) 'transient-amaranth)
- (`(transient-blue disallow) 'transient-teal)
- (`(transient-red transient-red) 'transient-pink)
- (`(transient-red transient-blue) 'transient-red)
- (`(transient-blue transient-blue) 'transient-blue))))
+ (`(transient-purple ,_) 'transient-purple)
+ ('(transient-red disallow) 'transient-amaranth)
+ ('(transient-blue disallow) 'transient-teal)
+ ('(transient-red transient-red) 'transient-pink)
+ ('(transient-red transient-blue) 'transient-red)
+ ('(transient-blue transient-blue) 'transient-blue))))
;;;; Edebug
@@ -3621,7 +3938,7 @@ search instead."
(funcall fn arg-mode)
(transient--suspend-override t)
(funcall fn arg-mode)
- (transient--resume-override t)))
+ (transient--resume-override)))
(advice-add 'edebug--recursive-edit :around
#'transient--edebug--recursive-edit)
@@ -3639,6 +3956,18 @@ search instead."
;;;; Miscellaneous
+(cl-pushnew (list nil (concat "^\\s-*("
+ (eval-when-compile
+ (regexp-opt
+ '("transient-define-prefix"
+ "transient-define-suffix"
+ "transient-define-infix"
+ "transient-define-argument")
+ t))
+ "\\s-+\\(" lisp-mode-symbol-regexp "\\)")
+ 2)
+ lisp-imenu-generic-expression :test #'equal)
+
(declare-function which-key-mode "which-key" (&optional arg))
(defun transient--suspend-which-key-mode ()
@@ -3741,7 +4070,7 @@ we stop there."
(oset obj value value)))
(cl-defmethod transient-format-description ((obj transient-lisp-variable))
- (or (oref obj description)
+ (or (cl-call-next-method obj)
(symbol-name (oref obj variable))))
(cl-defmethod transient-format-value ((obj transient-lisp-variable))
diff --git a/lisp/type-break.el b/lisp/type-break.el
index dca5a43b89..bb6382cfe9 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -46,11 +46,6 @@
;; in the mode line instead, do M-x type-break-mode-line-message-mode
;; or set the variable of the same name to t.
-;; This program can truly cons up a storm because of all the calls to
-;; `current-time' (which always returns fresh conses). I'm dismayed by
-;; this, but I think the health of my hands is far more important than a
-;; few pages of virtual memory.
-
;; This package was inspired by Roland McGrath's hanoi-break.el.
;; Several people contributed feedback and ideas, including
;; Roland McGrath <roland@gnu.org>
@@ -263,7 +258,7 @@ It will be either \"seconds\" or \"keystrokes\".")
(defvar type-break-keystroke-count 0)
(defvar type-break-time-last-break nil)
(defvar type-break-time-next-break nil)
-(defvar type-break-time-last-command (current-time))
+(defvar type-break-time-last-command (time-convert nil 'integer))
(defvar type-break-current-time-warning-interval nil)
(defvar type-break-current-keystroke-warning-interval nil)
(defvar type-break-time-warning-count 0)
@@ -362,7 +357,7 @@ problems."
(setq type-break-time-last-break
(or (type-break-get-previous-time)
- (current-time)))
+ (time-convert nil 'integer)))
;; Schedule according to break time from session file.
(type-break-schedule
@@ -381,7 +376,7 @@ problems."
(setq type-break-interval-start type-break-time-last-break)
(- type-break-interval diff))
;; Schedule from now.
- (setq type-break-interval-start (current-time))
+ (setq type-break-interval-start (time-convert nil 'integer))
(type-break-file-time type-break-interval-start)
type-break-interval))
type-break-interval-start
@@ -456,7 +451,7 @@ the variable of the same name."
;; file saving is left to auto-save
))))))
-(defun timep (time)
+(defun type-break-timep (time)
"If TIME is a Lisp time value then return TIME, else return nil."
(condition-case nil
(and (float-time time) time)
@@ -480,7 +475,7 @@ the variable of the same name."
Return nil if the file is missing or if the time is not a Lisp time value."
(let ((file (type-break-choose-file)))
(if file
- (timep ;; returns expected format, else nil
+ (type-break-timep ;; returns expected format, else nil
(with-current-buffer (find-file-noselect file 'nowarn)
(condition-case nil
(save-excursion
@@ -525,7 +520,7 @@ as per the function `type-break-schedule'."
;; remove any query scheduled during interactive invocation
(remove-hook 'type-break-post-command-hook 'type-break-do-query)
(let ((continue t)
- (start-time (current-time)))
+ (start-time (time-convert nil 'integer)))
(setq type-break-time-last-break start-time)
(while continue
(save-window-excursion
@@ -676,9 +671,9 @@ keystroke threshold has been exceeded."
(progn
(type-break-keystroke-reset)
(type-break-mode-line-countdown-or-break nil)
- (setq type-break-time-last-break (current-time))
+ (setq type-break-time-last-break (time-convert nil 'integer))
(type-break-schedule)))
- (setq type-break-time-last-command (current-time))))
+ (setq type-break-time-last-command (time-convert nil 'integer))))
(and type-break-keystroke-threshold
(let ((keys (this-command-keys)))
@@ -943,14 +938,13 @@ FRAC should be the inverse of the fractional value; for
example, a value of
;;; misc functions
-;; Compute the difference, in seconds, between a and b, two structures
-;; similar to those returned by `current-time'.
+;; Compute the difference, in seconds, between a and b, two time values.
(defun type-break-time-difference (a b)
(round (float-time (time-subtract b a))))
;; Return a time value that is the sum of the time-value arguments.
(defun type-break-time-sum (&rest tmlist)
- (let ((sum '(0 0)))
+ (let ((sum 0))
(dolist (tem tmlist)
(setq sum (time-add sum tem)))
sum))
@@ -967,7 +961,7 @@ FRAC should be the inverse of the fractional value; for
example, a value of
(t (format "%d seconds" secs)))))
(defun type-break-keystroke-reset ()
- (setq type-break-interval-start (current-time)) ; not a keystroke
+ (setq type-break-interval-start (time-convert nil 'integer))
(setq type-break-keystroke-count 0)
(setq type-break-keystroke-warning-count 0)
(setq type-break-current-keystroke-warning-interval
@@ -1149,6 +1143,8 @@ With optional non-nil ALL, force redisplay of all
mode-lines."
(and (get-buffer buffer-name)
(kill-buffer buffer-name))))))
+(define-obsolete-function-alias 'timep 'type-break-timep "29.1")
+
(provide 'type-break)
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 0b7db9b54f..74655e299a 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -109,8 +109,8 @@ BASE and EXTRA-STRINGS where BASE is a string and
EXTRA-STRINGS
is a list of strings. For example the current implementation for
post-forward-angle-brackets could be:
-(defun my-post-forward-angle-brackets (base extra-string)
- (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\"))
+ (defun my-post-forward-angle-brackets (base extra-string)
+ (concat base \"<\" (mapconcat #\\='identity extra-string \"/\") \">\"))
The \"mumble\" part may be stripped as well, depending on the
setting of `uniquify-strip-common-suffix'. For more options that
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 99e62d9b7a..a72b2e67a6 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -26,7 +26,6 @@
(require 'mailcap)
(require 'url-vars)
(require 'url-parse)
-(require 'url-dired)
(declare-function mm-disable-multibyte "mm-util" ())
(defvar url-allow-non-local-files nil
@@ -174,7 +173,7 @@ it up to them."
(if (file-directory-p filename)
;; A directory is done the same whether we are local or remote
- (url-find-file-dired filename)
+ (find-file filename)
(with-current-buffer
(setq buffer (generate-new-buffer " *url-file*"))
(require 'mm-util)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 3d7d877979..94ef156108 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -471,9 +471,7 @@ Return the number of characters removed."
t ;; Instruct caller to signal an error. Bug#50511
;; Find strongest supported auth.
(dolist (this-auth auths)
- (setq this-auth (url-eat-trailing-space
- (url-strip-leading-spaces
- this-auth)))
+ (setq this-auth (string-trim this-auth))
(let* ((this-type
(downcase (if (string-match "[ \t]" this-auth)
(substring this-auth 0 (match-beginning 0))
@@ -1048,19 +1046,15 @@ More sophisticated percentage downloaded, etc.
Also does minimal parsing of HTTP headers and will actually cause
the callback to be triggered."
(if url-http-content-type
- (url-display-percentage
+ (url-display-message
"Reading [%s]... %s of %s (%d%%)"
- (url-percentage (- nd url-http-end-of-headers)
- url-http-content-length)
url-http-content-type
(funcall byte-count-to-string-function (- nd url-http-end-of-headers))
(funcall byte-count-to-string-function url-http-content-length)
(url-percentage (- nd url-http-end-of-headers)
url-http-content-length))
- (url-display-percentage
+ (url-display-message
"Reading... %s of %s (%d%%)"
- (url-percentage (- nd url-http-end-of-headers)
- url-http-content-length)
(funcall byte-count-to-string-function (- nd url-http-end-of-headers))
(funcall byte-count-to-string-function url-http-content-length)
(url-percentage (- nd url-http-end-of-headers)
@@ -1069,7 +1063,6 @@ the callback to be triggered."
(if (> (- nd url-http-end-of-headers) url-http-content-length)
(progn
;; Found the end of the document! Wheee!
- (url-display-percentage nil nil)
(url-lazy-message "Reading... done.")
(if (url-http-parse-headers)
(url-http-activate-callback)))))
@@ -1099,13 +1092,6 @@ the end of the document."
;; one after-change-function call.
(while read-next-chunk
(setq no-initial-crlf (= 0 url-http-chunked-counter))
- (if url-http-content-type
- (url-display-percentage nil
- "Reading [%s]... chunk #%d"
- url-http-content-type
url-http-chunked-counter)
- (url-display-percentage nil
- "Reading... chunk #%d"
- url-http-chunked-counter))
(url-http-debug "Reading chunk %d (%d %d %d)"
url-http-chunked-counter st nd length)
(setq regexp (if no-initial-crlf
@@ -1163,7 +1149,6 @@ the end of the document."
;; Found the end of the document! Wheee!
(url-http-debug "Saw end of stream chunk!")
(setq read-next-chunk nil)
- (url-display-percentage nil nil)
;; Every chunk, even the last 0-length one, is
;; terminated by CRLF. Skip it.
(if (not (looking-at "\r?\n"))
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index f897248fe4..36ccbe2adc 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -41,9 +41,16 @@
nil)
;; First, we handle the inseparable OS/Windowing system
;; combinations
- ((eq system-type 'windows-nt) "Windows-NT; 32bit")
+ ((memq system-type '(windows-nt cygwin))
+ (concat "MS-Windows; "
+ (if (string-match-p "\\`x86_64" system-configuration)
+ "64bit"
+ "32bit")
+ "; "
+ (cond ((eq window-system 'w32) "w32")
+ ((eq window-system 'x) "X11")
+ (t "TTY"))))
((eq system-type 'ms-dos) "MS-DOS; 32bit")
- ((memq (or window-system 'tty) '(win32 w32)) "Windows; 32bit")
(t
(pcase (or window-system 'tty)
('x "X11")
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index fc84d45176..147a643c9f 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -27,8 +27,6 @@
(require 'url-parse)
(require 'url-vars)
-(autoload 'timezone-parse-date "timezone")
-(autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'mail-header-extract "mailheader")
(defvar url-parse-args-syntax-table
@@ -180,39 +178,28 @@ Will not do anything if `url-show-status' is nil."
(format-time-string "%a, %d %b %Y %T GMT" specified-time t)))
;;;###autoload
-(defun url-eat-trailing-space (x)
- "Remove spaces/tabs at the end of a string."
- (let ((y (1- (length x)))
- (skip-chars (list ? ?\t ?\n)))
- (while (and (>= y 0) (memq (aref x y) skip-chars))
- (setq y (1- y)))
- (substring x 0 (1+ y))))
+(define-obsolete-function-alias 'url-eat-trailing-space
+ #'string-trim-right "29.1")
;;;###autoload
-(defun url-strip-leading-spaces (x)
- "Remove spaces at the front of a string."
- (let ((y (1- (length x)))
- (z 0)
- (skip-chars (list ? ?\t ?\n)))
- (while (and (<= z y) (memq (aref x z) skip-chars))
- (setq z (1+ z)))
- (substring x z nil)))
-
+(define-obsolete-function-alias 'url-strip-leading-spaces
+ #'string-trim-left "29.1")
(define-obsolete-function-alias 'url-pretty-length
'file-size-human-readable "24.4")
;;;###autoload
-(defun url-display-percentage (fmt perc &rest args)
+(defun url-display-message (fmt &rest args)
+ "Like `message', but do nothing if `url-show-status' is nil."
(when (and url-show-status
- (or (null url-current-object)
- (not (url-silent url-current-object))))
- (if (null fmt)
- (if (fboundp 'clear-progress-display)
- (clear-progress-display))
- (if (and (fboundp 'progress-display) perc)
- (apply 'progress-display fmt perc args)
- (apply 'message fmt args)))))
+ (not (and url-current-object (url-silent url-current-object)))
+ fmt)
+ (apply #'message fmt args)))
+
+;;;###autoload
+(defun url-display-percentage (fmt _perc &rest args)
+ (declare (obsolete url-display-message "29.1"))
+ (url-display-message fmt args))
;;;###autoload
(defun url-percentage (x y)
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index e02d84f1f5..d710578fff 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -568,14 +568,12 @@ Compatibility function for \\[next-error] invocations."
;; Select window displaying source file.
(select-window change-log-find-window)))))
-(defvar change-log-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\C-c ?\C-p] #'add-log-edit-prev-comment)
- (define-key map [?\C-c ?\C-n] #'add-log-edit-next-comment)
- (define-key map [?\C-c ?\C-f] #'change-log-find-file)
- (define-key map [?\C-c ?\C-c] #'change-log-goto-source)
- map)
- "Keymap for Change Log major mode.")
+(defvar-keymap change-log-mode-map
+ :doc "Keymap for Change Log major mode."
+ "C-c C-p" #'add-log-edit-prev-comment
+ "C-c C-n" #'add-log-edit-next-comment
+ "C-c C-f" #'change-log-find-file
+ "C-c C-c" #'change-log-goto-source)
(easy-menu-define change-log-mode-menu change-log-mode-map
"Menu for Change Log major mode."
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index aa426446d7..e4a1996c1b 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -27,8 +27,8 @@
;; to the corresponding source file.
;; Inspired by Pavel Machek's patch-mode.el (<pavel@@atrey.karlin.mff.cuni.cz>)
-;; Some efforts were spent to have it somewhat compatible with XEmacs's
-;; diff-mode as well as with compilation-minor-mode
+;; Some efforts were spent to have it somewhat compatible with
+;; `compilation-minor-mode'.
;; Bugs:
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index 42fbde2165..e2d93d2b31 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -24,10 +24,6 @@
;;; Code:
-;; Compiler pacifier start
-(defvar ediff-multiframe)
-;; end pacifier
-
(require 'ediff-init)
(defvar ediff-multiframe)
diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el
index 0160d9f684..d1eff0151a 100644
--- a/lisp/vc/ediff-hook.el
+++ b/lisp/vc/ediff-hook.el
@@ -35,16 +35,8 @@
;; (define-key menu-bar-tools-menu [ediff]
;; '("Compare" . menu-bar-ediff-menu))
-;; Compiler pacifier
-(defvar ediff-menu)
-(defvar ediff-merge-menu)
-(defvar epatch-menu)
-(defvar ediff-misc-menu)
-;; end pacifier
-
;; allow menus to be set up without ediff-wind.el being loaded
-;; Emacs
;; initialize menu bar keymaps
(defvar menu-bar-ediff-misc-menu
(make-sparse-keymap "Ediff Miscellanea"))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 273bad5d35..a3e77200dd 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -27,35 +27,26 @@
(require 'cl-lib)
(require 'ediff-util)
-;; Start compiler pacifier
(defvar ediff-metajob-name)
(defvar ediff-meta-buffer)
(defvar ediff-grab-mouse)
(defvar ediff-mouse-pixel-position)
(defvar ediff-mouse-pixel-threshold)
-(defvar ediff-whitespace)
(defvar ediff-multiframe)
(defvar ediff-use-toolbar-p)
-(defvar mswindowsx-bitmap-file-path)
-;; end pacifier
(defvar ediff-force-faces nil
"If t, Ediff will think that it is running on a display that supports faces.
This is provided as a temporary relief for users of face-capable displays
that Ediff doesn't know about.")
-;; Are we running as a window application or on a TTY?
(defsubst ediff-device-type ()
- (declare (obsolete nil "27.1"))
+ (declare (obsolete window-system "27.1"))
window-system)
-(defun ediff-window-display-p ()
- (and window-system
- (not (memq window-system '(tty pc stream)))))
-
;; test if supports faces
(defun ediff-has-face-support-p ()
- (cond ((ediff-window-display-p))
+ (cond ((display-graphic-p))
(ediff-force-faces)
((display-color-p))
(t (memq window-system '(pc)))))
@@ -64,11 +55,6 @@ that Ediff doesn't know about.")
(defun ediff-has-toolbar-support-p ()
nil)
-
-(defun ediff-has-gutter-support-p ()
- (declare (obsolete nil "27.1"))
- nil)
-
(defun ediff-use-toolbar-p ()
(and (ediff-has-toolbar-support-p) ;Can it do it ?
(boundp 'ediff-use-toolbar-p)
@@ -259,7 +245,7 @@ It needs to be killed when we quit the session.")
(defsubst ediff-multiframe-setup-p ()
- (and (ediff-window-display-p) ediff-multiframe))
+ (and (display-graphic-p) ediff-multiframe))
(defmacro ediff-narrow-control-frame-p ()
'(and (ediff-multiframe-setup-p)
@@ -722,18 +708,6 @@ Ediff needs to find fine differences."
:type 'symbol
:group 'ediff)
-
-(define-obsolete-function-alias 'ediff-read-event #'read-event "27.1")
-
-(define-obsolete-function-alias 'ediff-overlayp #'overlayp "27.1")
-
-(define-obsolete-function-alias 'ediff-make-overlay #'make-overlay "27.1")
-
-(define-obsolete-function-alias 'ediff-delete-overlay #'delete-overlay "27.1")
-
-(define-obsolete-function-alias 'ediff-color-display-p #'display-color-p
"27.1")
-
-
;; A var local to each control panel buffer. Indicates highlighting style
;; in effect for this buffer: `face', `ascii',
;; `off' -- turned off (on a dumb terminal only).
@@ -789,7 +763,7 @@ Ediff needs to find fine differences."
(defun ediff-set-face-pixmap (face pixmap)
"Set stipple pixmap of FACE to PIXMAP on a monochrome display."
- (if (and (ediff-window-display-p) (not (display-color-p)))
+ (if (and (display-graphic-p) (not (display-color-p)))
(condition-case nil
(set-face-background-pixmap face pixmap)
(error
@@ -972,8 +946,6 @@ this variable represents.")
(cond ((not (ediff-has-face-support-p)) nil)
((and (boundp 'x-bitmap-file-path)
(locate-library "stipple" t x-bitmap-file-path)) "stipple")
- ((and (boundp 'mswindowsx-bitmap-file-path)
- (locate-library "stipple" t mswindowsx-bitmap-file-path))
"stipple")
(t "Stipple")))
(defface ediff-even-diff-A
@@ -1273,9 +1245,6 @@ This default should work without changes."
"Temporary file used for refining difference regions in buffer C.")
-(defun ediff-file-remote-p (file-name)
- (file-remote-p file-name))
-
;; File for which we can get attributes, such as size or date
(defun ediff-listable-file (file-name)
(let ((handler (find-file-name-handler file-name 'file-local-copy)))
@@ -1283,6 +1252,7 @@ This default should work without changes."
(defsubst ediff-frame-unsplittable-p (frame)
+ (declare (obsolete nil "29.1"))
(cdr (assq 'unsplittable (frame-parameters frame))))
(defsubst ediff-get-next-window (wind prev-wind)
@@ -1357,52 +1327,40 @@ This default should work without changes."
(ediff-clear-fine-differences-in-one-buffer n 'C)))
-(defsubst ediff-mouse-event-p (event)
- (string-match "mouse" (format "%S" (event-basic-type event))))
-
-
(defsubst ediff-key-press-event-p (event)
(or (char-or-string-p event) (symbolp event)))
(defun ediff-event-point (event)
- (cond ((ediff-mouse-event-p event)
+ (cond ((mouse-event-p event)
(posn-point (event-start event)))
((ediff-key-press-event-p event)
(point))
(t (error "Error"))))
(defun ediff-event-buffer (event)
- (cond ((ediff-mouse-event-p event)
+ (cond ((mouse-event-p event)
(window-buffer (posn-window (event-start event))))
((ediff-key-press-event-p event)
(current-buffer))
(t (error "Error"))))
-(define-obsolete-function-alias 'ediff-event-key #'identity "27.1")
-
(defun ediff-last-command-char ()
- (declare (obsolete nil "27.1"))
+ (declare (obsolete last-command-event "27.1"))
last-command-event)
(defsubst ediff-frame-iconified-p (frame)
- (and (ediff-window-display-p)
+ (and (display-graphic-p)
(frame-live-p frame)
(eq (frame-visible-p frame) 'icon)))
(defsubst ediff-window-visible-p (wind)
- ;; under TTY, window-live-p also means window is visible
(and (window-live-p wind)
- (or (not (ediff-window-display-p))
- (frame-visible-p (window-frame wind)))))
-
-
-(define-obsolete-function-alias 'ediff-frame-char-width
- #'frame-char-width "27.1")
+ (frame-visible-p (window-frame wind))))
(defun ediff-reset-mouse (&optional frame do-not-grab-mouse)
(or frame (setq frame (selected-frame)))
- (if (ediff-window-display-p)
+ (if (display-graphic-p)
(let ((frame-or-wind frame))
(or do-not-grab-mouse
;; don't set mouse if the user said to never do this
@@ -1419,29 +1377,28 @@ This default should work without changes."
)))
(defsubst ediff-spy-after-mouse ()
- (setq ediff-mouse-pixel-position (mouse-pixel-position)))
+ (declare (obsolete nil "29.1"))
+ (with-suppressed-warnings ((obsolete ediff-mouse-pixel-position))
+ (setq ediff-mouse-pixel-position (mouse-pixel-position))))
-;; It is not easy to find out when the user grabs the mouse, since emacs and
-;; xemacs behave differently when mouse is not in any frame. Also, this is
-;; sensitive to when the user grabbed mouse. Not used for now.
(defun ediff-user-grabbed-mouse ()
- (if ediff-mouse-pixel-position
- (cond ((not (eq (car ediff-mouse-pixel-position)
- (car (mouse-pixel-position)))))
- ((and (car (cdr ediff-mouse-pixel-position))
- (car (cdr (mouse-pixel-position)))
- (cdr (cdr ediff-mouse-pixel-position))
- (cdr (cdr (mouse-pixel-position))))
- (not (and (< (abs (- (car (cdr ediff-mouse-pixel-position))
- (car (cdr (mouse-pixel-position)))))
- ediff-mouse-pixel-threshold)
- (< (abs (- (cdr (cdr ediff-mouse-pixel-position))
- (cdr (cdr (mouse-pixel-position)))))
- ediff-mouse-pixel-threshold))))
- (t nil))))
-
-(define-obsolete-function-alias 'ediff-frame-char-height
- #'frame-char-height "27.1")
+ (declare (obsolete nil "29.1"))
+ (with-suppressed-warnings ((obsolete ediff-mouse-pixel-position))
+ (if ediff-mouse-pixel-position
+ (cond ((not (eq (car ediff-mouse-pixel-position)
+ (car (mouse-pixel-position)))))
+ ((and (car (cdr ediff-mouse-pixel-position))
+ (car (cdr (mouse-pixel-position)))
+ (cdr (cdr ediff-mouse-pixel-position))
+ (cdr (cdr (mouse-pixel-position))))
+ (not (and (< (abs (- (car (cdr ediff-mouse-pixel-position))
+ (car (cdr (mouse-pixel-position)))))
+ ediff-mouse-pixel-threshold)
+ (< (abs (- (cdr (cdr ediff-mouse-pixel-position))
+ (cdr (cdr (mouse-pixel-position)))))
+ ediff-mouse-pixel-threshold))))
+ (t nil)))))
+
;; Some overlay functions
@@ -1456,12 +1413,6 @@ This default should work without changes."
(defsubst ediff-empty-overlay-p (overl)
(= (ediff-overlay-start overl) (ediff-overlay-end overl)))
-(define-obsolete-function-alias 'ediff-overlay-buffer
- #'overlay-buffer "27.1")
-
-(define-obsolete-function-alias 'ediff-overlay-get #'overlay-get "27.1")
-
-
(defun ediff-move-overlay (overlay beg end &optional buffer)
"If OVERLAY's buffer exists, call `move-overlay'."
(let ((buf (and overlay (overlay-buffer overlay))))
@@ -1500,7 +1451,7 @@ This default should work without changes."
(ediff-abbreviate-file-name (file-name-directory dir))))
(defsubst ediff-nonempty-string-p (string)
- (and (stringp string) (not (string= string ""))))
+ (and (stringp string) (string-empty-p string)))
(defun ediff-abbrev-jobname (jobname)
(cond ((eq jobname 'ediff-directories)
@@ -1561,16 +1512,23 @@ This default should work without changes."
(ediff-file-attributes filename 5))
-;;; Obsolete
-
-(defun ediff-convert-standard-filename (fname)
- (declare (obsolete convert-standard-filename "28.1"))
- (convert-standard-filename fname))
-
-(define-obsolete-function-alias 'ediff-with-syntax-table
- #'with-syntax-table "27.1")
-
+(define-obsolete-function-alias 'ediff-has-gutter-support-p #'ignore "27.1")
+(define-obsolete-function-alias 'ediff-event-key #'identity "27.1")
+(define-obsolete-function-alias 'ediff-frame-char-width #'frame-char-width
"27.1")
+(define-obsolete-function-alias 'ediff-frame-char-height #'frame-char-height
"27.1")
+(define-obsolete-function-alias 'ediff-overlay-buffer #'overlay-buffer "27.1")
+(define-obsolete-function-alias 'ediff-overlay-get #'overlay-get "27.1")
+(define-obsolete-function-alias 'ediff-read-event #'read-event "27.1")
+(define-obsolete-function-alias 'ediff-overlayp #'overlayp "27.1")
+(define-obsolete-function-alias 'ediff-make-overlay #'make-overlay "27.1")
+(define-obsolete-function-alias 'ediff-delete-overlay #'delete-overlay "27.1")
+(define-obsolete-function-alias 'ediff-color-display-p #'display-color-p
"27.1")
+(define-obsolete-function-alias 'ediff-with-syntax-table #'with-syntax-table
"27.1")
+(define-obsolete-function-alias 'ediff-convert-standard-filename
#'convert-standard-filename "28.1")
(define-obsolete-function-alias 'ediff-hide-face #'ignore "28.1")
+(define-obsolete-function-alias 'ediff-file-remote-p #'file-remote-p "29.1")
+(define-obsolete-function-alias 'ediff-window-display-p #'display-graphic-p
"29.1")
+(define-obsolete-function-alias 'ediff-mouse-event-p #'mouse-event-p "29.1")
(provide 'ediff-init)
;;; ediff-init.el ends here
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index b7c349fc1c..52e356d8e9 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -144,20 +144,18 @@ Useful commands (type ? to hide them and free up screen):
(ediff-defvar-local ediff-meta-buffer-map nil
"The keymap for the meta buffer.")
-(defvar ediff-dir-diffs-buffer-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" #'ediff-bury-dir-diffs-buffer)
- (define-key map " " #'next-line)
- (define-key map "n" #'next-line)
- (define-key map "\C-?" #'previous-line)
- (define-key map "p" #'previous-line)
- (define-key map "C" #'ediff-dir-diff-copy-file)
- (define-key map [mouse-2] #'ediff-dir-diff-copy-file)
- (define-key map [delete] #'previous-line)
- (define-key map [backspace] #'previous-line)
- map)
- "Keymap for buffer showing differences between directories.")
+(defvar-keymap ediff-dir-diffs-buffer-map
+ :doc "Keymap for buffer showing differences between directories."
+ :suppress t
+ "q" #'ediff-bury-dir-diffs-buffer
+ "SPC" #'next-line
+ "n" #'next-line
+ "DEL" #'previous-line
+ "p" #'previous-line
+ "C" #'ediff-dir-diff-copy-file
+ "<mouse-2>" #'ediff-dir-diff-copy-file
+ "<delete>" #'previous-line
+ "<backspace>" #'previous-line)
;; Variable specifying the action to take when the use invokes ediff in the
;; meta buffer. This is usually ediff-registry-action or
ediff-filegroup-action
@@ -1861,7 +1859,6 @@ all marked sessions must be active."
;; handle an individual session with a live control buffer
((ediff-buffer-live-p session-buf)
(ediff-with-current-buffer session-buf
- (setq ediff-mouse-pixel-position (mouse-pixel-position))
(ediff-recenter 'no-rehighlight)))
((ediff-problematic-session-p info)
@@ -2005,7 +2002,6 @@ all marked sessions must be active."
(ediff-show-meta-buffer ctl-buf t)
;; it's a session buffer -- invoke go back to session
(ediff-with-current-buffer ctl-buf
- (setq ediff-mouse-pixel-position (mouse-pixel-position))
(ediff-recenter 'no-rehighlight)))
(beep)
(message "You've selected a stale session --- try again")
@@ -2056,14 +2052,14 @@ all marked sessions must be active."
((and
(setq wind
(ediff-get-visible-buffer-window ediff-registry-buffer))
- (ediff-window-display-p))
+ (display-graphic-p))
(select-window wind)
(other-window 1)
(set-window-buffer (selected-window) meta-buf))
(t (ediff-skip-unsuitable-frames 'ok-unsplittable)
(set-window-buffer (selected-window) meta-buf)))
))
- (if (and (ediff-window-display-p)
+ (if (and (display-graphic-p)
(window-live-p
(setq wind (ediff-get-visible-buffer-window meta-buf))))
(progn
@@ -2117,14 +2113,14 @@ all marked sessions must be active."
(select-window ediff-window-B))
((and (setq wind
(ediff-get-visible-buffer-window ediff-meta-buffer))
- (ediff-window-display-p))
+ (display-graphic-p))
(select-window wind)
(other-window 1)
(set-window-buffer (selected-window) ediff-registry-buffer))
(t (ediff-skip-unsuitable-frames 'ok-unsplittable)
(set-window-buffer (selected-window) ediff-registry-buffer)))
))
- (if (ediff-window-display-p)
+ (if (display-graphic-p)
(progn
(setq frame
(window-frame
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 17654f80ec..4d471e21b4 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -24,10 +24,8 @@
;;; Code:
-
(require 'diff-mode) ; For `diff-file-junk-re'.
-
(defgroup ediff-ptch nil
"Ediff patch support."
:tag "Patch"
@@ -798,7 +796,7 @@ you can still examine the changes via M-x ediff-files"
;; the orig file.
(setq target-filename
(concat
- (if (ediff-file-remote-p (file-truename source-filename))
+ (if (file-remote-p (file-truename source-filename))
magic-file-name
source-filename)
"_patched"))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 040a9a63c5..0d96a195ad 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -24,24 +24,11 @@
;;; Code:
-
(provide 'ediff-util) ;FIXME: Break cyclic dependencies and move to the end!
-;; Compiler pacifier
(defvar ediff-use-toolbar-p)
-(defvar ediff-toolbar-height)
-(defvar ediff-toolbar)
-(defvar ediff-toolbar-3way)
-(defvar bottom-toolbar)
-(defvar bottom-toolbar-visible-p)
-(defvar bottom-toolbar-height)
-(defvar mark-active)
-
(defvar ediff-after-quit-hook-internal nil)
-;; end pacifier
-
-
(require 'ediff-init)
(require 'ediff-help)
(require 'ediff-mult)
@@ -296,10 +283,6 @@ to invocation.")
(if (string-match "buffer" (symbol-name ediff-job-name))
(setq ediff-keep-variants t))
- (if (ediff-window-display-p)
- (add-hook 'pre-command-hook 'ediff-spy-after-mouse nil 'local))
- (setq ediff-mouse-pixel-position (mouse-pixel-position))
-
;; adjust for merge jobs
(if ediff-merge-job
(let ((buf
@@ -739,7 +722,7 @@ buffers."
;; set visibility range appropriate to this invocation of Ediff.
(ediff-visible-region)
;; raise
- (if (and (ediff-window-display-p)
+ (if (and (display-graphic-p)
(symbolp this-command)
(symbolp last-command)
;; Either one of the display-changing commands
@@ -764,7 +747,7 @@ buffers."
(raise-frame (window-frame ediff-window-B)))
(if (window-live-p ediff-window-C)
(raise-frame (window-frame ediff-window-C)))))
- (if (and (ediff-window-display-p)
+ (if (and (display-graphic-p)
(frame-live-p ediff-control-frame)
(not ediff-use-long-help-message)
(not (ediff-frame-iconified-p ediff-control-frame)))
@@ -1256,7 +1239,7 @@ of the current buffer."
This is especially useful when comparing buffers side-by-side."
(interactive)
(ediff-barf-if-not-control-buffer)
- (or (ediff-window-display-p)
+ (or (display-graphic-p)
(user-error "Emacs is not running as a window application"))
(ediff-recenter 'no-rehighlight) ; make sure buffs are displayed in windows
(let ((ctl-buf ediff-control-buffer))
@@ -1283,7 +1266,7 @@ To change the default, set the variable
`ediff-window-setup-function',
which see."
(interactive)
(let (window-setup-func)
- (or (ediff-window-display-p)
+ (or (display-graphic-p)
(user-error "Emacs is not running as a window application"))
(cond ((eq ediff-window-setup-function #'ediff-setup-windows-multiframe)
@@ -1327,7 +1310,7 @@ To change the default, set the variable
`ediff-use-toolbar-p', which see."
;; FIXME: Make it work in Emacs!
(if (featurep 'ediff-tbar)
(progn
- (or (ediff-window-display-p)
+ (or (display-graphic-p)
(user-error "Emacs is not running as a window application"))
;; do this only after killing the toolbar
(setq ediff-use-toolbar-p (not ediff-use-toolbar-p))
@@ -1341,10 +1324,6 @@ To change the default, set the variable
`ediff-use-toolbar-p', which see."
(if (ediff-in-control-buffer-p)
(ediff-recenter 'no-rehighlight)))))
-
-(define-obsolete-function-alias 'ediff-kill-bottom-toolbar #'ignore "27.1")
-(define-obsolete-function-alias 'ediff-make-bottom-toolbar #'ignore "27.1")
-
;; Merging
(defun ediff-toggle-show-clashes-only ()
@@ -2442,7 +2421,7 @@ reverse the meaning of this variable."
(after-quit-hook-internal (remq t ediff-after-quit-hook-internal))
(session-number ediff-meta-session-number)
;; suitable working frame
- (warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t))
+ (warp-frame (if (and (display-graphic-p) (eq ediff-grab-mouse t))
(cond ((window-live-p ediff-window-A)
(window-frame ediff-window-A))
((window-live-p ediff-window-B)
@@ -2516,7 +2495,7 @@ reverse the meaning of this variable."
(setq warp-frame ; if mouse is over a reasonable frame, use it
(cond ((ediff-good-frame-under-mouse))
(t warp-frame)))
- (if (and (ediff-window-display-p) (frame-live-p warp-frame) ediff-grab-mouse)
+ (if (and (display-graphic-p) (frame-live-p warp-frame) ediff-grab-mouse)
(set-mouse-position warp-frame 2 1))
(mapc #'funcall after-quit-hook-internal)
@@ -2573,7 +2552,7 @@ reverse the meaning of this variable."
(ediff-kill-buffer-carefully ediff-patch-diagnostics))
;; delete control frame or window
- (cond ((and (ediff-window-display-p) (frame-live-p ctl-frame))
+ (cond ((and (display-graphic-p) (frame-live-p ctl-frame))
(delete-frame ctl-frame))
((window-live-p ctl-wind)
(delete-window ctl-wind)))
@@ -2748,7 +2727,7 @@ only if this merge job is part of a group, i.e., was
invoked from within
(buf-fine-diff ediff-fine-diff-buffer))
;; hide the control panel
- (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
+ (if (and (display-graphic-p) (frame-live-p ediff-control-frame))
(iconify-frame ediff-control-frame)
(bury-buffer))
(if buf-err (bury-buffer buf-err))
@@ -3086,10 +3065,6 @@ Hit \\[ediff-recenter] to reset the windows afterward."
)
-;; for compatibility
-(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook
- #'minibuffer-with-setup-hook "28.1")
-
;; This is adapted from a similar function in `emerge.el'.
;; PROMPT should not have a trailing ': ', so that it can be modified
;; according to context.
@@ -3197,13 +3172,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(progn
(if (or (file-exists-p file) (not keep-proposed-name))
(setq file (make-temp-name proposed-name)))
- ;; the with-temp-buffer thing is a workaround for an XEmacs
- ;; bug: write-region complains that we are trying to visit a
- ;; file in an indirect buffer, failing to notice that the
- ;; VISIT flag is unset and that we are actually writing from a
- ;; string and not from any buffer.
- (with-temp-buffer
- (write-region "" nil file nil 'silent nil 'excl))
+ (write-region "" nil file nil 'silent nil 'excl)
nil)
(file-already-exists t))
;; the file was somehow created by someone else between
@@ -3212,16 +3181,6 @@ Hit \\[ediff-recenter] to reset the windows afterward."
file))
-;; Quote metacharacters (using \) when executing diff in Unix.
-;;(defun ediff-protect-metachars (str)
-;; (let ((limit 0))
-;; (while (string-match ediff-metachars str limit)
-;; (setq str (concat (substring str 0 (match-beginning 0))
-;; "\\"
-;; (substring str (match-beginning 0))))
-;; (setq limit (1+ (match-end 0)))))
-;; str)
-
;; Make sure the current buffer (for a file) has the same contents as the
;; file on disk, and attempt to remedy the situation if not.
;; Signal an error if we can't make them the same, or the user doesn't want
@@ -3282,8 +3241,9 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(defun ediff-filename-magic-p (file)
+ (declare (obsolete nil "29.1"))
(or (ediff-file-compressed-p file)
- (ediff-file-remote-p file)))
+ (file-remote-p file)))
(defun ediff-save-buffer (arg)
@@ -3330,7 +3290,8 @@ Without an argument, it saves customized diff argument,
if available
(select-window wind)
(delete-other-windows)
(or (mark) (push-mark))
- (ediff-activate-mark)
+ (setq mark-active 'ediff-util)
+ (setq-local transient-mark-mode t)
(split-window-vertically)
(ediff-select-lowest-window)
(setq other-wind (selected-window))
@@ -3404,11 +3365,11 @@ Without an argument, it saves customized diff argument,
if available
file-A file-B)
(unless (and buf-A-file-name
(file-exists-p buf-A-file-name)
- (not (ediff-file-remote-p buf-A-file-name)))
+ (not (file-remote-p buf-A-file-name)))
(setq file-A (ediff-make-temp-file ediff-buffer-A)))
(unless (and buf-B-file-name
(file-exists-p buf-B-file-name)
- (not (ediff-file-remote-p buf-B-file-name)))
+ (not (file-remote-p buf-B-file-name)))
(setq file-B (ediff-make-temp-file ediff-buffer-B)))
(or (ediff-buffer-live-p ediff-custom-diff-buffer)
(setq ediff-custom-diff-buffer
@@ -3909,11 +3870,9 @@ Ediff Control Panel to restore highlighting."
"Submit bug report on Ediff."
(interactive)
(ediff-barf-if-not-control-buffer)
- (defvar ediff-device-type)
(defvar ediff-buffer-name)
(let ((reporter-prompt-for-summary-p t)
(ctl-buf ediff-control-buffer)
- (ediff-device-type window-system)
varlist salutation ediff-buffer-name)
(setq varlist '(ediff-diff-program ediff-diff-options
ediff-diff3-program ediff-diff3-options
@@ -3932,8 +3891,7 @@ Ediff Control Panel to restore highlighting."
ediff-job-name
ediff-word-mode
ediff-buffer-name
- ediff-device-type
- ))
+ window-system))
(setq salutation "
Congratulations! You may have unearthed a bug in Ediff!
@@ -4011,24 +3969,19 @@ Mail anyway? (y or n) ")
(defun ediff-choose-syntax-table ()
(setq ediff-syntax-table
(ediff-with-current-buffer ediff-buffer-A
- (if (not (memq major-mode
- '(fundamental-mode text-mode indented-text-mode)))
- (syntax-table))))
+ (unless (memq major-mode '(fundamental-mode text-mode))
+ (syntax-table))))
(if (not ediff-syntax-table)
(setq ediff-syntax-table
(ediff-with-current-buffer ediff-buffer-B
(syntax-table))))
)
-
-(define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark
"27.1")
-
(defun ediff-activate-mark ()
+ (declare (obsolete nil "29.1"))
(setq mark-active 'ediff-util)
(setq-local transient-mark-mode t))
-(define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1")
-
;; The next two are modified versions from emerge.el.
;; VARS must be a list of symbols
;; ediff-save-variables returns an association list: ((var . val) ...)
@@ -4094,11 +4047,11 @@ Mail anyway? (y or n) ")
;;; Debug
-(ediff-defvar-local ediff-command-begin-time '(0 0 0))
+(ediff-defvar-local ediff-command-begin-time 0)
;; calculate time used by command
(defun ediff-calc-command-time ()
- (or (equal ediff-command-begin-time '(0 0 0))
+ (or (equal ediff-command-begin-time 0)
(message "Elapsed time: %g second(s)"
(float-time (time-since ediff-command-begin-time)))))
@@ -4112,10 +4065,10 @@ Mail anyway? (y or n) ")
(let ((pre-hook 'pre-command-hook)
(post-hook 'post-command-hook))
- (if (not (equal ediff-command-begin-time '(0 0 0)))
+ (if (not (equal ediff-command-begin-time 0))
(progn (remove-hook pre-hook 'ediff-save-time)
(remove-hook post-hook 'ediff-calc-command-time)
- (setq ediff-command-begin-time '(0 0 0))
+ (setq ediff-command-begin-time 0)
(message "Ediff profiling disabled"))
(add-hook pre-hook 'ediff-save-time t 'local)
(add-hook post-hook 'ediff-calc-command-time nil 'local)
@@ -4180,7 +4133,12 @@ Mail anyway? (y or n) ")
(key-description desc)
(format "M-x %s" func-def))))
+(define-obsolete-function-alias 'ediff-kill-bottom-toolbar #'ignore "27.1")
+(define-obsolete-function-alias 'ediff-make-bottom-toolbar #'ignore "27.1")
+(define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark
"27.1")
+(define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1")
(define-obsolete-function-alias 'ediff-add-to-history #'add-to-history "27.1")
+(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook
#'minibuffer-with-setup-hook "28.1")
(define-obsolete-function-alias 'ediff-copy-list #'copy-sequence "28.1")
(define-obsolete-function-alias 'ediff-union #'seq-union "28.1")
(define-obsolete-function-alias 'ediff-intersection #'seq-intersection "28.1")
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 6db3667545..d45e13ea72 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -1,6 +1,6 @@
;;; ediff-wind.el --- window manipulation utilities -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1997, 2000-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -24,23 +24,11 @@
;;; Code:
-
-;; Compiler pacifier
(defvar icon-title-format)
-(defvar top-toolbar-height)
-(defvar bottom-toolbar-height)
-(defvar left-toolbar-height)
-(defvar right-toolbar-height)
-(defvar left-toolbar-width)
-(defvar right-toolbar-width)
-(defvar default-menubar)
-(defvar top-gutter)
-(defvar frame-icon-title-format)
(defvar ediff-diff-status)
(require 'ediff-init)
(require 'ediff-help)
-;; end pacifier
(defgroup ediff-window nil
"Ediff window manipulation."
@@ -52,7 +40,7 @@
;; Determine which window setup function to use based on current window system.
(defun ediff-choose-window-setup-function-automatically ()
(declare (obsolete ediff-setup-windows-default "24.3"))
- (if (ediff-window-display-p)
+ (if (display-graphic-p)
#'ediff-setup-windows-multiframe
#'ediff-setup-windows-plain))
@@ -179,6 +167,7 @@ Used internally---not a user option.")
(ediff-defvar-local ediff-mouse-pixel-position nil
"Position of the mouse.
Used to decide whether to warp the mouse into control frame.")
+(make-obsolete-variable 'ediff-mouse-pixel-position "it is unused." "29.1")
;; not used for now
(defvar ediff-mouse-pixel-threshold 30
@@ -260,8 +249,8 @@ keyboard input to go into icons."
(let (event)
(message
"Select windows by clicking. Please click on Window %d " wind-number)
- (while (not (ediff-mouse-event-p (setq event
- (read--potential-mouse-event))))
+ (while (not (mouse-event-p (setq event
+ (read--potential-mouse-event))))
(if (sit-for 1) ; if sequence of events, wait till the final word
(beep 1))
(message "Please click on Window %d " wind-number))
@@ -303,7 +292,7 @@ keyboard input to go into icons."
(other-window 1))
;; in case user did a no-no on a tty
- (or (ediff-window-display-p)
+ (or (display-graphic-p)
(setq ediff-window-setup-function #'ediff-setup-windows-plain))
(or (ediff-keep-window-config control-buffer)
@@ -843,9 +832,9 @@ keyboard input to go into icons."
(defun ediff-skip-unsuitable-frames (&optional ok-unsplittable)
"Skip unsplittable frames and frames that have dedicated windows.
Create a new splittable frame if none is found."
- (if (ediff-window-display-p)
+ (if (display-graphic-p)
(let ((wind-frame (window-frame))
- seen-windows)
+ seen-windows)
(while (and (not (memq (selected-window) seen-windows))
(or
(ediff-frame-has-dedicated-windows wind-frame)
@@ -854,8 +843,8 @@ Create a new splittable frame if none is found."
(< (frame-height wind-frame)
(* 3 window-min-height))
(if ok-unsplittable
- nil
- (ediff-frame-unsplittable-p wind-frame))))
+ nil
+ (cdr (assq 'unsplittable (frame-parameters
wind-frame))))))
;; remember history
(setq seen-windows (cons (selected-window) seen-windows))
;; try new window
@@ -901,7 +890,6 @@ Create a new splittable frame if none is found."
fheight fwidth adjusted-parameters)
(with-current-buffer ctl-buffer
- ;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse))
(run-hooks 'ediff-before-setup-control-frame-hook))
(setq old-ctl-frame (with-current-buffer ctl-buffer ediff-control-frame))
@@ -993,7 +981,7 @@ Create a new splittable frame if none is found."
;; synchronize so the cursor will move to control frame
;; per RMS suggestion
- (if (ediff-window-display-p)
+ (if (display-graphic-p)
(let ((count 7))
(sit-for .1)
(while (and (not (frame-visible-p ctl-frame)) (> count 0))
@@ -1012,7 +1000,7 @@ Create a new splittable frame if none is found."
(defun ediff-destroy-control-frame (ctl-buffer)
(ediff-with-current-buffer ctl-buffer
- (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
+ (if (and (display-graphic-p) (frame-live-p ediff-control-frame))
(let ((ctl-frame ediff-control-frame))
(setq ediff-control-frame nil)
(delete-frame ctl-frame))))
@@ -1145,7 +1133,7 @@ It assumes that it is called from within the control
buffer."
;; Force mode-line redisplay
(force-mode-line-update)
- (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
+ (if (and (display-graphic-p) (frame-live-p ediff-control-frame))
(ediff-refresh-control-frame))
(ediff-with-current-buffer ediff-buffer-A
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 840ab8cf51..84ad5cef90 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -107,8 +107,6 @@
;;; Code:
(require 'ediff-util)
-;; end pacifier
-
(require 'ediff-init)
(require 'ediff-mult) ; required because of the registry stuff
@@ -283,7 +281,8 @@ deleted.
Returns the buffer into which the file is visited.
Also sets `ediff--magic-file-name' to indicate where the file's content
has been saved (if not in `buffer-file-name')."
- (let* ((file-magic (ediff-filename-magic-p file))
+ (let* ((file-magic (or (ediff-file-compressed-p file)
+ (file-remote-p file)))
(temp-file-name-prefix (file-name-nondirectory file)))
(cond ((not (file-readable-p file))
(user-error "File `%s' does not exist or is not readable" file))
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index 422ed5c0a4..de09be80e7 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -2942,6 +2942,7 @@ If some prefix of KEY has a non-prefix definition, it is
redefined."
;; Define a key if it (or a prefix) is not already defined in the map.
(defun emerge-define-key-if-possible (keymap key definition)
+ (declare (obsolete keymap-set "29.1"))
;; look up the present definition of the key
(let ((present (lookup-key keymap key)))
(if (integerp present)
@@ -2959,6 +2960,7 @@ If some prefix of KEY has a non-prefix definition, it is
redefined."
If the name won't fit on one line, the minibuffer is expanded to hold it,
and the command waits for a keystroke from the user. If the keystroke is
SPC, it is ignored; if it is anything else, it is processed as a command."
+ (declare (obsolete nil "29.1"))
(interactive)
(let ((name (buffer-file-name)))
(or name
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index 702033dd88..89f8d26880 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -38,6 +38,7 @@
(apply #'append (mapcar (lambda (x) (if (listp x) x (list x))) xs)))
(defun cvs-first (l &optional n)
+ ;; FIXME: Replace this with `seq-take'?
(if (null n) (car l)
(when l
(let* ((nl (list (pop l)))
@@ -53,10 +54,9 @@
The function returns a `cons' cell where the `car' contains
elements of L for which P is true while the `cdr' contains
the other elements. The ordering among elements is maintained."
- (let (car cdr)
- (dolist (x l)
- (if (funcall p x) (push x car) (push x cdr)))
- (cons (nreverse car) (nreverse cdr))))
+ (let ((res (seq-group-by p l)))
+ (cons (cdr (assq t res))
+ (cdr (assq nil res)))))
;;;
;;; frame, window, buffer handling
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index 1f19c4cfe2..a15cf417de 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -162,22 +162,20 @@ List of factors, used to expand/compress the time scale.
See `vc-annotate'."
:type '(repeat number)
:group 'vc)
-(defvar vc-annotate-mode-map
- (let ((m (make-sparse-keymap)))
- (define-key m "a" #'vc-annotate-revision-previous-to-line)
- (define-key m "d" #'vc-annotate-show-diff-revision-at-line)
- (define-key m "=" #'vc-annotate-show-diff-revision-at-line)
- (define-key m "D" #'vc-annotate-show-changeset-diff-revision-at-line)
- (define-key m "f" #'vc-annotate-find-revision-at-line)
- (define-key m "j" #'vc-annotate-revision-at-line)
- (define-key m "l" #'vc-annotate-show-log-revision-at-line)
- (define-key m "n" #'vc-annotate-next-revision)
- (define-key m "p" #'vc-annotate-prev-revision)
- (define-key m "w" #'vc-annotate-working-revision)
- (define-key m "v" #'vc-annotate-toggle-annotation-visibility)
- (define-key m "\C-m" #'vc-annotate-goto-line)
- m)
- "Local keymap used for VC-Annotate mode.")
+(defvar-keymap vc-annotate-mode-map
+ :doc "Local keymap used for VC-Annotate mode."
+ "a" #'vc-annotate-revision-previous-to-line
+ "d" #'vc-annotate-show-diff-revision-at-line
+ "=" #'vc-annotate-show-diff-revision-at-line
+ "D" #'vc-annotate-show-changeset-diff-revision-at-line
+ "f" #'vc-annotate-find-revision-at-line
+ "j" #'vc-annotate-revision-at-line
+ "l" #'vc-annotate-show-log-revision-at-line
+ "n" #'vc-annotate-next-revision
+ "p" #'vc-annotate-prev-revision
+ "w" #'vc-annotate-working-revision
+ "v" #'vc-annotate-toggle-annotation-visibility
+ "RET" #'vc-annotate-goto-line)
;;; Annotate functionality
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 072bd72b44..f6b17d4ce0 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1008,19 +1008,17 @@ stream. Standard error output is discarded."
;; frob the results accordingly.
(file-relative-name dir (vc-bzr-root dir)))))
-(defvar vc-bzr-shelve-map
- (let ((map (make-sparse-keymap)))
- ;; Turn off vc-dir marking
- (define-key map [mouse-2] #'ignore)
-
- (define-key map [down-mouse-3] #'vc-bzr-shelve-menu)
- (define-key map "\C-k" #'vc-bzr-shelve-delete-at-point)
- (define-key map "=" #'vc-bzr-shelve-show-at-point)
- (define-key map "\C-m" #'vc-bzr-shelve-show-at-point)
- (define-key map "A" #'vc-bzr-shelve-apply-and-keep-at-point)
- (define-key map "P" #'vc-bzr-shelve-apply-at-point)
- (define-key map "S" #'vc-bzr-shelve-snapshot)
- map))
+(defvar-keymap vc-bzr-shelve-map
+ ;; Turn off vc-dir marking
+ "<mouse-2>" #'ignore
+
+ "<down-mouse-3>" #'vc-bzr-shelve-menu
+ "C-k" #'vc-bzr-shelve-delete-at-point
+ "=" #'vc-bzr-shelve-show-at-point
+ "RET" #'vc-bzr-shelve-show-at-point
+ "A" #'vc-bzr-shelve-apply-and-keep-at-point
+ "P" #'vc-bzr-shelve-apply-at-point
+ "S" #'vc-bzr-shelve-snapshot)
(defvar vc-bzr-shelve-menu-map
(let ((map (make-sparse-keymap "Bzr Shelve")))
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 1f81ff2e0f..52cc42791f 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -250,7 +250,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
(let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
(lastmod (file-attribute-modification-time (file-attributes file))))
(cond
- ((equal checkout-time lastmod) 'up-to-date)
+ ((time-equal-p checkout-time lastmod) 'up-to-date)
((string= (vc-working-revision file) "0") 'added)
((null checkout-time) 'unregistered)
(t 'edited))))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 9335da1006..068a66b25b 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1467,17 +1467,13 @@ These are the commands available for use in the file
status buffer:
(propertize "Please add backend specific headers here. It's easy!"
'face 'vc-dir-status-warning)))
-(defvar vc-dir-status-mouse-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] #'vc-dir-toggle-mark)
- map)
- "Local keymap for toggling mark.")
+(defvar-keymap vc-dir-status-mouse-map
+ :doc "Local keymap for toggling mark."
+ "<mouse-2>" #'vc-dir-toggle-mark)
-(defvar vc-dir-filename-mouse-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] #'vc-dir-find-file-other-window)
- map)
- "Local keymap for visiting a file.")
+(defvar-keymap vc-dir-filename-mouse-map
+ :doc "Local keymap for visiting a file."
+ "<mouse-2>" #'vc-dir-find-file-other-window)
(defun vc-default-dir-printer (_backend fileentry)
"Pretty print FILEENTRY."
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 9ec78ee8ab..a5fd6b1413 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -664,32 +664,26 @@ or an empty string if none."
:files files
:update-function update-function)))
-(defvar vc-git-stash-shared-map
- (let ((map (make-sparse-keymap)))
- (define-key map "S" #'vc-git-stash-snapshot)
- (define-key map "C" #'vc-git-stash)
- map))
-
-(defvar vc-git-stash-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map vc-git-stash-shared-map)
- ;; Turn off vc-dir marking
- (define-key map [mouse-2] #'ignore)
-
- (define-key map [down-mouse-3] #'vc-git-stash-menu)
- (define-key map "\C-k" #'vc-git-stash-delete-at-point)
- (define-key map "=" #'vc-git-stash-show-at-point)
- (define-key map "\C-m" #'vc-git-stash-show-at-point)
- (define-key map "A" #'vc-git-stash-apply-at-point)
- (define-key map "P" #'vc-git-stash-pop-at-point)
- map))
-
-(defvar vc-git-stash-button-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map vc-git-stash-shared-map)
- (define-key map [mouse-2] #'push-button)
- (define-key map "\C-m" #'push-button)
- map))
+(defvar-keymap vc-git-stash-shared-map
+ "S" #'vc-git-stash-snapshot
+ "C" #'vc-git-stash)
+
+(defvar-keymap vc-git-stash-map
+ :parent vc-git-stash-shared-map
+ ;; Turn off vc-dir marking
+ "<mouse-2>" #'ignore
+
+ "<down-mouse-3>" #'vc-git-stash-menu
+ "C-k" #'vc-git-stash-delete-at-point
+ "=" #'vc-git-stash-show-at-point
+ "RET" #'vc-git-stash-show-at-point
+ "A" #'vc-git-stash-apply-at-point
+ "P" #'vc-git-stash-pop-at-point)
+
+(defvar-keymap vc-git-stash-button-map
+ :parent vc-git-stash-shared-map
+ "<mouse-2>" #'push-button
+ "RET" #'push-button)
(defconst vc-git-stash-shared-help
"\\<vc-git-stash-shared-map>\\[vc-git-stash]: Create named
stash\n\\[vc-git-stash-snapshot]: Snapshot stash")
@@ -910,12 +904,11 @@ If toggling on, also insert its message into the buffer."
standard-output 1 nil
"log" "--max-count=1" "--pretty=format:%B" "HEAD")))))
-(defvar vc-git-log-edit-mode-map
- (let ((map (make-sparse-keymap "Git-Log-Edit")))
- (define-key map "\C-c\C-s" #'vc-git-log-edit-toggle-signoff)
- (define-key map "\C-c\C-n" #'vc-git-log-edit-toggle-no-verify)
- (define-key map "\C-c\C-e" #'vc-git-log-edit-toggle-amend)
- map))
+(defvar-keymap vc-git-log-edit-mode-map
+ :name "Git-Log-Edit"
+ "C-c C-s" #'vc-git-log-edit-toggle-signoff
+ "C-c C-n" #'vc-git-log-edit-toggle-no-verify
+ "C-c C-e" #'vc-git-log-edit-toggle-amend)
(define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
"Major mode for editing Git log messages.
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 026f125396..61976288e3 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -966,7 +966,7 @@ REPO must be the directory name of an hg repository."
(attr (file-attributes (nth 0 fs)))
(current-mtime (file-attribute-modification-time attr))
(current-size (file-attribute-size attr)))
- (unless (and (equal saved-mtime current-mtime)
+ (unless (and (time-equal-p saved-mtime current-mtime)
(equal saved-size current-size))
(setf valid nil))))
valid))
@@ -1037,7 +1037,7 @@ Avoids the need to repeatedly scan dirstate on repeated
calls to
)
(if (and cache
(equal dirstate (pop cache))
- (equal mtime (pop cache))
+ (time-equal-p mtime (pop cache))
(equal size (pop cache))
(equal ascii-fname (pop cache)))
(pop cache)
@@ -1177,10 +1177,9 @@ If toggling on, also insert its message into the buffer."
standard-output 1 nil
"log" "--limit=1" "--template" "{desc}")))))
-(defvar vc-hg-log-edit-mode-map
- (let ((map (make-sparse-keymap "Hg-Log-Edit")))
- (define-key map "\C-c\C-e" #'vc-hg-log-edit-toggle-amend)
- map))
+(defvar-keymap vc-hg-log-edit-mode-map
+ :name "Hg-Log-Edit"
+ "C-c C-e" #'vc-hg-log-edit-toggle-amend)
(define-derived-mode vc-hg-log-edit-mode log-edit-mode "Log-Edit/hg"
"Major mode for editing Hg log messages.
@@ -1262,9 +1261,7 @@ REV is the revision to check out into WORKFILE."
;;; Hg specific functionality.
-(defvar vc-hg-extra-menu-map
- (let ((map (make-sparse-keymap)))
- map))
+(defvar-keymap vc-hg-extra-menu-map)
(defun vc-hg-extra-menu () vc-hg-extra-menu-map)
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 80508570f3..1f0eeb7e18 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -631,9 +631,10 @@ Before doing that, check if there are any old backups and
get rid of them."
(cond
((null backend))
((eq (vc-checkout-model backend (list file)) 'implicit)
- ;; If the file was saved in the same second in which it was
+ ;; If the file was saved at the same time that it was
;; checked out, clear the checkout-time to avoid confusion.
- (if (equal (vc-file-getprop file 'vc-checkout-time)
+ (if (time-equal-p
+ (vc-file-getprop file 'vc-checkout-time)
(file-attribute-modification-time (file-attributes file)))
(vc-file-setprop file 'vc-checkout-time nil))
(if (vc-state-refresh file backend)
@@ -854,38 +855,37 @@ In the latter case, VC mode is deactivated for this
buffer."
;; Autoloading works fine, but it prevents shortcuts from appearing
;; in the menu because they don't exist yet when the menu is built.
;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
-(defvar vc-prefix-map
- (let ((map (make-sparse-keymap)))
- (define-key map "a" #'vc-update-change-log)
- (with-suppressed-warnings ((obsolete vc-switch-backend))
- (define-key map "b" #'vc-switch-backend))
- (define-key map "d" #'vc-dir)
- (define-key map "g" #'vc-annotate)
- (define-key map "G" #'vc-ignore)
- (define-key map "h" #'vc-region-history)
- (define-key map "i" #'vc-register)
- (define-key map "l" #'vc-print-log)
- (define-key map "L" #'vc-print-root-log)
- (define-key map "I" #'vc-log-incoming)
- (define-key map "O" #'vc-log-outgoing)
- (define-key map "ML" #'vc-log-mergebase)
- (define-key map "MD" #'vc-diff-mergebase)
- (define-key map "m" #'vc-merge)
- (define-key map "r" #'vc-retrieve-tag)
- (define-key map "s" #'vc-create-tag)
- (define-key map "u" #'vc-revert)
- (define-key map "v" #'vc-next-action)
- (define-key map "+" #'vc-update)
- ;; I'd prefer some kind of symmetry with vc-update:
- (define-key map "P" #'vc-push)
- (define-key map "=" #'vc-diff)
- (define-key map "D" #'vc-root-diff)
- (define-key map "~" #'vc-revision-other-window)
- (define-key map "x" #'vc-delete-file)
- map))
+(defvar-keymap vc-prefix-map
+ "a" #'vc-update-change-log
+ "d" #'vc-dir
+ "g" #'vc-annotate
+ "G" #'vc-ignore
+ "h" #'vc-region-history
+ "i" #'vc-register
+ "l" #'vc-print-log
+ "L" #'vc-print-root-log
+ "I" #'vc-log-incoming
+ "O" #'vc-log-outgoing
+ "M L" #'vc-log-mergebase
+ "M D" #'vc-diff-mergebase
+ "m" #'vc-merge
+ "r" #'vc-retrieve-tag
+ "s" #'vc-create-tag
+ "u" #'vc-revert
+ "v" #'vc-next-action
+ "+" #'vc-update
+ ;; I'd prefer some kind of symmetry with vc-update:
+ "P" #'vc-push
+ "=" #'vc-diff
+ "D" #'vc-root-diff
+ "~" #'vc-revision-other-window
+ "x" #'vc-delete-file)
(fset 'vc-prefix-map vc-prefix-map)
(define-key ctl-x-map "v" 'vc-prefix-map)
+(with-suppressed-warnings ((obsolete vc-switch-backend))
+ (keymap-set vc-prefix-map "b" #'vc-switch-backend))
+
(defvar vc-menu-map
(let ((map (make-sparse-keymap "Version Control")))
;;(define-key map [show-files]
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 290054d523..fe0cb42e31 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -419,7 +419,7 @@
;; AND you'd like the current time considered to be anything besides
;; (vc-annotate-convert-time (current-time)) -- i.e. the current
;; time with hours, minutes, and seconds included. Probably safe to
-;; ignore. Return the current-time, in units of fractional days.
+;; ignore. Return the current time, in units of fractional days.
;;
;; - annotate-extract-revision-at-line ()
;;
diff --git a/lisp/wdired.el b/lisp/wdired.el
index a5858ed190..106d57174d 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -902,7 +902,6 @@ Like original function but it skips read-only words."
"x" #'wdired-set-bit
"-" #'wdired-set-bit
"S" #'wdired-set-bit
- "s" #'wdired-set-bit
"T" #'wdired-set-bit
"t" #'wdired-set-bit
"s" #'wdired-set-bit
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 5362618247..ec2eb146e9 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -3043,12 +3043,10 @@ The following properties have special meanings for this
widget:
:on "Hide"
:off-glyph "right"
:off "Show"
- :value-create 'widget-visibility-value-create
+ :value-create 'widget-toggle-value-create
:action 'widget-toggle-action
:match (lambda (_widget _value) t))
-(defalias 'widget-visibility-value-create 'widget-toggle-value-create)
-
;;; The `documentation-link' Widget.
;;
;; This is a helper widget for `documentation-string'.
@@ -4143,9 +4141,9 @@ is inline."
(setq help-echo (funcall help-echo widget)))
(if help-echo (message "%s" (eval help-echo)))))
-;;; Obsolete.
-
(define-obsolete-function-alias 'widget-sublist #'seq-subseq "28.1")
+(define-obsolete-function-alias 'widget-visibility-value-create
+ #'widget-toggle-value-create "29.1")
(provide 'wid-edit)
diff --git a/lisp/woman.el b/lisp/woman.el
index d8743c7fac..7f494a3b68 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -781,7 +781,7 @@ Built automatically from the customizable user options
(defvar woman-uncompressed-file-regexp) ; for the compiler
(defvar woman-file-compression-regexp) ; for the compiler
-(defun set-woman-file-regexp (symbol value)
+(defun woman-set-file-regexp (symbol value)
"Bind SYMBOL to VALUE and set `woman-file-regexp' as per user customizations.
Used as :set cookie by Customize when customizing the user options
`woman-uncompressed-file-regexp' and `woman-file-compression-regexp'."
@@ -806,7 +806,7 @@ in the ncurses package include `toe.1m', `form.3x', etc.
Note: an optional compression regexp will be appended, so this regexp
MUST NOT end with any kind of string terminator such as $ or \\\\='."
:type 'regexp
- :set #'set-woman-file-regexp
+ :set #'woman-set-file-regexp
:group 'woman-interface)
(defcustom woman-file-compression-regexp
@@ -822,7 +822,7 @@ Should begin with \\. and end with \\\\=' and MUST NOT be
optional."
;; not loaded by default!
:version "24.1" ; added xz
:type 'regexp
- :set #'set-woman-file-regexp
+ :set #'woman-set-file-regexp
:group 'woman-interface)
(defcustom woman-use-own-frame nil
@@ -902,7 +902,7 @@ Troff emulation is experimental and largely untested.
(defcustom woman-fontify
(or (display-color-p)
(display-graphic-p)
- (x-display-color-p))
+ (display-color-p))
"If non-nil then WoMan assumes that face support is available.
It defaults to a non-nil value if the display supports either colors
or different fonts."
@@ -4580,11 +4580,11 @@ logging the message."
(put 'woman-bookmark-jump 'bookmark-handler-type "WoMan")
-;; Obsolete.
-
(defvar woman-version "0.551 (beta)" "WoMan version information.")
(make-obsolete-variable 'woman-version 'emacs-version "28.1")
+(define-obsolete-function-alias 'set-woman-file-regexp 'woman-set-file-regexp
"29.1")
+
(provide 'woman)
;;; woman.el ends here
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index bdfe444bc1..2bda67fe3f 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1480,7 +1480,7 @@ instead of returning \"E\".")
(error '(STRING . "E")))))))
(defun x-dnd-handle-octet-stream (_selection _type _value)
- "Handle a selecton request for `application/octet-stream'.
+ "Handle a selection request for `application/octet-stream'.
Return the contents of the XDS file."
(cons 'application/octet-stream
(ignore-errors
diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in
index ee883f3cff..82bf13bc92 100644
--- a/nextstep/Makefile.in
+++ b/nextstep/Makefile.in
@@ -26,6 +26,7 @@ srcdir = @srcdir@
abs_builddir = @abs_builddir@
abs_top_builddir = @abs_top_builddir@
EXEEXT = @EXEEXT@
+DUMPING = @DUMPING@
# abs_top_srcdir may contain ".."
top_srcdir_abs = $(shell cd @top_srcdir@; pwd -P)
@@ -46,7 +47,7 @@ ns_check_file = @ns_appdir@/@ns_check_file@
.PHONY: all
ifeq ($(DUMPING),pdumper)
-ns_pdump_target = ${ns_applibexecdir}/Emacs.pdmp
+ns_pdmp_target = ${ns_applibexecdir}/Emacs.pdmp
endif
all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_pdmp_target}
diff --git a/src/Makefile.in b/src/Makefile.in
index 7d15b7afd5..92a8790efd 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -635,30 +635,23 @@ Emacs.pdmp: $(pdmp)
endif
ifeq ($(DUMPING),pdumper)
-$(pdmp): emacs$(EXEEXT)
+$(pdmp): emacs$(EXEEXT) $(lispsource)/loaddefs.el $(lispsource)/loaddefs.elc
LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump
\
--bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR)
cp -f $@ $(bootstrap_pdmp)
endif
-## We run make-docfile twice because the command line may get too long
-## on some systems. Unfortunately, no-one has any idea
-## exactly how long the maximum safe command line length is on all the
-## various systems that Emacs supports.
-##
## $(SOME_MACHINE_OBJECTS) comes before $(obj) because some files may
## or may not be included in $(obj), but they are always included in
## $(SOME_MACHINE_OBJECTS). Since a file is processed when it is mentioned
## for the first time, this prevents any variation between configurations
## in the contents of the DOC file.
##
-$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(doc_obj)
$(lispsource)/loaddefs.el
+$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(doc_obj)
$(AM_V_GEN)$(MKDIR_P) $(etc)
$(AM_V_at)rm -f $(etc)/DOC
$(AM_V_at)$(libsrc)/make-docfile -d $(srcdir) \
$(SOME_MACHINE_OBJECTS) $(doc_obj) > $(etc)/DOC
- $(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \
- loaddefs.el
$(libsrc)/make-docfile$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT): \
$(lib)/libgnu.a
@@ -888,13 +881,7 @@ elnlisp := $(addprefix ${lispsource}/,${elnlisp})
$(lisp:.elc=.eln)
fi
endif
-## VCSWITNESS points to the file that holds info about the current checkout.
-## We use it as a heuristic to decide when to rebuild loaddefs.el.
-## If empty it is ignored; the parent makefile can set it to some other value.
-VCSWITNESS =
-
-$(lispsource)/loaddefs.el: $(VCSWITNESS) | \
- bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp)
+$(lispsource)/loaddefs.el: | bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp)
$(MAKE) -C ../lisp autoloads EMACS="$(bootstrap_exe)"
## Dump an Emacs executable named bootstrap-emacs containing the
diff --git a/src/buffer.c b/src/buffer.c
index a07194aef7..e5601af505 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -6431,12 +6431,15 @@ will run for `clone-indirect-buffer' calls as well.
*/);
DEFVAR_LISP ("long-line-threshold", Vlong_line_threshold,
doc: /* Line length above which to use redisplay shortcuts.
+
The value should be a positive integer or nil.
If the value is an integer, shortcuts in the display code intended
to speed up redisplay for long lines will automatically be enabled
in buffers which contain one or more lines whose length is above
this threshold.
-If nil, these display shortcuts will always remain disabled. */);
+If nil, these display shortcuts will always remain disabled.
+
+There is no reason to change that value except for debugging purposes. */);
XSETFASTINT (Vlong_line_threshold, 10000);
defsubr (&Sbuffer_live_p);
diff --git a/src/bytecode.c b/src/bytecode.c
index 2b1eccdc51..d75767bb0c 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1480,8 +1480,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
CASE (Bnarrow_to_region):
{
- Lisp_Object v2 = POP, v1 = POP;
- TOP = Fnarrow_to_region (TOP, v1, v2);
+ Lisp_Object v1 = POP;
+ TOP = Fnarrow_to_region (TOP, v1);
NEXT;
}
diff --git a/src/callint.c b/src/callint.c
index ffa3b231eb..c974967459 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -161,73 +161,33 @@ check_mark (bool for_region)
xsignal0 (Qmark_inactive);
}
-/* If the list of args INPUT was produced with an explicit call to
- `list', look for elements that were computed with
- (region-beginning) or (region-end), and put those expressions into
- VALUES instead of the present values.
+/* If FUNCTION has an `interactive-args' spec, replace relevant
+ elements in VALUES with those forms instead.
This function doesn't return a value because it modifies elements
of VALUES to do its job. */
static void
-fix_command (Lisp_Object input, Lisp_Object function, Lisp_Object values)
+fix_command (Lisp_Object function, Lisp_Object values)
{
- /* FIXME: Instead of this ugly hack, we should provide a way for an
- interactive spec to return an expression/function that will re-build the
- args without user intervention. */
- if (CONSP (input))
+ /* Quick exit if there's no values to alter. */
+ if (!CONSP (values))
+ return;
+
+ Lisp_Object reps = Fget (function, Qinteractive_args);
+
+ if (CONSP (reps))
{
- Lisp_Object car;
+ int i = 0;
+ Lisp_Object vals = values;
- car = XCAR (input);
- /* Skip through certain special forms. */
- while (EQ (car, Qlet) || EQ (car, Qletx)
- || EQ (car, Qsave_excursion)
- || EQ (car, Qprogn))
+ while (!NILP (vals))
{
- while (CONSP (XCDR (input)))
- input = XCDR (input);
- input = XCAR (input);
- if (!CONSP (input))
- break;
- car = XCAR (input);
- }
- if (EQ (car, Qlist))
- {
- Lisp_Object intail, valtail;
- for (intail = Fcdr (input), valtail = values;
- CONSP (valtail);
- intail = Fcdr (intail), valtail = XCDR (valtail))
- {
- Lisp_Object elt;
- elt = Fcar (intail);
- if (CONSP (elt))
- {
- Lisp_Object presflag, carelt;
- carelt = XCAR (elt);
- /* If it is (if X Y), look at Y. */
- if (EQ (carelt, Qif)
- && NILP (Fnthcdr (make_fixnum (3), elt)))
- elt = Fnth (make_fixnum (2), elt);
- /* If it is (when ... Y), look at Y. */
- else if (EQ (carelt, Qwhen))
- {
- while (CONSP (XCDR (elt)))
- elt = XCDR (elt);
- elt = Fcar (elt);
- }
-
- /* If the function call we're looking at
- is a special preserved one, copy the
- whole expression for this argument. */
- if (CONSP (elt))
- {
- presflag = Fmemq (Fcar (elt), preserved_fns);
- if (!NILP (presflag))
- Fsetcar (valtail, Fcar (intail));
- }
- }
- }
+ Lisp_Object rep = Fassq (make_fixnum (i), reps);
+ if (!NILP (rep))
+ Fsetcar (vals, XCDR (rep));
+ vals = XCDR (vals);
+ ++i;
}
}
@@ -235,31 +195,28 @@ fix_command (Lisp_Object input, Lisp_Object function,
Lisp_Object values)
optional, remove them from the list. This makes navigating the
history less confusing, since it doesn't contain a lot of
parameters that aren't used. */
- if (CONSP (values))
+ Lisp_Object arity = Ffunc_arity (function);
+ /* We don't want to do this simplification if we have an &rest
+ function, because (cl-defun foo (a &optional (b 'zot)) ..)
+ etc. */
+ if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity)))
{
- Lisp_Object arity = Ffunc_arity (function);
- /* We don't want to do this simplification if we have an &rest
- function, because (cl-defun foo (a &optional (b 'zot)) ..)
- etc. */
- if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity)))
+ Lisp_Object final = Qnil;
+ ptrdiff_t final_i = 0, i = 0;
+ for (Lisp_Object tail = values;
+ CONSP (tail);
+ tail = XCDR (tail), ++i)
{
- Lisp_Object final = Qnil;
- ptrdiff_t final_i = 0, i = 0;
- for (Lisp_Object tail = values;
- CONSP (tail);
- tail = XCDR (tail), ++i)
+ if (!NILP (XCAR (tail)))
{
- if (!NILP (XCAR (tail)))
- {
- final = tail;
- final_i = i;
- }
+ final = tail;
+ final_i = i;
}
-
- /* Chop the trailing optional values. */
- if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1)
- XSETCDR (final, Qnil);
}
+
+ /* Chop the trailing optional values. */
+ if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1)
+ XSETCDR (final, Qnil);
}
}
@@ -360,7 +317,6 @@ invoke it (via an `interactive' spec that contains, for
instance, an
{
Lisp_Object funval = Findirect_function (function, Qt);
uintmax_t events = num_input_events;
- Lisp_Object input = specs;
/* Compute the arg values using the user's expression. */
specs = Feval (specs,
CONSP (funval) && EQ (Qclosure, XCAR (funval))
@@ -371,7 +327,7 @@ invoke it (via an `interactive' spec that contains, for
instance, an
Make a copy of the list of values, for the command history,
and turn them into things we can eval. */
Lisp_Object values = quotify_args (Fcopy_sequence (specs));
- fix_command (input, function, values);
+ fix_command (function, values);
call4 (intern ("add-to-history"), intern ("command-history"),
Fcons (function, values), Qnil, Qt);
}
@@ -950,4 +906,6 @@ use `event-start', `event-end', and `event-click-count'.
*/);
defsubr (&Scall_interactively);
defsubr (&Sfuncall_interactively);
defsubr (&Sprefix_numeric_value);
+
+ DEFSYM (Qinteractive_args, "interactive-args");
}
diff --git a/src/callproc.c b/src/callproc.c
index dd162f36a6..e8e4c48b5b 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -650,7 +650,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
child_errno
= emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
- SSDATA (current_dir), NULL, &oldset);
+ SSDATA (current_dir), NULL, false, false, &oldset);
eassert ((child_errno == 0) == (0 < pid));
if (pid > 0)
@@ -1412,14 +1412,15 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t
*attributes,
int
emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
char **argv, char **envp, const char *cwd,
- const char *pty, const sigset_t *oldset)
+ const char *pty_name, bool pty_in, bool pty_out,
+ const sigset_t *oldset)
{
#if USABLE_POSIX_SPAWN
/* Prefer the simpler `posix_spawn' if available. `posix_spawn'
doesn't yet support setting up pseudoterminals, so we fall back
to `vfork' if we're supposed to use a pseudoterminal. */
- bool use_posix_spawn = pty == NULL;
+ bool use_posix_spawn = pty_name == NULL;
posix_spawn_file_actions_t actions;
posix_spawnattr_t attributes;
@@ -1473,7 +1474,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
/* vfork, and prevent local vars from being clobbered by the vfork. */
pid_t *volatile newpid_volatile = newpid;
const char *volatile cwd_volatile = cwd;
- const char *volatile pty_volatile = pty;
+ const char *volatile ptyname_volatile = pty_name;
+ bool volatile ptyin_volatile = pty_in;
+ bool volatile ptyout_volatile = pty_out;
char **volatile argv_volatile = argv;
int volatile stdin_volatile = std_in;
int volatile stdout_volatile = std_out;
@@ -1485,7 +1488,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
/* Darwin doesn't let us run setsid after a vfork, so use fork when
necessary. Below, we reset SIGCHLD handling after a vfork, as
apparently macOS can mistakenly deliver SIGCHLD to the child. */
- if (pty != NULL)
+ if (pty_in || pty_out)
pid = fork ();
else
pid = VFORK ();
@@ -1495,7 +1498,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
newpid = newpid_volatile;
cwd = cwd_volatile;
- pty = pty_volatile;
+ pty_name = ptyname_volatile;
+ pty_in = ptyin_volatile;
+ pty_out = ptyout_volatile;
argv = argv_volatile;
std_in = stdin_volatile;
std_out = stdout_volatile;
@@ -1506,13 +1511,12 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out,
int std_err,
if (pid == 0)
#endif /* not WINDOWSNT */
{
- bool pty_flag = pty != NULL;
/* Make the pty be the controlling terminal of the process. */
#ifdef HAVE_PTYS
dissociate_controlling_tty ();
/* Make the pty's terminal the controlling terminal. */
- if (pty_flag && std_in >= 0)
+ if (pty_in && std_in >= 0)
{
#ifdef TIOCSCTTY
/* We ignore the return value
@@ -1521,7 +1525,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
#endif
}
#if defined (LDISC1)
- if (pty_flag && std_in >= 0)
+ if (pty_in && std_in >= 0)
{
struct termios t;
tcgetattr (std_in, &t);
@@ -1531,7 +1535,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
}
#else
#if defined (NTTYDISC) && defined (TIOCSETD)
- if (pty_flag && std_in >= 0)
+ if (pty_in && std_in >= 0)
{
/* Use new line discipline. */
int ldisc = NTTYDISC;
@@ -1548,18 +1552,21 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out,
int std_err,
both TIOCSCTTY is defined. */
/* Now close the pty (if we had it open) and reopen it.
This makes the pty the controlling terminal of the subprocess. */
- if (pty_flag)
+ if (pty_name)
{
/* I wonder if emacs_close (emacs_open (pty, ...))
would work? */
- if (std_in >= 0)
+ if (pty_in && std_in >= 0)
emacs_close (std_in);
- std_out = std_in = emacs_open_noquit (pty, O_RDWR, 0);
-
+ int ptyfd = emacs_open_noquit (pty_name, O_RDWR, 0);
+ if (pty_in)
+ std_in = ptyfd;
+ if (pty_out)
+ std_out = ptyfd;
if (std_in < 0)
{
- emacs_perror (pty);
+ emacs_perror (pty_name);
_exit (EXIT_CANCELED);
}
@@ -1599,7 +1606,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
/* Stop blocking SIGCHLD in the child. */
unblock_child_signal (oldset);
- if (pty_flag)
+ if (pty_out)
child_setup_tty (std_out);
#endif
diff --git a/src/composite.c b/src/composite.c
index 0f90b92a78..22422cca09 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -24,6 +24,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <config.h>
+#include <stdlib.h> /* for qsort */
+
#include "lisp.h"
#include "character.h"
#include "composite.h"
@@ -1021,7 +1023,11 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
/* But we don't know where to stop the searching. */
endpos = NILP (string) ? BEGV - 1 : -1;
/* Usually we don't reach ENDPOS because we stop searching
- at an uncomposable character (NL, LRE, etc). */
+ at an uncomposable character (NL, LRE, etc). In buffers
+ with long lines, however, NL might be far away, so
+ pretend that the buffer is smaller. */
+ if (current_buffer->long_line_optimizations_p)
+ endpos = get_closer_narrowed_begv (cmp_it->parent_it->w, charpos);
}
}
cmp_it->id = -1;
@@ -1580,7 +1586,6 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t
limit, ptrdiff_t backlim,
Lisp_Object window;
struct window *w;
bool need_adjustment = 0;
- ptrdiff_t narrowed_begv;
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
if (NILP (window))
@@ -1597,11 +1602,14 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t
limit, ptrdiff_t backlim,
}
else
head = backlim;
- /* In buffers with very long lines, this function becomes very
- slow. Pretend that the buffer is narrowed to make it fast. */
- narrowed_begv = get_narrowed_begv (w, window_point (w));
- if (narrowed_begv && pos > narrowed_begv)
- head = narrowed_begv;
+ if (current_buffer->long_line_optimizations_p)
+ {
+ /* In buffers with very long lines, this function becomes very
+ slow. Pretend that the buffer is narrowed to make it fast. */
+ ptrdiff_t begv = get_closer_narrowed_begv (w, window_point (w));
+ if (pos > begv)
+ head = begv;
+ }
tail = ZV;
stop = GPT;
cur.pos_byte = CHAR_TO_BYTE (cur.pos);
@@ -2048,6 +2056,54 @@ See `find-composition' for more details. */)
return Fcons (make_fixnum (start), Fcons (make_fixnum (end), tail));
}
+static int
+compare_composition_rules (const void *r1, const void *r2)
+{
+ Lisp_Object vec1 = *(Lisp_Object *)r1, vec2 = *(Lisp_Object *)r2;
+
+ return XFIXNAT (AREF (vec2, 1)) - XFIXNAT (AREF (vec1, 1));
+}
+
+DEFUN ("composition-sort-rules", Fcomposition_sort_rules,
+ Scomposition_sort_rules, 1, 1, 0,
+ doc: /* Sort composition RULES by their LOOKBACK parameter.
+
+If RULES include just one rule, return RULES.
+Otherwise, return a new list of rules where all the rules are
+arranged in decreasing order of the LOOKBACK parameter of the
+rules (the second element of the rule's vector). This is required
+when combining composition rules from different sources, because
+of the way buffer text is examined for matching one of the rules. */)
+ (Lisp_Object rules)
+{
+ ptrdiff_t nrules;
+ USE_SAFE_ALLOCA;
+
+ CHECK_LIST (rules);
+ nrules = list_length (rules);
+ if (nrules > 1)
+ {
+ ptrdiff_t i;
+ Lisp_Object *sortvec;
+
+ SAFE_NALLOCA (sortvec, 1, nrules);
+ for (i = 0; i < nrules; i++)
+ {
+ Lisp_Object elt = XCAR (rules);
+ if (VECTORP (elt) && ASIZE (elt) == 3 && FIXNATP (AREF (elt, 1)))
+ sortvec[i] = elt;
+ else
+ error ("Invalid composition rule in RULES argument");
+ rules = XCDR (rules);
+ }
+ qsort (sortvec, nrules, sizeof (Lisp_Object), compare_composition_rules);
+ rules = Flist (nrules, sortvec);
+ SAFE_FREE ();
+ }
+
+ return rules;
+}
+
void
syms_of_composite (void)
@@ -2179,4 +2235,5 @@ This list is auto-generated, you should not need to
modify it. */);
defsubr (&Sfind_composition_internal);
defsubr (&Scomposition_get_gstring);
defsubr (&Sclear_composition_cache);
+ defsubr (&Scomposition_sort_rules);
}
diff --git a/src/dispextern.h b/src/dispextern.h
index 037e02ff58..12ba927261 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -2287,6 +2287,8 @@ struct composition_it
reverse order, and thus the grapheme clusters must be rendered
from the last to the first. */
bool reversed_p;
+ /* Parent iterator. */
+ struct it *parent_it;
/** The following members contain information about the current
grapheme cluster. */
diff --git a/src/editfns.c b/src/editfns.c
index 79af27d24d..07f5c0bbef 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2660,9 +2660,11 @@ DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
doc: /* Remove restrictions (narrowing) from current buffer.
This allows the buffer's full text to be seen and edited.
-When called from Lisp inside a body form in which `narrow-to-region'
-was called with an optional argument LOCK non-nil, this function does
-not produce any effect. */)
+Note that, when the current buffer contains one or more lines whose
+length is above `long-line-threshold', Emacs may decide to leave, for
+performance reasons, the accessible portion of the buffer unchanged
+after this function is called from low-level hooks, such as
+`jit-lock-functions' or `post-command-hook'. */)
(void)
{
if (! NILP (Vrestrictions_locked))
@@ -2689,22 +2691,11 @@ unwind_locked_zv (Lisp_Object point_max)
SET_BUF_ZV (current_buffer, XFIXNUM (point_max));
}
-DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 3, "r",
- doc: /* Restrict editing in this buffer to the current region.
-The rest of the text becomes temporarily invisible and untouchable
-but is not deleted; if you save the buffer in a file, the invisible
-text is included in the file. \\[widen] makes all visible again.
-See also `save-restriction'.
-
-When calling from Lisp, pass two arguments START and END:
-positions (integers or markers) bounding the text that should
-remain visible.
-
-When called from Lisp with the optional argument LOCK non-nil,
-calls to `widen', or to `narrow-to-region' with an optional
-argument LOCK nil, do not produce any effect until the end of
-the current body form. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object lock)
+/* Internal function for Fnarrow_to_region, meant to be used with a
+ third argument 'true', in which case it should be followed by "specbind
+ (Qrestrictions_locked, Qt)". */
+Lisp_Object
+narrow_to_region_internal (Lisp_Object start, Lisp_Object end, bool lock)
{
EMACS_INT s = fix_position (start), e = fix_position (end);
@@ -2713,7 +2704,7 @@ the current body form. */)
EMACS_INT tem = s; s = e; e = tem;
}
- if (! NILP (lock))
+ if (lock)
{
if (!(BEGV <= s && s <= e && e <= ZV))
args_out_of_range (start, end);
@@ -2727,8 +2718,6 @@ the current body form. */)
SET_BUF_BEGV (current_buffer, s);
SET_BUF_ZV (current_buffer, e);
-
- specbind (Qrestrictions_locked, Qt);
}
else
{
@@ -2754,6 +2743,27 @@ the current body form. */)
return Qnil;
}
+DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
+ doc: /* Restrict editing in this buffer to the current region.
+The rest of the text becomes temporarily invisible and untouchable
+but is not deleted; if you save the buffer in a file, the invisible
+text is included in the file. \\[widen] makes all visible again.
+See also `save-restriction'.
+
+When calling from Lisp, pass two arguments START and END:
+positions (integers or markers) bounding the text that should
+remain visible.
+
+Note that, when the current buffer contains one or more lines whose
+length is above `long-line-threshold', Emacs may decide to leave, for
+performance reasons, the accessible portion of the buffer unchanged
+after this function is called from low-level hooks, such as
+`jit-lock-functions' or `post-command-hook'. */)
+ (Lisp_Object start, Lisp_Object end)
+{
+ return narrow_to_region_internal (start, end, false);
+}
+
Lisp_Object
save_restriction_save (void)
{
diff --git a/src/eval.c b/src/eval.c
index 141d2546f0..56b4296662 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -57,6 +57,12 @@ Lisp_Object Vrun_hooks;
/* FIXME: We should probably get rid of this! */
Lisp_Object Vsignaling_function;
+/* The handler structure which will catch errors in Lisp hooks called
+ from redisplay. We do not use it for this; we compare it with the
+ handler which is about to be used in signal_or_quit, and if it
+ matches, cause a backtrace to be generated. */
+static struct handler *redisplay_deep_handler;
+
/* These would ordinarily be static, but they need to be visible to GDB. */
bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE;
@@ -246,6 +252,7 @@ init_eval (void)
lisp_eval_depth = 0;
/* This is less than the initial value of num_nonmacro_input_events. */
when_entered_debugger = -1;
+ redisplay_deep_handler = NULL;
}
/* Ensure that *M is at least A + B if possible, or is its maximum
@@ -333,7 +340,8 @@ call_debugger (Lisp_Object arg)
/* Interrupting redisplay and resuming it later is not safe under
all circumstances. So, when the debugger returns, abort the
interrupted redisplay by going back to the top-level. */
- if (debug_while_redisplaying)
+ if (debug_while_redisplaying
+ && !EQ (Vdebugger, Qdebug_early))
Ftop_level ();
return unbind_to (count, val);
@@ -593,16 +601,19 @@ The return value is BASE-VARIABLE. */)
if (SYMBOL_CONSTANT_P (new_alias))
/* Making it an alias effectively changes its value. */
- error ("Cannot make a constant an alias");
+ error ("Cannot make a constant an alias: %s",
+ SDATA (SYMBOL_NAME (new_alias)));
sym = XSYMBOL (new_alias);
switch (sym->u.s.redirect)
{
case SYMBOL_FORWARDED:
- error ("Cannot make an internal variable an alias");
+ error ("Cannot make a built-in variable an alias: %s",
+ SDATA (SYMBOL_NAME (new_alias)));
case SYMBOL_LOCALIZED:
- error ("Don't know how to make a localized variable an alias");
+ error ("Don't know how to make a buffer-local variable an alias: %s",
+ SDATA (SYMBOL_NAME (new_alias)));
case SYMBOL_PLAINVAL:
case SYMBOL_VARALIAS:
break;
@@ -633,7 +644,8 @@ The return value is BASE-VARIABLE. */)
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->kind >= SPECPDL_LET
&& (EQ (new_alias, specpdl_symbol (p))))
- error ("Don't know how to make a let-bound variable an alias");
+ error ("Don't know how to make a let-bound variable an alias: %s",
+ SDATA (SYMBOL_NAME (new_alias)));
}
if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
@@ -1552,12 +1564,16 @@ internal_condition_case_n (Lisp_Object (*bfun)
(ptrdiff_t, Lisp_Object *),
ptrdiff_t nargs,
Lisp_Object *args))
{
+ struct handler *old_deep = redisplay_deep_handler;
struct handler *c = push_handler (handlers, CONDITION_CASE);
+ if (redisplaying_p)
+ redisplay_deep_handler = c;
if (sys_setjmp (c->jmp))
{
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
+ redisplay_deep_handler = old_deep;
return hfun (val, nargs, args);
}
else
@@ -1565,6 +1581,7 @@ internal_condition_case_n (Lisp_Object (*bfun)
(ptrdiff_t, Lisp_Object *),
Lisp_Object val = bfun (nargs, args);
eassert (handlerlist == c);
handlerlist = c->next;
+ redisplay_deep_handler = old_deep;
return val;
}
}
@@ -1697,6 +1714,11 @@ quit (void)
return signal_or_quit (Qquit, Qnil, true);
}
+/* Has an error in redisplay giving rise to a backtrace occurred as
+ yet in the current command? This gets reset in the command
+ loop. */
+bool backtrace_yet = false;
+
/* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal.
If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be
Qquit and DATA should be Qnil, and this function may return.
@@ -1812,6 +1834,40 @@ 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
+ backtrace into the buffer *Redisplay-trace*. */
+ if (!debugger_called && !NILP (error_symbol)
+ && backtrace_on_redisplay_error
+ && (NILP (clause) || h == redisplay_deep_handler)
+ && NILP (Vinhibit_debugger)
+ && !NILP (Ffboundp (Qdebug_early)))
+ {
+ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
+ specpdl_ref count = SPECPDL_INDEX ();
+ ptrdiff_t counti = specpdl_ref_to_count (count);
+ AUTO_STRING (redisplay_trace, "*Redisplay_trace*");
+ Lisp_Object redisplay_trace_buffer;
+ AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace*
*/
+ Lisp_Object delayed_warning;
+ max_ensure_room (&max_specpdl_size, counti, 200);
+ redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil);
+ current_buffer = XBUFFER (redisplay_trace_buffer);
+ if (!backtrace_yet) /* Are we on the first backtrace of the command? */
+ Ferase_buffer ();
+ else
+ Finsert (1, &gap);
+ backtrace_yet = true;
+ specbind (Qstandard_output, redisplay_trace_buffer);
+ specbind (Qdebugger, Qdebug_early);
+ call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
+ unbind_to (count, Qnil);
+ delayed_warning = make_string
+ ("Error in a redisplay Lisp hook. See buffer *Redisplay_trace*", 61);
+
+ Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning),
+ Vdelayed_warnings_list);
+ }
+
if (!NILP (clause))
{
Lisp_Object unwind_data
@@ -4274,6 +4330,11 @@ Does not apply if quit is handled by a `condition-case'.
*/);
DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call,
doc: /* Non-nil means enter debugger before next `eval', `apply'
or `funcall'. */);
+ DEFVAR_BOOL ("backtrace-on-redisplay-error", backtrace_on_redisplay_error,
+ doc: /* Non-nil means create a backtrace if a lisp error occurs
in redisplay.
+The backtrace is written to buffer *Redisplay-trace*. */);
+ backtrace_on_redisplay_error = false;
+
DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue,
doc: /* Non-nil means debugger may continue execution.
This is nil when the debugger is called under circumstances where it
diff --git a/src/frame.c b/src/frame.c
index a39e1c4944..25d71e0769 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3916,9 +3916,10 @@ static const struct frame_parm_table frame_parms[] =
{"z-group", SYMBOL_INDEX (Qz_group)},
{"override-redirect", SYMBOL_INDEX (Qoverride_redirect)},
{"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)},
- {"alpha-background", SYMBOL_INDEX (Qalpha_background)},
+ {"alpha-background", SYMBOL_INDEX (Qalpha_background)},
+ {"use-frame-synchronization", SYMBOL_INDEX
(Quse_frame_synchronization)},
#ifdef HAVE_X_WINDOWS
- {"shaded", SYMBOL_INDEX (Qshaded)},
+ {"shaded", SYMBOL_INDEX (Qshaded)},
#endif
#ifdef NS_IMPL_COCOA
{"ns-appearance", SYMBOL_INDEX (Qns_appearance)},
@@ -6195,6 +6196,7 @@ syms_of_frame (void)
DEFSYM (Qtop_only, "top-only");
DEFSYM (Qiconify_top_level, "iconify-top-level");
DEFSYM (Qmake_invisible, "make-invisible");
+ DEFSYM (Quse_frame_synchronization, "use-frame-synchronization");
{
int i;
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index 6bb41110d5..e089f9dea8 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -567,7 +567,7 @@ ftcrfont_draw (struct glyph_string *s,
unblock_input ();
return 0;
}
- BView_cr_dump_clipping (FRAME_HAIKU_VIEW (f), cr);
+ BView_cr_dump_clipping (FRAME_HAIKU_DRAWABLE (f), cr);
#endif
if (with_background)
@@ -677,7 +677,11 @@ ftcrhbfont_begin_hb_font (struct font *font, double
*position_unit)
ftcrfont_info->ft_size = ft_face->size;
hb_font_t *hb_font = fthbfont_begin_hb_font (font, position_unit);
- if (ftcrfont_info->bitmap_position_unit)
+ /* HarfBuzz 5 correctly scales bitmap-only fonts without position
+ unit adjustment.
+ (https://github.com/harfbuzz/harfbuzz/issues/489) */
+ if (!hb_version_atleast (5, 0, 0)
+ && ftcrfont_info->bitmap_position_unit)
*position_unit = ftcrfont_info->bitmap_position_unit;
return hb_font;
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index b7590f68a4..983928442a 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -1512,6 +1512,8 @@ public:
BMessage *wait_for_release_message;
int64 grabbed_buttons;
+ BScreen screen;
+ bool use_frame_synchronization;
EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs",
B_FOLLOW_NONE, B_WILL_DRAW),
@@ -1524,7 +1526,8 @@ public:
cr_context (NULL),
#endif
wait_for_release_message (NULL),
- grabbed_buttons (0)
+ grabbed_buttons (0),
+ use_frame_synchronization (false)
{
}
@@ -1546,6 +1549,16 @@ public:
grab_view_locker.Unlock ();
}
+ void
+ SetFrameSynchronization (bool sync)
+ {
+ if (LockLooper ())
+ {
+ use_frame_synchronization = sync;
+ UnlockLooper ();
+ }
+ }
+
void
MessageReceived (BMessage *msg)
{
@@ -1722,14 +1735,14 @@ public:
void
FlipBuffers (void)
{
+ EmacsWindow *w;
if (!LockLooper ())
gui_abort ("Failed to lock looper during buffer flip");
if (!offscreen_draw_view)
gui_abort ("Failed to lock offscreen view during buffer flip");
offscreen_draw_view->Sync ();
-
- EmacsWindow *w = (EmacsWindow *) Window ();
+ w = (EmacsWindow *) Window ();
w->shown_flag = 0;
if (copy_bitmap &&
@@ -1750,6 +1763,11 @@ public:
if (copy_bitmap->InitCheck () != B_OK)
gui_abort ("Failed to init copy bitmap during buffer flip");
+ /* Wait for VBLANK. If responding to the invalidation or buffer
+ flipping takes longer than the blanking period, we lose. */
+ if (use_frame_synchronization)
+ screen.WaitForRetrace ();
+
Invalidate (&invalid_region);
invalid_region.MakeEmpty ();
UnlockLooper ();
@@ -5474,3 +5492,12 @@ be_clear_grab_view (void)
grab_view_locker.Unlock ();
}
}
+
+void
+be_set_use_frame_synchronization (void *view, bool sync)
+{
+ EmacsView *vw;
+
+ vw = (EmacsView *) view;
+ vw->SetFrameSynchronization (sync);
+}
diff --git a/src/haiku_support.h b/src/haiku_support.h
index 76fe071f2c..ca1808556a 100644
--- a/src/haiku_support.h
+++ b/src/haiku_support.h
@@ -728,6 +728,7 @@ extern void be_lock_window (void *);
extern void be_unlock_window (void *);
extern bool be_get_explicit_workarea (int *, int *, int *, int *);
extern void be_clear_grab_view (void);
+extern void be_set_use_frame_synchronization (void *, bool);
#ifdef __cplusplus
}
diff --git a/src/haikufns.c b/src/haikufns.c
index f3667ac2f9..aaa4e86622 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -949,6 +949,10 @@ haiku_create_frame (Lisp_Object parms)
|| !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
kset_default_minibuffer_frame (kb, frame);
+ /* Set whether or not frame synchronization is enabled. */
+ gui_default_parameter (f, parms, Quse_frame_synchronization, Qt,
+ NULL, NULL, RES_TYPE_BOOLEAN);
+
gui_default_parameter (f, parms, Qz_group, Qnil,
NULL, NULL, RES_TYPE_SYMBOL);
@@ -1501,9 +1505,9 @@ haiku_set_background_color (struct frame *f, Lisp_Object
arg, Lisp_Object oldval
if (FRAME_HAIKU_VIEW (f))
{
- BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0);
- BView_SetViewColor (FRAME_HAIKU_VIEW (f), background);
- BView_draw_unlock (FRAME_HAIKU_VIEW (f));
+ BView_draw_lock (FRAME_HAIKU_DRAWABLE (f), false, 0, 0, 0, 0);
+ BView_SetViewColor (FRAME_HAIKU_DRAWABLE (f), background);
+ BView_draw_unlock (FRAME_HAIKU_DRAWABLE (f));
FRAME_OUTPUT_DATA (f)->cursor_fg = background;
update_face_from_frame_parameter (f, Qbackground_color, arg);
@@ -2115,6 +2119,13 @@ haiku_set_mouse_color (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
update_face_from_frame_parameter (f, Qmouse_color, arg);
}
+static void
+haiku_set_use_frame_synchronization (struct frame *f, Lisp_Object arg,
+ Lisp_Object oldval)
+{
+ be_set_use_frame_synchronization (FRAME_HAIKU_VIEW (f), !NILP (arg));
+}
+
DEFUN ("haiku-set-mouse-absolute-pixel-position",
@@ -3128,6 +3139,7 @@ frame_parm_handler haiku_frame_parm_handlers[] =
haiku_set_override_redirect,
gui_set_no_special_glyphs,
gui_set_alpha_background,
+ haiku_set_use_frame_synchronization,
};
void
diff --git a/src/haikuterm.c b/src/haikuterm.c
index f2bee1263d..c2d4e34ba2 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -163,15 +163,15 @@ haiku_clip_to_string (struct glyph_string *s)
/* If n[FOO].width is 0, it means to not draw at all, so set the
clipping to some impossible value. */
if (r[0].width <= 0)
- BView_ClipToRect (FRAME_HAIKU_VIEW (s->f),
+ BView_ClipToRect (FRAME_HAIKU_DRAWABLE (s->f),
FRAME_PIXEL_WIDTH (s->f),
FRAME_PIXEL_HEIGHT (s->f),
10, 10);
else
{
- BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[0].x,
+ BView_ClipToRect (FRAME_HAIKU_DRAWABLE (s->f), r[0].x,
r[0].y, r[0].width, r[0].height);
- BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[0].x,
+ BView_invalidate_region (FRAME_HAIKU_DRAWABLE (s->f), r[0].x,
r[0].y, r[0].width, r[0].height);
}
}
@@ -181,15 +181,15 @@ haiku_clip_to_string (struct glyph_string *s)
/* If n[FOO].width is 0, it means to not draw at all, so set the
clipping to some impossible value. */
if (r[1].width <= 0)
- BView_ClipToRect (FRAME_HAIKU_VIEW (s->f),
+ BView_ClipToRect (FRAME_HAIKU_DRAWABLE (s->f),
FRAME_PIXEL_WIDTH (s->f),
FRAME_PIXEL_HEIGHT (s->f),
10, 10);
else
{
- BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[1].x, r[1].y,
+ BView_ClipToRect (FRAME_HAIKU_DRAWABLE (s->f), r[1].x, r[1].y,
r[1].width, r[1].height);
- BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[1].x,
+ BView_invalidate_region (FRAME_HAIKU_DRAWABLE (s->f), r[1].x,
r[1].y, r[1].width, r[1].height);
}
}
@@ -198,9 +198,9 @@ haiku_clip_to_string (struct glyph_string *s)
static void
haiku_clip_to_string_exactly (struct glyph_string *s, struct glyph_string *dst)
{
- BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), s->x, s->y,
+ BView_ClipToRect (FRAME_HAIKU_DRAWABLE (s->f), s->x, s->y,
s->width, s->height);
- BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), s->x,
+ BView_invalidate_region (FRAME_HAIKU_DRAWABLE (s->f), s->x,
s->y, s->width, s->height);
}
@@ -246,7 +246,7 @@ static void
haiku_clear_frame_area (struct frame *f, int x, int y,
int width, int height)
{
- void *vw = FRAME_HAIKU_VIEW (f);
+ void *vw = FRAME_HAIKU_DRAWABLE (f);
block_input ();
BView_draw_lock (vw, true, x, y, width, height);
BView_StartClip (vw);
@@ -261,7 +261,7 @@ haiku_clear_frame_area (struct frame *f, int x, int y,
static void
haiku_clear_frame (struct frame *f)
{
- void *view = FRAME_HAIKU_VIEW (f);
+ void *view = FRAME_HAIKU_DRAWABLE (f);
mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
@@ -596,7 +596,7 @@ haiku_draw_box_rect (struct glyph_string *s, int left_x,
int top_y,
int right_x, int bottom_y, int hwidth, int vwidth,
bool left_p, bool right_p, struct haiku_rect *clip_rect)
{
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
struct face *face = s->face;
BView_SetHighColor (view, face->box_color);
@@ -660,7 +660,7 @@ haiku_draw_relief_rect (struct glyph_string *s, int left_x,
int top_y,
uint32_t color_white, color_black;
void *view;
- view = FRAME_HAIKU_VIEW (s->f);
+ view = FRAME_HAIKU_DRAWABLE (s->f);
haiku_calculate_relief_colors (s, &color_white, &color_black);
BView_SetHighColor (view, raised_p ? color_white : color_black);
@@ -769,7 +769,7 @@ haiku_draw_underwave (struct glyph_string *s, int width,
int x)
dy = wave_height - 1;
y = s->ybase - wave_height + 3;
xmax = x + width;
- view = FRAME_HAIKU_VIEW (s->f);
+ view = FRAME_HAIKU_DRAWABLE (s->f);
BView_StartClip (view);
haiku_clip_to_string (s);
@@ -811,7 +811,7 @@ haiku_draw_text_decoration (struct glyph_string *s, struct
face *face,
if (s->hl == DRAW_CURSOR)
haiku_merge_cursor_foreground (s, &cursor_color, NULL);
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
if (face->underline)
{
@@ -1013,7 +1013,7 @@ static void
haiku_draw_plain_background (struct glyph_string *s, struct face *face,
int x, int y, int width, int height)
{
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
unsigned long cursor_color;
if (s->hl == DRAW_CURSOR)
@@ -1075,7 +1075,7 @@ haiku_draw_stipple_background (struct glyph_string *s,
struct face *face,
unsigned long foreground, background;
void *view;
- view = FRAME_HAIKU_VIEW (s->f);
+ view = FRAME_HAIKU_DRAWABLE (s->f);
rec = haiku_get_bitmap_rec (s->f, s->face->stipple);
if (explicit_colors_p)
@@ -1173,7 +1173,7 @@ haiku_draw_glyph_string_foreground (struct glyph_string
*s)
else
x = s->x;
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
if (s->font_not_found_p)
{
@@ -1289,9 +1289,9 @@ haiku_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
else
color = s->face->foreground;
- BView_SetHighColor (FRAME_HAIKU_VIEW (s->f), color);
- BView_SetPenSize (FRAME_HAIKU_VIEW (s->f), 1);
- BView_StrokeRectangle (FRAME_HAIKU_VIEW (s->f),
+ BView_SetHighColor (FRAME_HAIKU_DRAWABLE (s->f), color);
+ BView_SetPenSize (FRAME_HAIKU_DRAWABLE (s->f), 1);
+ BView_StrokeRectangle (FRAME_HAIKU_DRAWABLE (s->f),
x, s->ybase - glyph->ascent,
glyph->pixel_width,
glyph->ascent + glyph->descent);
@@ -1335,7 +1335,7 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s)
if (s->row->reversed_p)
x -= width;
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
unsigned long cursor_color;
haiku_merge_cursor_foreground (s, NULL, &cursor_color);
@@ -1401,14 +1401,14 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s)
static void
haiku_start_clip (struct glyph_string *s)
{
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
BView_StartClip (view);
}
static void
haiku_end_clip (struct glyph_string *s)
{
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
BView_EndClip (view);
}
@@ -1428,7 +1428,7 @@ haiku_clip_to_row (struct window *w, struct glyph_row
*row,
width = window_width;
height = row->visible_height;
- BView_ClipToRect (FRAME_HAIKU_VIEW (f), x, y, width, height);
+ BView_ClipToRect (FRAME_HAIKU_DRAWABLE (f), x, y, width, height);
}
static void
@@ -1448,7 +1448,7 @@ haiku_draw_composite_glyph_string_foreground (struct
glyph_string *s)
{
int i, j, x;
struct font *font = s->font;
- void *view = FRAME_HAIKU_VIEW (s->f);
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);
struct face *face = s->face;
/* If first glyph of S has a left box line, start drawing the text
@@ -1670,7 +1670,7 @@ haiku_draw_image_glyph_string (struct glyph_string *s)
if (s->slice.y == 0)
y += box_line_vwidth;
- view = FRAME_HAIKU_VIEW (s->f);
+ view = FRAME_HAIKU_DRAWABLE (s->f);
bitmap = s->img->pixmap;
s->stippled_p = face->stipple != 0;
@@ -1803,7 +1803,7 @@ haiku_draw_image_glyph_string (struct glyph_string *s)
static void
haiku_draw_glyph_string (struct glyph_string *s)
{
- void *view = FRAME_HAIKU_VIEW (s->f);;
+ void *view = FRAME_HAIKU_DRAWABLE (s->f);;
struct face *face = s->face;
block_input ();
@@ -2001,7 +2001,7 @@ haiku_after_update_window_line (struct window *w,
block_input ();
if (face)
{
- void *view = FRAME_HAIKU_VIEW (f);
+ void *view = FRAME_HAIKU_DRAWABLE (f);
BView_draw_lock (view, false, 0, 0, 0, 0);
BView_StartClip (view);
BView_SetHighColor (view, (face->background_defaulted_p
@@ -2010,7 +2010,7 @@ haiku_after_update_window_line (struct window *w,
BView_FillRectangle (view, 0, y, width, height);
BView_FillRectangle (view, FRAME_PIXEL_WIDTH (f) - width,
y, width, height);
- BView_invalidate_region (FRAME_HAIKU_VIEW (f),
+ BView_invalidate_region (FRAME_HAIKU_DRAWABLE (f),
0, y, width, height);
BView_invalidate_region (view, FRAME_PIXEL_WIDTH (f) - width,
y, width, height);
@@ -2075,7 +2075,7 @@ haiku_draw_hollow_cursor (struct window *w, struct
glyph_row *row)
void *view;
f = XFRAME (WINDOW_FRAME (w));
- view = FRAME_HAIKU_VIEW (f);
+ view = FRAME_HAIKU_DRAWABLE (f);
/* Get the glyph the cursor is on. If we can't tell because
the current matrix is invalid or such, give up. */
@@ -2148,7 +2148,7 @@ haiku_draw_bar_cursor (struct window *w, struct glyph_row
*row,
}
else
{
- view = FRAME_HAIKU_VIEW (f);
+ view = FRAME_HAIKU_DRAWABLE (f);
face = FACE_FROM_ID (f, cursor_glyph->face_id);
/* If the glyph's background equals the color we normally draw
@@ -2334,7 +2334,7 @@ haiku_draw_vertical_window_border (struct window *w,
struct face *face;
face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
- void *view = FRAME_HAIKU_VIEW (f);
+ void *view = FRAME_HAIKU_DRAWABLE (f);
BView_draw_lock (view, true, x, y_0, 1, y_1);
BView_StartClip (view);
if (face)
@@ -2384,7 +2384,7 @@ haiku_draw_window_divider (struct window *w, int x0, int
x1, int y0, int y1)
unsigned long color_last = (face_last
? face_last->foreground
: FRAME_FOREGROUND_PIXEL (f));
- void *view = FRAME_HAIKU_VIEW (f);
+ void *view = FRAME_HAIKU_DRAWABLE (f);
BView_draw_lock (view, true, x0, y0, x1 - x0 + 1, y1 - y0 + 1);
BView_StartClip (view);
@@ -2554,7 +2554,7 @@ haiku_scroll_bar_create (struct window *w, int left, int
top,
void *view;
f = XFRAME (WINDOW_FRAME (w));
- view = FRAME_HAIKU_VIEW (f);
+ view = FRAME_HAIKU_DRAWABLE (f);
block_input ();
bar = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER);
@@ -2604,7 +2604,7 @@ haiku_set_horizontal_scroll_bar (struct window *w, int
portion, int whole, int p
width = window_width;
top = WINDOW_SCROLL_BAR_AREA_Y (w);
height = WINDOW_CONFIG_SCROLL_BAR_HEIGHT (w);
- view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w));
+ view = FRAME_HAIKU_DRAWABLE (WINDOW_XFRAME (w));
block_input ();
@@ -2663,7 +2663,7 @@ haiku_set_vertical_scroll_bar (struct window *w, int
portion, int whole, int pos
left = WINDOW_SCROLL_BAR_AREA_X (w);
width = WINDOW_SCROLL_BAR_AREA_WIDTH (w);
- view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w));
+ view = FRAME_HAIKU_DRAWABLE (WINDOW_XFRAME (w));
block_input ();
if (NILP (w->vertical_scroll_bar))
@@ -2712,7 +2712,7 @@ haiku_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
uint32 col;
f = XFRAME (WINDOW_FRAME (w));
- view = FRAME_HAIKU_VIEW (f);
+ view = FRAME_HAIKU_DRAWABLE (f);
face = p->face;
block_input ();
@@ -2828,7 +2828,7 @@ static void
haiku_scroll_run (struct window *w, struct run *run)
{
struct frame *f = XFRAME (w->frame);
- void *view = FRAME_HAIKU_VIEW (f);
+ void *view = FRAME_HAIKU_DRAWABLE (f);
int x, y, width, height, from_y, to_y, bottom_y;
window_box (w, ANY_AREA, &x, &y, &width, &height);
@@ -3211,9 +3211,9 @@ haiku_read_socket (struct terminal *terminal, struct
input_event *hold_quit)
continue;
}
- BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0);
- BView_resize_to (FRAME_HAIKU_VIEW (f), width, height);
- BView_draw_unlock (FRAME_HAIKU_VIEW (f));
+ BView_draw_lock (FRAME_HAIKU_DRAWABLE (f), false, 0, 0, 0, 0);
+ BView_resize_to (FRAME_HAIKU_DRAWABLE (f), width, height);
+ BView_draw_unlock (FRAME_HAIKU_DRAWABLE (f));
if (width != FRAME_PIXEL_WIDTH (f)
|| height != FRAME_PIXEL_HEIGHT (f)
@@ -4126,7 +4126,7 @@ haiku_flash (struct frame *f)
int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f);
int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f);
int width = flash_right - flash_left;
- void *view = FRAME_HAIKU_VIEW (f);
+ void *view = FRAME_HAIKU_DRAWABLE (f);
object_wait_info info;
bigtime_t wakeup;
@@ -4454,7 +4454,7 @@ haiku_clear_under_internal_border (struct frame *f)
? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
: INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
- void *view = FRAME_HAIKU_VIEW (f);
+ void *view = FRAME_HAIKU_DRAWABLE (f);
block_input ();
BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f),
@@ -4496,7 +4496,7 @@ haiku_scroll_bar_remove (struct scroll_bar *bar)
struct frame *f;
f = WINDOW_XFRAME (XWINDOW (bar->window));
- view = FRAME_HAIKU_VIEW (f);
+ view = FRAME_HAIKU_DRAWABLE (f);
block_input ();
BView_forget_scroll_bar (view, bar->left, bar->top,
diff --git a/src/haikuterm.h b/src/haikuterm.h
index 02a364f671..b603c0a482 100644
--- a/src/haikuterm.h
+++ b/src/haikuterm.h
@@ -275,7 +275,8 @@ struct scroll_bar
#define MAKE_FRAME_DIRTY(f) (FRAME_DIRTY_P (f) = 1)
#define FRAME_OUTPUT_DATA(f) ((f)->output_data.haiku)
#define FRAME_HAIKU_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window)
-#define FRAME_HAIKU_VIEW(f) ((MAKE_FRAME_DIRTY (f)),
FRAME_OUTPUT_DATA (f)->view)
+#define FRAME_HAIKU_VIEW(f) (FRAME_OUTPUT_DATA (f)->view)
+#define FRAME_HAIKU_DRAWABLE(f) ((MAKE_FRAME_DIRTY (f)),
FRAME_HAIKU_VIEW (f))
#define FRAME_HAIKU_MENU_BAR(f) (FRAME_OUTPUT_DATA (f)->menubar)
#define FRAME_DISPLAY_INFO(f) (FRAME_OUTPUT_DATA (f)->display_info)
#define FRAME_FONT(f) (FRAME_OUTPUT_DATA (f)->font)
@@ -287,7 +288,7 @@ struct scroll_bar
#ifdef USE_BE_CAIRO
#define FRAME_CR_CONTEXT(f) \
(FRAME_HAIKU_VIEW (f) \
- ? EmacsView_cairo_context (FRAME_HAIKU_VIEW (f)) \
+ ? EmacsView_cairo_context (FRAME_HAIKU_DRAWABLE (f)) \
: NULL)
#endif
diff --git a/src/indent.c b/src/indent.c
index fd2e763665..d2dfaee254 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -2345,7 +2345,15 @@ whether or not it is currently displayed in some window.
*/)
last line that it occupies. */
if (it_start < ZV)
{
- while (IT_CHARPOS (it) <= it_start)
+ if ((it.bidi_it.scan_dir > 0)
+ ? IT_CHARPOS (it) < it_start
+ : IT_CHARPOS (it) > it_start)
+ {
+ it.vpos = 0;
+ it.current_y = 0;
+ move_it_by_lines (&it, 1);
+ }
+ while (IT_CHARPOS (it) == it_start)
{
it.vpos = 0;
it.current_y = 0;
diff --git a/src/keyboard.c b/src/keyboard.c
index 2863058d63..719226caed 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1295,7 +1295,8 @@ command_loop_1 (void)
/* Note that the value cell will never directly contain nil
if the symbol is a local variable. */
if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
- safe_run_hooks (Qpost_command_hook);
+ safe_run_hooks_maybe_narrowed (Qpost_command_hook,
+ XWINDOW (selected_window));
/* If displaying a message, resize the echo area window to fit
that message's size exactly. */
@@ -1330,6 +1331,7 @@ command_loop_1 (void)
display_malloc_warning ();
Vdeactivate_mark = Qnil;
+ backtrace_yet = false;
/* Don't ignore mouse movements for more than a single command
loop. (This flag is set in xdisp.c whenever the tool bar is
@@ -1461,7 +1463,9 @@ command_loop_1 (void)
}
Vthis_command = cmd;
Vreal_this_command = cmd;
- safe_run_hooks (Qpre_command_hook);
+
+ safe_run_hooks_maybe_narrowed (Qpre_command_hook,
+ XWINDOW (selected_window));
already_adjusted = 0;
@@ -1513,7 +1517,8 @@ command_loop_1 (void)
}
kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
- safe_run_hooks (Qpost_command_hook);
+ safe_run_hooks_maybe_narrowed (Qpost_command_hook,
+ XWINDOW (selected_window));
/* If displaying a message, resize the echo area window to fit
that message's size exactly. Do this only if the echo area
@@ -1837,7 +1842,7 @@ safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
static Lisp_Object
safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
{
- eassert (nargs == 2);
+ eassert (nargs >= 2 && nargs <= 4);
AUTO_STRING (format, "Error in %s (%S): %S");
Lisp_Object hook = args[0];
Lisp_Object fun = args[1];
@@ -1895,6 +1900,33 @@ safe_run_hooks (Lisp_Object hook)
unbind_to (count, Qnil);
}
+void
+safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w)
+{
+ specpdl_ref count = SPECPDL_INDEX ();
+
+ specbind (Qinhibit_quit, Qt);
+
+ if (current_buffer->long_line_optimizations_p)
+ narrow_to_region_internal (make_fixnum (get_narrowed_begv (w, PT)),
+ make_fixnum (get_narrowed_zv (w, PT)),
+ true);
+
+ run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
safe_run_hook_funcall);
+ unbind_to (count, Qnil);
+}
+
+void
+safe_run_hooks_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
+{
+ specpdl_ref count = SPECPDL_INDEX ();
+
+ specbind (Qinhibit_quit, Qt);
+ run_hook_with_args (4, ((Lisp_Object []) {hook, hook, arg1, arg2}),
+ safe_run_hook_funcall);
+ unbind_to (count, Qnil);
+}
+
/* Nonzero means polling for input is temporarily suppressed. */
@@ -4622,6 +4654,11 @@ timer_check_2 (Lisp_Object timers, Lisp_Object
idle_timers)
/* If timer is ripe, run it if it hasn't been run. */
if (ripe)
{
+ /* If we got here, presumably `decode_timer` has checked
+ that this timer has not yet been triggered. */
+ eassert (NILP (AREF (chosen_timer, 0)));
+ /* In a production build, where assertions compile to
+ nothing, we still want to play it safe here. */
if (NILP (AREF (chosen_timer, 0)))
{
specpdl_ref count = SPECPDL_INDEX ();
@@ -4640,8 +4677,8 @@ timer_check_2 (Lisp_Object timers, Lisp_Object
idle_timers)
/* Since we have handled the event,
we don't need to tell the caller to wake up and do it. */
- /* But the caller must still wait for the next timer, so
- return 0 to indicate that. */
+ /* But the caller must still wait for the next timer, so
+ return 0 to indicate that. */
}
nexttime = make_timespec (0, 0);
@@ -12622,23 +12659,39 @@ Buffer modification stores t in this variable. */);
DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
doc: /* Normal hook run before each command is executed.
-If an unhandled error happens in running this hook,
-the function in which the error occurred is unconditionally removed, since
-otherwise the error might happen repeatedly and make Emacs nonfunctional.
+
+If an unhandled error happens in running this hook, the function in
+which the error occurred is unconditionally removed, since otherwise
+the error might happen repeatedly and make Emacs nonfunctional.
+
+Note that, when the current buffer contains one or more lines whose
+length is above `long-line-threshold', these hook functions are called
+with the buffer narrowed to a small portion around point, and the
+narrowing is locked (see `narrow-to-region'), so that these hook
+functions cannot use `widen' to gain access to other portions of
+buffer text.
See also `post-command-hook'. */);
Vpre_command_hook = Qnil;
DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
doc: /* Normal hook run after each command is executed.
-If an unhandled error happens in running this hook,
-the function in which the error occurred is unconditionally removed, since
-otherwise the error might happen repeatedly and make Emacs nonfunctional.
+
+If an unhandled error happens in running this hook, the function in
+which the error occurred is unconditionally removed, since otherwise
+the error might happen repeatedly and make Emacs nonfunctional.
It is a bad idea to use this hook for expensive processing. If
unavoidable, wrap your code in `(while-no-input (redisplay) CODE)' to
avoid making Emacs unresponsive while the user types.
+Note that, when the current buffer contains one or more lines whose
+length is above `long-line-threshold', these hook functions are called
+with the buffer narrowed to a small portion around point, and the
+narrowing is locked (see `narrow-to-region'), so that these hook
+functions cannot use `widen' to gain access to other portions of
+buffer text.
+
See also `pre-command-hook'. */);
Vpost_command_hook = Qnil;
@@ -12914,7 +12967,10 @@ This variable only has an effect when Transient Mark
mode is enabled.
If the value is `only', only temporarily active regions (usually made
by mouse-dragging or shift-selection) set the window system's primary
-selection. */);
+selection.
+
+If this variable causes the region to be set as the primary selection,
+`post-select-region-hook' is then run afterwards. */);
Vselect_active_regions = Qt;
DEFVAR_LISP ("saved-region-selection",
diff --git a/src/lisp.h b/src/lisp.h
index 8fcc9b6e75..2f73ba4c61 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3793,10 +3793,10 @@ make_symbol_constant (Lisp_Object sym)
/* Buffer-local variable access functions. */
-INLINE int
+INLINE bool
blv_found (struct Lisp_Buffer_Local_Value *blv)
{
- eassert (blv->found == !EQ (blv->defcell, blv->valcell));
+ eassert (blv->found == !BASE_EQ (blv->defcell, blv->valcell));
return blv->found;
}
@@ -4530,6 +4530,7 @@ extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
extern Lisp_Object inhibit_lisp_code;
extern bool signal_quit_p (Lisp_Object);
+extern bool backtrace_yet;
/* To run a normal hook, use the appropriate function from the list below.
The calling convention:
@@ -4679,6 +4680,7 @@ extern void save_restriction_restore (Lisp_Object);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, bool);
+extern Lisp_Object narrow_to_region_internal (Lisp_Object, Lisp_Object, bool);
extern void init_editfns (void);
extern void syms_of_editfns (void);
@@ -4829,6 +4831,8 @@ extern bool detect_input_pending (void);
extern bool detect_input_pending_ignore_squeezables (void);
extern bool detect_input_pending_run_timers (bool);
extern void safe_run_hooks (Lisp_Object);
+extern void safe_run_hooks_maybe_narrowed (Lisp_Object, struct window *);
+extern void safe_run_hooks_2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void cmd_error_internal (Lisp_Object, const char *);
extern Lisp_Object command_loop_2 (Lisp_Object);
extern Lisp_Object read_menu_command (void);
@@ -4941,7 +4945,8 @@ extern void setup_process_coding_systems (Lisp_Object);
#endif
extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
- const char *, const char *, const sigset_t *);
+ const char *, const char *, bool, bool,
+ const sigset_t *);
extern char **make_environment_block (Lisp_Object) ATTRIBUTE_RETURNS_NONNULL;
extern void init_callproc_1 (void);
extern void init_callproc (void);
diff --git a/src/lread.c b/src/lread.c
index 0720774db2..ccccd79cd7 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -131,25 +131,15 @@ static ptrdiff_t read_from_string_limit;
/* Position in object from which characters are being read by `readchar'. */
static EMACS_INT readchar_offset;
-/* This contains the last string skipped with #@. */
-static char *saved_doc_string;
-/* Length of buffer allocated in saved_doc_string. */
-static ptrdiff_t saved_doc_string_size;
-/* Length of actual data in saved_doc_string. */
-static ptrdiff_t saved_doc_string_length;
-/* This is the file position that string came from. */
-static file_offset saved_doc_string_position;
-
-/* This contains the previous string skipped with #@.
- We copy it from saved_doc_string when a new string
- is put in saved_doc_string. */
-static char *prev_saved_doc_string;
-/* Length of buffer allocated in prev_saved_doc_string. */
-static ptrdiff_t prev_saved_doc_string_size;
-/* Length of actual data in prev_saved_doc_string. */
-static ptrdiff_t prev_saved_doc_string_length;
-/* This is the file position that string came from. */
-static file_offset prev_saved_doc_string_position;
+struct saved_string {
+ char *string; /* string in allocated buffer */
+ ptrdiff_t size; /* allocated size of buffer */
+ ptrdiff_t length; /* length of string in buffer */
+ file_offset position; /* position in file the string came
from */
+};
+
+/* The last two strings skipped with #@ (most recent first). */
+static struct saved_string saved_strings[2];
/* A list of file names for files being loaded in Fload. Used to
check for recursive loads. */
@@ -1605,13 +1595,12 @@ Return t if the file exists and loads successfully. */)
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
- xfree (saved_doc_string);
- saved_doc_string = 0;
- saved_doc_string_size = 0;
-
- xfree (prev_saved_doc_string);
- prev_saved_doc_string = 0;
- prev_saved_doc_string_size = 0;
+ for (int i = 0; i < ARRAYELTS (saved_strings); i++)
+ {
+ xfree (saved_strings[i].string);
+ saved_strings[i].string = NULL;
+ saved_strings[i].size = 0;
+ }
if (!noninteractive && (NILP (nomessage) || force_load_messages))
{
@@ -2261,7 +2250,7 @@ readevalloop (Lisp_Object readcharfun,
/* Set point and ZV around stuff to be read. */
Fgoto_char (start);
if (!NILP (end))
- Fnarrow_to_region (make_fixnum (BEGV), end, Qnil);
+ Fnarrow_to_region (make_fixnum (BEGV), end);
/* Just for cleanliness, convert END to a marker
if it is an integer. */
@@ -3056,7 +3045,6 @@ read_string_literal (char stackbuf[VLA_ELEMS
(stackbufsize)],
/* True if we saw an escape sequence specifying
a single-byte character. */
bool force_singlebyte = false;
- bool cancel = false;
ptrdiff_t nchars = 0;
int ch;
@@ -3085,8 +3073,6 @@ read_string_literal (char stackbuf[VLA_ELEMS
(stackbufsize)],
case ' ':
case '\n':
/* `\SPC' and `\LF' generate no characters at all. */
- if (p == read_buffer)
- cancel = true;
continue;
default:
UNREAD (ch);
@@ -3152,15 +3138,6 @@ read_string_literal (char stackbuf[VLA_ELEMS
(stackbufsize)],
if (ch < 0)
end_of_file_error ();
- /* If purifying, and string starts with \ newline,
- return zero instead. This is for doc strings
- that we are really going to find in etc/DOC.nn.nn. */
- if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
- {
- unbind_to (count, Qnil);
- return make_fixnum (0);
- }
-
if (!force_multibyte && force_singlebyte)
{
/* READ_BUFFER contains raw 8-bit bytes and no multibyte
@@ -3457,57 +3434,95 @@ skip_lazy_string (Lisp_Object readcharfun)
record the last string that we skipped,
and record where in the file it comes from. */
- /* But first exchange saved_doc_string
- with prev_saved_doc_string, so we save two strings. */
- {
- char *temp = saved_doc_string;
- ptrdiff_t temp_size = saved_doc_string_size;
- file_offset temp_pos = saved_doc_string_position;
- ptrdiff_t temp_len = saved_doc_string_length;
-
- saved_doc_string = prev_saved_doc_string;
- saved_doc_string_size = prev_saved_doc_string_size;
- saved_doc_string_position = prev_saved_doc_string_position;
- saved_doc_string_length = prev_saved_doc_string_length;
-
- prev_saved_doc_string = temp;
- prev_saved_doc_string_size = temp_size;
- prev_saved_doc_string_position = temp_pos;
- prev_saved_doc_string_length = temp_len;
- }
+ /* First exchange the two saved_strings. */
+ verify (ARRAYELTS (saved_strings) == 2);
+ struct saved_string t = saved_strings[0];
+ saved_strings[0] = saved_strings[1];
+ saved_strings[1] = t;
enum { extra = 100 };
- if (saved_doc_string_size == 0)
+ struct saved_string *ss = &saved_strings[0];
+ if (ss->size == 0)
{
- saved_doc_string = xmalloc (nskip + extra);
- saved_doc_string_size = nskip + extra;
+ ss->size = nskip + extra;
+ ss->string = xmalloc (ss->size);
}
- if (nskip > saved_doc_string_size)
+ else if (nskip > ss->size)
{
- saved_doc_string = xrealloc (saved_doc_string, nskip + extra);
- saved_doc_string_size = nskip + extra;
+ ss->size = nskip + extra;
+ ss->string = xrealloc (ss->string, ss->size);
}
FILE *instream = infile->stream;
- saved_doc_string_position = (file_tell (instream) - infile->lookahead);
+ ss->position = (file_tell (instream) - infile->lookahead);
- /* Copy that many bytes into saved_doc_string. */
+ /* Copy that many bytes into the saved string. */
ptrdiff_t i = 0;
int c = 0;
for (int n = min (nskip, infile->lookahead); n > 0; n--)
- saved_doc_string[i++] = c = infile->buf[--infile->lookahead];
+ ss->string[i++] = c = infile->buf[--infile->lookahead];
block_input ();
for (; i < nskip && c >= 0; i++)
- saved_doc_string[i] = c = getc (instream);
+ ss->string[i] = c = getc (instream);
unblock_input ();
- saved_doc_string_length = i;
+ ss->length = i;
}
else
/* Skip that many bytes. */
skip_dyn_bytes (readcharfun, nskip);
}
+/* Given a lazy-loaded string designator VAL, return the actual string.
+ VAL is (FILENAME . POS). */
+static Lisp_Object
+get_lazy_string (Lisp_Object val)
+{
+ /* Get a doc string from the file we are loading.
+ If it's in a saved string, get it from there.
+
+ Here, we don't know if the string is a bytecode string or a doc
+ string. As a bytecode string must be unibyte, we always return a
+ unibyte string. If it is actually a doc string, caller must make
+ it multibyte. */
+
+ /* We used to emit negative positions for 'user variables' (whose doc
+ strings started with an asterisk); take the absolute value for
+ compatibility. */
+ EMACS_INT pos = eabs (XFIXNUM (XCDR (val)));
+ struct saved_string *ss = &saved_strings[0];
+ struct saved_string *ssend = ss + ARRAYELTS (saved_strings);
+ while (ss < ssend
+ && !(pos >= ss->position && pos < ss->position + ss->length))
+ ss++;
+ if (ss >= ssend)
+ return get_doc_string (val, 1, 0);
+
+ ptrdiff_t start = pos - ss->position;
+ char *str = ss->string;
+ ptrdiff_t from = start;
+ ptrdiff_t to = start;
+
+ /* Process quoting with ^A, and find the end of the string,
+ which is marked with ^_ (037). */
+ while (str[from] != 037)
+ {
+ int c = str[from++];
+ if (c == 1)
+ {
+ c = str[from++];
+ str[to++] = (c == 1 ? c
+ : c == '0' ? 0
+ : c == '_' ? 037
+ : c);
+ }
+ else
+ str[to++] = c;
+ }
+
+ return make_unibyte_string (str + start, to - start);
+}
+
/* Length of prefix only consisting of symbol constituent characters. */
static ptrdiff_t
@@ -4249,6 +4264,15 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
XSETCDR (e->u.list.tail, obj);
read_stack_pop ();
obj = e->u.list.head;
+
+ /* Hack: immediately convert (#$ . FIXNUM) to the corresponding
+ string if load-force-doc-strings is set. */
+ if (load_force_doc_strings
+ && BASE_EQ (XCAR (obj), Vload_file_name)
+ && !NILP (XCAR (obj))
+ && FIXNUMP (XCDR (obj)))
+ obj = get_lazy_string (obj);
+
break;
}
diff --git a/src/marker.c b/src/marker.c
index 3c8e628762..9727586f42 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -214,11 +214,12 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t
charpos)
We have one known above and one known below.
Scan, counting characters, from whichever one is closer. */
+ eassert (best_below <= charpos && charpos <= best_above);
if (charpos - best_below < best_above - charpos)
{
bool record = charpos - best_below > 5000;
- while (best_below != charpos)
+ while (best_below < charpos)
{
best_below++;
best_below_byte += buf_next_char_len (b, best_below_byte);
@@ -243,7 +244,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
{
bool record = best_above - charpos > 5000;
- while (best_above != charpos)
+ while (best_above > charpos)
{
best_above--;
best_above_byte -= buf_prev_char_len (b, best_above_byte);
diff --git a/src/nsfns.m b/src/nsfns.m
index 433df05961..1d3dcd3124 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1057,6 +1057,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
0, /* x_set_override_redirect */
gui_set_no_special_glyphs,
gui_set_alpha_background,
+ NULL,
#ifdef NS_IMPL_COCOA
ns_set_appearance,
ns_set_transparent_titlebar,
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index d998c3d938..beaf28f69d 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -991,6 +991,7 @@ frame_parm_handler pgtk_frame_parm_handlers[] =
pgtk_set_override_redirect,
gui_set_no_special_glyphs,
pgtk_set_alpha_background,
+ NULL,
};
diff --git a/src/print.c b/src/print.c
index 7303e847aa..1c96ec14b8 100644
--- a/src/print.c
+++ b/src/print.c
@@ -63,16 +63,17 @@ static Lisp_Object being_printed[PRINT_CIRCLE];
/* Last char printed to stdout by printchar. */
static unsigned int printchar_stdout_last;
+struct print_buffer
+{
+ char *buffer; /* Allocated buffer. */
+ ptrdiff_t size; /* Size of allocated buffer. */
+ ptrdiff_t pos; /* Chars stored in buffer. */
+ ptrdiff_t pos_byte; /* Bytes stored in buffer. */
+};
+
/* When printing into a buffer, first we put the text in this
block, then insert it all at once. */
-static char *print_buffer;
-
-/* Size allocated in print_buffer. */
-static ptrdiff_t print_buffer_size;
-/* Chars stored in print_buffer. */
-static ptrdiff_t print_buffer_pos;
-/* Bytes stored in print_buffer. */
-static ptrdiff_t print_buffer_pos_byte;
+static struct print_buffer print_buffer;
/* Vprint_number_table is a table, that keeps objects that are going to
be printed, to allow use of #n= and #n# to express sharing.
@@ -91,121 +92,139 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
/* Low level output routines for characters and strings. */
-/* Lisp functions to do output using a stream
- must have the stream in a variable called printcharfun
- and must start with PRINTPREPARE, end with PRINTFINISH.
- Use printchar to output one character,
- or call strout to output a block of characters. */
-
-#define PRINTPREPARE \
- ptrdiff_t old_point = -1, start_point = -1; \
- ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
- specpdl_ref specpdl_count = SPECPDL_INDEX (); \
- bool multibyte \
- = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
- Lisp_Object original = printcharfun;
\
- record_unwind_current_buffer (); \
- specbind(Qprint__unreadable_callback_buffer, Fcurrent_buffer ()); \
- if (NILP (printcharfun)) printcharfun = Qt; \
- if (BUFFERP (printcharfun)) \
- { \
- if (XBUFFER (printcharfun) != current_buffer) \
- Fset_buffer (printcharfun); \
- printcharfun = Qnil; \
- } \
- if (MARKERP (printcharfun)) \
- { \
- ptrdiff_t marker_pos; \
- if (! XMARKER (printcharfun)->buffer) \
- error ("Marker does not point anywhere"); \
- if (XMARKER (printcharfun)->buffer != current_buffer) \
- set_buffer_internal (XMARKER (printcharfun)->buffer); \
- marker_pos = marker_position (printcharfun); \
- if (marker_pos < BEGV || marker_pos > ZV) \
- signal_error ("Marker is outside the accessible " \
- "part of the buffer", printcharfun); \
- old_point = PT; \
- old_point_byte = PT_BYTE; \
- SET_PT_BOTH (marker_pos,
\
- marker_byte_position (printcharfun)); \
- start_point = PT; \
- start_point_byte = PT_BYTE; \
- printcharfun = Qnil; \
- } \
- if (NILP (printcharfun)) \
- { \
- Lisp_Object string; \
- if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
- && ! print_escape_multibyte) \
- specbind (Qprint_escape_multibyte, Qt); \
- if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \
- && ! print_escape_nonascii) \
- specbind (Qprint_escape_nonascii, Qt);
\
- if (print_buffer != 0) \
- { \
- string = make_string_from_bytes (print_buffer, \
- print_buffer_pos, \
- print_buffer_pos_byte); \
- record_unwind_protect (print_unwind, string); \
- } \
- else \
- { \
- int new_size = 1000; \
- print_buffer = xmalloc (new_size); \
- print_buffer_size = new_size; \
- record_unwind_protect_void (print_free_buffer); \
- } \
- print_buffer_pos = 0; \
- print_buffer_pos_byte = 0; \
- } \
- if (EQ (printcharfun, Qt) && ! noninteractive) \
- setup_echo_area_for_printing (multibyte);
-
-#define PRINTFINISH \
- if (NILP (printcharfun)) \
- { \
- if (print_buffer_pos != print_buffer_pos_byte \
- && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
- { \
- USE_SAFE_ALLOCA; \
- unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1); \
- copy_text ((unsigned char *) print_buffer, temp, \
- print_buffer_pos_byte, 1, 0); \
- insert_1_both ((char *) temp, print_buffer_pos, \
- print_buffer_pos, 0, 1, 0); \
- SAFE_FREE (); \
- } \
- else \
- insert_1_both (print_buffer, print_buffer_pos, \
- print_buffer_pos_byte, 0, 1, 0); \
- signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
- } \
- if (MARKERP (original)) \
- set_marker_both (original, Qnil, PT, PT_BYTE); \
- if (old_point >= 0) \
- SET_PT_BOTH (old_point + (old_point >= start_point
\
- ? PT - start_point : 0), \
- old_point_byte + (old_point_byte >= start_point_byte \
- ? PT_BYTE - start_point_byte : 0)); \
- unbind_to (specpdl_count, Qnil); \
-
/* This is used to free the print buffer; we don't simply record xfree
since print_buffer can be reallocated during the printing. */
-
static void
print_free_buffer (void)
{
- xfree (print_buffer);
- print_buffer = NULL;
+ xfree (print_buffer.buffer);
+ print_buffer.buffer = NULL;
}
/* This is used to restore the saved contents of print_buffer
when there is a recursive call to print. */
-
static void
print_unwind (Lisp_Object saved_text)
{
- memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
+ memcpy (print_buffer.buffer, SDATA (saved_text), SCHARS (saved_text));
+}
+
+/* Lisp functions to do output using a stream must start with a call to
+ print_prepare, and end with calling print_finish.
+ Use printchar to output one character, or call strout to output a
+ block of characters. */
+
+/* State carried between print_prepare and print_finish. */
+struct print_context
+{
+ Lisp_Object printcharfun;
+ Lisp_Object old_printcharfun;
+ ptrdiff_t old_point, start_point;
+ ptrdiff_t old_point_byte, start_point_byte;
+ specpdl_ref specpdl_count;
+};
+
+static inline struct print_context
+print_prepare (Lisp_Object printcharfun)
+{
+ struct print_context pc = {
+ .old_printcharfun = printcharfun,
+ .old_point = -1,
+ .start_point = -1,
+ .old_point_byte = -1,
+ .start_point_byte = -1,
+ .specpdl_count = SPECPDL_INDEX (),
+ };
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ record_unwind_current_buffer ();
+ specbind(Qprint__unreadable_callback_buffer, Fcurrent_buffer ());
+ if (NILP (printcharfun))
+ printcharfun = Qt;
+ if (BUFFERP (printcharfun))
+ {
+ if (XBUFFER (printcharfun) != current_buffer)
+ Fset_buffer (printcharfun);
+ printcharfun = Qnil;
+ }
+ if (MARKERP (printcharfun))
+ {
+ if (! XMARKER (printcharfun)->buffer)
+ error ("Marker does not point anywhere");
+ if (XMARKER (printcharfun)->buffer != current_buffer)
+ set_buffer_internal (XMARKER (printcharfun)->buffer);
+ ptrdiff_t marker_pos = marker_position (printcharfun);
+ if (marker_pos < BEGV || marker_pos > ZV)
+ signal_error ("Marker is outside the accessible part of the buffer",
+ printcharfun);
+ pc.old_point = PT;
+ pc.old_point_byte = PT_BYTE;
+ SET_PT_BOTH (marker_pos, marker_byte_position (printcharfun));
+ pc.start_point = PT;
+ pc.start_point_byte = PT_BYTE;
+ printcharfun = Qnil;
+ }
+ if (NILP (printcharfun))
+ {
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters))
+ && ! print_escape_multibyte)
+ specbind (Qprint_escape_multibyte, Qt);
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters))
+ && ! print_escape_nonascii)
+ specbind (Qprint_escape_nonascii, Qt);
+ if (print_buffer.buffer != NULL)
+ {
+ Lisp_Object string = make_string_from_bytes (print_buffer.buffer,
+ print_buffer.pos,
+ print_buffer.pos_byte);
+ record_unwind_protect (print_unwind, string);
+ }
+ else
+ {
+ int new_size = 1000;
+ print_buffer.buffer = xmalloc (new_size);
+ print_buffer.size = new_size;
+ record_unwind_protect_void (print_free_buffer);
+ }
+ print_buffer.pos = 0;
+ print_buffer.pos_byte = 0;
+ }
+ if (EQ (printcharfun, Qt) && ! noninteractive)
+ setup_echo_area_for_printing (multibyte);
+ pc.printcharfun = printcharfun;
+ return pc;
+}
+
+static inline void
+print_finish (struct print_context *pc)
+{
+ if (NILP (pc->printcharfun))
+ {
+ if (print_buffer.pos != print_buffer.pos_byte
+ && NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ {
+ USE_SAFE_ALLOCA;
+ unsigned char *temp = SAFE_ALLOCA (print_buffer.pos + 1);
+ copy_text ((unsigned char *) print_buffer.buffer, temp,
+ print_buffer.pos_byte, 1, 0);
+ insert_1_both ((char *) temp, print_buffer.pos,
+ print_buffer.pos, 0, 1, 0);
+ SAFE_FREE ();
+ }
+ else
+ insert_1_both (print_buffer.buffer, print_buffer.pos,
+ print_buffer.pos_byte, 0, 1, 0);
+ signal_after_change (PT - print_buffer.pos, 0, print_buffer.pos);
+ }
+ if (MARKERP (pc->old_printcharfun))
+ set_marker_both (pc->old_printcharfun, Qnil, PT, PT_BYTE);
+ if (pc->old_point >= 0)
+ SET_PT_BOTH (pc->old_point
+ + (pc->old_point >= pc->start_point
+ ? PT - pc->start_point : 0),
+ pc->old_point_byte
+ + (pc->old_point_byte >= pc->start_point_byte
+ ? PT_BYTE - pc->start_point_byte : 0));
+ unbind_to (pc->specpdl_count, Qnil);
}
/* Print character CH to the stdio stream STREAM. */
@@ -293,13 +312,14 @@ printchar (unsigned int ch, Lisp_Object fun)
if (NILP (fun))
{
- ptrdiff_t incr = len - (print_buffer_size - print_buffer_pos_byte);
+ ptrdiff_t incr = len - (print_buffer.size - print_buffer.pos_byte);
if (incr > 0)
- print_buffer = xpalloc (print_buffer, &print_buffer_size,
- incr, -1, 1);
- memcpy (print_buffer + print_buffer_pos_byte, str, len);
- print_buffer_pos += 1;
- print_buffer_pos_byte += len;
+ print_buffer.buffer = xpalloc (print_buffer.buffer,
+ &print_buffer.size,
+ incr, -1, 1);
+ memcpy (print_buffer.buffer + print_buffer.pos_byte, str, len);
+ print_buffer.pos += 1;
+ print_buffer.pos_byte += len;
}
else if (noninteractive)
{
@@ -358,12 +378,13 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t
size_byte,
{
if (NILP (printcharfun))
{
- ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
+ ptrdiff_t incr = size_byte - (print_buffer.size - print_buffer.pos_byte);
if (incr > 0)
- print_buffer = xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
- memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
- print_buffer_pos += size;
- print_buffer_pos_byte += size_byte;
+ print_buffer.buffer = xpalloc (print_buffer.buffer,
+ &print_buffer.size, incr, -1, 1);
+ memcpy (print_buffer.buffer + print_buffer.pos_byte, ptr, size_byte);
+ print_buffer.pos += size;
+ print_buffer.pos_byte += size_byte;
}
else if (noninteractive && EQ (printcharfun, Qt))
{
@@ -527,14 +548,14 @@ PRINTCHARFUN defaults to the value of `standard-output'
(which see). */)
if (NILP (printcharfun))
printcharfun = Vstandard_output;
CHECK_FIXNUM (character);
- PRINTPREPARE;
- printchar (XFIXNUM (character), printcharfun);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ printchar (XFIXNUM (character), pc.printcharfun);
+ print_finish (&pc);
return character;
}
/* Print the contents of a unibyte C string STRING using PRINTCHARFUN.
- The caller should arrange to put this inside PRINTPREPARE and PRINTFINISH.
+ The caller should arrange to put this inside print_prepare and print_finish.
Do not use this on the contents of a Lisp string. */
static void
@@ -550,9 +571,9 @@ print_c_string (char const *string, Lisp_Object
printcharfun)
static void
write_string (const char *data, Lisp_Object printcharfun)
{
- PRINTPREPARE;
- print_c_string (data, printcharfun);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ print_c_string (data, pc.printcharfun);
+ print_finish (&pc);
}
@@ -605,21 +626,21 @@ If PRINTCHARFUN is omitted or nil, the value of
`standard-output' is used. */)
if (NILP (printcharfun))
printcharfun = Vstandard_output;
- PRINTPREPARE;
+ struct print_context pc = print_prepare (printcharfun);
if (NILP (ensure))
val = Qt;
/* Difficult to check if at line beginning so abort. */
- else if (FUNCTIONP (printcharfun))
- signal_error ("Unsupported function argument", printcharfun);
- else if (noninteractive && !NILP (printcharfun))
+ else if (FUNCTIONP (pc.printcharfun))
+ signal_error ("Unsupported function argument", pc.printcharfun);
+ else if (noninteractive && !NILP (pc.printcharfun))
val = printchar_stdout_last == 10 ? Qnil : Qt;
else
val = NILP (Fbolp ()) ? Qt : Qnil;
if (!NILP (val))
- printchar ('\n', printcharfun);
- PRINTFINISH;
+ printchar ('\n', pc.printcharfun);
+ print_finish (&pc);
return val;
}
@@ -750,9 +771,9 @@ means "use default values for all the print-related
settings". */)
if (!NILP (overrides))
print_bind_overrides (overrides);
- PRINTPREPARE;
- print (object, printcharfun, 1);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ print (object, pc.printcharfun, 1);
+ print_finish (&pc);
return unbind_to (count, object);
}
@@ -787,11 +808,10 @@ A printed representation of an object is text which
describes that object. */)
No need for specbind, since errors deactivate the mark. */
Lisp_Object save_deactivate_mark = Vdeactivate_mark;
- Lisp_Object printcharfun = Vprin1_to_string_buffer;
- PRINTPREPARE;
- print (object, printcharfun, NILP (noescape));
- /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
- PRINTFINISH;
+ struct print_context pc = print_prepare (Vprin1_to_string_buffer);
+ print (object, pc.printcharfun, NILP (noescape));
+ /* Make Vprin1_to_string_buffer be the default buffer after print_finish */
+ print_finish (&pc);
struct buffer *previous = current_buffer;
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
@@ -836,15 +856,15 @@ is used instead. */)
{
if (NILP (printcharfun))
printcharfun = Vstandard_output;
- PRINTPREPARE;
+ struct print_context pc = print_prepare (printcharfun);
if (STRINGP (object)
&& !string_intervals (object)
&& NILP (Vprint_continuous_numbering))
/* fast path for plain strings */
- print_string (object, printcharfun);
+ print_string (object, pc.printcharfun);
else
- print (object, printcharfun, 0);
- PRINTFINISH;
+ print (object, pc.printcharfun, 0);
+ print_finish (&pc);
return object;
}
@@ -875,11 +895,11 @@ is used instead. */)
{
if (NILP (printcharfun))
printcharfun = Vstandard_output;
- PRINTPREPARE;
- printchar ('\n', printcharfun);
- print (object, printcharfun, 1);
- printchar ('\n', printcharfun);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ printchar ('\n', pc.printcharfun);
+ print (object, pc.printcharfun, 1);
+ printchar ('\n', pc.printcharfun);
+ print_finish (&pc);
return object;
}
diff --git a/src/process.c b/src/process.c
index a15efa39bd..23479c0619 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1243,14 +1243,31 @@ or t (process is stopped). */)
return XPROCESS (process)->command;
}
-DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
+DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 2, 0,
doc: /* Return the name of the terminal PROCESS uses, or nil if none.
This is the terminal that the process itself reads and writes on,
-not the name of the pty that Emacs uses to talk with that terminal. */)
- (register Lisp_Object process)
+not the name of the pty that Emacs uses to talk with that terminal.
+
+If STREAM is nil, return the terminal name if any of PROCESS's
+standard streams use a terminal for communication. If STREAM is one
+of `stdin', `stdout', or `stderr', return the name of the terminal
+PROCESS uses for that stream specifically, or nil if that stream
+communicates via a pipe. */)
+ (register Lisp_Object process, Lisp_Object stream)
{
CHECK_PROCESS (process);
- return XPROCESS (process)->tty_name;
+ register struct Lisp_Process *p = XPROCESS (process);
+
+ if (NILP (stream))
+ return p->tty_name;
+ else if (EQ (stream, Qstdin))
+ return p->pty_in ? p->tty_name : Qnil;
+ else if (EQ (stream, Qstdout))
+ return p->pty_out ? p->tty_name : Qnil;
+ else if (EQ (stream, Qstderr))
+ return p->pty_out && NILP (p->stderrproc) ? p->tty_name : Qnil;
+ else
+ signal_error ("Unknown stream", stream);
}
static void
@@ -1316,6 +1333,19 @@ set_process_filter_masks (struct Lisp_Process *p)
add_process_read_fd (p->infd);
}
+static bool
+is_pty_from_symbol (Lisp_Object symbol)
+{
+ if (EQ (symbol, Qpty))
+ return true;
+ else if (EQ (symbol, Qpipe))
+ return false;
+ else if (NILP (symbol))
+ return !NILP (Vprocess_connection_type);
+ else
+ report_file_error ("Unknown connection type", symbol);
+}
+
DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
2, 2, 0,
doc: /* Give PROCESS the filter function FILTER; nil means default.
@@ -1741,15 +1771,18 @@ signals to stop and continue a process.
:connection-type TYPE -- TYPE is control type of device used to
communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
to use a pty, or nil to use the default specified through
-`process-connection-type'.
+`process-connection-type'. If TYPE is a cons (INPUT . OUTPUT), then
+INPUT will be used for standard input and OUTPUT for standard output
+(and standard error if `:stderr' is nil).
:filter FILTER -- Install FILTER as the process filter.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
:stderr STDERR -- STDERR is either a buffer or a pipe process attached
-to the standard error of subprocess. Specifying this implies
-`:connection-type' is set to `pipe'. If STDERR is nil, standard error
+to the standard error of subprocess. When specifying this, the
+subprocess's standard error will always communicate via a pipe, no
+matter the value of `:connection-type'. If STDERR is nil, standard error
is mixed with standard output and sent to BUFFER or FILTER. (Note
that specifying :stderr will create a new, separate (but associated)
process, with its own filter and sentinel. See
@@ -1845,22 +1878,20 @@ usage: (make-process &rest ARGS) */)
CHECK_TYPE (NILP (tem), Qnull, tem);
tem = plist_get (contact, QCconnection_type);
- if (EQ (tem, Qpty))
- XPROCESS (proc)->pty_flag = true;
- else if (EQ (tem, Qpipe))
- XPROCESS (proc)->pty_flag = false;
- else if (NILP (tem))
- XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
+ if (CONSP (tem))
+ {
+ XPROCESS (proc)->pty_in = is_pty_from_symbol (XCAR (tem));
+ XPROCESS (proc)->pty_out = is_pty_from_symbol (XCDR (tem));
+ }
else
- report_file_error ("Unknown connection type", tem);
-
- if (!NILP (stderrproc))
{
- pset_stderrproc (XPROCESS (proc), stderrproc);
-
- XPROCESS (proc)->pty_flag = false;
+ XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out =
+ is_pty_from_symbol (tem);
}
+ if (!NILP (stderrproc))
+ pset_stderrproc (XPROCESS (proc), stderrproc);
+
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
verify (GNUTLS_STAGE_EMPTY == 0);
@@ -2099,66 +2130,80 @@ static void
create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
{
struct Lisp_Process *p = XPROCESS (process);
- int inchannel, outchannel;
+ int inchannel = -1, outchannel = -1;
pid_t pid = -1;
int vfork_errno;
int forkin, forkout, forkerr = -1;
- bool pty_flag = 0;
+ bool pty_in = false, pty_out = false;
char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
+ int ptychannel = -1, pty_tty = -1;
sigset_t oldset;
/* Ensure that the SIGCHLD handler can notify
`wait_reading_process_output'. */
child_signal_init ();
- inchannel = outchannel = -1;
-
- if (p->pty_flag)
- outchannel = inchannel = allocate_pty (pty_name);
+ if (p->pty_in || p->pty_out)
+ ptychannel = allocate_pty (pty_name);
- if (inchannel >= 0)
+ if (ptychannel >= 0)
{
- p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
- forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
- if (forkin < 0)
+ pty_tty = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
+ if (pty_tty < 0)
report_file_error ("Opening pty", Qnil);
- p->open_fd[SUBPROCESS_STDIN] = forkin;
-#else
- forkin = forkout = -1;
#endif /* not USG, or USG_SUBTTY_WORKS */
- pty_flag = 1;
+ pty_in = p->pty_in;
+ pty_out = p->pty_out;
lisp_pty_name = build_string (pty_name);
}
+
+ /* Set up stdin for the child process. */
+ if (ptychannel >= 0 && p->pty_in)
+ {
+ p->open_fd[SUBPROCESS_STDIN] = forkin = pty_tty;
+ outchannel = ptychannel;
+ }
else
{
- if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
- || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+ if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0)
report_file_error ("Creating pipe", Qnil);
forkin = p->open_fd[SUBPROCESS_STDIN];
outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
+ }
+
+ /* Set up stdout for the child process. */
+ if (ptychannel >= 0 && p->pty_out)
+ {
+ forkout = pty_tty;
+ p->open_fd[READ_FROM_SUBPROCESS] = inchannel = ptychannel;
+ }
+ else
+ {
+ if (emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+ report_file_error ("Creating pipe", Qnil);
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
forkout = p->open_fd[SUBPROCESS_STDOUT];
#if defined(GNU_LINUX) && defined(F_SETPIPE_SZ)
fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
#endif
+ }
- if (!NILP (p->stderrproc))
- {
- struct Lisp_Process *pp = XPROCESS (p->stderrproc);
+ if (!NILP (p->stderrproc))
+ {
+ struct Lisp_Process *pp = XPROCESS (p->stderrproc);
- forkerr = pp->open_fd[SUBPROCESS_STDOUT];
+ forkerr = pp->open_fd[SUBPROCESS_STDOUT];
- /* Close unnecessary file descriptors. */
- close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
- close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
- }
+ /* Close unnecessary file descriptors. */
+ close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
+ close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
}
if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
@@ -2183,7 +2228,8 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
we just reopen the device (see emacs_get_tty_pgrp) as this is
more portable (see USG_SUBTTY_WORKS above). */
- p->pty_flag = pty_flag;
+ p->pty_in = pty_in;
+ p->pty_out = pty_out;
pset_status (p, Qrun);
if (!EQ (p->command, Qt)
@@ -2199,13 +2245,15 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
block_input ();
block_child_signal (&oldset);
- pty_flag = p->pty_flag;
- eassert (pty_flag == ! NILP (lisp_pty_name));
+ pty_in = p->pty_in;
+ pty_out = p->pty_out;
+ eassert ((pty_in || pty_out) == ! NILP (lisp_pty_name));
vfork_errno
= emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
SSDATA (current_dir),
- pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
+ pty_in || pty_out ? SSDATA (lisp_pty_name) : NULL,
+ pty_in, pty_out, &oldset);
eassert ((vfork_errno == 0) == (0 < pid));
@@ -2263,7 +2311,7 @@ create_pty (Lisp_Object process)
{
struct Lisp_Process *p = XPROCESS (process);
char pty_name[PTY_NAME_SIZE];
- int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
+ int pty_fd = !(p->pty_in || p->pty_out) ? -1 : allocate_pty (pty_name);
if (pty_fd >= 0)
{
@@ -2301,7 +2349,7 @@ create_pty (Lisp_Object process)
we just reopen the device (see emacs_get_tty_pgrp) as this is
more portable (see USG_SUBTTY_WORKS above). */
- p->pty_flag = 1;
+ p->pty_in = p->pty_out = true;
pset_status (p, Qrun);
setup_process_coding_systems (process);
@@ -2412,7 +2460,7 @@ usage: (make-pipe-process &rest ARGS) */)
p->kill_without_query = 1;
if (tem = plist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
- eassert (! p->pty_flag);
+ eassert (! p->pty_in && ! p->pty_out);
if (!EQ (p->command, Qt)
&& !EQ (p->filter, Qt))
@@ -3147,7 +3195,7 @@ usage: (make-serial-process &rest ARGS) */)
p->kill_without_query = 1;
if (tem = plist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
- eassert (! p->pty_flag);
+ eassert (! p->pty_in && ! p->pty_out);
if (!EQ (p->command, Qt)
&& !EQ (p->filter, Qt))
@@ -6339,7 +6387,7 @@ Otherwise it discards the output. */)
/* If the restriction isn't what it should be, set it. */
if (old_begv != BEGV || old_zv != ZV)
- Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv), Qnil);
+ Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv));
bset_read_only (current_buffer, old_read_only);
SET_PT_BOTH (opoint, opoint_byte);
@@ -6808,7 +6856,7 @@ process_send_signal (Lisp_Object process, int signo,
Lisp_Object current_group,
error ("Process %s is not active",
SDATA (p->name));
- if (!p->pty_flag)
+ if (! p->pty_in)
current_group = Qnil;
/* If we are using pgrps, get a pgrp number and make it negative. */
@@ -7177,7 +7225,7 @@ process has been transmitted to the serial port. */)
send_process (proc, "", 0, Qnil);
}
- if (XPROCESS (proc)->pty_flag)
+ if (XPROCESS (proc)->pty_in)
send_process (proc, "\004", 1, Qnil);
else if (EQ (XPROCESS (proc)->type, Qserial))
{
diff --git a/src/process.h b/src/process.h
index 392b661ce6..92baf0c4cb 100644
--- a/src/process.h
+++ b/src/process.h
@@ -156,8 +156,9 @@ struct Lisp_Process
/* True means kill silently if Emacs is exited.
This is the inverse of the `query-on-exit' flag. */
bool_bf kill_without_query : 1;
- /* True if communicating through a pty. */
- bool_bf pty_flag : 1;
+ /* True if communicating through a pty for input or output. */
+ bool_bf pty_in : 1;
+ bool_bf pty_out : 1;
/* Flag to set coding-system of the process buffer from the
coding_system used to decode process output. */
bool_bf inherit_coding_system_flag : 1;
diff --git a/src/puresize.h b/src/puresize.h
index 5516747ac2..4b746924bb 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN
#endif
#ifndef BASE_PURESIZE
-#define BASE_PURESIZE (2000000 + SYSTEM_PURESIZE_EXTRA +
SITELOAD_PURESIZE_EXTRA)
+#define BASE_PURESIZE (2750000 + SYSTEM_PURESIZE_EXTRA +
SITELOAD_PURESIZE_EXTRA)
#endif
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
diff --git a/src/sysdep.c b/src/sysdep.c
index c1545622df..efd9638b07 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -3169,7 +3169,8 @@ list_system_processes (void)
#endif /* !defined (WINDOWSNT) */
-#if defined __FreeBSD__ || defined DARWIN_OS || defined __OpenBSD__
+#if (HAVE_GETRUSAGE \
+ || defined __FreeBSD__ || defined DARWIN_OS || defined __OpenBSD__)
static Lisp_Object
make_lisp_s_us (time_t s, long us)
@@ -4276,7 +4277,7 @@ does the same thing as `current-time'. */)
usecs -= 1000000;
secs++;
}
- return make_lisp_time (make_timespec (secs, usecs * 1000));
+ return make_lisp_s_us (secs, usecs);
#else /* ! HAVE_GETRUSAGE */
#ifdef WINDOWSNT
return w32_get_internal_run_time ();
diff --git a/src/timefns.c b/src/timefns.c
index 9df50eaecc..1112f17476 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -387,9 +387,9 @@ enum { flt_radix_power_size = DBL_MANT_DIG - DBL_MIN_EXP +
1 };
equals FLT_RADIX**P. */
static Lisp_Object flt_radix_power;
-/* Convert T into an Emacs time *RESULT, truncating toward minus infinity.
- Return zero if successful, an error number otherwise. */
-static int
+/* Convert the finite number T into an Emacs time *RESULT, truncating
+ toward minus infinity. Signal an error if unsuccessful. */
+static void
decode_float_time (double t, struct lisp_time *result)
{
Lisp_Object ticks, hz;
@@ -401,6 +401,7 @@ decode_float_time (double t, struct lisp_time *result)
else
{
int scale = double_integer_scale (t);
+ eassume (scale < flt_radix_power_size);
if (scale < 0)
{
@@ -412,8 +413,6 @@ decode_float_time (double t, struct lisp_time *result)
which is typically better than signaling overflow. */
scale = 0;
}
- else if (flt_radix_power_size <= scale)
- return isnan (t) ? EDOM : EOVERFLOW;
/* Compute TICKS, HZ such that TICKS / HZ exactly equals T, where HZ is
T's frequency or 1, whichever is greater. Here, “frequency” means
@@ -431,7 +430,6 @@ decode_float_time (double t, struct lisp_time *result)
}
result->ticks = ticks;
result->hz = hz;
- return 0;
}
/* Make a 4-element timestamp (HI LO US PS) from TICKS and HZ.
@@ -705,7 +703,7 @@ enum timeform
TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
};
-/* From the valid form FORM and the time components HIGH, LOW, USEC
+/* From the non-float form FORM and the time components HIGH, LOW, USEC
and PSEC, generate the corresponding time value. If LOW is
floating point, the other components should be zero and FORM should
not be TIMEFORM_TICKS_HZ.
@@ -734,16 +732,7 @@ decode_time_components (enum timeform form,
return EINVAL;
case TIMEFORM_FLOAT:
- {
- double t = XFLOAT_DATA (low);
- if (result)
- return decode_float_time (t, result);
- else
- {
- *dresult = t;
- return 0;
- }
- }
+ eassume (false);
case TIMEFORM_NIL:
return decode_ticks_hz (timespec_ticks (current_timespec ()),
@@ -830,7 +819,16 @@ decode_lisp_time (Lisp_Object specified_time, bool
decode_secs_only,
if (NILP (specified_time))
form = TIMEFORM_NIL;
else if (FLOATP (specified_time))
- form = TIMEFORM_FLOAT;
+ {
+ double d = XFLOAT_DATA (specified_time);
+ if (!isfinite (d))
+ time_error (isnan (d) ? EDOM : EOVERFLOW);
+ if (result)
+ decode_float_time (d, result);
+ else
+ *dresult = d;
+ return TIMEFORM_FLOAT;
+ }
else if (CONSP (specified_time))
{
high = XCAR (specified_time);
@@ -878,7 +876,7 @@ decode_lisp_time (Lisp_Object specified_time, bool
decode_secs_only,
return form;
}
-/* Convert a Lisp timestamp SPECIFIED_TIME to double.
+/* Convert a non-float Lisp timestamp SPECIFIED_TIME to double.
Signal an error if unsuccessful. */
double
float_time (Lisp_Object specified_time)
@@ -1074,27 +1072,9 @@ lispint_arith (Lisp_Object a, Lisp_Object b, bool
subtract)
static Lisp_Object
time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
{
- if (FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
- {
- double da = XFLOAT_DATA (a);
- double db = float_time (b);
- return make_float (subtract ? da - db : da + db);
- }
enum timeform aform, bform;
struct lisp_time ta = lisp_time_struct (a, &aform);
-
- if (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))
- return subtract ? make_float (-XFLOAT_DATA (b)) : b;
-
- /* Subtract nil from nil correctly, and handle other eq values
- quicker while we're at it. Compare here rather than earlier, to
- handle NaNs and check formats. */
- struct lisp_time tb;
- if (BASE_EQ (a, b))
- bform = aform, tb = ta;
- else
- tb = lisp_time_struct (b, &bform);
-
+ struct lisp_time tb = lisp_time_struct (b, &bform);
Lisp_Object ticks, hz;
if (FASTER_TIMEFNS && BASE_EQ (ta.hz, tb.hz))
@@ -1201,30 +1181,32 @@ See `format-time-string' for the various forms of a
time value.
For example, nil stands for the current time. */)
(Lisp_Object a, Lisp_Object b)
{
+ /* Subtract nil from nil correctly, and handle other eq values
+ quicker while we're at it. This means (time-subtract X X) does
+ not signal an error if X is not a valid time value, but that's OK. */
+ if (BASE_EQ (a, b))
+ return timespec_to_lisp ((struct timespec) {0});
+
return time_arith (a, b, true);
}
-/* Return negative, 0, positive if a < b, a == b, a > b respectively.
- Return positive if either a or b is a NaN; this is good enough
- for the current callers. */
-static int
+/* Return negative, 0, positive if A < B, A == B, A > B respectively.
+ A and B should be Lisp time values. */
+static EMACS_INT
time_cmp (Lisp_Object a, Lisp_Object b)
{
- if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
- || (FLOATP (b) && !isfinite (XFLOAT_DATA (b))))
- {
- double da = FLOATP (a) ? XFLOAT_DATA (a) : 0;
- double db = FLOATP (b) ? XFLOAT_DATA (b) : 0;
- return da < db ? -1 : da != db;
- }
-
/* Compare nil to nil correctly, and handle other eq values quicker
- while we're at it. Compare here rather than earlier, to handle
- NaNs. This means (time-equal-p X X) does not signal an error if
- X is not a valid time value, but that's OK. */
+ while we're at it. This means (time-equal-p X X) does not signal
+ an error if X is not a valid time value, but that's OK. */
if (BASE_EQ (a, b))
return 0;
+ /* Compare (X . Z) to (Y . Z) quickly if X and Y are fixnums.
+ Do not inspect Z, as it is OK to not signal if A and B are invalid. */
+ if (FASTER_TIMEFNS && CONSP (a) && CONSP (b) && BASE_EQ (XCDR (a), XCDR (b))
+ && FIXNUMP (XCAR (a)) && FIXNUMP (XCAR (b)))
+ return XFIXNUM (XCAR (a)) - XFIXNUM (XCAR (b));
+
/* Compare (ATICKS . AZ) to (BTICKS . BHZ) by comparing
ATICKS * BHZ to BTICKS * AHZ. */
struct lisp_time ta = lisp_time_struct (a, 0);
@@ -1258,7 +1240,9 @@ DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2,
2, 0,
See `format-time-string' for the various forms of a time value. */)
(Lisp_Object a, Lisp_Object b)
{
- return time_cmp (a, b) == 0 ? Qt : Qnil;
+ /* A nil arg compares unequal to a non-nil arg. This also saves the
+ expense of current_timespec if either arg is nil. */
+ return NILP (a) == NILP (b) && time_cmp (a, b) == 0 ? Qt : Qnil;
}
@@ -1269,11 +1253,12 @@ instead of the current time. See `format-time-string'
for the various
forms of a time value.
WARNING: Since the result is floating point, it may not be exact.
-If precise time stamps are required, use either `encode-time',
+If precise time stamps are required, use either `time-convert',
or (if you need time as a string) `format-time-string'. */)
(Lisp_Object specified_time)
{
- return make_float (float_time (specified_time));
+ return (FLOATP (specified_time) ? specified_time
+ : make_float (float_time (specified_time)));
}
/* Write information into buffer S of size MAXSIZE, according to the
diff --git a/src/w32fns.c b/src/w32fns.c
index 5e42a1df6f..28d13a68d4 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -10508,6 +10508,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
0, /* x_set_override_redirect */
gui_set_no_special_glyphs,
gui_set_alpha_background,
+ 0, /* x_set_use_frame_synchronization */
};
void
diff --git a/src/xdisp.c b/src/xdisp.c
index 88a489e290..5268c359ec 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -3229,6 +3229,7 @@ init_iterator (struct it *it, struct window *w,
it->f = XFRAME (w->frame);
it->cmp_it.id = -1;
+ it->cmp_it.parent_it = it;
if (max_redisplay_ticks > 0)
update_redisplay_ticks (0, w);
@@ -3413,12 +3414,6 @@ init_iterator (struct it *it, struct window *w,
}
}
- if (current_buffer->long_line_optimizations_p)
- {
- it->narrowed_begv = get_narrowed_begv (w, window_point (w));
- it->narrowed_zv = get_narrowed_zv (w, window_point (w));
- }
-
/* If a buffer position was specified, set the iterator there,
getting overlays and face properties from that position. */
if (charpos >= BUF_BEG (current_buffer))
@@ -3478,6 +3473,10 @@ init_iterator (struct it *it, struct window *w,
&it->bidi_it);
}
+ /* This is set only when long_line_optimizations_p is non-zero
+ for the current buffer. */
+ it->narrowed_begv = 0;
+
/* Compute faces etc. */
reseat (it, it->current.pos, true);
}
@@ -3510,9 +3509,7 @@ ptrdiff_t
get_narrowed_begv (struct window *w, ptrdiff_t pos)
{
int len = get_narrowed_len (w);
- ptrdiff_t begv;
- begv = max ((pos / len - 1) * len, BEGV);
- return begv == BEGV ? 0 : begv;
+ return max ((pos / len - 1) * len, BEGV);
}
ptrdiff_t
@@ -4397,16 +4394,16 @@ handle_fontified_prop (struct it *it)
if (current_buffer->long_line_optimizations_p)
{
- ptrdiff_t begv = it->narrowed_begv ? it->narrowed_begv : BEGV;
+ ptrdiff_t begv = it->narrowed_begv;
ptrdiff_t zv = it->narrowed_zv;
ptrdiff_t charpos = IT_CHARPOS (*it);
if (charpos < begv || charpos > zv)
{
begv = get_narrowed_begv (it->w, charpos);
- if (!begv) begv = BEGV;
zv = get_narrowed_zv (it->w, charpos);
}
- Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv), Qt);
+ narrow_to_region_internal (make_fixnum (begv), make_fixnum (zv),
true);
+ specbind (Qrestrictions_locked, Qt);
}
/* Don't allow Lisp that runs from 'fontification-functions'
@@ -7416,7 +7413,7 @@ back_to_previous_visible_line_start (struct it *it)
it->continuation_lines_width = 0;
eassert (IT_CHARPOS (*it) >= BEGV);
- eassert (it->narrowed_begv > BEGV
+ eassert (it->narrowed_begv > 0 /* long-line optimizations: all bets off */
|| IT_CHARPOS (*it) == BEGV
|| FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
CHECK_IT (it);
@@ -7532,6 +7529,21 @@ reseat (struct it *it, struct text_pos pos, bool force_p)
reseat_1 (it, pos, false);
+ if (current_buffer->long_line_optimizations_p)
+ {
+ if (!it->narrowed_begv)
+ {
+ it->narrowed_begv = get_narrowed_begv (it->w, window_point (it->w));
+ it->narrowed_zv = get_narrowed_zv (it->w, window_point (it->w));
+ }
+ else if ((pos.charpos < it->narrowed_begv || pos.charpos >
it->narrowed_zv)
+ && (!redisplaying_p || it->line_wrap == TRUNCATE))
+ {
+ it->narrowed_begv = get_narrowed_begv (it->w, pos.charpos);
+ it->narrowed_zv = get_narrowed_zv (it->w, pos.charpos);
+ }
+ }
+
/* Determine where to check text properties. Avoid doing it
where possible because text property lookup is very expensive. */
if (force_p
@@ -8837,7 +8849,7 @@ get_visually_first_element (struct it *it)
SET_WITH_NARROWED_BEGV (it, bob,
string_p ? 0 :
- IT_BYTEPOS (*it) < BEGV ? obegv : BEGV,
+ IT_CHARPOS (*it) < BEGV ? obegv : BEGV,
it->narrowed_begv);
if (STRINGP (it->string))
@@ -10699,6 +10711,11 @@ move_it_vertically_backward (struct it *it, int dy)
while (nlines-- && IT_CHARPOS (*it) > pos_limit)
back_to_previous_visible_line_start (it);
+ /* Move one line more back, for the (rare) situation where we have
+ bidi-reordered continued lines, and we start from the top-most
+ screen line, which is the last in logical order. */
+ if (it->bidi_p && dy == 0)
+ back_to_previous_visible_line_start (it);
/* Reseat the iterator here. When moving backward, we don't want
reseat to skip forward over invisible text, set up the iterator
to deliver from overlay strings at the new position etc. So,
@@ -10772,7 +10789,7 @@ move_it_vertically_backward (struct it *it, int dy)
dec_both (&cp, &bp);
SET_WITH_NARROWED_BEGV (it, cp,
find_newline_no_quit (cp, bp, -1, NULL),
- it->narrowed_begv);
+ get_closer_narrowed_begv (it->w, IT_CHARPOS
(*it)));
move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS);
}
bidi_unshelve_cache (it3data, true);
@@ -10950,6 +10967,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
position. This may actually move vertically backwards,
in case of overlays, so adjust dvpos accordingly. */
dvpos += it->vpos;
+ start_charpos = IT_CHARPOS (*it);
move_it_vertically_backward (it, 0);
dvpos -= it->vpos;
@@ -11003,7 +11021,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
SAVE_IT (it2, *it, it2data);
move_it_to (it, -1, -1, -1, it->vpos + delta, MOVE_TO_VPOS);
/* Move back again if we got too far ahead. */
- if (IT_CHARPOS (*it) >= start_charpos)
+ if (it->vpos - it2.vpos > delta)
RESTORE_IT (it, &it2, it2data);
else
bidi_unshelve_cache (it2data, true);
@@ -18115,8 +18133,8 @@ run_window_scroll_functions (Lisp_Object window, struct
text_pos startp)
{
specpdl_ref count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
- run_hook_with_args_2 (Qwindow_scroll_functions, window,
- make_fixnum (CHARPOS (startp)));
+ safe_run_hooks_2
+ (Qwindow_scroll_functions, window, make_fixnum (CHARPOS (startp)));
unbind_to (count, Qnil);
SET_TEXT_POS_FROM_MARKER (startp, w->start);
/* In case the hook functions switch buffers. */
@@ -18825,6 +18843,8 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
{
/* Cursor has to be moved backward. Note that PT >=
CHARPOS (startp) because of the outer if-statement. */
+ struct glyph_row *row0 = row;
+
while (!row->mode_line_p
&& (MATRIX_ROW_START_CHARPOS (row) > PT
|| (MATRIX_ROW_START_CHARPOS (row) == PT
@@ -18839,6 +18859,23 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
--row;
}
+ /* With bidi-reordered rows we can have buffer positions
+ _decrease_ when going down by rows. If we haven't
+ found our row in the loop above, give it another try
+ now going in the other direction from the original row. */
+ if (!(MATRIX_ROW_START_CHARPOS (row) <= PT
+ && PT <= MATRIX_ROW_END_CHARPOS (row))
+ && row0->continued_p)
+ {
+ row = row0;
+ while (MATRIX_ROW_START_CHARPOS (row) > PT
+ && MATRIX_ROW_BOTTOM_Y (row) < last_y)
+ {
+ eassert (row->enabled_p);
+ ++row;
+ }
+ }
+
/* Consider the following case: Window starts at BEGV,
there is invisible, intangible text at BEGV, so that
display starts at some point START > BEGV. It can
@@ -18862,9 +18899,16 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
&& !cursor_row_p (row))
++row;
- /* If within the scroll margin, scroll. */
- if (row->y < top_scroll_margin
- && CHARPOS (startp) != BEGV)
+ /* If within the scroll margin, either the top one or
+ the bottom one, scroll. */
+ if ((row->y < top_scroll_margin
+ && CHARPOS (startp) != BEGV)
+ || MATRIX_ROW_BOTTOM_Y (row) > last_y
+ || PT > MATRIX_ROW_END_CHARPOS (row)
+ || (MATRIX_ROW_BOTTOM_Y (row) == last_y
+ && PT == MATRIX_ROW_END_CHARPOS (row)
+ && !row->ends_at_zv_p
+ && !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row)))
scroll_p = true;
}
else
@@ -19448,7 +19492,7 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
{
ptrdiff_t cur, next, found, max = 0, threshold;
threshold = XFIXNUM (Vlong_line_threshold);
- for (cur = 1; cur < Z; cur = next)
+ for (cur = BEG; cur < Z; cur = next)
{
next = find_newline1 (cur, CHAR_TO_BYTE (cur), 0, -1, 1,
&found, NULL, true);
diff --git a/src/xfns.c b/src/xfns.c
index 1ae615fad4..2845ecca6a 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -609,24 +609,24 @@ x_relative_mouse_position (struct frame *f, int *x, int
*y)
block_input ();
- XQueryPointer (FRAME_X_DISPLAY (f),
- FRAME_DISPLAY_INFO (f)->root_window,
+ x_query_pointer (FRAME_X_DISPLAY (f),
+ FRAME_DISPLAY_INFO (f)->root_window,
- /* The root window which contains the pointer. */
- &root,
+ /* The root window which contains the pointer. */
+ &root,
- /* Window pointer is on, not used */
- &dummy_window,
+ /* Window pointer is on, not used */
+ &dummy_window,
- /* The position on that root window. */
- x, y,
+ /* The position on that root window. */
+ x, y,
- /* x/y in dummy_window coordinates, not used. */
- &dummy, &dummy,
+ /* x/y in dummy_window coordinates, not used. */
+ &dummy, &dummy,
- /* Modifier keys and pointer buttons, about which
- we don't care. */
- (unsigned int *) &dummy);
+ /* Modifier keys and pointer buttons, about which
+ we don't care. */
+ (unsigned int *) &dummy);
XTranslateCoordinates (FRAME_X_DISPLAY (f),
@@ -1202,20 +1202,6 @@ x_set_background_color (struct frame *f, Lisp_Object
arg, Lisp_Object oldval)
xg_set_background_color (f, bg);
#endif
-#ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
- toolkit scroll bars. */
- {
- Lisp_Object bar;
- for (bar = FRAME_SCROLL_BARS (f);
- !NILP (bar);
- bar = XSCROLL_BAR (bar)->next)
- {
- Window window = XSCROLL_BAR (bar)->x_window;
- XSetWindowBackground (dpy, window, bg);
- }
- }
-#endif /* USE_TOOLKIT_SCROLL_BARS */
-
unblock_input ();
update_face_from_frame_parameter (f, Qbackground_color, arg);
@@ -2431,6 +2417,28 @@ x_set_alpha (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
}
}
+static void
+x_set_use_frame_synchronization (struct frame *f, Lisp_Object arg,
+ Lisp_Object oldval)
+{
+#if !defined USE_GTK && defined HAVE_XSYNC
+ struct x_display_info *dpyinfo;
+
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+
+ if (!NILP (arg) && FRAME_X_EXTENDED_COUNTER (f))
+ FRAME_X_OUTPUT (f)->use_vsync_p
+ = x_wm_supports (f, dpyinfo->Xatom_net_wm_frame_drawn);
+ else
+ FRAME_X_OUTPUT (f)->use_vsync_p = false;
+
+ store_frame_param (f, Quse_frame_synchronization,
+ FRAME_X_OUTPUT (f)->use_vsync_p ? Qt : Qnil);
+#else
+ store_frame_param (f, Quse_frame_synchronization, Qnil);
+#endif
+}
+
/* Record in frame F the specified or default value according to ALIST
of the parameter named PROP (a Lisp symbol). If no value is
@@ -5149,18 +5157,20 @@ This function is an internal primitive--use
`make-frame' instead. */)
(unsigned char *) &counters,
((STRINGP (value)
&& !strcmp (SSDATA (value), "extended")) ? 2 : 1));
-#endif
-#ifndef USE_GTK
- if (FRAME_X_EXTENDED_COUNTER (f))
- FRAME_X_OUTPUT (f)->use_vsync_p
- = x_wm_supports (f, dpyinfo->Xatom_net_wm_frame_drawn);
+#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK
+ x_sync_init_fences (f);
+#endif
#endif
}
#endif
unblock_input ();
+ /* Set whether or not frame synchronization is enabled. */
+ gui_default_parameter (f, parms, Quse_frame_synchronization, Qt,
+ NULL, NULL, RES_TYPE_BOOLEAN);
+
/* Works iff frame has been already mapped. */
gui_default_parameter (f, parms, Qskip_taskbar, Qnil,
NULL, NULL, RES_TYPE_BOOLEAN);
@@ -6813,10 +6823,10 @@ selected frame's display. */)
return Qnil;
block_input ();
- XQueryPointer (FRAME_X_DISPLAY (f),
- FRAME_DISPLAY_INFO (f)->root_window,
- &root, &dummy_window, &x, &y, &dummy, &dummy,
- (unsigned int *) &dummy);
+ x_query_pointer (FRAME_X_DISPLAY (f),
+ FRAME_DISPLAY_INFO (f)->root_window,
+ &root, &dummy_window, &x, &y, &dummy, &dummy,
+ (unsigned int *) &dummy);
unblock_input ();
return Fcons (make_fixnum (x), make_fixnum (y));
@@ -8372,8 +8382,8 @@ compute_tip_xy (struct frame *f, Lisp_Object parms,
Lisp_Object dx,
Lisp_Object frame, attributes, monitor, geometry;
block_input ();
- XQueryPointer (FRAME_X_DISPLAY (f), FRAME_DISPLAY_INFO (f)->root_window,
- &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
+ x_query_pointer (FRAME_X_DISPLAY (f), FRAME_DISPLAY_INFO
(f)->root_window,
+ &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
unblock_input ();
XSETFRAME (frame, f);
@@ -9775,6 +9785,7 @@ frame_parm_handler x_frame_parm_handlers[] =
x_set_override_redirect,
gui_set_no_special_glyphs,
x_set_alpha_background,
+ x_set_use_frame_synchronization,
x_set_shaded,
};
diff --git a/src/xmenu.c b/src/xmenu.c
index 3be0fb1876..5b8a8f77a2 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -232,6 +232,7 @@ static void
x_menu_translate_generic_event (XEvent *event)
{
struct x_display_info *dpyinfo;
+ struct xi_device_t *device;
XEvent copy;
XIDeviceEvent *xev;
@@ -265,6 +266,16 @@ x_menu_translate_generic_event (XEvent *event)
copy.xbutton.button = xev->detail;
copy.xbutton.same_screen = True;
+ device = xi_device_from_id (dpyinfo, xev->deviceid);
+
+ /* I don't know the repercussions of changing
+ device->grab on XI_ButtonPress events, so be safe and
+ only do what is necessary to prevent the grab from
+ being left invalid as XMenuActivate swallows
+ events. */
+ if (device && xev->evtype == XI_ButtonRelease)
+ device->grab &= ~(1 << xev->detail);
+
XPutBackEvent (dpyinfo->display, ©);
break;
@@ -2507,6 +2518,10 @@ pop_down_menu (void *arg)
struct pop_down_menu *data = arg;
struct frame *f = data->frame;
XMenu *menu = data->menu;
+#ifdef HAVE_XINPUT2
+ int i;
+ struct xi_device_t *device;
+#endif
block_input ();
#ifndef MSDOS
@@ -2526,6 +2541,17 @@ pop_down_menu (void *arg)
results, and it is a pain to ask which are actually held now. */
FRAME_DISPLAY_INFO (f)->grabbed = 0;
+#ifdef HAVE_XINPUT2
+ /* Likewise for XI grabs when the mouse is released on top of the
+ menu itself. */
+
+ for (i = 0; i < FRAME_DISPLAY_INFO (f)->num_devices; ++i)
+ {
+ device = &FRAME_DISPLAY_INFO (f)->devices[i];
+ device->grab = 0;
+ }
+#endif
+
#endif /* HAVE_X_WINDOWS */
unblock_input ();
diff --git a/src/xsettings.c b/src/xsettings.c
index c29a844e0a..9c60ff825a 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -964,9 +964,10 @@ read_and_apply_settings (Display_Info *dpyinfo, bool
send_event_p)
#endif
#ifndef HAVE_PGTK
-/* Check if EVENT for the display in DPYINFO is XSettings related. */
+/* Check if EVENT for the display in DPYINFO is XSettings related.
+ Return true if it is, after performing associated side effects. */
-void
+bool
xft_settings_event (Display_Info *dpyinfo, const XEvent *event)
{
bool check_window_p = false, apply_settings_p = false;
@@ -1004,6 +1005,8 @@ xft_settings_event (Display_Info *dpyinfo, const XEvent
*event)
if (apply_settings_p)
read_and_apply_settings (dpyinfo, true);
+
+ return check_window_p || apply_settings_p;
}
#endif
diff --git a/src/xsettings.h b/src/xsettings.h
index 5e5df37062..833c2b367d 100644
--- a/src/xsettings.h
+++ b/src/xsettings.h
@@ -36,7 +36,7 @@ typedef struct pgtk_display_info Display_Info;
extern void xsettings_initialize (Display_Info *);
#ifndef HAVE_PGTK
-extern void xft_settings_event (Display_Info *, const XEvent *);
+extern bool xft_settings_event (Display_Info *, const XEvent *);
#endif
extern const char *xsettings_get_system_font (void);
#ifdef USE_LUCID
diff --git a/src/xterm.c b/src/xterm.c
index d7d4cb418f..48f10269df 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -997,6 +997,7 @@ static const struct x_atom_ref x_atom_refs[] =
ATOM_REFS_INIT ("_NET_WORKAREA", Xatom_net_workarea)
ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST", Xatom_net_wm_sync_request)
ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST_COUNTER",
Xatom_net_wm_sync_request_counter)
+ ATOM_REFS_INIT ("_NET_WM_SYNC_FENCES", Xatom_net_wm_sync_fences)
ATOM_REFS_INIT ("_NET_WM_FRAME_DRAWN", Xatom_net_wm_frame_drawn)
ATOM_REFS_INIT ("_NET_WM_FRAME_TIMINGS", Xatom_net_wm_frame_timings)
ATOM_REFS_INIT ("_NET_WM_USER_TIME", Xatom_net_wm_user_time)
@@ -2837,8 +2838,8 @@ x_dnd_free_toplevels (bool display_alive)
struct x_client_list_window *last;
struct x_client_list_window *tem = x_dnd_toplevels;
ptrdiff_t n_windows, i, buffer_size;
- Window *destroy_windows;
- unsigned long *prev_masks;
+ Window *destroy_windows UNINIT;
+ unsigned long *prev_masks UNINIT;
specpdl_ref count;
Display *dpy;
struct x_display_info *dpyinfo;
@@ -2847,10 +2848,6 @@ x_dnd_free_toplevels (bool display_alive)
/* Probably called inside an IO error handler. */
return;
- /* Pacify GCC. */
- prev_masks = NULL;
- destroy_windows = NULL;
-
if (display_alive)
{
buffer_size = 1024;
@@ -2913,6 +2910,7 @@ x_dnd_free_toplevels (bool display_alive)
if (n_windows)
{
+ eassume (dpyinfo);
x_ignore_errors_for_next_request (dpyinfo);
for (i = 0; i < n_windows; ++i)
@@ -4963,15 +4961,6 @@ x_xr_ensure_picture (struct frame *f)
}
#endif
-/* Remove calls to XFlush by defining XFlush to an empty replacement.
- Calls to XFlush should be unnecessary because the X output buffer
- is flushed automatically as needed by calls to XPending,
- XNextEvent, or XWindowEvent according to the XFlush man page.
- XTread_socket calls XPending. Removing XFlush improves
- performance. */
-
-#define XFlush(DISPLAY) (void) 0
-
/***********************************************************************
Debugging
@@ -5293,15 +5282,15 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
* device->num_classes);
values = NULL;
#endif
-#ifdef HAVE_XINPUT2_2
- xi_device->touchpoints = NULL;
-#endif
xi_device->use = device->use;
+ xi_device->name = build_string (device->name);
+ xi_device->attachment = device->attachment;
+
#ifdef HAVE_XINPUT2_2
+ xi_device->touchpoints = NULL;
xi_device->direct_p = false;
#endif
- xi_device->name = build_string (device->name);
for (c = 0; c < device->num_classes; ++c)
{
@@ -5405,7 +5394,7 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
static void
x_cache_xi_devices (struct x_display_info *dpyinfo)
{
- int ndevices, actual_devices;
+ int ndevices, actual_devices, i;
XIDeviceInfo *infos;
actual_devices = 0;
@@ -5422,9 +5411,9 @@ x_cache_xi_devices (struct x_display_info *dpyinfo)
return;
}
- dpyinfo->devices = xmalloc (sizeof *dpyinfo->devices * ndevices);
+ dpyinfo->devices = xzalloc (sizeof *dpyinfo->devices * ndevices);
- for (int i = 0; i < ndevices; ++i)
+ for (i = 0; i < ndevices; ++i)
{
if (infos[i].enabled)
xi_populate_device_from_info (&dpyinfo->devices[actual_devices++],
@@ -6617,12 +6606,17 @@ x_if_event (Display *dpy, XEvent *event_return,
current_time = current_timespec ();
target = timespec_add (current_time, timeout);
+ /* Check if an event is already in the queue. If it is, avoid
+ syncing. */
+ if (XCheckIfEvent (dpy, event_return, predicate, arg))
+ return 0;
+
while (true)
{
/* Get events into the queue. */
XSync (dpy, False);
- /* Check if an event is now in the queue. */
+ /* Look for an event again. */
if (XCheckIfEvent (dpy, event_return, predicate, arg))
return 0;
@@ -6646,6 +6640,61 @@ x_if_event (Display *dpy, XEvent *event_return,
}
}
+/* Return the monotonic time corresponding to the high-resolution
+ server timestamp TIMESTAMP. Return 0 if the necessary information
+ is not available. */
+
+static uint64_t
+x_sync_get_monotonic_time (struct x_display_info *dpyinfo,
+ uint64_t timestamp)
+{
+ if (dpyinfo->server_time_monotonic_p)
+ return timestamp;
+
+ /* This means we haven't yet initialized the server time offset. */
+ if (!dpyinfo->server_time_offset)
+ return 0;
+
+ return timestamp - dpyinfo->server_time_offset;
+}
+
+/* Return the current monotonic time in the same format as a
+ high-resolution server timestamp. */
+
+static uint64_t
+x_sync_current_monotonic_time (void)
+{
+ struct timespec time;
+
+ clock_gettime (CLOCK_MONOTONIC, &time);
+ return time.tv_sec * 1000000 + time.tv_nsec / 1000;
+}
+
+/* Decode a _NET_WM_FRAME_DRAWN message and calculate the time it took
+ to draw the last frame. */
+
+static void
+x_sync_note_frame_times (struct x_display_info *dpyinfo,
+ struct frame *f, XEvent *event)
+{
+ uint64_t low, high, time;
+ struct x_output *output;
+
+ low = event->xclient.data.l[2];
+ high = event->xclient.data.l[3];
+ output = FRAME_X_OUTPUT (f);
+
+ time = x_sync_get_monotonic_time (dpyinfo, low | (high << 32));
+
+ if (time)
+ output->last_frame_time = time - output->temp_frame_time;
+
+#ifdef FRAME_DEBUG
+ fprintf (stderr, "Drawing the last frame took: %lu ms (%lu)\n",
+ output->last_frame_time / 1000, time);
+#endif
+}
+
static Bool
x_sync_is_frame_drawn_event (Display *dpy, XEvent *event,
XPointer user_data)
@@ -6689,7 +6738,12 @@ x_sync_wait_for_frame_drawn_event (struct frame *f)
fprintf (stderr, "Warning: compositing manager spent more than 1 second "
"drawing a frame. Frame synchronization has been disabled\n");
FRAME_X_OUTPUT (f)->use_vsync_p = false;
+
+ /* Also change the frame parameter to reflect the new state. */
+ store_frame_param (f, Quse_frame_synchronization, Qnil);
}
+ else
+ x_sync_note_frame_times (FRAME_DISPLAY_INFO (f), f, &event);
FRAME_X_WAITING_FOR_DRAW (f) = false;
}
@@ -6735,6 +6789,10 @@ x_sync_update_begin (struct frame *f)
/* Wait for the last frame to be drawn before drawing this one. */
x_sync_wait_for_frame_drawn_event (f);
+ /* Make a note of the time at which we started to draw this
+ frame. */
+ FRAME_X_OUTPUT (f)->temp_frame_time = x_sync_current_monotonic_time ();
+
/* Since Emacs needs a non-urgent redraw, ensure that value % 4 ==
1. Later, add 3 to create the even counter value. */
if (XSyncValueLow32 (value) % 4 == 2)
@@ -6755,6 +6813,85 @@ x_sync_update_begin (struct frame *f)
FRAME_X_COUNTER_VALUE (f));
}
+#ifdef HAVE_XSYNCTRIGGERFENCE
+
+/* Trigger the sync fence for counter VALUE immediately before a frame
+ finishes. */
+
+static void
+x_sync_trigger_fence (struct frame *f, XSyncValue value)
+{
+ uint64_t n, low, high, idx;
+
+ /* Sync fences aren't supported by the X server. */
+ if (FRAME_DISPLAY_INFO (f)->xsync_major < 3
+ || (FRAME_DISPLAY_INFO (f)->xsync_major == 3
+ && FRAME_DISPLAY_INFO (f)->xsync_minor < 1))
+ return;
+
+ low = XSyncValueLow32 (value);
+ high = XSyncValueHigh32 (value);
+
+ n = low | (high << 32);
+ idx = (n / 4) % 2;
+
+#ifdef FRAME_DEBUG
+ fprintf (stderr, "Triggering synchronization fence: %lu\n", idx);
+#endif
+
+ XSyncTriggerFence (FRAME_X_DISPLAY (f),
+ FRAME_X_OUTPUT (f)->sync_fences[idx]);
+}
+
+/* Initialize the sync fences on F. */
+
+void
+x_sync_init_fences (struct frame *f)
+{
+ struct x_output *output;
+ struct x_display_info *dpyinfo;
+
+ output = FRAME_X_OUTPUT (f);
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+
+ /* Sync fences aren't supported by the X server. */
+ if (dpyinfo->xsync_major < 3
+ || (dpyinfo->xsync_major == 3
+ && dpyinfo->xsync_minor < 1))
+ return;
+
+ output->sync_fences[0]
+ = XSyncCreateFence (FRAME_X_DISPLAY (f),
+ /* The drawable given below is only used to
+ determine the screen on which the fence is
+ created. */
+ FRAME_X_WINDOW (f),
+ False);
+ output->sync_fences[1]
+ = XSyncCreateFence (FRAME_X_DISPLAY (f),
+ FRAME_X_WINDOW (f),
+ False);
+
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ dpyinfo->Xatom_net_wm_sync_fences, XA_CARDINAL,
+ 32, PropModeReplace,
+ (unsigned char *) &output->sync_fences, 2);
+}
+
+static void
+x_sync_free_fences (struct frame *f)
+{
+ if (FRAME_X_OUTPUT (f)->sync_fences[0] != None)
+ XSyncDestroyFence (FRAME_X_DISPLAY (f),
+ FRAME_X_OUTPUT (f)->sync_fences[0]);
+
+ if (FRAME_X_OUTPUT (f)->sync_fences[1] != None)
+ XSyncDestroyFence (FRAME_X_DISPLAY (f),
+ FRAME_X_OUTPUT (f)->sync_fences[1]);
+}
+
+#endif
+
/* Tell the compositing manager that FRAME has been drawn and can be
updated. */
@@ -6787,12 +6924,15 @@ x_sync_update_finish (struct frame *f)
if (overflow)
XSyncIntToValue (&FRAME_X_COUNTER_VALUE (f), 0);
+ /* Trigger any sync fences if necessary. */
+#ifdef HAVE_XSYNCTRIGGERFENCE
+ x_sync_trigger_fence (f, FRAME_X_COUNTER_VALUE (f));
+#endif
+
XSyncSetCounter (FRAME_X_DISPLAY (f),
FRAME_X_EXTENDED_COUNTER (f),
FRAME_X_COUNTER_VALUE (f));
- /* FIXME: this leads to freezes if the compositing manager crashes
- in the meantime. */
if (FRAME_OUTPUT_DATA (f)->use_vsync_p)
FRAME_X_WAITING_FOR_DRAW (f) = true;
}
@@ -6805,6 +6945,8 @@ x_sync_handle_frame_drawn (struct x_display_info *dpyinfo,
{
if (FRAME_OUTER_WINDOW (f) == message->xclient.window)
FRAME_X_WAITING_FOR_DRAW (f) = false;
+
+ x_sync_note_frame_times (dpyinfo, f, message);
}
#endif
@@ -7388,6 +7530,9 @@ x_display_set_last_user_time (struct x_display_info
*dpyinfo, Time time,
#ifndef USE_GTK
struct frame *focus_frame;
Time old_time;
+#if defined HAVE_XSYNC
+ uint64_t monotonic_time;
+#endif
focus_frame = dpyinfo->x_focus_frame;
old_time = dpyinfo->last_user_time;
@@ -7400,6 +7545,28 @@ x_display_set_last_user_time (struct x_display_info
*dpyinfo, Time time,
if (!send_event || time > dpyinfo->last_user_time)
dpyinfo->last_user_time = time;
+#if defined HAVE_XSYNC && !defined USE_GTK
+ if (!send_event)
+ {
+ /* See if the current CLOCK_MONOTONIC time is reasonably close
+ to the X server time. */
+ monotonic_time = x_sync_current_monotonic_time ();
+
+ if (time * 1000 > monotonic_time - 500 * 1000
+ && time * 1000 < monotonic_time + 500 * 1000)
+ dpyinfo->server_time_monotonic_p = true;
+ else
+ {
+ /* Compute an offset that can be subtracted from the server
+ time to estimate the monotonic time on the X server. */
+
+ dpyinfo->server_time_monotonic_p = false;
+ dpyinfo->server_time_offset
+ = ((int64_t) time * 1000) - monotonic_time;
+ }
+ }
+#endif
+
#ifndef USE_GTK
/* Don't waste bandwidth if the time hasn't actually changed. */
if (focus_frame && old_time != dpyinfo->last_user_time)
@@ -7419,6 +7586,26 @@ x_display_set_last_user_time (struct x_display_info
*dpyinfo, Time time,
#endif
}
+#ifdef USE_GTK
+
+static void
+x_set_gtk_user_time (struct frame *f, Time time)
+{
+ GtkWidget *widget;
+ GdkWindow *window;
+
+ widget = FRAME_GTK_OUTER_WIDGET (f);
+ window = gtk_widget_get_window (widget);
+
+ /* This widget isn't realized yet. */
+ if (!window)
+ return;
+
+ gdk_x11_window_set_user_time (window, time);
+}
+
+#endif
+
/* Not needed on GTK because GTK handles reporting the user time
itself. */
@@ -9308,9 +9495,7 @@ x_composite_image (struct glyph_string *s, Pixmap dest,
{
Picture destination;
XRenderPictFormat *default_format;
- XRenderPictureAttributes attr;
- /* Pacify GCC. */
- memset (&attr, 0, sizeof attr);
+ XRenderPictureAttributes attr UNINIT;
default_format = FRAME_X_PICTURE_FORMAT (s->f);
destination = XRenderCreatePicture (display, dest,
@@ -10466,16 +10651,12 @@ x_clear_frame (struct frame *f)
mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
block_input ();
-
font_drop_xrender_surfaces (f);
x_clear_window (f);
/* We have to clear the scroll bars. If we have changed colors or
something like that, then they should be notified. */
x_scroll_bar_clear (f);
-
- XFlush (FRAME_X_DISPLAY (f));
-
unblock_input ();
}
@@ -10853,7 +11034,6 @@ x_scroll_run (struct window *w, struct run *run)
view->clip_bottom -
view->clip_top);
}
xwidget_expose (view);
- XFlush (dpy);
}
}
}
@@ -12280,12 +12460,465 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time
time, Atom xaction,
action = Qnil;
unblock_input ();
- return unbind_to (base, action);
+ return unbind_to (base, action);
+ }
+
+ return unbind_to (base, Qnil);
+}
+
+#ifdef HAVE_XINPUT2
+
+/* Since the input extension assigns a keyboard focus to each master
+ device, there is no longer a 1:1 correspondence between the
+ selected frame and the focus frame immediately after the keyboard
+ focus is switched to a given frame. This situation is handled by
+ keeping track of each master device's focus frame, the time of the
+ last interaction with that frame, and always keeping the focus on
+ the most recently selected frame. We also use the pointer of the
+ device that is keeping the current frame focused in functions like
+ `mouse-position'. */
+
+static void
+xi_handle_focus_change (struct x_display_info *dpyinfo)
+{
+ struct input_event ie;
+ struct frame *focus, *new;
+ struct xi_device_t *device, *source = NULL;
+ ptrdiff_t i;
+ Time time;
+#ifdef USE_GTK
+ struct x_output *output;
+ GtkWidget *widget;
+#endif
+
+ focus = dpyinfo->x_focus_frame;
+ new = NULL;
+ time = 0;
+
+ dpyinfo->client_pointer_device = -1;
+
+ for (i = 0; i < dpyinfo->num_devices; ++i)
+ {
+ device = &dpyinfo->devices[i];
+
+ if (device->focus_frame
+ && device->focus_frame_time > time)
+ {
+ new = device->focus_frame;
+ time = device->focus_frame_time;
+ source = device;
+
+ /* Use this device for future calls to `mouse-position' etc.
+ If it is a keyboard, use its attached pointer. */
+
+ if (device->use == XIMasterKeyboard)
+ dpyinfo->client_pointer_device = device->attachment;
+ else
+ dpyinfo->client_pointer_device = device->device_id;
+ }
+
+ if (device->focus_implicit_frame
+ && device->focus_implicit_time > time)
+ {
+ new = device->focus_implicit_frame;
+ time = device->focus_implicit_time;
+ source = device;
+
+ /* Use this device for future calls to `mouse-position' etc.
+ If it is a keyboard, use its attached pointer. */
+
+ if (device->use == XIMasterKeyboard)
+ dpyinfo->client_pointer_device = device->attachment;
+ else
+ dpyinfo->client_pointer_device = device->device_id;
+ }
+ }
+
+ if (new != focus && focus)
+ {
+#ifdef HAVE_X_I18N
+ if (FRAME_XIC (focus))
+ XUnsetICFocus (FRAME_XIC (focus));
+#endif
+
+#ifdef USE_GTK
+ output = FRAME_X_OUTPUT (focus);
+
+ if (x_gtk_use_native_input)
+ {
+ gtk_im_context_focus_out (output->im_context);
+ gtk_im_context_set_client_window (output->im_context,
+ NULL);
+ }
+#endif
+
+ EVENT_INIT (ie);
+ ie.kind = FOCUS_OUT_EVENT;
+ XSETFRAME (ie.frame_or_window, focus);
+
+ kbd_buffer_store_event (&ie);
+ }
+
+ if (new != focus && new)
+ {
+#ifdef HAVE_X_I18N
+ if (FRAME_XIC (new))
+ XSetICFocus (FRAME_XIC (new));
+#endif
+
+#ifdef USE_GTK
+ output = FRAME_X_OUTPUT (new);
+
+ if (x_gtk_use_native_input)
+ {
+ widget = FRAME_GTK_OUTER_WIDGET (new);
+
+ gtk_im_context_focus_in (output->im_context);
+ gtk_im_context_set_client_window (output->im_context,
+ gtk_widget_get_window (widget));
+ }
+#endif
+
+ EVENT_INIT (ie);
+ ie.kind = FOCUS_IN_EVENT;
+ ie.device = source->name;
+ XSETFRAME (ie.frame_or_window, new);
+
+ kbd_buffer_store_event (&ie);
+ }
+
+ x_new_focus_frame (dpyinfo, new);
+}
+
+static void
+xi_focus_handle_for_device (struct x_display_info *dpyinfo,
+ struct frame *mentioned_frame,
+ XIEvent *base_event)
+{
+ struct xi_device_t *device;
+ XIEnterEvent *event;
+
+ /* XILeaveEvent, XIFocusInEvent, etc are just synonyms for
+ XIEnterEvent. */
+ event = (XIEnterEvent *) base_event;
+ device = xi_device_from_id (dpyinfo, event->deviceid);
+
+ if (!device)
+ return;
+
+ switch (event->evtype)
+ {
+ case XI_FocusIn:
+ device->focus_frame = mentioned_frame;
+ device->focus_frame_time = event->time;
+ break;
+
+ case XI_FocusOut:
+ device->focus_frame = NULL;
+ break;
+
+ case XI_Enter:
+ if (!event->focus)
+ break;
+
+ if (device->use == XIMasterPointer)
+ device = xi_device_from_id (dpyinfo, device->attachment);
+
+ if (!device)
+ break;
+
+ device->focus_implicit_frame = mentioned_frame;
+ device->focus_implicit_time = event->time;
+ break;
+
+ case XI_Leave:
+ if (!event->focus)
+ break;
+
+ if (device->use == XIMasterPointer)
+ device = xi_device_from_id (dpyinfo, device->attachment);
+
+ if (!device)
+ break;
+
+ device->focus_implicit_frame = NULL;
+ break;
+ }
+
+ xi_handle_focus_change (dpyinfo);
+}
+
+static void
+xi_handle_delete_frame (struct x_display_info *dpyinfo,
+ struct frame *f)
+{
+ struct xi_device_t *device;
+ ptrdiff_t i;
+
+ for (i = 0; i < dpyinfo->num_devices; ++i)
+ {
+ device = &dpyinfo->devices[i];
+
+ if (device->focus_frame == f)
+ device->focus_frame = NULL;
+
+ if (device->focus_implicit_frame == f)
+ device->focus_implicit_frame = NULL;
+ }
+}
+
+/* Handle an interaction by DEVICE on frame F. TIME is the time of
+ the interaction; if F isn't currently the global focus frame, but
+ is the focus of DEVICE, make it the focus frame. */
+
+static void
+xi_handle_interaction (struct x_display_info *dpyinfo,
+ struct frame *f, struct xi_device_t *device,
+ Time time)
+{
+ bool change;
+
+ /* If DEVICE is a pointer, use its attached keyboard device. */
+ if (device->use == XIMasterPointer)
+ device = xi_device_from_id (dpyinfo, device->attachment);
+
+ if (!device)
+ return;
+
+ change = false;
+
+ if (device->focus_frame == f)
+ {
+ device->focus_frame_time = time;
+ change = true;
+ }
+
+ if (device->focus_implicit_frame == f)
+ {
+ device->focus_implicit_time = time;
+ change = true;
+ }
+
+ /* If F isn't currently focused, update the focus state. */
+ if (change && f != dpyinfo->x_focus_frame)
+ xi_handle_focus_change (dpyinfo);
+}
+
+#ifdef HAVE_XINPUT2_1
+
+/* Look up a scroll valuator in DEVICE by NUMBER. */
+
+static struct xi_scroll_valuator_t *
+xi_get_scroll_valuator (struct xi_device_t *device, int number)
+{
+ int i;
+
+ for (i = 0; i < device->scroll_valuator_count; ++i)
+ {
+ if (device->valuators[i].number == number)
+ return &device->valuators[i];
+ }
+
+ return NULL;
+}
+
+#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
+ XIDeviceInfo *info;
+ XIScrollClassInfo *scroll;
+ int i, ndevices;
+ struct xi_scroll_valuator_t *valuator;
+ XIValuatorClassInfo *valuator_info;
+#endif
+#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 (info)
+ {
+ device->valuators = xrealloc (device->valuators,
+ (info->num_classes
+ * sizeof *device->valuators));
+ device->scroll_valuator_count = 0;
+#ifdef HAVE_XINPUT2_2
+ device->direct_p = false;
+#endif
+
+ for (i = 0; i < info->num_classes; ++i)
+ {
+ 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;
+
+#ifdef HAVE_XINPUT2_2
+ case XITouchClass:
+ touch = (XITouchClassInfo *) info->classes[i];
+
+ if (touch->mode == XIDirectTouch)
+ device->direct_p = true;
+ break;
+#endif
+ }
+ }
+
+ /* 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];
+
+ valuator = xi_get_scroll_valuator (device,
+ valuator_info->number);
+ if (valuator)
+ {
+ valuator->invalid_p = false;
+ valuator->current_value = valuator_info->value;
+
+ /* Make sure that this is reset if the pointer moves
+ into a window of ours.
+
+ Otherwise the valuator state could be left
+ invalid if the DeviceChange event happened with
+ the pointer outside any Emacs frame. */
+ valuator->pending_enter_reset = true;
+ }
+
+ break;
+ }
+ }
+
+#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
+
+ XIFreeDeviceInfo (info);
+ }
+#endif
+}
+
+/* Remove the client-side record of every device in TO_DISABLE.
+ Called while processing XI_HierarchyChanged events. We batch up
+ multiple disabled devices because it is more efficient to disable
+ them at once. */
+
+static void
+xi_disable_devices (struct x_display_info *dpyinfo,
+ int *to_disable, int n_disabled)
+{
+ struct xi_device_t *devices;
+ int ndevices, i, j;
+#ifdef HAVE_XINPUT2_2
+ struct xi_touch_point_t *tem, *last;
+#endif
+
+ /* Don't pointlessly copy dpyinfo->devices if there are no devices
+ to disable. */
+ if (!n_disabled)
+ return;
+
+ ndevices = 0;
+ devices = xzalloc (sizeof *devices * dpyinfo->num_devices);
+
+ /* Loop through every device currently in DPYINFO, and copy it to
+ DEVICES if it is not in TO_DISABLE. Note that this function
+ should be called with input blocked, since xfree can otherwise
+ call GC, which will call mark_xterm with invalid state. */
+ for (i = 0; i < dpyinfo->num_devices; ++i)
+ {
+ for (j = 0; j < n_disabled; ++j)
+ {
+ if (to_disable[j] == dpyinfo->devices[i].device_id)
+ {
+ /* Free any scroll valuators that might be on this
+ device. */
+#ifdef HAVE_XINPUT2_1
+ xfree (dpyinfo->devices[i].valuators);
+#endif
+
+ /* Free any currently active touch points on this
+ device. */
+#ifdef HAVE_XINPUT2_2
+ tem = dpyinfo->devices[i].touchpoints;
+ while (tem)
+ {
+ last = tem;
+ tem = tem->next;
+ xfree (last);
+ }
+#endif
+
+ goto out;
+ }
+
+ devices[ndevices++] = dpyinfo->devices[i];
+
+ out:
+ continue;
+ }
}
- return unbind_to (base, Qnil);
+ /* Free the old devices array and replace it with ndevices. */
+ xfree (dpyinfo->devices);
+
+ dpyinfo->devices = devices;
+ dpyinfo->num_devices = ndevices;
}
+#endif
+
/* The focus may have changed. Figure out if it is a real focus change,
by checking both FocusIn/Out and Enter/LeaveNotify events.
@@ -12316,37 +12949,6 @@ x_detect_focus_change (struct x_display_info *dpyinfo,
struct frame *frame,
}
break;
-#ifdef HAVE_XINPUT2
- case GenericEvent:
- {
- XIEvent *xi_event = event->xcookie.data;
- XIEnterEvent *enter_or_focus = event->xcookie.data;
-
- struct frame *focus_frame = dpyinfo->x_focus_event_frame;
- int focus_state
- = focus_frame ? focus_frame->output_data.x->focus_state : 0;
-
- if (xi_event->evtype == XI_FocusIn
- || xi_event->evtype == XI_FocusOut)
- x_focus_changed ((xi_event->evtype == XI_FocusIn
- ? FocusIn : FocusOut),
- ((enter_or_focus->detail
- == XINotifyPointer)
- ? FOCUS_IMPLICIT : FOCUS_EXPLICIT),
- dpyinfo, frame, bufp);
- else if ((xi_event->evtype == XI_Enter
- || xi_event->evtype == XI_Leave)
- && (enter_or_focus->detail != XINotifyInferior)
- && enter_or_focus->focus
- && !(focus_state & FOCUS_EXPLICIT))
- x_focus_changed ((xi_event->evtype == XI_Enter
- ? FocusIn : FocusOut),
- FOCUS_IMPLICIT,
- dpyinfo, frame, bufp);
- break;
- }
-#endif
-
case FocusIn:
case FocusOut:
/* Ignore transient focus events from hotkeys, window manager
@@ -12692,6 +13294,68 @@ get_keysym_name (int keysym)
return value;
}
+/* Like XQueryPointer, but always use the right client pointer
+ device. */
+
+Bool
+x_query_pointer (Display *dpy, Window w, Window *root_return,
+ Window *child_return, int *root_x_return,
+ int *root_y_return, int *win_x_return,
+ int *win_y_return, unsigned int *mask_return)
+{
+ Bool rc;
+#ifdef HAVE_XINPUT2
+ struct x_display_info *dpyinfo;
+ bool had_errors;
+ XIModifierState modifiers;
+ XIButtonState buttons;
+ XIGroupState group; /* Unused. */
+ double root_x, root_y, win_x, win_y;
+ unsigned int state;
+#endif
+
+#ifdef HAVE_XINPUT2
+ dpyinfo = x_display_info_for_display (dpy);
+ if (dpyinfo && dpyinfo->client_pointer_device != -1)
+ {
+ /* Catch errors caused by the device going away. This is not
+ very expensive, since XIQueryPointer will sync anyway. */
+ x_catch_errors (dpy);
+ rc = XIQueryPointer (dpyinfo->display,
+ dpyinfo->client_pointer_device,
+ w, root_return, child_return,
+ &root_x, &root_y, &win_x, &win_y,
+ &buttons, &modifiers, &group);
+ had_errors = x_had_errors_p (dpy);
+ x_uncatch_errors_after_check ();
+
+ if (had_errors)
+ rc = XQueryPointer (dpyinfo->display, w, root_return,
+ child_return, root_x_return,
+ root_y_return, win_x_return,
+ win_y_return, mask_return);
+ else
+ {
+ state = 0;
+
+ xi_convert_button_state (&buttons, &state);
+ *mask_return = state | modifiers.effective;
+
+ *root_x_return = lrint (root_x);
+ *root_y_return = lrint (root_y);
+ *win_x_return = lrint (win_x);
+ *win_y_return = lrint (win_y);
+ }
+ }
+ else
+#endif
+ rc = XQueryPointer (dpy, w, root_return, child_return,
+ root_x_return, root_y_return, win_x_return,
+ win_y_return, mask_return);
+
+ return rc;
+}
+
/* Mouse clicks and mouse movement. Rah.
Formerly, we used PointerMotionHintMask (in standard_event_mask)
@@ -12958,20 +13622,20 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
dpyinfo->last_mouse_scroll_bar = NULL;
/* Figure out which root window we're on. */
- XQueryPointer (FRAME_X_DISPLAY (*fp),
- DefaultRootWindow (FRAME_X_DISPLAY (*fp)),
- /* The root window which contains the pointer. */
- &root,
- /* Trash which we can't trust if the pointer is on
- a different screen. */
- &dummy_window,
- /* The position on that root window. */
- &root_x, &root_y,
- /* More trash we can't trust. */
- &dummy, &dummy,
- /* Modifier keys and pointer buttons, about which
- we don't care. */
- (unsigned int *) &dummy);
+ x_query_pointer (FRAME_X_DISPLAY (*fp),
+ DefaultRootWindow (FRAME_X_DISPLAY (*fp)),
+ /* The root window which contains the pointer. */
+ &root,
+ /* Trash which we can't trust if the pointer is on
+ a different screen. */
+ &dummy_window,
+ /* The position on that root window. */
+ &root_x, &root_y,
+ /* More trash we can't trust. */
+ &dummy, &dummy,
+ /* Modifier keys and pointer buttons, about which
+ we don't care. */
+ (unsigned int *) &dummy);
/* Now we have a position on the root; find the innermost window
containing the pointer. */
@@ -13206,6 +13870,37 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
/* Scroll bar support. */
+#if defined HAVE_XINPUT2
+
+/* Select for input extension events used by scroll bars. This will
+ result in the corresponding core events not being generated for
+ SCROLL_BAR. */
+
+MAYBE_UNUSED static void
+xi_select_scroll_bar_events (struct x_display_info *dpyinfo,
+ Window scroll_bar)
+{
+ XIEventMask mask;
+ unsigned char *m;
+ ptrdiff_t length;
+
+ length = XIMaskLen (XI_LASTEVENT);
+ mask.mask = m = alloca (length);
+ memset (m, 0, length);
+ mask.mask_len = length;
+
+ mask.deviceid = XIAllMasterDevices;
+ XISetMask (m, XI_ButtonPress);
+ XISetMask (m, XI_ButtonRelease);
+ XISetMask (m, XI_Motion);
+ XISetMask (m, XI_Enter);
+ XISetMask (m, XI_Leave);
+
+ XISelectEvents (dpyinfo->display, scroll_bar, &mask, 1);
+}
+
+#endif
+
/* Given an X window ID and a DISPLAY, find the struct scroll_bar which
manages it.
This can be called in GC, so we have to make sure to strip off mark
@@ -13996,25 +14691,8 @@ x_create_toolkit_scroll_bar (struct frame *f, struct
scroll_bar *bar)
/* Ask for input extension button and motion events. This lets us
send the proper `wheel-up' or `wheel-down' events to Emacs. */
if (FRAME_DISPLAY_INFO (f)->supports_xi2)
- {
- XIEventMask mask;
- ptrdiff_t l = XIMaskLen (XI_LASTEVENT);
- unsigned char *m;
-
- mask.mask = m = alloca (l);
- memset (m, 0, l);
- mask.mask_len = l;
-
- mask.deviceid = XIAllMasterDevices;
- XISetMask (m, XI_ButtonPress);
- XISetMask (m, XI_ButtonRelease);
- XISetMask (m, XI_Motion);
- XISetMask (m, XI_Enter);
- XISetMask (m, XI_Leave);
-
- XISelectEvents (XtDisplay (widget), XtWindow (widget),
- &mask, 1);
- }
+ xi_select_scroll_bar_events (FRAME_DISPLAY_INFO (f),
+ XtWindow (widget));
#endif
#else /* !USE_MOTIF i.e. use Xaw */
@@ -14221,25 +14899,8 @@ x_create_horizontal_toolkit_scroll_bar (struct frame
*f, struct scroll_bar *bar)
/* Ask for input extension button and motion events. This lets us
send the proper `wheel-up' or `wheel-down' events to Emacs. */
if (FRAME_DISPLAY_INFO (f)->supports_xi2)
- {
- XIEventMask mask;
- ptrdiff_t l = XIMaskLen (XI_LASTEVENT);
- unsigned char *m;
-
- mask.mask = m = alloca (l);
- memset (m, 0, l);
- mask.mask_len = l;
-
- mask.deviceid = XIAllMasterDevices;
- XISetMask (m, XI_ButtonPress);
- XISetMask (m, XI_ButtonRelease);
- XISetMask (m, XI_Motion);
- XISetMask (m, XI_Enter);
- XISetMask (m, XI_Leave);
-
- XISelectEvents (XtDisplay (widget), XtWindow (widget),
- &mask, 1);
- }
+ xi_select_scroll_bar_events (FRAME_DISPLAY_INFO (f),
+ XtWindow (widget));
#endif
#else /* !USE_MOTIF i.e. use Xaw */
@@ -14661,24 +15322,8 @@ x_scroll_bar_create (struct window *w, int top, int
left,
/* Ask for input extension button and motion events. This lets us
send the proper `wheel-up' or `wheel-down' events to Emacs. */
if (FRAME_DISPLAY_INFO (f)->supports_xi2)
- {
- XIEventMask mask;
- ptrdiff_t l = XIMaskLen (XI_LASTEVENT);
- unsigned char *m;
-
- mask.mask = m = alloca (l);
- memset (m, 0, l);
- mask.mask_len = l;
-
- mask.deviceid = XIAllMasterDevices;
- XISetMask (m, XI_ButtonPress);
- XISetMask (m, XI_ButtonRelease);
- XISetMask (m, XI_Motion);
- XISetMask (m, XI_Enter);
- XISetMask (m, XI_Leave);
-
- XISelectEvents (FRAME_X_DISPLAY (f), window, &mask, 1);
- }
+ xi_select_scroll_bar_events (FRAME_DISPLAY_INFO (f),
+ window);
#endif
bar->x_window = window;
@@ -15563,17 +16208,17 @@ x_scroll_bar_report_motion (struct frame **fp,
Lisp_Object *bar_window,
/* Get the mouse's position relative to the scroll bar window, and
report that. */
- if (XQueryPointer (FRAME_X_DISPLAY (f), w,
+ if (x_query_pointer (FRAME_X_DISPLAY (f), w,
- /* Root, child, root x and root y. */
- &dummy_window, &dummy_window,
- &dummy_coord, &dummy_coord,
+ /* Root, child, root x and root y. */
+ &dummy_window, &dummy_window,
+ &dummy_coord, &dummy_coord,
- /* Position relative to scroll bar. */
- &win_x, &win_y,
+ /* Position relative to scroll bar. */
+ &win_x, &win_y,
- /* Mouse buttons and modifier keys. */
- &dummy_mask))
+ /* Mouse buttons and modifier keys. */
+ &dummy_mask))
{
int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (f, bar->height);
@@ -15632,17 +16277,17 @@ x_horizontal_scroll_bar_report_motion (struct frame
**fp, Lisp_Object *bar_windo
/* Get the mouse's position relative to the scroll bar window, and
report that. */
- if (XQueryPointer (FRAME_X_DISPLAY (f), w,
+ if (x_query_pointer (FRAME_X_DISPLAY (f), w,
- /* Root, child, root x and root y. */
- &dummy_window, &dummy_window,
- &dummy_coord, &dummy_coord,
+ /* Root, child, root x and root y. */
+ &dummy_window, &dummy_window,
+ &dummy_coord, &dummy_coord,
- /* Position relative to scroll bar. */
- &win_x, &win_y,
+ /* Position relative to scroll bar. */
+ &win_x, &win_y,
- /* Mouse buttons and modifier keys. */
- &dummy_mask))
+ /* Mouse buttons and modifier keys. */
+ &dummy_mask))
{
int left_range = HORIZONTAL_SCROLL_BAR_LEFT_RANGE (f, bar->width);
@@ -16501,6 +17146,29 @@ x_wait_for_cell_change (Lisp_Object cell, struct
timespec timeout)
}
}
+/* Find whether or not an undelivered MONITORS_CHANGED_EVENT is
+ already on the event queue. DPYINFO is the display any such event
+ must apply to. */
+
+static bool
+x_find_monitors_changed_event (struct x_display_info *dpyinfo)
+{
+ union buffered_input_event *event;
+
+ event = kbd_fetch_ptr;
+
+ while (event != kbd_store_ptr)
+ {
+ if (event->ie.kind == MONITORS_CHANGED_EVENT
+ && XTERMINAL (event->ie.arg) == dpyinfo->terminal)
+ return true;
+
+ event = X_NEXT_KBD_EVENT (event);
+ }
+
+ return false;
+}
+
#ifdef USE_GTK
static void
x_monitors_changed_cb (GdkScreen *gscr, gpointer user_data)
@@ -16518,6 +17186,9 @@ x_monitors_changed_cb (GdkScreen *gscr, gpointer
user_data)
if (!dpyinfo)
return;
+ if (x_find_monitors_changed_event (dpyinfo))
+ return;
+
XSETTERMINAL (terminal, dpyinfo->terminal);
current_monitors
@@ -16645,6 +17316,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
union buffered_input_event inev;
int count = 0;
int do_help = 0;
+#ifdef HAVE_XINPUT2
+ struct xi_device_t *gen_help_device;
+ Time gen_help_time;
+#endif
ptrdiff_t nbytes = 0;
struct frame *any, *f = NULL;
Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight;
@@ -16674,6 +17349,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
EVENT_INIT (inev.ie);
inev.ie.kind = NO_EVENT;
inev.ie.arg = Qnil;
+#ifdef HAVE_XINPUT2
+ gen_help_device = NULL;
+#endif
/* Ignore events coming from various extensions, such as XFIXES and
XKB. */
@@ -17172,7 +17850,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto done;
#endif
- xft_settings_event (dpyinfo, event);
+ if (xft_settings_event (dpyinfo, event))
+ goto done;
f = any;
/* We don't want to ever leak tooltip frames to Lisp code. */
@@ -17198,6 +17877,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!x_window_to_frame (dpyinfo, event->xselection.requestor))
goto OTHER;
#endif /* not USE_X_TOOLKIT and not USE_GTK */
+#ifdef HAVE_GTK3
+ /* GTK 3 apparently chokes on these events since they have no
+ associated device. (bug#56869, another bug as well that I
+ can't find) */
+ *finish = X_EVENT_DROP;
+#endif
x_handle_selection_notify (&event->xselection);
break;
@@ -17206,6 +17891,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!x_window_to_frame (dpyinfo, event->xselectionclear.window))
goto OTHER;
#endif /* not USE_X_TOOLKIT and not USE_GTK */
+#ifdef HAVE_GTK3
+ *finish = X_EVENT_DROP;
+#endif
{
const XSelectionClearEvent *eventp = &event->xselectionclear;
@@ -17232,6 +17920,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!x_window_to_frame (dpyinfo, event->xselectionrequest.owner))
goto OTHER;
#endif /* USE_X_TOOLKIT */
+#ifdef HAVE_GTK3
+ *finish = X_EVENT_DROP;
+#endif
{
const XSelectionRequestEvent *eventp = &event->xselectionrequest;
@@ -17873,6 +18564,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_display_set_last_user_time (dpyinfo, event->xkey.time,
event->xkey.send_event);
ignore_next_mouse_click_timeout = 0;
+
coding = Qlatin_1;
#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
@@ -17883,6 +18575,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = any;
+#ifdef USE_GTK
+ if (f)
+ x_set_gtk_user_time (f, event->xkey.time);
+#endif
+
/* If mouse-highlight is an integer, input clears out
mouse highlighting. */
if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight)
@@ -18462,7 +19159,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
/* Now clear dpyinfo->last_mouse_motion_frame, or
gui_redo_mouse_highlight will end up highlighting the
- last known poisition of the mouse if a tooltip frame is
+ last known position of the mouse if a tooltip frame is
later unmapped. */
if (f == dpyinfo->last_mouse_motion_frame)
@@ -18885,13 +19582,20 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (configureEvent.xconfigure.width != dpyinfo->screen_width
|| configureEvent.xconfigure.height != dpyinfo->screen_height)
{
- inev.ie.kind = MONITORS_CHANGED_EVENT;
- XSETTERMINAL (inev.ie.arg, dpyinfo->terminal);
+ /* Also avoid storing duplicate events here, since
+ Fx_display_monitor_attributes_list will return the
+ same information for both invocations of the
+ hook. */
+ if (!x_find_monitors_changed_event (dpyinfo))
+ {
+ inev.ie.kind = MONITORS_CHANGED_EVENT;
+ XSETTERMINAL (inev.ie.arg, dpyinfo->terminal);
- /* Store this event now since inev.ie.type could be set to
- MOVE_FRAME_EVENT later. */
- kbd_buffer_store_event (&inev.ie);
- inev.ie.kind = NO_EVENT;
+ /* Store this event now since inev.ie.type could be set to
+ MOVE_FRAME_EVENT later. */
+ kbd_buffer_store_event (&inev.ie);
+ inev.ie.kind = NO_EVENT;
+ }
/* Also update the position of the drag-and-drop
tooltip. */
@@ -19663,11 +20367,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
case XI_FocusIn:
{
- XIFocusInEvent *focusin = (XIFocusInEvent *) xi_event;
- struct xi_device_t *source;
+ XIFocusInEvent *focusin;
+ focusin = (XIFocusInEvent *) xi_event;
any = x_any_window_to_frame (dpyinfo, focusin->event);
- source = xi_device_from_id (dpyinfo, focusin->sourceid);
+
#ifdef USE_GTK
/* Some WMs (e.g. Mutter in Gnome Shell), don't unmap
minimized/iconified windows; thus, for those WMs we won't get
@@ -19696,24 +20400,19 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ xi_focus_handle_for_device (dpyinfo, any, xi_event);
- if (inev.ie.kind != NO_EVENT && source)
- inev.ie.device = source->name;
goto XI_OTHER;
}
case XI_FocusOut:
{
- XIFocusOutEvent *focusout = (XIFocusOutEvent *) xi_event;
- struct xi_device_t *source;
+ XIFocusOutEvent *focusout;
+ focusout = (XIFocusOutEvent *) xi_event;
any = x_any_window_to_frame (dpyinfo, focusout->event);
- source = xi_device_from_id (dpyinfo, focusout->sourceid);
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ xi_focus_handle_for_device (dpyinfo, any, xi_event);
- if (inev.ie.kind != NO_EVENT && source)
- inev.ie.device = source->name;
goto XI_OTHER;
}
@@ -19762,7 +20461,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
are an inferiors of the frame's top window, which will
get virtual events. */
if (any)
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ xi_focus_handle_for_device (dpyinfo, any, xi_event);
if (!any)
any = x_any_window_to_frame (dpyinfo, enter->event);
@@ -19902,7 +20601,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
if (any)
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ xi_focus_handle_for_device (dpyinfo, any, xi_event);
#ifndef USE_X_TOOLKIT
f = x_top_window_to_frame (dpyinfo, leave->event);
@@ -19929,7 +20628,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
/* Now clear dpyinfo->last_mouse_motion_frame, or
gui_redo_mouse_highlight will end up highlighting
- the last known poisition of the mouse if a
+ the last known position of the mouse if a
tooltip frame is later unmapped. */
if (f == dpyinfo->last_mouse_motion_frame)
@@ -20590,7 +21289,15 @@ handle_one_xevent (struct x_display_info *dpyinfo,
has changed, generate a HELP_EVENT. */
if (!NILP (help_echo_string)
|| !NILP (previous_help_echo_string))
- do_help = 1;
+ {
+ /* Also allow the focus and client pointer to be
+ adjusted accordingly, in case a help tooltip is
+ shown. */
+ gen_help_device = device;
+ gen_help_time = xev->time;
+
+ do_help = 1;
+ }
goto XI_OTHER;
}
@@ -20653,6 +21360,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#endif
+ if (f && device)
+ xi_handle_interaction (dpyinfo, f, device,
+ xev->time);
+
if (xev->evtype == XI_ButtonPress
&& x_dnd_last_seen_window != None)
{
@@ -20899,11 +21610,19 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xev->send_event);
source = xi_device_from_id (dpyinfo, xev->sourceid);
+ device = xi_device_from_id (dpyinfo, xev->deviceid);
#ifdef HAVE_XWIDGETS
xvw = xwidget_view_from_window (xev->event);
if (xvw)
{
+ /* If the user interacts with a frame that's focused
+ on another device, but not the current focus
+ frame, make it the focus frame. */
+ if (device)
+ xi_handle_interaction (dpyinfo, xvw->frame,
+ device, xev->time);
+
xwidget_button (xvw, xev->evtype == XI_ButtonPress,
lrint (xev->event_x), lrint (xev->event_y),
xev->detail, xi_convert_event_state (xev),
@@ -20923,8 +21642,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#endif
- device = xi_device_from_id (dpyinfo, xev->deviceid);
-
if (!device)
goto XI_OTHER;
@@ -20962,6 +21679,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
+ if (f)
+ {
+ /* If the user interacts with a frame that's focused
+ on another device, but not the current focus
+ frame, make it the focus frame. */
+ if (device)
+ xi_handle_interaction (dpyinfo, f, device,
+ xev->time);
+ }
+
#ifdef USE_GTK
if (!f)
{
@@ -21243,6 +21970,25 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = x_any_window_to_frame (dpyinfo, xev->event);
+ /* GTK handles TAB events in an undesirable manner, so
+ keyboard events are always dropped. But as a side
+ effect, the user time will no longer be set by GDK,
+ so do that manually. */
+#ifdef USE_GTK
+ if (f)
+ x_set_gtk_user_time (f, xev->time);
+#endif
+
+ if (f)
+ {
+ /* If the user interacts with a frame that's focused
+ on another device, but not the current focus
+ frame, make it the focus frame. */
+ if (device)
+ xi_handle_interaction (dpyinfo, f, device,
+ xev->time);
+ }
+
XKeyPressedEvent xkey;
memset (&xkey, 0, sizeof xkey);
@@ -21717,14 +22463,14 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case XI_HierarchyChanged:
{
- XIHierarchyEvent *hev = (XIHierarchyEvent *) xi_event;
+ XIHierarchyEvent *hev;
XIDeviceInfo *info;
- int i, j, ndevices, n_disabled, *disabled;
- struct xi_device_t *device, *devices;
-#ifdef HAVE_XINPUT2_2
- struct xi_touch_point_t *tem, *last;
-#endif
+ int i, ndevices, n_disabled, *disabled;
+ struct xi_device_t *device;
+ bool any_changed;
+ any_changed = false;
+ hev = (XIHierarchyEvent *) xi_event;
disabled = SAFE_ALLOCA (sizeof *disabled * hev->num_info);
n_disabled = 0;
@@ -21734,44 +22480,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
/* Handle all disabled devices now, to prevent
things happening out-of-order later. */
- if (n_disabled)
- {
- ndevices = 0;
- devices = xmalloc (sizeof *devices *
dpyinfo->num_devices);
-
- for (i = 0; i < dpyinfo->num_devices; ++i)
- {
- for (j = 0; j < n_disabled; ++j)
- {
- if (disabled[j] ==
dpyinfo->devices[i].device_id)
- {
-#ifdef HAVE_XINPUT2_1
- xfree (dpyinfo->devices[i].valuators);
-#endif
-#ifdef HAVE_XINPUT2_2
- tem = dpyinfo->devices[i].touchpoints;
- while (tem)
- {
- last = tem;
- tem = tem->next;
- xfree (last);
- }
-#endif
- goto continue_detachment;
- }
- }
-
- devices[ndevices++] = dpyinfo->devices[i];
-
- continue_detachment:
- continue;
- }
-
- xfree (dpyinfo->devices);
- dpyinfo->devices = devices;
- dpyinfo->num_devices = ndevices;
+ if (ndevices)
+ {
+ xi_disable_devices (dpyinfo, disabled, n_disabled);
n_disabled = 0;
+
+ /* This flag really just means that disabled
+ devices were handled early and should be
+ used in conjunction with n_disabled. */
+ any_changed = true;
}
x_catch_errors (dpyinfo->display);
@@ -21784,6 +22502,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
dpyinfo->devices
= xrealloc (dpyinfo->devices, (sizeof
*dpyinfo->devices
*
++dpyinfo->num_devices));
+ 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);
}
@@ -21805,7 +22525,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (info)
{
if (device && info->enabled)
- device->use = info->use;
+ {
+ device->use = info->use;
+ device->attachment = info->attachment;
+ }
else if (device)
disabled[n_disabled++] = hev->info[i].deviceid;
@@ -21814,174 +22537,37 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
- if (n_disabled)
- {
- ndevices = 0;
- devices = xmalloc (sizeof *devices * dpyinfo->num_devices);
-
- for (i = 0; i < dpyinfo->num_devices; ++i)
- {
- for (j = 0; j < n_disabled; ++j)
- {
- if (disabled[j] == dpyinfo->devices[i].device_id)
- {
-#ifdef HAVE_XINPUT2_1
- xfree (dpyinfo->devices[i].valuators);
-#endif
-#ifdef HAVE_XINPUT2_2
- tem = dpyinfo->devices[i].touchpoints;
- while (tem)
- {
- last = tem;
- tem = tem->next;
- xfree (last);
- }
-#endif
- goto break_detachment;
- }
- }
-
- devices[ndevices++] = dpyinfo->devices[i];
-
- break_detachment:
- continue;
- }
+ /* Delete all devices that were disabled by this
+ event. */
+ xi_disable_devices (dpyinfo, disabled, n_disabled);
- xfree (dpyinfo->devices);
- dpyinfo->devices = devices;
- dpyinfo->num_devices = ndevices;
- }
+ /* If the device hierarchy has been changed, recompute
+ focus. This might seem like a micro-optimization but
+ it actually keeps the focus from changing in some
+ cases where it would be undesierable. */
+ if (any_changed || n_disabled)
+ xi_handle_focus_change (dpyinfo);
goto XI_OTHER;
}
case XI_DeviceChanged:
{
- XIDeviceChangedEvent *device_changed = (XIDeviceChangedEvent *)
xi_event;
+ XIDeviceChangedEvent *device_changed;
struct xi_device_t *device;
-#ifdef HAVE_XINPUT2_2
- struct xi_touch_point_t *tem, *last;
-#endif
- int c;
-#ifdef HAVE_XINPUT2_1
- int i;
-#endif
+ device_changed = (XIDeviceChangedEvent *) xi_event;
device = xi_device_from_id (dpyinfo, device_changed->deviceid);
- if (!device)
- {
- /* An existing device might have been enabled. */
- x_cache_xi_devices (dpyinfo);
-
- /* Now try to find the device again, in case it was
- just enabled. */
- device = xi_device_from_id (dpyinfo,
device_changed->deviceid);
- }
-
- /* If it wasn't enabled, then stop handling this event. */
+ /* If the device isn't enabled, then stop handling this
+ event. A HierarchyChanged event will be sent if it
+ is enabled afterwards. */
if (!device)
goto XI_OTHER;
- /* Free data that we will regenerate from new
- information. */
-#ifdef HAVE_XINPUT2_1
- device->valuators = xrealloc (device->valuators,
- (device_changed->num_classes
- * sizeof *device->valuators));
- device->scroll_valuator_count = 0;
-#endif
-#ifdef HAVE_XINPUT2_2
- device->direct_p = false;
-#endif
-
- for (c = 0; c < device_changed->num_classes; ++c)
- {
- switch (device_changed->classes[c]->type)
- {
-#ifdef HAVE_XINPUT2_1
- case XIScrollClass:
- {
- XIScrollClassInfo *info;
-
- info = (XIScrollClassInfo *) device_changed->classes[c];
- struct xi_scroll_valuator_t *valuator;
-
- valuator =
&device->valuators[device->scroll_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;
-
- break;
- }
-#endif
-
-#ifdef HAVE_XINPUT2_2
- case XITouchClass:
- {
- XITouchClassInfo *info;
-
- info = (XITouchClassInfo *) device_changed->classes[c];
- device->direct_p = info->mode == XIDirectTouch;
- }
-#endif
- default:
- break;
- }
- }
-
-#ifdef HAVE_XINPUT2_1
- for (c = 0; c < device_changed->num_classes; ++c)
- {
- if (device_changed->classes[c]->type == XIValuatorClass)
- {
- XIValuatorClassInfo *info;
-
- info = (XIValuatorClassInfo *) device_changed->classes[c];
-
- for (i = 0; i < device->scroll_valuator_count; ++i)
- {
- if (device->valuators[i].number == info->number)
- {
- device->valuators[i].invalid_p = false;
- device->valuators[i].current_value = info->value;
-
- /* Make sure that this is reset if the
- pointer moves into a window of ours.
-
- Otherwise the valuator state could be
- left invalid if the DeviceChange
- event happened with the pointer
- outside any Emacs frame. */
- device->valuators[i].pending_enter_reset = true;
- }
- }
- }
- }
-#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;
-
- while (tem)
- {
- last = tem;
- tem = tem->next;
- xfree (last);
- }
-
- device->touchpoints = NULL;
- }
-#endif
-
+ /* Now handle the event by retrieving scroll valuators
+ and touch info. */
+ xi_handle_device_changed (dpyinfo, device, device_changed);
goto XI_OTHER;
}
@@ -22533,7 +23119,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| event->type == (dpyinfo->xrandr_event_base
+ RRNotify)))
{
- union buffered_input_event *ev;
Time timestamp;
Lisp_Object current_monitors;
XRRScreenChangeNotifyEvent *notify;
@@ -22561,13 +23146,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
else
timestamp = 0;
- ev = (kbd_store_ptr == kbd_buffer
- ? kbd_buffer + KBD_BUFFER_SIZE - 1
- : kbd_store_ptr - 1);
-
- if (kbd_store_ptr != kbd_fetch_ptr
- && ev->ie.kind == MONITORS_CHANGED_EVENT
- && XTERMINAL (ev->ie.arg) == dpyinfo->terminal)
+ if (x_find_monitors_changed_event (dpyinfo))
/* Don't store a MONITORS_CHANGED_EVENT if there is
already an undelivered event on the queue. */
goto OTHER;
@@ -22655,6 +23234,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (do_help > 0)
{
any_help_event_p = true;
+#ifdef HAVE_XINPUT2
+ if (gen_help_device)
+ xi_handle_interaction (dpyinfo, f,
+ gen_help_device,
+ gen_help_time);
+#endif
gen_help_event (help_echo_string, frame, help_echo_window,
help_echo_object, help_echo_pos);
}
@@ -23132,8 +23717,6 @@ x_draw_window_cursor (struct window *w, struct
glyph_row *glyph_row, int x,
xic_set_preeditarea (w, x, y);
#endif
}
-
- XFlush (FRAME_X_DISPLAY (f));
}
@@ -25648,6 +26231,7 @@ x_make_frame_visible (struct frame *f)
struct x_display_info *dpyinfo;
struct x_output *output;
#endif
+ bool output_flushed;
if (FRAME_PARENT_FRAME (f))
{
@@ -25738,8 +26322,6 @@ x_make_frame_visible (struct frame *f)
}
}
- XFlush (FRAME_X_DISPLAY (f));
-
/* Synchronize to ensure Emacs knows the frame is visible
before we do anything else. We do this loop with input not blocked
so that incoming events are handled. */
@@ -25758,6 +26340,10 @@ x_make_frame_visible (struct frame *f)
/* This must come after we set COUNT. */
unblock_input ();
+ /* Keep track of whether or not the output buffer was flushed, to
+ avoid any extra flushes. */
+ output_flushed = false;
+
/* We unblock here so that arriving X events are processed. */
/* Now move the window back to where it was "supposed to be".
@@ -25791,6 +26377,7 @@ x_make_frame_visible (struct frame *f)
there, and take the potential window manager hit. */
XGetGeometry (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
&rootw, &x, &y, &width, &height, &border, &depth);
+ output_flushed = true;
if (original_left != x || original_top != y)
XMoveWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
@@ -25825,7 +26412,11 @@ x_make_frame_visible (struct frame *f)
(f, build_string ("x_make_frame_visible"));
x_wait_for_event (f, MapNotify);
+ output_flushed = true;
}
+
+ if (!output_flushed)
+ x_flush (f);
}
}
@@ -26045,6 +26636,11 @@ x_free_frame_resources (struct frame *f)
block_input ();
+#ifdef HAVE_XINPUT2
+ /* Remove any record of this frame being focused. */
+ xi_handle_delete_frame (dpyinfo, f);
+#endif
+
/* If a display connection is dead, don't try sending more
commands to the X server. */
if (dpyinfo->display)
@@ -26192,7 +26788,10 @@ x_free_frame_resources (struct frame *f)
if (f->output_data.x->bottom_left_corner_cursor != 0)
XFreeCursor (FRAME_X_DISPLAY (f),
f->output_data.x->bottom_left_corner_cursor);
- XFlush (FRAME_X_DISPLAY (f));
+ /* Free sync fences. */
+#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK
+ x_sync_free_fences (f);
+#endif
}
#ifdef HAVE_GTK3
@@ -27416,6 +28015,8 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
int minor = 0;
#endif
+ dpyinfo->client_pointer_device = -1;
+
if (XQueryExtension (dpyinfo->display, "XInputExtension",
&dpyinfo->xi2_opcode, &xi_first_event,
&xi_first_error))
diff --git a/src/xterm.h b/src/xterm.h
index 2b8a2e5da4..e97f3d4c83 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -238,23 +238,54 @@ struct xi_touch_point_t
struct xi_device_t
{
+ /* The numerical ID of this device. */
int device_id;
+
#ifdef HAVE_XINPUT2_1
+ /* The number of scroll valuators in `valuators'. */
int scroll_valuator_count;
#endif
+
+ /* Whether or not the device is grabbed and its use. */
int grab, use;
+
+ /* The attached device. Only valid if USE is some kind of master
+ device. */
+ int attachment;
+
#ifdef HAVE_XINPUT2_2
+ /* Whether or not this device is a direct touch device. */
bool direct_p;
#endif
#ifdef HAVE_XINPUT2_1
+ /* An array of scroll valuators Emacs knows about. */
struct xi_scroll_valuator_t *valuators;
#endif
+
#ifdef HAVE_XINPUT2_2
+ /* An array of in-progress touchscreen events. */
struct xi_touch_point_t *touchpoints;
#endif
+ /* The name of this device. */
Lisp_Object name;
+
+ /* The time at which `focus_frame' became the keyboard focus (only
+ applies to master devices). */
+ Time focus_frame_time;
+
+ /* The frame that is currently this device's keyboard focus, or
+ NULL. */
+ struct frame *focus_frame;
+
+ /* The time at which `focus_frame' became the implicit keyboard
+ focus. */
+ Time focus_implicit_time;
+
+ /* The frame that is currently this device's implicit keyboard
+ focus, or NULL. */
+ struct frame *focus_implicit_frame;
};
#endif
@@ -482,7 +513,10 @@ struct x_display_info
/* The last frame mentioned in a FocusIn or FocusOut event. This is
separate from x_focus_frame, because whether or not LeaveNotify
events cause us to lose focus depends on whether or not we have
- received a FocusIn event for it. */
+ received a FocusIn event for it.
+
+ This field is not used when the input extension is being
+ utilized. */
struct frame *x_focus_event_frame;
/* The frame which currently has the visual highlight, and should get
@@ -614,9 +648,9 @@ struct x_display_info
Xatom_net_wm_state_shaded, Xatom_net_frame_extents,
Xatom_net_current_desktop,
Xatom_net_workarea, Xatom_net_wm_opaque_region, Xatom_net_wm_ping,
Xatom_net_wm_sync_request, Xatom_net_wm_sync_request_counter,
- Xatom_net_wm_frame_drawn, Xatom_net_wm_frame_timings,
Xatom_net_wm_user_time,
- Xatom_net_wm_user_time_window, Xatom_net_client_list_stacking,
- Xatom_net_wm_pid;
+ Xatom_net_wm_sync_fences, Xatom_net_wm_frame_drawn,
Xatom_net_wm_frame_timings,
+ Xatom_net_wm_user_time, Xatom_net_wm_user_time_window,
+ Xatom_net_client_list_stacking, Xatom_net_wm_pid;
/* XSettings atoms and windows. */
Atom Xatom_xsettings_sel, Xatom_xsettings_prop, Xatom_xsettings_mgr;
@@ -678,13 +712,27 @@ struct x_display_info
#ifdef HAVE_XINPUT2
bool supports_xi2;
+
+ /* The minor version of the input extension. (Major is always
+ 2.x.) */
int xi2_version;
+
+ /* The generic event opcode of XI2 events. */
int xi2_opcode;
+ /* The number of devices on this display known to Emacs. */
int num_devices;
+
+ /* Array of all input extension devices on this display known to
+ Emacs. */
struct xi_device_t *devices;
+ /* Pending keystroke time. */
Time pending_keystroke_time;
+
+ /* Pending keystroke source. If a core KeyPress event arrives with
+ the same timestamp as pending_keystroke_time, it will be treated
+ as originating from this device. */
int pending_keystroke_source;
#if defined USE_GTK && !defined HAVE_GTK3
@@ -694,6 +742,10 @@ struct x_display_info
input method) core key event. */
bool pending_keystroke_time_special_p;
#endif
+
+ /* The client pointer. We keep a record client-side to avoid
+ calling XISetClientPointer all the time. */
+ int client_pointer_device;
#endif
#ifdef HAVE_XKB
@@ -769,6 +821,16 @@ struct x_display_info
/* The pending drag-and-drop time for middle-click based
drag-and-drop emulation. */
Time pending_dnd_time;
+
+#if defined HAVE_XSYNC && !defined USE_GTK
+ /* Whether or not the server time is probably the same as
+ "clock_gettime (CLOCK_MONOTONIC, ...)". */
+ bool server_time_monotonic_p;
+
+ /* The time difference between the X server clock and the monotonic
+ clock. */
+ int64_t server_time_offset;
+#endif
};
#ifdef HAVE_X_I18N
@@ -1061,6 +1123,19 @@ struct x_output
/* Whether or not Emacs should wait for the compositing manager to
draw frames before starting a new frame. */
bool_bf use_vsync_p : 1;
+
+ /* The time (in microseconds) it took to draw the last frame. */
+ uint64_t last_frame_time;
+
+ /* A temporary time used to calculate that value. */
+ uint64_t temp_frame_time;
+
+#ifdef HAVE_XSYNCTRIGGERFENCE
+ /* An array of two sync fences that are triggered in order after a
+ frame completes. Not initialized if the XSync extension is too
+ old to support sync fences. */
+ XSyncFence sync_fences[2];
+#endif
#endif
#endif
@@ -1078,7 +1153,9 @@ struct x_output
/* Keep track of focus. May be EXPLICIT if we received a FocusIn for this
frame, or IMPLICIT if we received an EnterNotify.
- FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */
+ FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT.
+
+ Not used when the input extension is being utilized. */
int focus_state;
/* The offset we need to add to compensate for type A WMs. */
@@ -1500,6 +1577,9 @@ extern void x_make_frame_invisible (struct frame *);
extern void x_iconify_frame (struct frame *);
extern void x_free_frame_resources (struct frame *);
extern void x_wm_set_size_hint (struct frame *, long, bool);
+#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK
+extern void x_sync_init_fences (struct frame *);
+#endif
extern void x_delete_terminal (struct terminal *);
extern Cursor x_create_font_cursor (struct x_display_info *, int);
@@ -1541,11 +1621,14 @@ extern Lisp_Object x_cr_export_frames (Lisp_Object,
cairo_surface_type_t);
#ifdef HAVE_XRENDER
extern void x_xrender_color_from_gc_background (struct frame *, GC,
XRenderColor *, bool);
-extern void x_xr_ensure_picture (struct frame *f);
-extern void x_xr_apply_ext_clip (struct frame *f, GC gc);
-extern void x_xr_reset_ext_clip (struct frame *f);
+extern void x_xr_ensure_picture (struct frame *);
+extern void x_xr_apply_ext_clip (struct frame *, GC);
+extern void x_xr_reset_ext_clip (struct frame *);
#endif
+extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *,
+ int *, int *, int *, unsigned int *);
+
#ifdef HAVE_GTK3
extern void x_scroll_bar_configure (GdkEvent *);
#endif
diff --git a/test/lisp/net/netrc-resources/authinfo
b/test/lisp/auth-source-resources/authinfo
similarity index 100%
rename from test/lisp/net/netrc-resources/authinfo
rename to test/lisp/auth-source-resources/authinfo
diff --git a/test/lisp/net/netrc-resources/netrc-folding
b/test/lisp/auth-source-resources/netrc-folding
similarity index 100%
rename from test/lisp/net/netrc-resources/netrc-folding
rename to test/lisp/auth-source-resources/netrc-folding
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 41f8b6d8c9..a76e4fb0d2 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -27,7 +27,7 @@
;;; Code:
(require 'ert)
-(eval-when-compile (require 'ert-x))
+(require 'ert-x)
(require 'cl-lib)
(require 'auth-source)
(require 'secrets)
@@ -410,5 +410,29 @@ machine c1 port c2 user c3 password c4\n"
;; this is actually the same as `auth-source-search'.
(should (equal found expected)))))
+(ert-deftest test-netrc-credentials ()
+ (let ((data (auth-source-netrc-parse-all (ert-resource-file "authinfo"))))
+ (should data)
+ (let ((imap (seq-find (lambda (elem)
+ (equal (cdr (assoc "machine" elem))
+ "imap.example.org"))
+ data)))
+ (should (equal (cdr (assoc "login" imap)) "jrh@example.org"))
+ (should (equal (cdr (assoc "password" imap)) "*foobar*")))
+ (let ((imap (seq-find (lambda (elem)
+ (equal (cdr (assoc "machine" elem))
+ "ftp.example.org"))
+ data)))
+ (should (equal (cdr (assoc "login" imap)) "jrh"))
+ (should (equal (cdr (assoc "password" imap)) "*baz*")))))
+
+(ert-deftest test-netrc-credentials-2 ()
+ (let ((data (auth-source-netrc-parse-all
+ (ert-resource-file "netrc-folding"))))
+ (should
+ (equal data
+ '((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
+ (("machine" . "YM") ("login" . "YL") ("password" . "YP")))))))
+
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 64e59f5b9b..cd984f7ff7 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -818,7 +818,3 @@ An existing calc stack is reused, otherwise a new one is
created."
(provide 'calc-tests)
;;; calc-tests.el ends here
-
-;; Local Variables:
-;; bug-reference-url-format: "https://debbugs.gnu.org/%s";
-;; End:
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index 2885aaa914..8402c13daf 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -95,8 +95,4 @@ flow. Hook function returns alternative password."
password flow if it returns a nil value."
(comint-tests/test-password-function #'ignore))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
-
;;; comint-tests.el ends here
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el
b/test/lisp/emacs-lisp/lisp-mode-tests.el
index fd1af75ba3..d3e78aa1d7 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -330,5 +330,28 @@ Expected initialization file: `%s'\"
(faceup-clean-buffer)
(should (faceup-test-font-lock-buffer 'emacs-lisp-mode faceup)))))
+(ert-deftest test-lisp-current-defun-name ()
+ (require 'edebug)
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(defun foo ()\n'bar)\n")
+ (goto-char 5)
+ (should (equal (lisp-current-defun-name) "foo")))
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(define-flabbergast-test zot ()\n'bar)\n")
+ (goto-char 5)
+ (should (equal (lisp-current-defun-name) "zot")))
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(progn\n ;; comment\n ;; about that\n (define-key ...)\n )")
+ (goto-char 5)
+ (should (equal (lisp-current-defun-name) "progn")))
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(defblarg \"a\" 'b)")
+ (goto-char 5)
+ (should (equal (lisp-current-defun-name) "defblarg"))))
+
(provide 'lisp-mode-tests)
;;; lisp-mode-tests.el ends here
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index d7a55998c2..b903cd781b 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -638,6 +638,21 @@ but with a different end of line convention (bug#48137)."
(package-refresh-contents)
(should (equal (length package-archive-contents) 2)))))
+(ert-deftest package-test-package-installed-p ()
+ "Test package-installed-p before and after package initialization."
+ (with-package-test ()
+ ;; Verify that `package-installed-p' evaluates true for a built-in
+ ;; package, in this case `project', before package initialization.
+ (should (not package--initialized))
+ (should (package-installed-p 'project nil))
+ (should (not (package-installed-p 'imaginary-package nil)))
+
+ ;; The results don't change after package initialization.
+ (package-initialize)
+ (should package--initialized)
+ (should (package-installed-p 'project nil))
+ (should (not (package-installed-p 'imaginary-package nil)))))
+
(ert-deftest package-test-describe-package ()
"Test displaying help for a package."
diff --git a/test/lisp/emacs-lisp/seq-tests.el
b/test/lisp/emacs-lisp/seq-tests.el
index 3b22e42df2..1a27467d29 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -559,5 +559,23 @@ Evaluate BODY for each created sequence.
(should (equal (seq-split seq 3)
'("012" "345" "678" "9")))))
+(ert-deftest test-seq-uniq-list ()
+ (let ((list '(1 2 3)))
+ (should (equal (seq-uniq (append list list)) '(1 2 3))))
+ (let ((list '(1 2 3 2 1)))
+ (should (equal (seq-uniq list) '(1 2 3))))
+ (let ((list (list (substring "1")
+ (substring "2")
+ (substring "3")
+ (substring "2")
+ (substring "1"))))
+ (should (equal (seq-uniq list) '("1" "2" "3")))
+ (should (equal (seq-uniq list #'eq) '("1" "2" "3" "2" "1"))))
+ ;; Long lists have a different code path.
+ (let ((list (seq-map-indexed (lambda (_ i) i)
+ (make-list 10000 nil))))
+ (should (= (length list) 10000))
+ (should (= (length (seq-uniq (append list list))) 10000))))
+
(provide 'seq-tests)
;;; seq-tests.el ends here
diff --git a/test/lisp/emacs-lisp/syntax-tests.el
b/test/lisp/emacs-lisp/syntax-tests.el
index 53812c0c80..f266db5c70 100644
--- a/test/lisp/emacs-lisp/syntax-tests.el
+++ b/test/lisp/emacs-lisp/syntax-tests.el
@@ -60,8 +60,4 @@
(should-error
(syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7)))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
-
;;; syntax-tests.el ends here.
diff --git a/test/lisp/env-tests.el b/test/lisp/env-tests.el
new file mode 100644
index 0000000000..fd3d3cb273
--- /dev/null
+++ b/test/lisp/env-tests.el
@@ -0,0 +1,40 @@
+;;; env-tests.el --- Tests for env.el -*- 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 'env)
+(require 'ert)
+
+(ert-deftest test-substitute-env-in-file-name ()
+ (should (equal (substitute-env-in-file-name "foo_${HOME}_bar")
+ (concat "foo_" (getenv "HOME") "_bar"))))
+
+(ert-deftest test-getenv-setenv ()
+ (should (equal (setenv "EMACS_ENV_EL_TEST_VAR" "foobar") "foobar"))
+ (should (equal (getenv "EMACS_ENV_EL_TEST_VAR") "foobar"))
+ (should-not (getenv "LIKELY_TO_BE_NON_EXISTENT_FOO_BAR_BAZ")))
+
+(ert-deftest test-with-environment-variables ()
+ (let ((A "TEST") (B "/foo/bar"))
+ (with-environment-variables ((A B))
+ (should (equal (getenv A) B)))))
+
+(provide 'env-tests)
+;;; env-tests.el ends here
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index cbabfcd26b..bc2cb68cd8 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -142,10 +142,10 @@ Dialog resource directories are located by expanding the
variable
(declare (indent 1))
(let* ((orig-autojoin-mode (make-symbol "orig-autojoin-mode"))
- (combind `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode))
+ (combined `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode))
,@(erc-scenarios-common--make-bindings bindings))))
- `(erc-d-t-with-cleanup (,@combind)
+ `(erc-d-t-with-cleanup (,@combined)
(ert-info ("Restore autojoin, etc., kill ERC buffers")
(dolist (buf (buffer-list))
diff --git a/test/lisp/eshell/em-pred-tests.el
b/test/lisp/eshell/em-pred-tests.el
index c8c1a6a931..0d6351ec82 100644
--- a/test/lisp/eshell/em-pred-tests.el
+++ b/test/lisp/eshell/em-pred-tests.el
@@ -75,7 +75,7 @@ The following attributes are recognized:
(`(,(and (or "links" "uid" "gid" "size") key) ,value)
(cons (intern key) (string-to-number value)))
(`(,(and (or "atime" "mtime" "ctime") key) ,value)
- (cons (intern key) (time-convert (string-to-number value))))
+ (cons (intern key) (time-convert (string-to-number value) t)))
(`(,key ,value)
(cons (intern key) value))
(_ (error "invalid format %S" i))))
diff --git a/test/lisp/eshell/esh-proc-tests.el
b/test/lisp/eshell/esh-proc-tests.el
index 7f461d1813..734bb91a6a 100644
--- a/test/lisp/eshell/esh-proc-tests.el
+++ b/test/lisp/eshell/esh-proc-tests.el
@@ -28,6 +28,15 @@
(file-name-directory (or load-file-name
default-directory))))
+(defvar esh-proc-test--detect-pty-cmd
+ (concat "sh -c '"
+ "if [ -t 0 ]; then echo stdin; fi; "
+ "if [ -t 1 ]; then echo stdout; fi; "
+ "if [ -t 2 ]; then echo stderr; fi"
+ "'"))
+
+;;; Tests:
+
(ert-deftest esh-proc-test/sigpipe-exits-process ()
"Test that a SIGPIPE is properly sent to a process if a pipe closes"
(skip-unless (and (executable-find "sh")
@@ -44,6 +53,40 @@
(eshell-wait-for-subprocess t)
(should (eq (process-list) nil))))
+(ert-deftest esh-proc-test/pipeline-connection-type/no-pipeline ()
+ "Test that all streams are PTYs when a command is not in a pipeline."
+ (skip-unless (executable-find "sh"))
+ (should (equal (eshell-test-command-result esh-proc-test--detect-pty-cmd)
+ ;; PTYs aren't supported on MS-Windows.
+ (unless (eq system-type 'windows-nt)
+ "stdin\nstdout\nstderr\n"))))
+
+(ert-deftest esh-proc-test/pipeline-connection-type/first ()
+ "Test that only stdin is a PTY when a command starts a pipeline."
+ (skip-unless (and (executable-find "sh")
+ (executable-find "cat")))
+ (should (equal (eshell-test-command-result
+ (concat esh-proc-test--detect-pty-cmd " | cat"))
+ (unless (eq system-type 'windows-nt)
+ "stdin\n"))))
+
+(ert-deftest esh-proc-test/pipeline-connection-type/middle ()
+ "Test that all streams are pipes when a command is in the middle of a
+pipeline."
+ (skip-unless (and (executable-find "sh")
+ (executable-find "cat")))
+ (should (equal (eshell-test-command-result
+ (concat "echo | " esh-proc-test--detect-pty-cmd " | cat"))
+ nil)))
+
+(ert-deftest esh-proc-test/pipeline-connection-type/last ()
+ "Test that only output streams are PTYs when a command ends a pipeline."
+ (skip-unless (executable-find "sh"))
+ (should (equal (eshell-test-command-result
+ (concat "echo | " esh-proc-test--detect-pty-cmd))
+ (unless (eq system-type 'windows-nt)
+ "stdout\nstderr\n"))))
+
(ert-deftest esh-proc-test/kill-pipeline ()
"Test that killing a pipeline of processes only emits a single
prompt. See bug#54136."
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 5c935965f7..7f30b27b00 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -93,7 +93,9 @@
(with-substitute-command-keys-test
(test "\\`C-m'" "C-m")
(test "\\`C-m'\\`C-j'" "C-mC-j")
- (test "foo\\`C-m'bar\\`C-j'baz" "fooC-mbarC-jbaz")))
+ (test "foo\\`C-m'bar\\`C-j'baz" "fooC-mbarC-jbaz")
+ (test "\\`M-x next-line'" "M-x next-line")
+ (test "\\`mouse-1'" "mouse-1")))
(ert-deftest
help-tests-substitute-command-keys/literal-key-sequence-ignore-invalid ()
"Ignore any invalid literal key sequence."
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index 343e2ae50b..d54718e297 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -132,7 +132,7 @@
(ibuffer-switch-to-saved-filter-groups "saved-filters")
(should (assoc "Elisp" (cdar ibuffer-saved-filter-groups))))
(setq ibuffer-saved-filter-groups orig-filters)
- (ibuffer-awhen (get-buffer "*Ibuffer*")
+ (when-let ((it (get-buffer "*Ibuffer*")))
(and (buffer-live-p it) (kill-buffer it))))))
diff --git a/test/lisp/net/netrc-resources/services
b/test/lisp/net/netrc-resources/services
deleted file mode 100644
index fd8a0348df..0000000000
--- a/test/lisp/net/netrc-resources/services
+++ /dev/null
@@ -1,6 +0,0 @@
-tcpmux 1/tcp # TCP port service multiplexer
-smtp 25/tcp mail
-http 80/tcp www # WorldWideWeb HTTP
-kerberos 88/tcp kerberos5 krb5 kerberos-sec # Kerberos v5
-kerberos 88/udp kerberos5 krb5 kerberos-sec # Kerberos v5
-rtmp 1/ddp # Routing Table Maintenance Protocol
diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el
deleted file mode 100644
index 8e83f405bc..0000000000
--- a/test/lisp/net/netrc-tests.el
+++ /dev/null
@@ -1,60 +0,0 @@
-;;; netrc-tests.el --- Tests for netrc.el -*- lexical-binding:t -*-
-
-;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
-
-;; Author: Stefan Kangas <stefankangas@gmail.com>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert)
-(require 'ert-x)
-(require 'netrc)
-
-(ert-deftest test-netrc-parse-services ()
- (let ((netrc-services-file (ert-resource-file "services")))
- (should (equal (netrc-parse-services)
- '(("tcpmux" 1 tcp)
- ("smtp" 25 tcp)
- ("http" 80 tcp)
- ("kerberos" 88 tcp)
- ("kerberos" 88 udp)
- ("rtmp" 1 ddp))))))
-
-(ert-deftest test-netrc-find-service-name ()
- (let ((netrc-services-file (ert-resource-file "services")))
- (should (equal (netrc-find-service-name 25) "smtp"))
- (should (equal (netrc-find-service-name 88 'udp) "kerberos"))
- (should-not (netrc-find-service-name 12345))))
-
-(ert-deftest test-netrc-credentials ()
- (let ((netrc-file (ert-resource-file "authinfo")))
- (should (equal (netrc-credentials "imap.example.org")
- '("jrh@example.org" "*foobar*")))
- (should (equal (netrc-credentials "ftp.example.org")
- '("jrh" "*baz*")))))
-
-(ert-deftest test-netrc-credentials-2 ()
- (let ((netrc-file (ert-resource-file "netrc-folding")))
- (should
- (equal (netrc-parse netrc-file)
- '((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
- (("machine" . "YM")) (("login" . "YL")) (("password" .
"YP")))))))
-
-(provide 'netrc-tests)
-
-;;; netrc-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5a8d9100e1..4dcf671f51 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2481,6 +2481,19 @@ This checks also `file-name-as-directory',
`file-name-directory',
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo")))
+ ;; Write empty string. Used for creation of temporary files.
+ ;; Since Emacs 27.1.
+ (when (fboundp 'make-empty-file)
+ (with-no-warnings
+ (should-error
+ (make-empty-file tmp-name)
+ :type 'file-already-exists)
+ (delete-file tmp-name)
+ (make-empty-file tmp-name)
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "")))))
+
;; Write partly.
(with-temp-buffer
(insert "123456789")
@@ -3219,20 +3232,21 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(goto-char (point-min))
(should
(looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
- (with-temp-buffer
- (insert-directory
- (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
- (goto-char (point-min))
- (should
- (looking-at-p
- (concat
- ;; There might be a summary line.
- "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?"
- ;; We don't know in which order ".", ".." and "foo" appear.
- (format
- "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
- (regexp-opt (directory-files tmp-name1))
- (length (directory-files tmp-name1)))))))
+ (let ((directory-files (directory-files tmp-name1)))
+ (with-temp-buffer
+ (insert-directory
+ (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
+ (goto-char (point-min))
+ (should
+ (looking-at-p
+ (concat
+ ;; There might be a summary line.
+ "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?"
+ ;; We don't know in which order ".", ".." and "foo" appear.
+ (format
+ "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
+ (regexp-opt directory-files)
+ (length directory-files)))))))
;; Check error cases.
(when (and (tramp--test-supports-set-file-modes-p)
@@ -3790,7 +3804,11 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
(when (tramp--test-emacs28-p)
(with-no-warnings
(set-file-modes tmp-name1 #o222 'nofollow)
- (should (= (file-modes tmp-name1 'nofollow) #o222)))))
+ (should (= (file-modes tmp-name1 'nofollow) #o222))))
+ ;; Setting the mode for not existing files shall fail.
+ (should-error
+ (set-file-modes tmp-name2 #o777)
+ :type 'file-missing))
;; Cleanup.
(ignore-errors (delete-file tmp-name1)))
@@ -4142,7 +4160,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(file-attributes tmp-name1))))
;; Skip the test, if the remote handler is not able to set
;; the correct time.
- (skip-unless (set-file-times tmp-name1 (seconds-to-time 1)))
+ ;; Some remote machines cannot resolve seconds. So we use a minute.
+ (skip-unless (set-file-times tmp-name1 (seconds-to-time 60)))
;; Dumb remote shells without perl(1) or stat(1) are not
;; able to return the date correctly. They say "don't know".
(unless (tramp-compat-time-equal-p
@@ -4152,7 +4171,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(should
(tramp-compat-time-equal-p
(file-attribute-modification-time (file-attributes tmp-name1))
- (seconds-to-time 1)))
+ (seconds-to-time 60)))
+ ;; Setting the time for not existing files shall fail.
+ (should-error
+ (set-file-times tmp-name2)
+ :type 'file-missing)
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))
@@ -4163,12 +4186,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; regular files, there shouldn't be a difference.
(when (tramp--test-emacs28-p)
(with-no-warnings
- (set-file-times tmp-name1 (seconds-to-time 1) 'nofollow)
+ (set-file-times tmp-name1 (seconds-to-time 60) 'nofollow)
(should
(tramp-compat-time-equal-p
(file-attribute-modification-time
(file-attributes tmp-name1))
- (seconds-to-time 1)))))))
+ (seconds-to-time 60)))))))
;; Cleanup.
(ignore-errors
@@ -7029,7 +7052,8 @@ This requires restrictions of file name syntax."
"银河系漫游指南系列"
"Автостопом по гала́ктике"
;; Use codepoints without a name. See Bug#31272.
- "bung"
+ ;; Works on some Android systems only.
+ (unless (tramp--test-adb-p) "bung")
;; Use codepoints from Supplementary Multilingual Plane (U+10000
;; to U+1FFFF).
"🌈🍒👋")
@@ -7569,7 +7593,7 @@ Since it unloads Tramp, it shall be the last test to run."
(should-not (cl--find-class 'tramp-file-name))
(mapatoms
(lambda (x)
- (and (functionp x)
+ (and (functionp x) (null (autoloadp (symbol-function x)))
(string-match-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
diff --git a/test/lisp/makesum-tests.el b/test/lisp/obsolete/makesum-tests.el
similarity index 100%
rename from test/lisp/makesum-tests.el
rename to test/lisp/obsolete/makesum-tests.el
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 6f2ad87f81..d303050fad 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -380,6 +380,162 @@ def f(x: CustomInt) -> CustomInt:
(128 . font-lock-builtin-face) (131)
(144 . font-lock-keyword-face) (150))))
+(ert-deftest python-font-lock-escape-sequence-string-newline ()
+ (python-tests-assert-faces
+ "'\\n'
+\"\\n\"
+f'\\n'
+f\"\\n\"
+u'\\n'
+u\"\\n\""
+ '((1 . font-lock-doc-face)
+ (2 . font-lock-constant-face)
+ (4 . font-lock-doc-face) (5)
+ (6 . font-lock-doc-face)
+ (7 . font-lock-constant-face)
+ (9 . font-lock-doc-face) (10)
+ (12 . font-lock-string-face)
+ (13 . font-lock-constant-face)
+ (15 . font-lock-string-face) (16)
+ (18 . font-lock-string-face)
+ (19 . font-lock-constant-face)
+ (21 . font-lock-string-face) (22)
+ (24 . font-lock-string-face)
+ (25 . font-lock-constant-face)
+ (27 . font-lock-string-face) (28)
+ (30 . font-lock-string-face)
+ (31 . font-lock-constant-face)
+ (33 . font-lock-string-face))))
+
+(ert-deftest python-font-lock-escape-sequence-multiline-string ()
+ (python-tests-assert-faces
+ (let ((escape-sequences "\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus
Sign}"))
+ (cl-loop for string-prefix in '("" "f" "rf" "fr" "r" "rb" "br" "b")
+ concat (cl-loop for quote-string in '("\"\"\"" "'''")
+ concat (concat string-prefix
+ quote-string
+ escape-sequences
+ quote-string
+ "\n"))))
+ '((1 . font-lock-doc-face)
+ (4 . font-lock-constant-face)
+ (8 . font-lock-doc-face)
+ (11 . font-lock-constant-face)
+ (13 . font-lock-doc-face)
+ (14 . font-lock-constant-face)
+ (20 . font-lock-doc-face)
+ (21 . font-lock-constant-face)
+ (31 . font-lock-doc-face)
+ (32 . font-lock-constant-face)
+ (51 . font-lock-doc-face) (54)
+ (55 . font-lock-doc-face)
+ (58 . font-lock-constant-face)
+ (62 . font-lock-doc-face)
+ (65 . font-lock-constant-face)
+ (67 . font-lock-doc-face)
+ (68 . font-lock-constant-face)
+ (74 . font-lock-doc-face)
+ (75 . font-lock-constant-face)
+ (85 . font-lock-doc-face)
+ (86 . font-lock-constant-face)
+ (105 . font-lock-doc-face) (108)
+ (110 . font-lock-string-face)
+ (113 . font-lock-constant-face)
+ (117 . font-lock-string-face)
+ (120 . font-lock-constant-face)
+ (122 . font-lock-string-face)
+ (123 . font-lock-constant-face)
+ (129 . font-lock-string-face)
+ (130 . font-lock-constant-face)
+ (140 . font-lock-string-face)
+ (141 . font-lock-constant-face)
+ (160 . font-lock-string-face) (163)
+ (165 . font-lock-string-face)
+ (168 . font-lock-constant-face)
+ (172 . font-lock-string-face)
+ (175 . font-lock-constant-face)
+ (177 . font-lock-string-face)
+ (178 . font-lock-constant-face)
+ (184 . font-lock-string-face)
+ (185 . font-lock-constant-face)
+ (195 . font-lock-string-face)
+ (196 . font-lock-constant-face)
+ (215 . font-lock-string-face) (218)
+ (221 . font-lock-string-face) (274)
+ (277 . font-lock-string-face) (330)
+ (333 . font-lock-string-face) (386)
+ (389 . font-lock-string-face) (442)
+ (444 . font-lock-string-face) (497)
+ (499 . font-lock-string-face) (552)
+ (555 . font-lock-string-face) (608)
+ (611 . font-lock-string-face) (664)
+ (667 . font-lock-string-face) (720)
+ (723 . font-lock-string-face) (776)
+ (778 . font-lock-string-face)
+ (781 . font-lock-constant-face)
+ (785 . font-lock-string-face)
+ (788 . font-lock-constant-face)
+ (790 . font-lock-string-face) (831)
+ (833 . font-lock-string-face)
+ (836 . font-lock-constant-face)
+ (840 . font-lock-string-face)
+ (843 . font-lock-constant-face)
+ (845 . font-lock-string-face) (886))))
+
+(ert-deftest python-font-lock-escape-sequence-bytes-newline ()
+ (python-tests-assert-faces
+ "b'\\n'
+b\"\\n\""
+ '((1)
+ (2 . font-lock-doc-face)
+ (3 . font-lock-constant-face)
+ (5 . font-lock-doc-face) (6)
+ (8 . font-lock-doc-face)
+ (9 . font-lock-constant-face)
+ (11 . font-lock-doc-face))))
+
+(ert-deftest python-font-lock-escape-sequence-hex-octal ()
+ (python-tests-assert-faces
+ "b'\\x12 \\777 \\1\\23'
+'\\x12 \\777 \\1\\23'"
+ '((1)
+ (2 . font-lock-doc-face)
+ (3 . font-lock-constant-face)
+ (7 . font-lock-doc-face)
+ (8 . font-lock-constant-face)
+ (12 . font-lock-doc-face)
+ (13 . font-lock-constant-face)
+ (18 . font-lock-doc-face) (19)
+ (20 . font-lock-doc-face)
+ (21 . font-lock-constant-face)
+ (25 . font-lock-doc-face)
+ (26 . font-lock-constant-face)
+ (30 . font-lock-doc-face)
+ (31 . font-lock-constant-face)
+ (36 . font-lock-doc-face))))
+
+(ert-deftest python-font-lock-escape-sequence-unicode ()
+ (python-tests-assert-faces
+ "b'\\u1234 \\U00010348 \\N{Plus-Minus Sign}'
+'\\u1234 \\U00010348 \\N{Plus-Minus Sign}'"
+ '((1)
+ (2 . font-lock-doc-face) (41)
+ (42 . font-lock-doc-face)
+ (43 . font-lock-constant-face)
+ (49 . font-lock-doc-face)
+ (50 . font-lock-constant-face)
+ (60 . font-lock-doc-face)
+ (61 . font-lock-constant-face)
+ (80 . font-lock-doc-face))))
+
+(ert-deftest python-font-lock-raw-escape-sequence ()
+ (python-tests-assert-faces
+ "rb'\\x12 \123 \\n'
+r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'"
+ '((1)
+ (3 . font-lock-doc-face) (14)
+ (16 . font-lock-doc-face))))
+
;;; Indentation
@@ -2657,6 +2813,28 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3):
(point))
(python-tests-look-at "def wwrap(f):" -1)))))
+(ert-deftest python-nav-beginning-of-block-2 ()
+ (python-tests-with-temp-buffer
+ "
+if True:
+
+ pass
+if False:
+ # comment
+ pass
+"
+ (python-tests-look-at "if True:")
+ (forward-line)
+ (should (= (save-excursion
+ (python-nav-beginning-of-block)
+ (point))
+ (python-tests-look-at "if True:" -1)))
+ (python-tests-look-at "# comment")
+ (should (= (save-excursion
+ (python-nav-beginning-of-block)
+ (point))
+ (python-tests-look-at "if False:" -1)))))
+
(ert-deftest python-nav-end-of-block-1 ()
(python-tests-with-temp-buffer
"
@@ -5976,8 +6154,4 @@ buffer with overlapping strings."
(provide 'python-tests)
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
-
;;; python-tests.el ends here
diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el
index 6f66f3fa34..99318d295d 100644
--- a/test/lisp/saveplace-tests.el
+++ b/test/lisp/saveplace-tests.el
@@ -84,7 +84,7 @@
(save-place-file
(ert-resource-file "saveplace"))
(save-place-alist nil))
- (load-save-place-alist-from-file)
+ (save-place-load-alist-from-file)
(should (equal save-place-alist
'(("/home/skangas/.emacs.d/cache/recentf" . 1306)
("/home/skangas/wip/emacs/"
diff --git a/test/lisp/textmodes/reftex-tests.el
b/test/lisp/textmodes/reftex-tests.el
index 9ef41088d1..97ff390817 100644
--- a/test/lisp/textmodes/reftex-tests.el
+++ b/test/lisp/textmodes/reftex-tests.el
@@ -190,8 +190,8 @@
(ert-deftest reftex-format-citation-test ()
"Test `reftex-format-citation'."
- (let ((entry (reftex-parse-bibtex-entry
-"@article{Foo13,
+ (let ((entry (reftex-parse-bibtex-entry "\
+@article{Foo13,
author = {Jane Roe and John Doe and Jane Q. Taxpayer},
title = {Some Article},
journal = {Some Journal},
@@ -202,6 +202,137 @@
(should (string= (reftex-format-citation entry "%l:%A:%y:%t %j %P %a")
"Foo13:Jane Roe:2013:Some Article Some Journal 1 Jane
Roe, John Doe \\& Jane Taxpayer"))))
+(ert-deftest reftex-all-used-citation-keys ()
+ "Test `reftex-all-used-citation-keys'.
+Take the cite macros provided by biblatex package as reference."
+ (ert-with-temp-directory temp-dir
+ (let ((tex-file (expand-file-name "keys.tex" temp-dir))
+ keys)
+ (with-temp-buffer
+ (insert "\
+\\documentclass{article}
+\\usepackage{biblatex}
+\\begin{document}
+
+Standard commands:
+\\cite[pre][pos]{cite:2022}
+\\Cite[pos]{Cite:2022}
+\\parencite{parencite:2022}
+\\Parencite[pre][]{Parencite:2022}
+\\footcite[][]{footcite:2022}
+\\footcitetext[pre][pos]{footcitetext:2022}
+
+Style specific commands:
+\\textcite{textcite:2022}
+\\Textcite[pos]{Textcite:2022}
+\\smartcite[pre][pos]{smartcite:2022}
+\\Smartcite[pre][]{Smartcite:2022}
+\\cite*[pre][pos]{cite*:2022}
+\\parencite*[][]{parencite*:2022}
+
+Style independent commands:
+\\autocite[pre][pos]{autocite:2022}
+\\autocite*[pos]{autocite*:2022}
+\\Autocite[pre][]{Autocite:2022}
+\\Autocite*{Autocite*:2022}
+
+Text commands:
+\\citeauthor[pre][pos]{citeauthor:2022}
+\\citeauthor*[pre][]{citeauthor*:2022}
+\\Citeauthor[pos]{Citeauthor:2022}
+\\Citeauthor*{Citeauthor*:2022}
+\\citetitle[][]{citetitle:2022}
+\\citetitle*[pre][pos]{citetitle*:2022}
+\\citeyear[pre][pos]{citeyear:2022}
+\\citeyear*[pre][pos]{citeyear*:2022}
+\\citedate[pre][pos]{citedate:2022}
+\\citedate*[pre][pos]{citedate*:2022}
+\\citeurl[pre][pos]{citeurl:2022}
+
+Special commands:
+\\nocite{nocite:2022}
+\\fullcite[pos]{fullcite:2022}
+\\footfullcite[][]{fullfootcite:2022}
+``volcite'' macros have different number of args.
+\\volcite{2}{volcite:2022}
+\\Volcite[pre]{1}{Volcite:2022}
+\\pvolcite{1}[pg]{pvolcite:2022}
+\\Pvolcite[pre]{2}[pg]{Pvolcite:2022}
+\\fvolcite[pre]{3}[pg]{fvolcite:2022}
+\\ftvolcite[pre]{3}[pg]{ftvolcite:2022}
+\\svolcite[pre]{2}[pg]{svolcite:2022}
+\\Svolcite[pre]{4}[pg]{Svolcite:2022}
+\\tvolcite[pre]{5}[pg]{tvolcite:2022}
+\\Tvolcite[pre]{2}[pg]{Tvolcite:2022}
+\\avolcite[pre]{3}[pg]{avolcite:2022}
+\\Avolcite[pre]{1}[pg]{Avolcite:2022}
+\\Notecite[pre]{Notecite:2022}
+\\pnotecite[pre]{pnotecite:2022}
+\\Pnotecite[pre]{Pnotecite:2022}
+\\fnotecite[pre]{fnotecite:2022}
+
+Natbib compatibility commands:
+\\citet{citet:2022}
+\\citet*[pre][pos]{citet*:2022}
+\\citep[pre][pos]{citep:2022}
+\\citep*[pos]{citep*:2022}
+\\citealt[pre][]{citealt:2022}
+\\citealt*[][]{citealt*:2022}
+\\citealp[pre][pos]{citealp:2022}
+\\citealp*{citealp*:2022}
+\\Citet[pre][pos]{Citet:2022}
+\\Citet*[pre][pos]{Citet*:2022}
+\\Citep[pre][pos]{Citep:2022}
+\\Citep*[pre][pos]{Citep*:2022}
+
+Test for bug#56655:
+There was a few \\% of increase in budget \\Citep*{bug:56655}.
+
+And this should be % \\cite{ignored}.
+\\end{document}")
+ (write-region (point-min) (point-max) tex-file))
+ (find-file tex-file)
+ (setq keys (reftex-all-used-citation-keys))
+ (should (equal (sort keys #'string<)
+ (sort '(;; Standard commands:
+ "cite:2022" "Cite:2022"
+ "parencite:2022" "Parencite:2022"
+ "footcite:2022" "footcitetext:2022"
+ ;; Style specific commands:
+ "textcite:2022" "Textcite:2022"
+ "smartcite:2022" "Smartcite:2022"
+ "cite*:2022" "parencite*:2022"
+ ;; Style independent commands:
+ "autocite:2022" "autocite*:2022"
+ "Autocite:2022" "Autocite*:2022"
+ ;; Text commands
+ "citeauthor:2022" "citeauthor*:2022"
+ "Citeauthor:2022" "Citeauthor*:2022"
+ "citetitle:2022" "citetitle*:2022"
+ "citeyear:2022" "citeyear*:2022"
+ "citedate:2022" "citedate*:2022"
+ "citeurl:2022"
+ ;; Special commands:
+ "nocite:2022" "fullcite:2022"
+ "fullfootcite:2022"
+ "volcite:2022" "Volcite:2022"
+ "pvolcite:2022" "Pvolcite:2022"
+ "fvolcite:2022" "ftvolcite:2022"
+ "svolcite:2022" "Svolcite:2022"
+ "tvolcite:2022" "Tvolcite:2022"
+ "avolcite:2022" "Avolcite:2022"
+ "Notecite:2022" "pnotecite:2022"
+ "Pnotecite:2022" "fnotecite:2022"
+ ;; Natbib compatibility commands:
+ "citet:2022" "citet*:2022"
+ "citep:2022" "citep*:2022"
+ "citealt:2022" "citealt*:2022"
+ "citealp:2022" "citealp*:2022"
+ "Citet:2022" "Citet*:2022"
+ "Citep:2022" "Citep*:2022"
+ "bug:56655")
+ #'string<)))
+ (kill-buffer (file-name-nondirectory tex-file)))))
;;; Autoload tests
diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el
index 8c042c0135..cfc2d93c89 100644
--- a/test/lisp/url/url-util-tests.el
+++ b/test/lisp/url/url-util-tests.el
@@ -46,6 +46,26 @@
("key2" "val2")
("key1" "val1")))))
+(ert-deftest url-unhex-string-tests ()
+ (should (equal (url-unhex-string "foo%20bar")
+ "foo bar"))
+ (should (equal (decode-coding-string (url-unhex-string "Fran%C3%A7ois")
'utf-8)
+ "François"))
+ (should (equal (url-unhex-string "%20%21%23%24%25%26%27%28%29%2A")
+ " !#$%&'()*"))
+ (should (equal (url-unhex-string "%2B%2C%2F%3A%3B%3D%3F%40%5B%5D")
+ "+,/:;=?@[]")))
+
+(ert-deftest url-hexify-string-tests ()
+ (should (equal (url-hexify-string "foo bar")
+ "foo%20bar"))
+ (should (equal (url-hexify-string "François")
+ "Fran%C3%A7ois"))
+ (should (equal (url-hexify-string " !#$%&'()*")
+ "%20%21%23%24%25%26%27%28%29%2A"))
+ (should (equal (url-hexify-string "+,/:;=?@[]")
+ "%2B%2C%2F%3A%3B%3D%3F%40%5B%5D")))
+
(ert-deftest url-domain-tests ()
(should (equal (url-domain (url-generic-parse-url "http://www.fsf.co.uk";))
"fsf.co.uk"))
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 748f1e3944..0040e5c7ba 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -195,8 +195,4 @@ Parser is called with and without `symbol-qnames'
argument.")
(should (equal (cdr test)
(xml-parse-region (point-min) (point-max))))))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
-
;;; xml-tests.el ends here
diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el
index d964fc3c1f..5a633fdc2b 100644
--- a/test/src/callint-tests.el
+++ b/test/src/callint-tests.el
@@ -52,4 +52,17 @@
(call-interactively #'ignore t))
(should (= (length command-history) history-length))))
+(defun callint-test-int-args (foo bar &optional zot)
+ (declare (interactive-args
+ (bar 10)
+ (zot 11)))
+ (interactive (list 1 1 1))
+ (+ foo bar zot))
+
+(ert-deftest test-interactive-args ()
+ (let ((history-length 1)
+ (command-history ()))
+ (should (= (call-interactively 'callint-test-int-args t) 3))
+ (should (equal command-history '((callint-test-int-args 1 10 11))))))
+
;;; callint-tests.el ends here
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index de4ddb546d..f65d575d0c 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -61,16 +61,17 @@
;; Return the contents (specified by CONTENT-TYPE; ascii, latin, or
;; binary) of a test file.
(defun coding-tests-file-contents (content-type)
- (let* ((ascii "ABCDEFGHIJKLMNOPQRSTUVWXYZ\n")
- (latin (concat ascii "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ\n"))
- (binary (string-to-multibyte
- (concat (string-as-unibyte latin)
- (unibyte-string #xC0 #xC1 ?\n)))))
- (cond ((eq content-type 'ascii) ascii)
- ((eq content-type 'latin) latin)
- ((eq content-type 'binary) binary)
- (t
- (error "Invalid file content type: %s" content-type)))))
+ (with-suppressed-warnings ((obsolete string-as-unibyte))
+ (let* ((ascii "ABCDEFGHIJKLMNOPQRSTUVWXYZ\n")
+ (latin (concat ascii "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ\n"))
+ (binary (string-to-multibyte
+ (concat (string-as-unibyte latin)
+ (unibyte-string #xC0 #xC1 ?\n)))))
+ (cond ((eq content-type 'ascii) ascii)
+ ((eq content-type 'latin) latin)
+ ((eq content-type 'binary) binary)
+ (t
+ (error "Invalid file content type: %s" content-type))))))
;; Generate FILE with CONTENTS encoded by CODING-SYSTEM.
;; whose encoding specified by CODING-SYSTEM.
@@ -429,9 +430,5 @@
'((iso-latin-1 3) (us-ascii 1 3))))
(should-error (check-coding-systems-region "å" nil '(bad-coding-system))))
-;; Local Variables:
-;; byte-compile-warnings: (not obsolete)
-;; End:
-
(provide 'coding-tests)
;;; coding-tests.el ends here
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index d99b0be89e..7e9669c651 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -96,8 +96,7 @@ expected font properties from parsing NAME.")
(put 'font-parse-check 'ert-explainer 'font-parse-explain)
(defun font-parse-explain (name prop expected)
- (let ((result (font-get (font-spec :name name) prop))
- (propname (symbol-name prop)))
+ (let ((propname (symbol-name prop)))
(format "Parsing `%s': expected %s `%s', got `%s'."
name (substring propname 1) expected
(font-get (font-spec :name name) prop))))
@@ -184,9 +183,5 @@ expected font properties from parsing NAME.")
:family)
'name-with-lots-of-dashes)))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
-
(provide 'font-tests)
;;; font-tests.el ends here.
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index b0876664ed..ce96be6869 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -430,6 +430,18 @@ g .. h foo
(make-non-key-event 'keymap-tests-event)
(should (equal (where-is-internal 'keymap-tests-command) '([3 103]))))
+(ert-deftest keymap-test-duplicate-definitions ()
+ "Check that defvar-keymap rejects duplicate key definitions."
+ (should-error
+ (defvar-keymap
+ ert-keymap-duplicate
+ "a" #'next-line
+ "a" #'previous-line))
+ (should-error
+ (define-keymap
+ "a" #'next-line
+ "a" #'previous-line)))
+
(provide 'keymap-tests)
;;; keymap-tests.el ends here
diff --git a/test/src/lread-resources/lazydoc.el
b/test/src/lread-resources/lazydoc.el
new file mode 100644
index 0000000000..cb434c239b
Binary files /dev/null and b/test/src/lread-resources/lazydoc.el differ
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index f190f14781..2f25de4cc3 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -322,4 +322,21 @@ literals (Bug#20852)."
(should-error (read-from-string "?\\\n x"))
(should (equal (read-from-string "\"a\\\nb\"") '("ab" . 6))))
+(ert-deftest lread-force-load-doc-strings ()
+ ;; Verify that lazy doc strings are loaded lazily by default,
+ ;; but eagerly with `force-load-doc-strings' set.
+ (let ((file (expand-file-name "lazydoc.el" (ert-resource-directory))))
+ (fmakunbound 'lazydoc-fun)
+ (load file)
+ (let ((f (symbol-function 'lazydoc-fun)))
+ (should (byte-code-function-p f))
+ (should (equal (aref f 4) (cons file 87))))
+
+ (fmakunbound 'lazydoc-fun)
+ (let ((load-force-doc-strings t))
+ (load file)
+ (let ((f (symbol-function 'lazydoc-fun)))
+ (should (byte-code-function-p f))
+ (should (equal (aref f 4) "My little\ndoc string\nhere"))))))
+
;;; lread-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index aab95b2d73..db8a504478 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -38,10 +38,11 @@
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
-;; Start a process that exits immediately. Call WAIT-FUNCTION,
-;; possibly multiple times, to wait for the process to complete.
-(defun process-test-sentinel-wait-function-working-p (wait-function)
- (let ((proc (start-process "test" nil "bash" "-c" "exit 20"))
+(defun process-test-wait-for-sentinel (proc exit-status &optional
wait-function)
+ "Set a sentinel on PROC and wait for it to be called with EXIT-STATUS.
+Call WAIT-FUNCTION, possibly multiple times, to wait for the
+process to complete."
+ (let ((wait-function (or wait-function #'accept-process-output))
(sentinel-called nil)
(start-time (float-time)))
(set-process-sentinel proc (lambda (_proc _msg)
@@ -50,21 +51,22 @@
(> (- (float-time) start-time)
process-test-sentinel-wait-timeout)))
(funcall wait-function))
- (cl-assert (eq (process-status proc) 'exit))
- (cl-assert (= (process-exit-status proc) 20))
- sentinel-called))
+ (should sentinel-called)
+ (should (eq (process-status proc) 'exit))
+ (should (= (process-exit-status proc) exit-status))))
(ert-deftest process-test-sentinel-accept-process-output ()
(skip-unless (executable-find "bash"))
(with-timeout (60 (ert-fail "Test timed out"))
- (should (process-test-sentinel-wait-function-working-p
- #'accept-process-output))))
+ (let ((proc (start-process "test" nil "bash" "-c" "exit 20")))
+ (should (process-test-wait-for-sentinel proc 20)))))
(ert-deftest process-test-sentinel-sit-for ()
(skip-unless (executable-find "bash"))
(with-timeout (60 (ert-fail "Test timed out"))
- (should
- (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01
t))))))
+ (let ((proc (start-process "test" nil "bash" "-c" "exit 20")))
+ (should (process-test-wait-for-sentinel
+ proc 20 (lambda () (sit-for 0.01 t)))))))
(when (eq system-type 'windows-nt)
(ert-deftest process-test-quoted-batfile ()
@@ -97,17 +99,8 @@
"echo hello stderr! >&2; "
"exit 20"))
:buffer stdout-buffer
- :stderr stderr-buffer))
- (sentinel-called nil)
- (start-time (float-time)))
- (set-process-sentinel proc (lambda (_proc _msg)
- (setq sentinel-called t)))
- (while (not (or sentinel-called
- (> (- (float-time) start-time)
- process-test-sentinel-wait-timeout)))
- (accept-process-output))
- (cl-assert (eq (process-status proc) 'exit))
- (cl-assert (= (process-exit-status proc) 20))
+ :stderr stderr-buffer)))
+ (process-test-wait-for-sentinel proc 20)
(should (with-current-buffer stdout-buffer
(goto-char (point-min))
(looking-at "hello stdout!")))
@@ -118,8 +111,7 @@
(ert-deftest process-test-stderr-filter ()
(skip-unless (executable-find "bash"))
(with-timeout (60 (ert-fail "Test timed out"))
- (let* ((sentinel-called nil)
- (stderr-sentinel-called nil)
+ (let* ((stderr-sentinel-called nil)
(stdout-output nil)
(stderr-output nil)
(stdout-buffer (generate-new-buffer "*stdout*"))
@@ -131,23 +123,14 @@
(concat "echo hello stdout!; "
"echo hello stderr! >&2; "
"exit 20"))
- :stderr stderr-proc))
- (start-time (float-time)))
+ :stderr stderr-proc)))
(set-process-filter proc (lambda (_proc input)
(push input stdout-output)))
- (set-process-sentinel proc (lambda (_proc _msg)
- (setq sentinel-called t)))
(set-process-filter stderr-proc (lambda (_proc input)
(push input stderr-output)))
(set-process-sentinel stderr-proc (lambda (_proc _input)
(setq stderr-sentinel-called t)))
- (while (not (or sentinel-called
- (> (- (float-time) start-time)
- process-test-sentinel-wait-timeout)))
- (accept-process-output))
- (cl-assert (eq (process-status proc) 'exit))
- (cl-assert (= (process-exit-status proc) 20))
- (should sentinel-called)
+ (process-test-wait-for-sentinel proc 20)
(should (equal 1 (with-current-buffer stdout-buffer
(point-max))))
(should (equal "hello stdout!\n"
@@ -289,6 +272,77 @@
(error :got-error))))
(should have-called-debugger))))
+(defun make-process/test-connection-type (ttys &rest args)
+ "Make a process and check whether its standard streams match TTYS.
+This calls `make-process', passing ARGS to adjust how the process
+is created. TTYS should be a list of 3 boolean values,
+indicating whether the subprocess's stdin, stdout, and stderr
+should be a TTY, respectively."
+ (declare (indent 1))
+ (let* (;; MS-Windows doesn't support communicating via pty.
+ (ttys (if (eq system-type 'windows-nt) '(nil nil nil) ttys))
+ (expected-output (concat (and (nth 0 ttys) "stdin\n")
+ (and (nth 1 ttys) "stdout\n")
+ (and (nth 2 ttys) "stderr\n")))
+ (stdout-buffer (generate-new-buffer "*stdout*"))
+ (proc (apply
+ #'make-process
+ :name "test"
+ :command (list "sh" "-c"
+ (concat "if [ -t 0 ]; then echo stdin; fi; "
+ "if [ -t 1 ]; then echo stdout; fi; "
+ "if [ -t 2 ]; then echo stderr; fi"))
+ :buffer stdout-buffer
+ args)))
+ (should (eq (and (process-tty-name proc 'stdin) t) (nth 0 ttys)))
+ (should (eq (and (process-tty-name proc 'stdout) t) (nth 1 ttys)))
+ (should (eq (and (process-tty-name proc 'stderr) t) (nth 2 ttys)))
+ (process-test-wait-for-sentinel proc 0)
+ (should (equal (with-current-buffer stdout-buffer (buffer-string))
+ expected-output))))
+
+(ert-deftest make-process/connection-type/pty ()
+ (skip-unless (executable-find "sh"))
+ (make-process/test-connection-type '(t t t)
+ :connection-type 'pty))
+
+(ert-deftest make-process/connection-type/pty-2 ()
+ (skip-unless (executable-find "sh"))
+ (make-process/test-connection-type '(t t t)
+ :connection-type '(pty . pty)))
+
+(ert-deftest make-process/connection-type/pipe ()
+ (skip-unless (executable-find "sh"))
+ (make-process/test-connection-type '(nil nil nil)
+ :connection-type 'pipe))
+
+(ert-deftest make-process/connection-type/pipe-2 ()
+ (skip-unless (executable-find "sh"))
+ (make-process/test-connection-type '(nil nil nil)
+ :connection-type '(pipe . pipe)))
+
+(ert-deftest make-process/connection-type/in-pty ()
+ (skip-unless (executable-find "sh"))
+ (make-process/test-connection-type '(t nil nil)
+ :connection-type '(pty . pipe)))
+
+(ert-deftest make-process/connection-type/out-pty ()
+ (skip-unless (executable-find "sh"))
+ (make-process/test-connection-type '(nil t t)
+ :connection-type '(pipe . pty)))
+
+(ert-deftest make-process/connection-type/pty-with-stderr-buffer ()
+ (skip-unless (executable-find "sh"))
+ (let ((stderr-buffer (generate-new-buffer "*stderr*")))
+ (make-process/test-connection-type '(t t nil)
+ :connection-type 'pty :stderr stderr-buffer)))
+
+(ert-deftest make-process/connection-type/out-pty-with-stderr-buffer ()
+ (skip-unless (executable-find "sh"))
+ (let ((stderr-buffer (generate-new-buffer "*stderr*")))
+ (make-process/test-connection-type '(nil t nil)
+ :connection-type '(pipe . pty) :stderr stderr-buffer)))
+
(ert-deftest make-process/file-handler/found ()
"Check that the `:file-handler’ argument of `make-process’
works as expected if a file name handler is found."