[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/long-lines-improvements e2b774e64a: Merge branch 'master' into f
|
From: |
Gregory Heytings |
|
Subject: |
feature/long-lines-improvements e2b774e64a: Merge branch 'master' into feature/long-lines-improvements |
|
Date: |
Thu, 4 Aug 2022 06:23:39 -0400 (EDT) |
branch: feature/long-lines-improvements
commit e2b774e64a903e856356971c0fc3a3835d3883c1
Merge: 5e33712672 87ac0b945f
Author: Gregory Heytings <gregory@heytings.org>
Commit: Gregory Heytings <gregory@heytings.org>
Merge branch 'master' into feature/long-lines-improvements
---
ChangeLog.3 | 51 +-
Makefile.in | 9 +-
admin/make-tarball.txt | 14 +-
configure.ac | 4 +
doc/emacs/search.texi | 5 +-
doc/lispref/frames.texi | 12 +-
doc/lispref/keymaps.texi | 6 +-
doc/lispref/loading.texi | 25 +-
doc/lispref/os.texi | 7 +-
doc/lispref/positions.texi | 19 +-
doc/misc/modus-themes.org | 453 +++++++++++++---
doc/misc/vtable.texi | 6 +-
etc/AUTHORS | 2 +-
etc/NEWS | 49 +-
etc/TODO | 11 +-
etc/emacs_lldb.py | 2 +-
etc/publicsuffix.txt | 8 +-
etc/themes/modus-operandi-theme.el | 4 +-
etc/themes/modus-themes.el | 409 +++++++-------
etc/themes/modus-vivendi-theme.el | 4 +-
lib-src/make-docfile.c | 360 +-----------
lisp/Makefile.in | 54 +-
lisp/apropos.el | 31 +-
lisp/auth-source.el | 3 +-
lisp/battery.el | 16 +-
lisp/bookmark.el | 4 +-
lisp/calendar/time-date.el | 4 +-
lisp/calendar/timeclock.el | 2 +-
lisp/cedet/ede/base.el | 4 +-
lisp/cedet/ede/config.el | 4 +-
lisp/cedet/ede/speedbar.el | 4 +-
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/srecode/compile.el | 10 +-
lisp/cedet/srecode/insert.el | 4 +
lisp/desktop.el | 2 +-
lisp/dired-aux.el | 2 +-
lisp/dired.el | 3 +-
lisp/edmacro.el | 9 +-
lisp/emacs-lisp/bytecomp.el | 6 +-
lisp/emacs-lisp/checkdoc.el | 2 +-
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/loaddefs-gen.el | 21 +-
lisp/emacs-lisp/package.el | 5 +-
lisp/emacs-lisp/shortdoc.el | 2 +-
lisp/emulation/viper-ex.el | 2 +-
lisp/emulation/viper-util.el | 41 +-
lisp/epg.el | 4 +-
lisp/eshell/em-unix.el | 6 +-
lisp/eshell/esh-arg.el | 2 +-
lisp/files.el | 9 +-
lisp/find-dired.el | 18 +-
lisp/find-lisp.el | 2 +-
lisp/gnus/gnus-demon.el | 2 +-
lisp/gnus/gnus-srvr.el | 1 -
lisp/gnus/gnus-sum.el | 2 -
lisp/gnus/gnus-util.el | 19 +-
lisp/gnus/nneething.el | 3 +-
lisp/gnus/nnfolder.el | 3 +-
lisp/gnus/nnheader.el | 2 +-
lisp/gnus/nnmaildir.el | 10 +-
lisp/gnus/nnmh.el | 11 +-
lisp/gnus/nnrss.el | 2 +-
lisp/gnus/nntp.el | 21 +-
lisp/gnus/spam-stat.el | 3 +-
lisp/gnus/spam.el | 6 +-
lisp/help.el | 31 +-
lisp/ibuffer.el | 1 -
lisp/international/titdic-cnv.el | 7 +-
lisp/isearch.el | 4 +-
lisp/keymap.el | 16 +-
lisp/ldefs-boot.el | 89 ++-
lisp/leim/quail/hangul.el | 33 +-
lisp/loadup.el | 18 +-
lisp/mail/binhex.el | 4 +
lisp/mail/footnote.el | 30 +-
lisp/mail/mailabbrev.el | 2 +-
lisp/mail/rfc2047.el | 3 +
lisp/mail/sendmail.el | 6 +-
lisp/mpc.el | 7 +-
lisp/net/dig.el | 33 +-
lisp/net/eudc-hotlist.el | 15 +-
lisp/net/eww.el | 4 +-
lisp/net/net-utils.el | 9 -
lisp/net/netrc.el | 5 +-
lisp/net/newst-backend.el | 8 +-
lisp/net/tramp-adb.el | 236 ++++----
lisp/net/tramp-archive.el | 12 +-
lisp/net/tramp-cache.el | 164 ++++--
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-crypt.el | 9 +-
lisp/net/tramp-ftp.el | 1 -
lisp/net/tramp-gvfs.el | 47 +-
lisp/net/tramp-sh.el | 701 ++++++++++++------------
lisp/net/tramp-smb.el | 346 ++++++------
lisp/net/tramp-sshfs.el | 13 +-
lisp/net/tramp-sudoedit.el | 24 +-
lisp/net/tramp.el | 127 ++---
lisp/nxml/rng-loc.el | 2 +-
lisp/{url => obsolete}/url-about.el | 5 +-
lisp/{url => obsolete}/url-dired.el | 3 +-
lisp/org/ob-core.el | 12 +-
lisp/org/ox.el | 2 +-
lisp/pixel-scroll.el | 3 +-
lisp/play/cookie1.el | 3 +-
lisp/play/doctor.el | 9 +-
lisp/play/hanoi.el | 44 +-
lisp/progmodes/cperl-mode.el | 7 +-
lisp/progmodes/hideif.el | 3 +-
lisp/select.el | 3 -
lisp/simple.el | 5 +-
lisp/subr.el | 103 +++-
lisp/tar-mode.el | 2 +-
lisp/term.el | 2 +-
lisp/textmodes/flyspell.el | 3 +
lisp/textmodes/picture.el | 1 -
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/sgml-mode.el | 2 +-
lisp/textmodes/texinfo.el | 3 -
lisp/transient.el | 995 ++++++++++++++++++++++------------
lisp/type-break.el | 30 +-
lisp/uniquify.el | 4 +-
lisp/url/url-file.el | 3 +-
lisp/url/url-http.el | 4 +-
lisp/url/url-privacy.el | 11 +-
lisp/url/url-util.el | 35 +-
lisp/vc/ediff-util.el | 8 +-
lisp/vc/vc-cvs.el | 2 +-
lisp/vc/vc-hg.el | 4 +-
lisp/vc/vc-hooks.el | 5 +-
lisp/vc/vc.el | 2 +-
lisp/wdired.el | 1 -
lisp/woman.el | 10 +-
nextstep/Makefile.in | 3 +-
src/Makefile.in | 19 +-
src/bytecode.c | 4 +-
src/editfns.c | 54 +-
src/eval.c | 12 +-
src/frame.c | 6 +-
src/ftcrfont.c | 2 +-
src/haiku_support.cc | 33 +-
src/haiku_support.h | 1 +
src/haikufns.c | 18 +-
src/haikuterm.c | 88 +--
src/haikuterm.h | 5 +-
src/lisp.h | 5 +-
src/lread.c | 14 +-
src/marker.c | 5 +-
src/nsfns.m | 1 +
src/pgtkfns.c | 1 +
src/process.c | 2 +-
src/sysdep.c | 5 +-
src/timefns.c | 97 ++--
src/w32fns.c | 1 +
src/xdisp.c | 5 +-
src/xfns.c | 49 +-
src/xsettings.c | 7 +-
src/xsettings.h | 2 +-
src/xterm.c | 381 +++++++++----
src/xterm.h | 32 +-
test/lisp/emacs-lisp/package-tests.el | 15 +
test/lisp/help-tests.el | 4 +-
test/lisp/net/tramp-tests.el | 25 +-
test/lisp/url/url-util-tests.el | 20 +
test/src/keymap-tests.el | 12 +
176 files changed, 3521 insertions(+), 2836 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/make-tarball.txt b/admin/make-tarball.txt
index 6990f27bfa..f5b9d56c4d 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -183,12 +183,12 @@ 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:
- tar tJf emacs-OLD.tar.xz | sed -e 's,^[^/]*,,' | sort > old_tmp
- tar tJf emacs-NEW.tar.xz | sed -e 's,^[^/]*,,' | sort > new_tmp
+ tar tf emacs-OLD.tar | sed -e 's,^[^/]*,,' | sort > old_tmp
+ tar tf emacs-NEW.tar | sed -e 's,^[^/]*,,' | sort > new_tmp
diff -u old_tmp new_tmp
If this is the first pretest of a major release, just comparing
@@ -203,7 +203,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 +288,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 +309,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/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/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/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/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..874200d9f2 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
@@ -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/os.texi b/doc/lispref/os.texi
index 2b49818ed3..5fb34fb9b6 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -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/misc/modus-themes.org b/doc/misc/modus-themes.org
index 943294b626..a80bf6be8a 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:
@@ -1252,7 +1253,7 @@ accepts is as follows (order is not significant):
The ~popup~ key takes the same values as ~selection~.
-Apart from specifying each key separately, a fallback list is accepted.
+Apart from specfying 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:
@@ -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~):
@@ -3347,7 +3639,7 @@ it if you plan to control face attributes.
:end:
#+cindex: Org custom emphasis faces
-Org provides the user option ~org-emphasis-alist~ which associates a
+Org provides the user option ~org-emphasis-alist~ which assosiates a
character with a face, list of faces, or face attributes. The default
specification of that variable looks like this:
@@ -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/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..ef3e1f0a55 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -349,6 +349,12 @@ 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 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.
@@ -620,6 +626,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
@@ -1454,6 +1463,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
@@ -1633,6 +1647,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
@@ -2429,14 +2449,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 +2476,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:
@@ -2557,12 +2578,10 @@ 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
diff --git a/etc/TODO b/etc/TODO
index 5c55a8b999..4d0bfd1c2a 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -1713,17 +1713,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
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..54e5e465b1 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
@@ -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/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/Makefile.in b/lisp/Makefile.in
index 9516f2fc36..7c1f872939 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,38 @@ 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.
+# 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
# gets created before the final emacs is dumped. Having leim
# 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.
+autoloads:
$(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.
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/auth-source.el b/lisp/auth-source.el
index a802ef856d..a36386101a 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -957,7 +957,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..7c99d05dc3 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -256,10 +256,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/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/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/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/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/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..bb24954386 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -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"))
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/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 1ecd77f751..7d2971502d 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))
@@ -3833,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)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 611f32e23c..94ade5928f 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -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)
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/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 36b0b1e9cd..8dd67ca993 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -60,7 +60,10 @@ be included.")
"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")
"List of strings naming definitions to ignore for prefixes.
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
@@ -588,7 +591,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)
@@ -634,18 +638,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 df70f908da..482de52f85 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2085,7 +2085,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)))))
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/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-util.el b/lisp/emulation/viper-util.el
index 6d23ae9a0f..c9e4fa70d0 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
@@ -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/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/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/files.el b/lisp/files.el
index 65f9039b33..e258bf7bbe 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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/find-dired.el b/lisp/find-dired.el
index 63f2148e47..fba5126133 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -242,6 +242,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 +278,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 ()
@@ -419,10 +419,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/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..2c10969ba0 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)))
@@ -1134,14 +1134,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 +1148,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 +1251,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))
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..92df41ea82 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -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/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 30f473b129..98e074233d 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -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
@@ -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))
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..5047be1a6a 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)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 9902a280d5..b26afe6e78 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
@@ -1166,7 +1147,7 @@ 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))
+ (let* ((list (netrc-parse))
(alist (netrc-machine list nntp-address "nntp"))
(auth-info
(nth 0 (auth-source-search
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.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/ibuffer.el b/lisp/ibuffer.el
index 742d21d0b0..65430d7d11 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
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..336c5f1bde 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2838,7 +2838,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))
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 376a30f106..107565590c 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -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/ldefs-boot.el b/lisp/ldefs-boot.el
index 6574badf2d..85985399db 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1825,7 +1825,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
@@ -2865,7 +2865,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
@@ -4566,7 +4566,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
@@ -5558,7 +5558,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
@@ -6289,12 +6289,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
@@ -6314,7 +6314,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
@@ -7305,7 +7305,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
@@ -7917,7 +7917,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
@@ -8632,7 +8632,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
@@ -9164,7 +9164,7 @@ 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
@@ -9417,7 +9417,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
@@ -11073,7 +11073,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
@@ -14642,16 +14642,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-"))
@@ -19328,7 +19325,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
@@ -23588,11 +23585,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-"))
@@ -27833,7 +27825,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
@@ -31260,7 +31252,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" "\
@@ -31773,12 +31765,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-archive" "\
-Invoke the file archive related OPERATION.
-First arg specifies the OPERATION, second arg ARGS is a list of
-arguments to pass to the OPERATION.
-
-(fn OPERATION &rest ARGS)" nil nil)
+(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 "\
@@ -31790,7 +31777,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
@@ -31916,9 +31903,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.
@@ -31928,9 +31917,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.
@@ -31954,7 +31945,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
@@ -32318,11 +32309,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" "\
@@ -32424,11 +32410,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-"))
@@ -32781,14 +32762,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" "\
@@ -35880,8 +35855,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/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/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/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/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/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/eww.el b/lisp/net/eww.el
index 4dbd5de2ef..b7b2e08975 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."
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/netrc.el b/lisp/net/netrc.el
index c272c07e4c..2f38e22178 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -63,8 +63,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)
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/tramp-adb.el b/lisp/net/tramp-adb.el
index 3e780aa1a1..1d35f2b2ff 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -517,34 +517,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 +832,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)
@@ -923,102 +928,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."
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index b224494110..fda1441615 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-archine")
+;;;###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-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-ftp.el b/lisp/net/tramp-ftp.el
index d4bbb94479..dd7e0f9f34 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -31,7 +31,6 @@
(require 'tramp)
;; Pacify byte-compiler.
-(declare-function tramp-archive-file-name-handler "tramp-archive")
(defvar ange-ftp-ftp-name-arg)
(defvar ange-ftp-ftp-name-res)
(defvar ange-ftp-name-format)
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..d88e388cd5 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.
@@ -2966,102 +2968,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 +3244,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)
@@ -3334,194 +3336,201 @@ 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 "echo -n \"\">%s" (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 0afa6fc431..aac63882ce 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -62,7 +62,6 @@
(require 'cl-lib)
(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
-(declare-function tramp-archive-file-name-handler "tramp-archive")
(defvar auto-save-file-name-transforms)
;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA
package.
@@ -97,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
@@ -1441,8 +1441,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)
@@ -1485,13 +1486,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 file)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
+If FILE 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 file)
+ ;; FIXME: This is a sanity check. When this error
+ ;; doesn't happen for a while, it can be removed.
+ (or (file-name-absolute-p file)
+ (tramp-error
+ vec 'file-error "File `%s' must be absolute" file))
+ (directory-file-name (tramp-compat-file-name-unquote file)))
(tramp-file-name-hop vec) nil))
vec)
@@ -1525,6 +1535,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)
@@ -1546,6 +1557,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
@@ -1637,6 +1649,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,
@@ -1747,6 +1760,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.
@@ -1856,6 +1870,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.
@@ -1912,8 +1927,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
@@ -1921,8 +1935,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))
@@ -2034,6 +2046,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
@@ -2107,10 +2120,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
@@ -2163,8 +2178,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
@@ -2177,8 +2190,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
@@ -2246,8 +2257,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\")."
@@ -2284,8 +2293,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.
@@ -2302,8 +2309,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
@@ -2399,45 +2404,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'
@@ -3424,8 +3390,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."
@@ -3441,8 +3405,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'.
@@ -3474,8 +3436,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'.
@@ -3485,7 +3445,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
@@ -3493,9 +3452,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)
@@ -3524,10 +3484,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
@@ -3541,7 +3499,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)
@@ -3602,6 +3575,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.
@@ -3645,8 +3621,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
@@ -3843,7 +3817,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."
@@ -5620,7 +5596,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)))
@@ -6049,6 +6025,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-loc.el b/lisp/nxml/rng-loc.el
index 0fa455cbb5..302aa05176 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -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/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/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/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/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/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/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ab70d574c5..c6235d9013 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -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/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/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..e7768837f6 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.
diff --git a/lisp/subr.el b/lisp/subr.el
index ff82d0d1d8..1b59db0604 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2700,18 +2700,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 +2745,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)
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/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/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-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/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/transient.el b/lisp/transient.el
index 8c41706f15..250201903d 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))
@@ -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..125f8436f6 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))
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..48ea947fab 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,22 @@ 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-percentage (fmt _perc &rest args)
(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-percentage (x y)
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 040a9a63c5..3641b75251 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -4094,11 +4094,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 +4112,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)
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-hg.el b/lisp/vc/vc-hg.el
index 026f125396..5fba2b3908 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)
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 80508570f3..405c9bc2ca 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)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index d3e53858c1..b05adfb2d5 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/woman.el b/lisp/woman.el
index d8743c7fac..23ce2218b5 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
@@ -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/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..9ef4561c4a 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.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/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/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..d82d05797b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -593,16 +593,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 +636,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)
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..119ec28409 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)
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/lisp.h b/src/lisp.h
index 7136bb3dc1..8e36620fe5 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;
}
@@ -4679,6 +4679,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);
diff --git a/src/lread.c b/src/lread.c
index 0720774db2..b7d8d9eeca 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2261,7 +2261,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 +3056,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 +3084,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 +3149,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
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/process.c b/src/process.c
index a15efa39bd..1ac5a509e5 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6339,7 +6339,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);
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 12f56227e4..099efed2db 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4401,7 +4401,8 @@ handle_fontified_prop (struct it *it)
begv = get_narrowed_begv (it->w, charpos);
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'
@@ -19458,7 +19459,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..672097c0d8 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -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);
@@ -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/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..33e90603f8 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
@@ -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 synchonization 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, 1);
+}
+
+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)
@@ -9308,9 +9475,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 +10631,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 +11014,6 @@ x_scroll_run (struct window *w, struct run *run)
view->clip_bottom -
view->clip_top);
}
xwidget_expose (view);
- XFlush (dpy);
}
}
}
@@ -13206,6 +13366,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 +14187,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 +14395,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 +14818,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;
@@ -16501,6 +16642,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 +16682,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
@@ -17172,7 +17339,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. */
@@ -18885,13 +19053,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. */
@@ -22533,7 +22708,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 +22735,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;
@@ -23132,8 +23300,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 +25814,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 +25905,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 +25923,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 +25960,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 +25995,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);
}
}
@@ -26192,7 +26366,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
diff --git a/src/xterm.h b/src/xterm.h
index 2b8a2e5da4..c1a944d3cd 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -614,9 +614,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;
@@ -769,6 +769,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 +1071,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
@@ -1500,6 +1523,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);
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/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/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5a8d9100e1..e2d4ed781b 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 temprorary 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")
@@ -3790,7 +3803,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)))
@@ -4153,6 +4170,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(tramp-compat-time-equal-p
(file-attribute-modification-time (file-attributes tmp-name1))
(seconds-to-time 1)))
+ ;; 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))
@@ -7569,7 +7590,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/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/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