[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp f1bc8e4 1/6: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp f1bc8e4 1/6: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Sat, 15 Feb 2020 04:24:36 -0500 (EST) |
branch: feature/native-comp
commit f1bc8e480cc9d4a81826b344cac06d0bad88e21e
Merge: d71801e 333cc6a
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Merge remote-tracking branch 'savannah/master' into HEAD
---
configure.ac | 15 +++
doc/emacs/display.texi | 2 +
doc/emacs/fixit.texi | 5 +-
doc/emacs/misc.texi | 5 +-
doc/emacs/package.texi | 66 ++++++----
doc/emacs/screen.texi | 2 +-
doc/lispintro/emacs-lisp-intro.texi | 2 +-
doc/lispref/display.texi | 9 +-
doc/lispref/frames.texi | 3 +
doc/lispref/lists.texi | 9 +-
doc/lispref/minibuf.texi | 1 +
doc/lispref/searching.texi | 5 +-
doc/lispref/text.texi | 10 ++
doc/misc/calc.texi | 4 +-
doc/misc/gnus.texi | 2 +-
doc/misc/mh-e.texi | 6 +-
doc/misc/org.texi | 2 +-
doc/misc/sc.texi | 4 +-
etc/NEWS | 34 +++++
etc/NEWS.27 | 14 +++
lib/_Noreturn.h | 5 +-
lib/c++defs.h | 3 -
lib/gnulib.mk.in | 4 +
lib/libc-config.h | 13 +-
lib/sys_stat.in.h | 41 +++---
lisp/align.el | 2 +-
lisp/allout-widgets.el | 2 +-
lisp/allout.el | 2 +-
lisp/autoinsert.el | 2 +-
lisp/battery.el | 206 ++++++++++++++++++++-----------
lisp/cedet/mode-local.el | 14 +--
lisp/emacs-lisp/bytecomp.el | 3 +-
lisp/emacs-lisp/cl-macs.el | 7 +-
lisp/emacs-lisp/gv.el | 2 +-
lisp/emacs-lisp/map.el | 17 ++-
lisp/emacs-lisp/package.el | 226 +++++++++++++++++++++++++++-------
lisp/emacs-lisp/rx.el | 2 +-
lisp/font-lock.el | 4 +-
lisp/gnus/gnus-sum.el | 2 +-
lisp/gnus/mm-util.el | 2 +-
lisp/gnus/mm-uu.el | 12 +-
lisp/gnus/mm-view.el | 4 +-
lisp/gnus/nnheader.el | 2 +-
lisp/gnus/nnir.el | 3 +-
lisp/gnus/nnmaildir.el | 30 +++--
lisp/ido.el | 16 ++-
lisp/json.el | 3 +-
lisp/mail/feedmail.el | 2 +-
lisp/mail/sendmail.el | 2 +-
lisp/mail/supercite.el | 2 +-
lisp/mh-e/mh-e.el | 9 +-
lisp/mh-e/mh-show.el | 8 +-
lisp/minibuffer.el | 18 ++-
lisp/net/goto-addr.el | 8 +-
lisp/net/tramp-cache.el | 69 +++++------
lisp/net/tramp-gvfs.el | 49 ++++----
lisp/net/tramp-sh.el | 39 +++++-
lisp/net/tramp.el | 27 ++--
lisp/net/zeroconf.el | 12 +-
lisp/org/org-attach.el | 2 +-
lisp/org/org.el | 5 +-
lisp/progmodes/cc-engine.el | 17 +--
lisp/progmodes/cc-langs.el | 21 +++-
lisp/progmodes/gdb-mi.el | 57 ++++++---
lisp/progmodes/idlw-shell.el | 2 +-
lisp/ps-print.el | 6 +-
lisp/simple.el | 33 +++--
lisp/subr.el | 5 +-
lisp/tab-bar.el | 60 ++++++---
lisp/tab-line.el | 4 +-
lisp/vc/diff-mode.el | 4 +-
lisp/vc/ediff-util.el | 4 +-
lisp/vc/vc-dir.el | 5 +-
lisp/vc/vc-hg.el | 15 ++-
lisp/vc/vc.el | 4 +-
lisp/whitespace.el | 2 +-
lisp/wid-edit.el | 41 ++----
lisp/windmove.el | 25 ++--
lisp/window.el | 16 ++-
m4/gnulib-common.m4 | 7 +-
m4/sys_stat_h.m4 | 4 +-
src/buffer.c | 3 +
src/cmds.c | 4 +-
src/composite.c | 13 +-
src/editfns.c | 4 +-
src/fontset.c | 2 +-
src/frame.h | 2 +-
src/lread.c | 102 ++-------------
src/nsterm.h | 4 +-
src/nsterm.m | 152 +++++++++++++----------
src/regex-emacs.c | 2 +-
src/systhread.c | 8 +-
src/xdisp.c | 40 +++---
src/xfaces.c | 10 +-
test/lisp/emacs-lisp/map-tests.el | 8 +-
test/lisp/emacs-lisp/package-tests.el | 125 ++++++++++++++-----
test/lisp/emacs-lisp/rx-tests.el | 2 +-
test/lisp/net/tramp-tests.el | 91 ++++++++------
test/lisp/simple-tests.el | 42 +++++++
test/src/lread-tests.el | 16 ---
100 files changed, 1302 insertions(+), 741 deletions(-)
diff --git a/configure.ac b/configure.ac
index e406ae4..c8e22ff 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4217,6 +4217,21 @@ if test "$ac_cv_func_pthread_setname_np" = "yes"; then
AC_DEFINE(
HAVE_PTHREAD_SETNAME_NP_1ARG, 1,
[Define to 1 if pthread_setname_np takes a single argument.])
+ else
+ AC_CACHE_CHECK(
+ [whether pthread_setname_np takes three arguments],
+ [emacs_cv_pthread_setname_np_3arg],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <pthread.h>]],
+ [[pthread_setname_np (0, "%s", "a");]])],
+ [emacs_cv_pthread_setname_np_3arg=yes],
+ [emacs_cv_pthread_setname_np_3arg=no])])
+ if test "$emacs_cv_pthread_setname_np_3arg" = "yes"; then
+ AC_DEFINE(
+ HAVE_PTHREAD_SETNAME_NP_3ARG, 1,
+ [Define to 1 if pthread_setname_np takes three arguments.])
+ fi
fi
fi
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 8444aef..4ecebc7 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1654,6 +1654,8 @@ Customization}). (The other attributes of this face have
no effect;
the text shown under the cursor is drawn using the frame's background
color.) To change its shape, customize the buffer-local variable
@code{cursor-type}; possible values are @code{box} (the default),
+@code{(box . @var{size})} (box cursor becoming a hollow box under
+masked images larger than @var{size} pixels in either dimension),
@code{hollow} (a hollow box), @code{bar} (a vertical bar), @code{(bar
. @var{n})} (a vertical bar @var{n} pixels wide), @code{hbar} (a
horizontal bar), @code{(hbar . @var{n})} (a horizontal bar @var{n}
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 3665faf..2c268f1 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -66,6 +66,7 @@ changes have already been undone, the undo command signals an
error.
@cindex redo
@findex undo-only
+@findex undo-redo
Any command other than an undo command breaks the sequence of undo
commands. Starting from that moment, the entire sequence of undo
commands that you have just performed are themselves placed into the
@@ -76,7 +77,9 @@ undo commands.
Alternatively, if you want to resume undoing, without redoing
previous undo commands, use @kbd{M-x undo-only}. This is like
-@code{undo}, but will not redo changes you have just undone.
+@code{undo}, but will not redo changes you have just undone. To
+complement it, @kbd{M-x undo-redo} will undo previous undo commands
+(and will not record itself as an undoable command).
If you notice that a buffer has been modified accidentally, the
easiest way to recover is to type @kbd{C-/} repeatedly until the stars
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 6b95b12..d097f4e 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2939,9 +2939,8 @@ done by calling @code{browse-url} as a subroutine
It can be useful to add @code{goto-address-mode} to mode hooks and
hooks for displaying an incoming message
-(e.g., @code{rmail-show-message-hook} for Rmail, and
-@code{mh-show-mode-hook} for MH-E). This is not needed for Gnus,
-which has a similar feature of its own.
+(e.g., @code{rmail-show-message-hook} for Rmail). This is not needed
+for Gnus or MH-E, which have similar features of their own.
@node FFAP
@subsection Finding Files and URLs at Point
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 1cac7f9..db3cf31 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -151,38 +151,62 @@ Refresh the package list (@code{revert-buffer}). This
fetches the
list of available packages from the package archive again, and
redisplays the package list.
+@item H
+@kindex H @r{(Package Menu)}
+@findex package-menu-hide-package
+Hide packages whose names match a regexp
+(@code{package-menu-hide-package}). This prompts for a regexp, and
+then hides the packages with matching names. The default value of the
+regexp will hide only the package whose name is at point, so just
+pressing @key{RET} to the prompt will hide the current package.
+
+@item (
+@kindex ( @r{(Package Menu)}
+@findex package-menu-toggle-hiding
+Toggle visibility of old versions of packages and also of versions
+from lower-priority archives (@code{package-menu-toggle-hiding}).
+
+@item / a
+@kindex / a @r{(Package Menu)}
+@findex package-menu-filter-by-archive
+Filter package list by archive (@code{package-menu-filter-by-archive}).
+This prompts for a package archive (e.g., @samp{gnu}), then shows only
+packages from that archive.
+
@item / k
@kindex / k @r{(Package Menu)}
@findex package-menu-filter-by-keyword
-Filter the package list by keyword
-(@code{package-menu-filter-by-keyword}). This prompts for a keyword
-(e.g., @samp{games}), then shows only the packages that relate to that
-keyword.
+Filter package list by keyword (@code{package-menu-filter-by-keyword}).
+This prompts for a keyword (e.g., @samp{games}), then shows only
+packages with that keyword.
@item / n
@kindex / n @r{(Package Menu)}
@findex package-menu-filter-by-name
-Filter the package list by name (@code{package-menu-filter-by-name}).
-This prompts for a string, then shows only the packages whose names
-match a regexp with that value.
+Filter package list by name (@code{package-menu-filter-by-name}).
+This prompts for a regular expression, then shows only packages
+with names matching that regexp.
+
+@item / s
+@kindex / s @r{(Package Menu)}
+@findex package-menu-filter-by-status
+Filter package list by status (@code{package-menu-filter-by-status}).
+This prompts for one or more statuses (e.g., @samp{available}), then
+shows only packages with matching status.
+
+@item / v
+@kindex / v @r{(Package Menu)}
+@findex package-menu-filter-by-version
+Filter package list by version (@code{package-menu-filter-by-version}).
+This prompts first for one of the qualifiers @samp{<}, @samp{>} or
+@samp{=}, and then a package version, and shows packages that has a
+lower, equal or higher version than the one specified.
@item / /
@kindex / / @r{(Package Menu)}
-@findex package-menu-clear-filter
+@findex package-menu-filter-clear
Clear filter currently applied to the package list
-(@code{package-menu-clear-filter}).
-
-@item H
-@kindex H @r{(Package Menu)}
-@findex package-menu-hide-package
-Permanently hide packages that match a regexp
-(@code{package-menu-hide-package}).
-
-@item (
-@kindex ( @r{(Package Menu)}
-@findex package-menu-toggle-hiding
-Toggle visibility of old versions of packages and also of versions
-from lower-priority archives (@code{package-menu-toggle-hiding}).
+(@code{package-menu-filter-clear}).
@end table
@noindent
diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi
index 773bb93..5c5a5da 100644
--- a/doc/emacs/screen.texi
+++ b/doc/emacs/screen.texi
@@ -167,7 +167,7 @@ what is going on in the current buffer. When there is only
one
window, the mode line appears right above the echo area; it is the
next-to-last line in the frame. On a graphical display, the mode line
is drawn with a 3D box appearance. Emacs also usually draws the mode
-line of the selected window with a different color than that of
+line of the selected window with a different color from that of
unselected windows, in order to make it stand out.
The text displayed in the mode line has the following format:
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index a6f4b68..9834952 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -12919,7 +12919,7 @@ familiar part of this function.
@unnumberedsubsec The @code{let*} expression
The next line of the @code{forward-paragraph} function begins a
-@code{let*} expression. This is a different than @code{let}. The
+@code{let*} expression. This is different from @code{let}. The
symbol is @code{let*} not @code{let}.
@findex let*
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index e4980fe..2b25d60 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -319,7 +319,10 @@ the echo area. See also @code{clear-message-function}
that can be
used to clear the message displayed by this function.
The default value is the function that displays the message at the end
-of the minibuffer when the minibuffer is active.
+of the minibuffer when the minibuffer is active. However, if the text
+shown in the active minibuffer has the @code{minibuffer-message} text
+property (@pxref{Special Properties}) on some character, the message
+will be displayed before the first character having that property.
@end defvar
@defvar clear-message-function
@@ -332,8 +335,8 @@ after displaying an echo-area message. The function is
expected to
clear the message displayed by its counterpart function specified by
@code{set-message-function}.
-The default value is the function that clears the message displayed at
-the end of the minibuffer when the minibuffer is active.
+The default value is the function that clears the message displayed in
+an active minibuffer.
@end defvar
@defvar inhibit-message
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 2bb505c..caa08ff 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -2220,6 +2220,9 @@ How to display the cursor. Legitimate values are:
@table @code
@item box
Display a filled box. (This is the default.)
+@item (box . @var{size})
+Display a filled box. However, display it as a hollow box if point is
+under masked image larger than @var{size} pixels in either dimension.
@item hollow
Display a hollow box.
@item nil
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 5ef21d0..27fa538 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -777,6 +777,9 @@ non-@code{nil}, it is added at the end.
The argument @var{symbol} is not implicitly quoted; @code{add-to-list}
is an ordinary function, like @code{set} and unlike @code{setq}. Quote
the argument yourself if that is what you want.
+
+Do not use this function when @var{symbol} refers to a lexical
+variable.
@end defun
Here's a scenario showing how to use @code{add-to-list}:
@@ -799,8 +802,9 @@ foo ;; @r{@code{foo} was changed.}
@var{value})} is this:
@example
-(or (member @var{value} @var{var})
- (setq @var{var} (cons @var{value} @var{var})))
+(if (member @var{value} @var{var})
+ @var{var}
+ (setq @var{var} (cons @var{value} @var{var})))
@end example
@defun add-to-ordered-list symbol element &optional order
@@ -828,6 +832,7 @@ and unlike @code{setq}. Quote the argument yourself if
necessary.
The ordering information is stored in a hash table on @var{symbol}'s
@code{list-order} property.
+@var{symbol} cannot refer to a lexical variable.
@end defun
Here's a scenario showing how to use @code{add-to-ordered-list}:
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 0f60b3f..ac38b9d 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -572,6 +572,7 @@ and returns the updated history list. It limits the list
length to
the value of @var{maxelt} (if non-@code{nil}) or @code{history-length}
(described below). The possible values of @var{maxelt} have the same
meaning as the values of @code{history-length}.
+@var{history-var} cannot refer to a lexical variable.
Normally, @code{add-to-history} removes duplicate members from the
history list if @code{history-delete-duplicates} is non-@code{nil}.
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 3d7ea93..5f4509a 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1080,7 +1080,10 @@ Corresponding string regexp: @samp{@var{A}@var{B}@dots{}}
@cindex @code{or} in rx
@itemx @code{(| @var{rx}@dots{})}
@cindex @code{|} in rx
-Match exactly one of the @var{rx}s, trying from left to right.
+Match exactly one of the @var{rx}s.
+If all arguments are string literals, the longest possible match
+will always be used. Otherwise, either the longest match or the
+first (in left-to-right order) will be used.
Without arguments, the expression will not match anything at all.@*
Corresponding string regexp: @samp{@var{A}\|@var{B}\|@dots{}}.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 527057e..f027cdf 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3741,6 +3741,16 @@ single glyph composed from components. But the value of
the property
itself is completely internal to Emacs and should not be manipulated
directly by, for instance, @code{put-text-property}.
+@item minibuffer-message
+@kindex minibuffer-message @r{(text property)}
+This text property tells where to display temporary messages in an
+active minibuffer. Specifically, the first character of the
+minibuffer text which has this property will have the temporary
+message displayed before it. The default is to display temporary
+messages at the end of the minibuffer text. This text property is
+used by the function that is the default value of
+@code{set-message-function} (@pxref{Displaying Messages}).
+
@end table
@defvar inhibit-point-motion-hooks
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index a31f232..1dab29b 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -27155,7 +27155,7 @@ anywhere in the formula.
It is possible for a rule set to get into an infinite loop. The
most obvious case, replacing a formula with itself, is not a problem
because a rule is not considered to ``succeed'' unless the righthand
-side actually comes out to something different than the original
+side actually comes out to something different from the original
formula or sub-formula that was matched. But if you accidentally
had both @samp{ln(a b) := ln(a) + ln(b)} and the reverse
@samp{ln(a) + ln(b) := ln(a b)} in your rule set, Calc would
@@ -28075,7 +28075,7 @@ for angstroms.
The unit @code{pt} stands for pints; the name @code{point} stands for
a typographical point, defined by @samp{72 point = 1 in}. This is
-slightly different than the point defined by the American Typefounder's
+slightly different from the point defined by the American Typefounder's
Association in 1886, but the point used by Calc has become standard
largely due to its use by the PostScript page description language.
There is also @code{texpt}, which stands for a printer's point as
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 2545d21..b5eb81b 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -27658,7 +27658,7 @@ added. A plethora of new commands and modes have been
added.
@xref{Gnus Unplugged}, for the full story.
@item
-The @code{nndraft} back end has returned, but works differently than
+The @code{nndraft} back end has returned, but works differently from
before. All Message buffers are now also articles in the @code{nndraft}
group, which is created automatically.
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 0630b60..962f22a 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -2256,10 +2256,10 @@ signature block is more to your liking.
Two hooks can be used to control how messages are displayed. The first
hook, @code{mh-show-mode-hook}, is called early on in the process of
the message display. It is usually used to perform some action on the
-message's content. The second hook, @code{mh-show-hook}, is the last
+message's buffer. The second hook, @code{mh-show-hook}, is the last
thing called after messages are displayed. It's used to affect the
-behavior of MH-E in general or when @code{mh-show-mode-hook} is too
-early.
+message's content, the behavior of MH-E in general, or when
+@code{mh-show-mode-hook} is too early.
@cindex MH-Show mode
@cindex modes, MH-Show
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index 8979796..495d562 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -31,7 +31,7 @@ modify this GNU manual.''
@end quotation
@end copying
-@dircategory Emacs
+@dircategory Emacs editing modes
@direntry
* Org Mode: (org). Outline-based notes management and organizer.
@end direntry
diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi
index abde85c..ccf5b9e 100644
--- a/doc/misc/sc.texi
+++ b/doc/misc/sc.texi
@@ -1033,7 +1033,7 @@ that will be used to composed a non-nested citation
string. Supercite
scans the various mail headers present in the original article and uses
a number of heuristics to extract strings which it puts into the
@dfn{attribution association list} or @dfn{attribution alist}. This is
-analogous, but different than, the info alist previously mentioned. Each
+analogous, but different from, the info alist previously mentioned. Each
element in the attribution alist is a key-value pair containing such
information as the author's first name, middle names, and last name, the
author's initials, and the author's email terminus.
@@ -1330,7 +1330,7 @@ co-worker that uses an uncommon citation style (say one
that employs a
possible for Supercite to recognize this and @emph{coerce} the citation
to your preferred style, for consistency. In theory, it is possible for
Supercite to recognize such things as uuencoded messages or C code and
-cite or fill those differently than normal text. None of this is
+cite or fill those differently from normal text. None of this is
currently part of Supercite, but contributions are welcome!
@node Using Regi
diff --git a/etc/NEWS b/etc/NEWS
index de8e20e..b0e17c7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -64,10 +64,21 @@ It was declared obsolete in Emacs 27.1.
* Changes in Emacs 28.1
+** Support for '(box . SIZE)' cursor-type.
+By default, 'box' cursor always has a filled box shape. But if you
+specify cursor-type to be '(box . SIZE)', the cursor becomes a hollow
+box if the point is on an image larger than 'SIZE' pixels in any
+dimension.
+
* Editing Changes in Emacs 28.1
+++
+** New command 'undo-redo'.
+It undoes previous undo commands, but doesn't record itself as an
+undoable command.
+
++++
** 'read-number' now has its own history variable.
Additionally, the function now accepts a HIST argument which can be
used to specify a custom history variable.
@@ -115,6 +126,26 @@ supplied error message.
*** New connection method "media", which allows accessing media devices
like cell phones, tablets or cameras.
+** map.el
+
+*** Pcase 'map' pattern added keyword symbols abbreviation.
+A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
+equivalent to '(map (:sym sym))'.
+** Package
+
++++
+*** New functions to filter the package list.
+The filter command key bindings are as follows:
+
+key binding
+--- -------
+/ a package-menu-filter-by-archive
+/ k package-menu-filter-by-keyword
+/ n package-menu-filter-by-name
+/ s package-menu-filter-by-status
+/ v package-menu-filter-by-version
+/ / package-menu-filter-clear
+
* New Modes and Packages in Emacs 28.1
@@ -142,6 +173,9 @@ by mistake and were not useful to Lisp code.
* Lisp Changes in Emacs 28.1
+** Remove the 'force-new-style-backquotes' variable.
+This removes the final remaining trace of old-style backquotes.
+
** The module header 'emacs-module.h' now contains type aliases
'emacs_function' and 'emacs_finalizer' for module functions and
finalizers, respectively.
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index 433f1f7..312869f 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -2630,6 +2630,14 @@ will be chosen even if you have an entry for "image/*"
in your
overrides all system and Emacs-provided defaults. To get the old
method back, set 'mailcap-prefer-mailcap-viewers' to nil.
+** MH-E
++++
+*** The hook 'mh-show-mode-hook' is now called before the message is inserted.
+Functions that want to affect the message text (for example, to change
+highlighting) can no longer use 'mh-show-mode-hook', because the
+message contents will not yet have been inserted when the hook is
+called. Such functions should now be attached to 'mh-show-hook'.
+
** URL
---
@@ -3583,6 +3591,12 @@ Setting this on the first character of a help string
disables
conversions via 'substitute-command-keys'.
+++
+** New text property 'minibuffer-message'.
+Setting this on a character of the minibuffer text will display the
+temporary echo messages before that character, when messages need to
+be displayed while minibuffer is active.
+
++++
** 'undo' can be made to ignore the active region for a command
by setting 'undo-inhibit-region' symbol property of that command to
non-nil. This is used by 'mouse-drag-region' to make the effect
diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h
index 0d4b9c2..394ca3c 100644
--- a/lib/_Noreturn.h
+++ b/lib/_Noreturn.h
@@ -28,7 +28,10 @@
# define _Noreturn [[noreturn]]
# elif ((!defined __cplusplus || defined __clang__) \
&& (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)))
+ || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))
/* _Noreturn works as-is. */
# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
diff --git a/lib/c++defs.h b/lib/c++defs.h
index 7a05763..3e6aaab 100644
--- a/lib/c++defs.h
+++ b/lib/c++defs.h
@@ -301,9 +301,6 @@
_GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \
"The symbol ::" #func " refers to the system
function. " \
"Use " #namespace "::" #func " instead.")
-# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
-# define
_GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
- extern __typeof__ (func) func
# else
# define
_GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
_GL_EXTERN_C int _gl_cxxalias_dummy
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 1c8085b..6775db0 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -854,6 +854,7 @@ REPLACE_DPRINTF = @REPLACE_DPRINTF@
REPLACE_DUP = @REPLACE_DUP@
REPLACE_DUP2 = @REPLACE_DUP2@
REPLACE_FACCESSAT = @REPLACE_FACCESSAT@
+REPLACE_FCHMODAT = @REPLACE_FCHMODAT@
REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@
REPLACE_FCLOSE = @REPLACE_FCLOSE@
REPLACE_FCNTL = @REPLACE_FCNTL@
@@ -885,6 +886,7 @@ REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@
REPLACE_GMTIME = @REPLACE_GMTIME@
REPLACE_INITSTATE = @REPLACE_INITSTATE@
REPLACE_ISATTY = @REPLACE_ISATTY@
+REPLACE_LCHMOD = @REPLACE_LCHMOD@
REPLACE_LCHOWN = @REPLACE_LCHOWN@
REPLACE_LINK = @REPLACE_LINK@
REPLACE_LINKAT = @REPLACE_LINKAT@
@@ -2935,9 +2937,11 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNU
-e 's|@''HAVE_MKNOD''@|$(HAVE_MKNOD)|g' \
-e 's|@''HAVE_MKNODAT''@|$(HAVE_MKNODAT)|g' \
-e 's|@''HAVE_UTIMENSAT''@|$(HAVE_UTIMENSAT)|g' \
+ -e 's|@''REPLACE_FCHMODAT''@|$(REPLACE_FCHMODAT)|g' \
-e 's|@''REPLACE_FSTAT''@|$(REPLACE_FSTAT)|g' \
-e 's|@''REPLACE_FSTATAT''@|$(REPLACE_FSTATAT)|g' \
-e 's|@''REPLACE_FUTIMENS''@|$(REPLACE_FUTIMENS)|g' \
+ -e 's|@''REPLACE_LCHMOD''@|$(REPLACE_LCHMOD)|g' \
-e 's|@''REPLACE_LSTAT''@|$(REPLACE_LSTAT)|g' \
-e 's|@''REPLACE_MKDIR''@|$(REPLACE_MKDIR)|g' \
-e 's|@''REPLACE_MKFIFO''@|$(REPLACE_MKFIFO)|g' \
diff --git a/lib/libc-config.h b/lib/libc-config.h
index aef1f79..124f1d7 100644
--- a/lib/libc-config.h
+++ b/lib/libc-config.h
@@ -55,8 +55,17 @@
#ifndef __glibc_clang_prereq
# if defined __clang_major__ && defined __clang_minor__
-# define __glibc_clang_prereq(maj, min) \
- ((maj) < __clang_major__ + ((min) <= __clang_minor__))
+# ifdef __apple_build_version__
+/* Apple for some reason renumbers __clang_major__ and __clang_minor__.
+ Gnulib code uses only __glibc_clang_prereq (3, 5); map it to
+ 6000000 <= __apple_build_version__. Support for other calls to
+ __glibc_clang_prereq can be added here as needed. */
+# define __glibc_clang_prereq(maj, min) \
+ ((maj) == 3 && (min) == 5 ? 6000000 <= __apple_build_version__ : 0)
+# else
+# define __glibc_clang_prereq(maj, min) \
+ ((maj) < __clang_major__ + ((min) <= __clang_minor__))
+# endif
# else
# define __glibc_clang_prereq(maj, min) 0
# endif
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index c1e3243..e3ab315 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -392,13 +392,25 @@ struct stat
#if @GNULIB_FCHMODAT@
-# if !@HAVE_FCHMODAT@
+# if @REPLACE_FCHMODAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fchmodat
+# define fchmodat rpl_fchmodat
+# endif
+_GL_FUNCDECL_RPL (fchmodat, int,
+ (int fd, char const *file, mode_t mode, int flag)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (fchmodat, int,
+ (int fd, char const *file, mode_t mode, int flag));
+# else
+# if !@HAVE_FCHMODAT@
_GL_FUNCDECL_SYS (fchmodat, int,
(int fd, char const *file, mode_t mode, int flag)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (fchmodat, int,
(int fd, char const *file, mode_t mode, int flag));
+# endif
_GL_CXXALIASWARN (fchmodat);
#elif defined GNULIB_POSIXCHECK
# undef fchmodat
@@ -502,31 +514,24 @@ _GL_WARN_ON_USE (futimens, "futimens is not portable - "
#if @GNULIB_LCHMOD@
/* Change the mode of FILENAME to MODE, without dereferencing it if FILENAME
denotes a symbolic link. */
-# if !@HAVE_LCHMOD@
-/* The lchmod replacement follows symbolic links. Callers should take
- this into account; lchmod should be applied only to arguments that
- are known to not be symbolic links. On hosts that lack lchmod,
- this can lead to race conditions between the check and the
- invocation of lchmod, but we know of no workarounds that are
- reliable in general. You might try requesting support for lchmod
- from your operating system supplier. */
+# if @REPLACE_LCHMOD@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# define lchmod chmod
+# undef lchmod
+# define lchmod rpl_lchmod
# endif
-/* Need to cast, because on mingw, the second parameter of chmod is
- int mode. */
-_GL_CXXALIAS_RPL_CAST_1 (lchmod, chmod, int,
- (const char *filename, mode_t mode));
+_GL_FUNCDECL_RPL (lchmod, int,
+ (char const *filename, mode_t mode)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (lchmod, int,
+ (char const *filename, mode_t mode));
# else
-# if 0 /* assume already declared */
+# if !@HAVE_LCHMOD@ || defined __hpux
_GL_FUNCDECL_SYS (lchmod, int, (const char *filename, mode_t mode)
_GL_ARG_NONNULL ((1)));
# endif
_GL_CXXALIAS_SYS (lchmod, int, (const char *filename, mode_t mode));
# endif
-# if @HAVE_LCHMOD@
_GL_CXXALIASWARN (lchmod);
-# endif
#elif defined GNULIB_POSIXCHECK
# undef lchmod
# if HAVE_RAW_DECL_LCHMOD
diff --git a/lisp/align.el b/lisp/align.el
index f16cb84..61387b2 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -261,7 +261,7 @@ The possible settings for `align-region-separate' are:
`group' Each contiguous set of lines where a specific alignment
occurs is considered a section for that alignment rule.
Note that each rule may have any entirely different set
- of section divisions than another.
+ of section divisions from another.
int alpha = 1; /* one */
double beta = 2.0;
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index fecaf20..fbdddca 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -1847,7 +1847,7 @@ Optional HAS-SUCCESSOR is true if the item is followed by
a sibling.
We also hide the header-prefix string.
Guides are established according to the item-widget's :guide-column-flags,
-when different than :was-guide-column-flags. Changing that property and
+when different from :was-guide-column-flags. Changing that property and
reapplying this method will rectify the glyphs."
(when (not (widget-get item-widget :is-container))
diff --git a/lisp/allout.el b/lisp/allout.el
index 408a2a9..dedad45 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -5926,7 +5926,7 @@ See `allout-toggle-current-subtree-encryption' for more
details."
(setq buffer-file-coding-system
(select-safe-coding-system subtree-beg subtree-end))
;; if the coding system for the text being encrypted is different
- ;; than that prevailing, then there a real risk that the coding
+ ;; from that prevailing, then there a real risk that the coding
;; system can't be noticed by emacs when the file is visited. to
;; mitigate that, offer to preserve the coding system using a file
;; local variable.
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 9bc3aad..25961d4 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -171,7 +171,7 @@ If this contains a %s, that will be replaced by the
matching rule."
(mapatoms (lambda (mode)
(let ((name (symbol-name mode)))
(when (string-match "-mode$" name)
- (add-to-list 'modes name)))))
+ (push name modes)))))
(sort modes 'string<)))
(completing-read "Local variables for mode: " v1 nil t)
" . (("
diff --git a/lisp/battery.el b/lisp/battery.el
index 1d33900..7027b25 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -1,8 +1,9 @@
-;;; battery.el --- display battery status information
+;;; battery.el --- display battery status information -*- lexical-binding:t
-*-
;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <address@hidden>
+;; Maintainer: address@hidden
;; Keywords: hardware
;; This file is part of GNU Emacs.
@@ -22,15 +23,19 @@
;;; Commentary:
-;; There is at present support for GNU/Linux, macOS and Windows. This
-;; library supports both the `/proc/apm' file format of Linux version
-;; 1.3.58 or newer and the `/proc/acpi/' directory structure of Linux
-;; 2.4.20 and 2.6. Darwin (macOS) is supported by using the `pmset'
-;; program. Windows is supported by the GetSystemPowerStatus API call.
+;; There is at present support for GNU/Linux, macOS, and Windows.
+;; This library supports:
+;; - UPower (https://upower.freedesktop.org) via D-Bus API.
+;; - the `/sys/class/power_supply/' files of Linux >= 2.6.39.
+;; - the `/proc/acpi/' directory structure of Linux 2.4.20 and 2.6.
+;; - the `/proc/apm' file format of Linux version 1.3.58 or newer.
+;; - Darwin (macOS) by using the `pmset' program.
+;; - Windows via the GetSystemPowerStatus API call.
;;; Code:
(require 'timer)
+(require 'dbus)
(eval-when-compile (require 'cl-lib))
(defgroup battery nil
@@ -38,11 +43,22 @@
:prefix "battery-"
:group 'hardware)
-(defcustom battery-upower-device "battery_BAT1"
- "Upower battery device name."
- :version "26.1"
- :type 'string
- :group 'battery)
+(defcustom battery-upower-device nil
+ "UPower device of the `:battery' type.
+Use `battery-upower-device-list' to list all available UPower devices.
+If set to nil, then autodetect `:battery' device."
+ :version "28.1"
+ :type '(choice string (const :tag "Autodetect" nil)))
+
+(defcustom battery-upower-line-power-device nil
+ "UPower device of the `:line-power' type.
+Use `battery-upower-device-list' to list all available UPower devices.
+If set to nil, then autodetect `:battery' device."
+ :version "28.1"
+ :type '(choice string (const :tag "Autodetect" nil)))
+
+(defconst battery-upower-dbus-service "org.freedesktop.UPower"
+ "Well-known UPower service name for the D-Bus system.")
(defun battery--find-linux-sysfs-batteries ()
(let ((dirs nil))
@@ -54,7 +70,9 @@
(nreverse dirs)))
(defcustom battery-status-function
- (cond ((and (eq system-type 'gnu/linux)
+ (cond ((dbus-ping :system battery-upower-dbus-service)
+ #'battery-upower)
+ ((and (eq system-type 'gnu/linux)
(file-readable-p "/proc/apm"))
#'battery-linux-proc-apm)
((and (eq system-type 'gnu/linux)
@@ -84,8 +102,7 @@ Its cons cells are of the form
CONVERSION is the character code of a \"conversion specification\"
introduced by a `%' character in a control string."
- :type '(choice (const nil) function)
- :group 'battery)
+ :type '(choice (const nil) function))
(defcustom battery-echo-area-format
"Power %L, battery %B (%p%% load, remaining time %t)"
@@ -105,8 +122,7 @@ string are substituted as defined by the current value of
the variable
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- :type '(choice string (const nil))
- :group 'battery)
+ :type '(choice string (const nil)))
(defvar battery-mode-line-string nil
"String to display in the mode line.")
@@ -115,8 +131,7 @@ string are substituted as defined by the current value of
the variable
(defcustom battery-mode-line-limit 100
"Percentage of full battery load below which display battery status."
:version "24.1"
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-mode-line-format
(cond ((eq battery-status-function 'battery-linux-proc-acpi)
@@ -139,25 +154,21 @@ string are substituted as defined by the current value of
the variable
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- :type '(choice string (const nil))
- :group 'battery)
+ :type '(choice string (const nil)))
(defcustom battery-update-interval 60
"Seconds after which the battery status will be updated."
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-load-low 25
"Upper bound of low battery load percentage.
A battery load percentage below this number is considered low."
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-load-critical 10
"Upper bound of critical battery load percentage.
A battery load percentage below this number is considered critical."
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defvar battery-update-timer nil
"Interval timer object.")
@@ -181,7 +192,7 @@ The text displayed in the mode line is controlled by
`battery-mode-line-format' and `battery-status-function'.
The mode line is be updated every `battery-update-interval'
seconds."
- :global t :group 'battery
+ :global t
(setq battery-mode-line-string "")
(or global-mode-string (setq global-mode-string '("")))
(and battery-update-timer (cancel-timer battery-update-timer))
@@ -537,17 +548,68 @@ The following %-sequences are provided:
(t "N/A"))))))
-(declare-function dbus-get-property "dbus.el"
- (bus service path interface property))
-
;;; `upowerd' interface.
-(defsubst battery-upower-prop (pname &optional device)
+(defconst battery-upower-dbus-interface "org.freedesktop.UPower"
+ "The interface to UPower.
+See URL `https://upower.freedesktop.org/docs/'.")
+
+(defconst battery-upower-dbus-path "/org/freedesktop/UPower"
+ "D-Bus path to talk to UPower service.")
+
+(defconst battery-upower-dbus-device-interface
+ (concat battery-upower-dbus-interface ".Device")
+ "The Device interface of the UPower.
+See URL `https://upower.freedesktop.org/docs/Device.html'.")
+
+(defconst battery-upower-dbus-device-path
+ (concat battery-upower-dbus-path "/devices")
+ "D-Bus path to talk to devices part of the UPower service.")
+
+(defconst battery-upower-types
+ '((0 . :unknown) (1 . :line-power) (2 . :battery)
+ (3 . :ups) (4 . :monitor) (5 . :mouse)
+ (6 . :keyboard) (7 . :pda) (8 . :phone))
+ "Type of the device.")
+
+(defconst battery-upower-states
+ '((0 . "unknown") (1 . "charging") (2 . "discharging")
+ (3 . "empty") (4 . "fully-charged") (5 . "pending-charge")
+ (6 . "pending-discharge"))
+ "Alist of battery power states.
+Only valid for `:battery' devices.")
+
+(defun battery-upower-device-property (device property)
+ "Get value of the single PROPERTY for the UPower DEVICE."
(dbus-get-property
- :system
- "org.freedesktop.UPower"
- (concat "/org/freedesktop/UPower/devices/" (or device
battery-upower-device))
- "org.freedesktop.UPower"
- pname))
+ :system battery-upower-dbus-service
+ (expand-file-name device battery-upower-dbus-device-path)
+ battery-upower-dbus-device-interface
+ property))
+
+(defun battery-upower-device-all-properties (device)
+ "Return value for all available properties for the UPower DEVICE."
+ (dbus-get-all-properties
+ :system battery-upower-dbus-service
+ (expand-file-name device battery-upower-dbus-device-path)
+ battery-upower-dbus-device-interface))
+
+(defun battery-upower-device-list ()
+ "Return list of all available UPower devices.
+Each element is the cons cell in form: (DEVICE . DEVICE-TYPE)."
+ (mapcar (lambda (device-path)
+ (let* ((device (file-relative-name
+ device-path battery-upower-dbus-device-path))
+ (type-num (battery-upower-device-property device "Type")))
+ (cons device (or (cdr (assq type-num battery-upower-types))
+ :unknown))))
+ (dbus-call-method :system battery-upower-dbus-service
+ battery-upower-dbus-path
+ battery-upower-dbus-interface
+ "EnumerateDevices")))
+
+(defun battery-upower-device-autodetect (device-type)
+ "Return first matching UPower device of DEVICE-TYPE."
+ (car (rassq device-type (battery-upower-device-list))))
(defun battery-upower ()
"Get battery status from dbus Upower interface.
@@ -559,45 +621,49 @@ The following %-sequences are provided:
%p Battery load percentage
%r Current rate
%B Battery status (verbose)
+%b Battery status: empty means high, `-' means low,
+ `!' means critical, and `+' means charging
%L AC line status (verbose)
%s Remaining time (to charge or discharge) in seconds
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- (let ((percents (battery-upower-prop "Percentage"))
- (time-to-empty (battery-upower-prop "TimeToEmpty"))
- (time-to-full (battery-upower-prop "TimeToFull"))
- (state (battery-upower-prop "State"))
- (online (battery-upower-prop "Online" "line_power_ACAD"))
- (energy (battery-upower-prop "Energy"))
- (energy-rate (battery-upower-prop "EnergyRate"))
- (battery-states '((0 . "unknown") (1 . "charging")
- (2 . "discharging") (3 . "empty")
- (4 . "fully-charged") (5 . "pending-charge")
- (6 . "pending-discharge")))
- seconds minutes hours remaining-time)
- (cond ((and online time-to-full)
- (setq seconds time-to-full))
- ((and (not online) time-to-empty)
- (setq seconds time-to-empty)))
- (when seconds
- (setq minutes (/ seconds 60)
- hours (/ minutes 60)
- remaining-time (format "%d:%02d" hours (mod minutes 60))))
- (list (cons ?c (or (and energy
- (number-to-string (round (* 1000 energy))))
- "N/A"))
- (cons ?p (or (and percents (number-to-string (round percents)))
- "N/A"))
- (cons ?r (or (and energy-rate
- (concat (number-to-string energy-rate) " W"))
- "N/A"))
- (cons ?B (or (and state (cdr (assoc state battery-states)))
- "unknown"))
- (cons ?L (or (and online "on-line") "off-line"))
- (cons ?s (or (and seconds (number-to-string seconds)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
+ (let* ((bat-device (or battery-upower-device
+ (battery-upower-device-autodetect :battery)))
+ (bat-props (when bat-device
+ (battery-upower-device-all-properties bat-device)))
+ (percents (cdr (assoc "Percentage" bat-props)))
+ (time-to-empty (cdr (assoc "TimeToEmpty" bat-props)))
+ (time-to-full (cdr (assoc "TimeToFull" bat-props)))
+ (state (cdr (assoc "State" bat-props)))
+ (level (cdr (assoc "BatteryLevel" bat-props)))
+ (energy (cdr (assoc "Energy" bat-props)))
+ (energy-rate (cdr (assoc "EnergyRate" bat-props)))
+ (lp-device (or battery-upower-line-power-device
+ (battery-upower-device-autodetect :line-power)))
+ (online-p (when lp-device
+ (battery-upower-device-property lp-device "Online")))
+ (seconds (if online-p time-to-full time-to-empty))
+ (minutes (when seconds (/ seconds 60)))
+ (hours (when minutes (/ minutes 60)))
+ (remaining-time (when hours
+ (format "%d:%02d" hours (mod minutes 60)))))
+ (list (cons ?c (if energy (number-to-string (round (* 1000 energy)))
"N/A"))
+ (cons ?p (if percents (number-to-string (round percents)) "N/A"))
+ (cons ?r (if energy-rate
+ (concat (number-to-string energy-rate) " W")
+ "N/A"))
+ (cons ?B (if state
+ (cdr (assq state battery-upower-states))
+ "unknown"))
+ (cons ?b (cond ((= level 3) "-")
+ ((= level 4) "!")
+ (online-p "+")
+ (t "")))
+ (cons ?L (if online-p "on-line" (if lp-device "off-line" "unknown")))
+ (cons ?s (if seconds (number-to-string seconds) "N/A"))
+ (cons ?m (if minutes (number-to-string minutes) "N/A"))
+ (cons ?h (if hours (number-to-string hours) "N/A"))
(cons ?t (or remaining-time "N/A")))))
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index a6e143c..a1aea30 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -819,14 +819,12 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
)
;; Order symbols by type
(mapatoms
- #'(lambda (s)
- (add-to-list (cond
- ((get s 'mode-variable-flag)
- (if (get s 'constant-flag) 'mc 'mv))
- ((get s 'override-flag)
- (if (get s 'constant-flag) 'fo 'ov))
- ('us))
- s))
+ (lambda (s) (push s (cond
+ ((get s 'mode-variable-flag)
+ (if (get s 'constant-flag) mc mv))
+ ((get s 'override-flag)
+ (if (get s 'constant-flag) fo ov))
+ (t us))))
table)
;; Print symbols by type
(when us
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 89a7114..1f64626 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2209,8 +2209,7 @@ With argument ARG, insert value in current buffer after
the form."
(defun byte-compile-insert-header (_filename outbuffer)
"Insert a header at the start of OUTBUFFER.
Call from the source buffer."
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
- (dynamic byte-compile-dynamic)
+ (let ((dynamic byte-compile-dynamic)
(optimize byte-optimize))
(with-current-buffer outbuffer
(goto-char (point-min))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9d0fd15..4c2f589 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1037,9 +1037,10 @@ For more details, see Info node `(cl)Loop Facility'.
(defmacro cl--push-clause-loop-body (clause)
"Apply CLAUSE to both `cl--loop-conditions' and `cl--loop-body'."
- `(progn
- (push ,clause cl--loop-conditions)
- (push ,clause cl--loop-body)))
+ (macroexp-let2 nil sym clause
+ `(progn
+ (push ,sym cl--loop-conditions)
+ (push ,sym cl--loop-body))))
;; Below is a complete spec for cl-loop, in several parts that correspond
;; to the syntax given in CLtL2. The specs do more than specify where
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 92241a7..b43e53b 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -24,7 +24,7 @@
;;; Commentary:
;; This is a re-implementation of the setf machinery using a different
-;; underlying approach than the one used earlier in CL, which was based on
+;; underlying approach from the one used earlier in CL, which was based on
;; define-setf-expander.
;; `define-setf-expander' makes every "place-expander" return a 5-tuple
;; (VARS VALUES STORES GETTER SETTER)
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 67f5b3c..9c23344 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <address@hidden>
;; Keywords: convenience, map, hash-table, alist, array
-;; Version: 2.0
+;; Version: 2.1
;; Package-Requires: ((emacs "25"))
;; Package: map
@@ -56,8 +56,10 @@ evaluated and searched for in the map. The match fails if
for any KEY
found in the map, the corresponding PAT doesn't match the value
associated to the KEY.
-Each element can also be a SYMBOL, which is an abbreviation of a (KEY
-PAT) tuple of the form (\\='SYMBOL SYMBOL).
+Each element can also be a SYMBOL, which is an abbreviation of
+a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL
+is a keyword, it is an abbreviation of the form (:SYMBOL SYMBOL),
+useful for binding plist values.
Keys in ARGS not found in the map are ignored, and the match doesn't
fail."
@@ -486,9 +488,12 @@ Example:
(defun map--make-pcase-bindings (args)
"Return a list of pcase bindings from ARGS to the elements of a map."
(seq-map (lambda (elt)
- (if (consp elt)
- `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt))
- `(app (pcase--flip map-elt ',elt) ,elt)))
+ (cond ((consp elt)
+ `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
+ ((keywordp elt)
+ (let ((var (intern (substring (symbol-name elt) 1))))
+ `(app (pcase--flip map-elt ,elt) ,var)))
+ (t `(app (pcase--flip map-elt ',elt) ,elt))))
args))
(defun map--make-pcase-patterns (args)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a9508c1..c4f7518 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2679,15 +2679,18 @@ either a full name or nil, and EMAIL is a valid email
address."
(define-key map "i" 'package-menu-mark-install)
(define-key map "U" 'package-menu-mark-upgrades)
(define-key map "r" 'revert-buffer)
- (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
- (define-key map (kbd "/ n") 'package-menu-filter-by-name)
- (define-key map (kbd "/ /") 'package-menu-clear-filter)
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
(define-key map "H" #'package-menu-hide-package)
(define-key map "?" 'package-menu-describe-package)
(define-key map "(" #'package-menu-toggle-hiding)
+ (define-key map (kbd "/ /") 'package-menu-clear-filter)
+ (define-key map (kbd "/ a") 'package-menu-filter-by-archive)
+ (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
+ (define-key map (kbd "/ n") 'package-menu-filter-by-name)
+ (define-key map (kbd "/ s") 'package-menu-filter-by-status)
+ (define-key map (kbd "/ v") 'package-menu-filter-by-version)
map)
"Local keymap for `package-menu-mode' buffers.")
@@ -2714,11 +2717,14 @@ either a full name or nil, and EMAIL is a valid email
address."
"--"
("Filter Packages"
+ ["Filter by Archive" package-menu-filter-by-archive :help "Filter
packages by archive"]
["Filter by Keyword" package-menu-filter-by-keyword :help "Filter
packages by keyword"]
["Filter by Name" package-menu-filter-by-name :help "Filter packages by
name"]
+ ["Filter by Status" package-menu-filter-by-status :help "Filter packages
by status"]
+ ["Filter by Version" package-menu-filter-by-version :help "Filter
packages by version"]
["Clear Filter" package-menu-clear-filter :help "Clear package list
filter"])
- ["Hide by Regexp" package-menu-hide-package :help "Permanently hide all
packages matching a regexp"]
+ ["Hide by Regexp" package-menu-hide-package :help "Hide all packages
matching a regexp"]
["Display Older Versions" package-menu-toggle-hiding
:style toggle :selected (not package-menu--hide-packages)
:help "Display package even if a newer version is already installed"]
@@ -3021,22 +3027,31 @@ When none are given, the package matches."
found)
t))
-(defun package-menu--generate (remember-pos packages &optional keywords)
- "Populate the Package Menu.
+(defun package-menu--display (remember-pos suffix)
+ "Display the Package Menu.
If REMEMBER-POS is non-nil, keep point on the same entry.
+
+If SUFFIX is non-nil, append that to \"Package\" for the first
+column in the header line."
+ (setf (car (aref tabulated-list-format 0))
+ (if suffix
+ (concat "Package[" suffix "]")
+ "Package"))
+ (tabulated-list-init-header)
+ (tabulated-list-print remember-pos))
+
+(defun package-menu--generate (remember-pos &optional packages keywords)
+ "Populate and display the Package Menu.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display.
With KEYWORDS given, only packages with those keywords are
shown."
(package-menu--refresh packages keywords)
- (setf (car (aref tabulated-list-format 0))
- (if keywords
- (let ((filters (mapconcat #'identity keywords ",")))
- (concat "Package[" filters "]"))
- "Package"))
- (tabulated-list-init-header)
- (tabulated-list-print remember-pos))
+ (package-menu--display remember-pos
+ (when keywords
+ (let ((filters (mapconcat #'identity keywords ",")))
+ (concat "Package[" filters "]")))))
(defun package-menu--print-info (pkg)
"Return a package entry suitable for `tabulated-list-entries'.
@@ -3174,8 +3189,9 @@ function. The args ARG and NOCONFIRM, passed from
(define-obsolete-function-alias 'package-menu-refresh 'revert-buffer "27.1")
(defun package-menu-hide-package ()
- "Hide a package under point in Package Menu.
-If optional arg BUTTON is non-nil, describe its associated package."
+ "Hide in Package Menu packages that match a regexp.
+Prompts for the regexp to match against package names.
+The default regexp will hide only the package whose name is at point."
(interactive)
(package--ensure-package-menu-mode)
(declare (interactive-only "change `package-hidden-regexps' instead."))
@@ -3673,45 +3689,160 @@ shown."
(select-window win)
(switch-to-buffer buf))))
+(defun package-menu--filter-by (predicate suffix)
+ "Filter \"*Packages*\" buffer by PREDICATE and add SUFFIX to header.
+PREDICATE is a function which will be called with one argument, a
+`package-desc' object, and returns t if that object should be
+listed in the Package Menu.
+
+SUFFIX is passed on to `package-menu--display' and is added to
+the header line of the first column."
+ ;; Update `tabulated-list-entries' so that it contains all
+ ;; packages before searching.
+ (package-menu--refresh t nil)
+ (let (found-entries)
+ (dolist (entry tabulated-list-entries)
+ (when (funcall predicate (car entry))
+ (push entry found-entries)))
+ (if found-entries
+ (progn
+ (setq tabulated-list-entries found-entries)
+ (package-menu--display t suffix))
+ (user-error "No packages found"))))
+
+(defun package-menu-filter-by-archive (archive)
+ "Filter the \"*Packages*\" buffer by ARCHIVE.
+Display only packages from package archive ARCHIVE.
+
+When called interactively, prompt for ARCHIVE, which can be a
+comma-separated string. If ARCHIVE is empty, show all packages.
+
+When called from Lisp, ARCHIVE can be a string or a list of
+strings. If ARCHIVE is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read-multiple
+ "Filter by archive (comma separated): "
+ (mapcar #'car package-archives))))
+ (package--ensure-package-menu-mode)
+ (let ((re (if (listp archive)
+ (regexp-opt archive)
+ archive)))
+ (package-menu--filter-by (lambda (pkg-desc)
+ (let ((pkg-archive (package-desc-archive pkg-desc)))
+ (and pkg-archive
+ (string-match-p re pkg-archive))))
+ (concat "archive:" (if (listp archive)
+ (string-join archive ",")
+ archive)))))
+
(defun package-menu-filter-by-keyword (keyword)
"Filter the \"*Packages*\" buffer by KEYWORD.
-Show only those items that relate to the specified KEYWORD.
-
-KEYWORD can be a string or a list of strings. If it is a list, a
-package will be displayed if it matches any of the keywords.
-Interactively, it is a list of strings separated by commas.
-
-KEYWORD can also be used to filter by status or archive name by
-using keywords like \"arc:gnu\" and \"status:available\".
-Statuses available include \"incompat\", \"available\",
-\"built-in\" and \"installed\"."
- (interactive
- (list (completing-read-multiple
- "Keywords (comma separated): " (package-all-keywords))))
+Display only packages with specified KEYWORD.
+
+When called interactively, prompt for KEYWORD, which can be a
+comma-separated string. If KEYWORD is empty, show all packages.
+
+When called from Lisp, KEYWORD can be a string or a list of
+strings. If KEYWORD is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read-multiple
+ "Keywords (comma separated): "
+ (package-all-keywords))))
+ (when (stringp keyword)
+ (setq keyword (list keyword)))
(package--ensure-package-menu-mode)
- (package-show-package-list t (if (stringp keyword)
- (list keyword)
- keyword)))
+ (if (not keyword)
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (package--has-keyword-p pkg-desc keyword))
+ (concat "keyword:" (string-join keyword ",")))))
(defun package-menu-filter-by-name (name)
- "Filter the \"*Packages*\" buffer by NAME.
-Show only those items whose name matches the regular expression
-NAME. If NAME is nil or the empty string, show all packages."
- (interactive (list (read-from-minibuffer "Filter by name (regexp): ")))
+ "Filter the \"*Packages*\" buffer by NAME regexp.
+Display only packages with name that matches regexp NAME.
+
+When called interactively, prompt for NAME.
+
+If NAME is nil or the empty string, show all packages."
+ (interactive (list (read-regexp "Filter by name (regexp)")))
(package--ensure-package-menu-mode)
(if (or (not name) (string-empty-p name))
- (package-show-package-list t nil)
- ;; Update `tabulated-list-entries' so that it contains all
- ;; packages before searching.
- (package-menu--refresh t nil)
- (let (matched)
- (dolist (entry tabulated-list-entries)
- (let* ((pkg-name (package-desc-name (car entry))))
- (when (string-match name (symbol-name pkg-name))
- (push pkg-name matched))))
- (if matched
- (package-show-package-list matched nil)
- (user-error "No packages found")))))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match-p name (symbol-name
+ (package-desc-name pkg-desc))))
+ (format "name:%s" name))))
+
+(defun package-menu-filter-by-status (status)
+ "Filter the \"*Packages*\" buffer by STATUS.
+Display only packages with specified STATUS.
+
+When called interactively, prompt for STATUS, which can be a
+comma-separated string. If STATUS is empty, show all packages.
+
+When called from Lisp, STATUS can be a string or a list of
+strings. If STATUS is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read "Filter by status: "
+ '("avail-obso"
+ "available"
+ "built-in"
+ "dependency"
+ "disabled"
+ "external"
+ "held"
+ "incompat"
+ "installed"
+ "new"
+ "unsigned"))))
+ (package--ensure-package-menu-mode)
+ (if (or (not status) (string-empty-p status))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match-p status (package-desc-status pkg-desc)))
+ (format "status:%s" status))))
+
+(defun package-menu-filter-by-version (version predicate)
+ "Filter the \"*Packages*\" buffer by VERSION and PREDICATE.
+Display only packages with a matching version.
+
+When called interactively, prompt for one of the qualifiers `<',
+`>' or `=', and a package version. Show only packages that has a
+lower (`<'), equal (`=') or higher (`>') version than the
+specified one.
+
+When called from Lisp, VERSION should be a version string and
+PREDICATE should be the symbol `=', `<' or `>'.
+
+If VERSION is nil or the empty string, show all packages."
+ (interactive (let ((choice (intern
+ (char-to-string
+ (read-char-choice
+ "Filter by version? [Type =, <, > or q] "
+ '(?< ?> ?= ?q))))))
+ (if (eq choice 'q)
+ '(quit nil)
+ (list (read-from-minibuffer
+ (concat "Filter by version ("
+ (pcase choice
+ ('= "= equal to")
+ ('< "< less than")
+ ('> "> greater than"))
+ "): "))
+ choice))))
+ (unless (equal predicate 'quit)
+ (if (or (not version) (string-empty-p version))
+ (package-menu--generate t t)
+ (package-menu--filter-by
+ (let ((fun (pcase predicate
+ ('= 'version-list-=)
+ ('< 'version-list-<)
+ ('> '(lambda (a b) (not (version-list-<= a b))))
+ (_ (error "Unknown predicate: %s" predicate))))
+ (ver (version-to-list version)))
+ (lambda (pkg-desc)
+ (funcall fun (package-desc-version pkg-desc) ver)))
+ (format "versions:%s%s" predicate version)))))
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
@@ -3760,6 +3891,7 @@ The return value is a string (or nil in case we can't
find it)."
(or (lm-header "package-version")
(lm-header "version")))))))))
+
;;;; Quickstart: precompute activation actions for faster start up.
;; Activating packages via `package-initialize' is costly: for N installed
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 03af053..b4cab57 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -290,7 +290,7 @@ Return (REGEXP . PRECEDENCE)."
((null (cdr body)) ; Single item.
(rx--translate (car body)))
((rx--every #'stringp body) ; All strings.
- (cons (list (regexp-opt body nil t))
+ (cons (list (regexp-opt body nil))
t))
((rx--every #'rx--charset-p body) ; All charsets.
(rx--translate-union nil body))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 77b8e42..506c888 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1004,14 +1004,14 @@ The value of this variable is used when Font Lock mode
is turned on."
;; font-lock.el uses its own function for buffer fontification. This function
;; makes fontification be on a message-by-message basis and so visiting an
;; RMAIL file is much faster. A clever implementation of the function might
-;; fontify the headers differently than the message body. (It should, and
+;; fontify the headers differently from the message body. (It should, and
;; correspondingly for Mail mode, but I can't be bothered to do the work. Can
;; you?) This hints at a more interesting use...
;;
;; Languages that contain text normally contained in different major modes
;; could define their own fontification functions that treat text differently
;; depending on its context. For example, Perl mode could arrange that here
-;; docs are fontified differently than Perl code. Or Yacc mode could fontify
+;; docs are fontified differently from Perl code. Or Yacc mode could fontify
;; rules one way and C code another. Neat!
;;
;; A further reason to use the fontification indirection feature is when the
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 65a0263..a47e657 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -12498,7 +12498,7 @@ save those articles instead."
(gnus-activate-group to-newsgroup nil nil to-method)
(gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup))
+ (user-error "No such group: %s" to-newsgroup))
to-newsgroup)))
(defvar gnus-summary-save-parts-counter)
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index e863051..7629d5c 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -53,7 +53,7 @@
;; positions!
,@(unless (mm-coding-system-p 'iso-8859-15)
'((iso-8859-15 . iso-8859-1)))
- ;; BIG-5HKSCS is similar to, but different than, BIG-5.
+ ;; BIG-5HKSCS is similar to, but different from, BIG-5.
,@(unless (mm-coding-system-p 'big5-hkscs)
'((big5-hkscs . big5)))
;; A Microsoft misunderstanding.
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index e6fdc93..61bf0a7 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -251,19 +251,23 @@ The value should be nil on displays where the face
(((type tty)
(class color)
(background dark))
- (:background "dark blue"))
+ (:background "dark blue"
+ :extend t))
(((class color)
(background dark))
(:foreground "light yellow"
- :background "dark green"))
+ :background "dark green"
+ :extend t))
(((type tty)
(class color)
(background light))
- (:foreground "dark blue"))
+ (:foreground "dark blue"
+ :extend t))
(((class color)
(background light))
(:foreground "dark green"
- :background "light yellow"))
+ :background "light yellow"
+ :extend t))
(t
()))
"Face for extracted buffers."
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index a6be04e..828ac63 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -497,7 +497,9 @@ If MODE is not set, try to find mode automatically."
(let ((auto-mode-alist
(delq (rassq 'doc-view-mode-maybe auto-mode-alist)
(copy-sequence auto-mode-alist))))
- (set-auto-mode)
+ ;; Don't run hooks that might assume buffer-file-name
+ ;; really associates buffer with a file (bug#39190).
+ (delay-mode-hooks (set-auto-mode))
(setq mode major-mode)))
;; Do not fontify if the guess mode is fundamental.
(unless (eq major-mode 'fundamental-mode)
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 199d524..fee7a16 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -209,7 +209,7 @@ on your system, you could say something like:
;; about twice as fast, even though it looks messier. You
;; can't have everything, I guess. Speed and elegance don't
;; always go hand in hand.
- (vector
+ (make-full-mail-header
;; Number.
(or number 0)
;; Subject.
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 0f364d6..0277524 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -617,7 +617,8 @@ A non-nil `specs' arg must be an alist with
`nnir-query-spec' and
(list (gnus-group-group-name))
(mapcar (lambda (entry)
(gnus-info-group (cadr entry)))
- (gnus-topic-find-groups (gnus-group-topic-name)))))
+ (gnus-topic-find-groups (gnus-group-topic-name)
+ nil t nil t))))
gnus-group-server))))
(query-spec
(or (cdr (assq 'nnir-query-spec specs))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index bf1ac31..9c7b125 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1,4 +1,4 @@
-;;; nnmaildir.el --- maildir backend for Gnus
+;;; nnmaildir.el --- maildir backend for Gnus -*- lexical-binding:t -*-
;; This file is in the public domain.
@@ -261,7 +261,7 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir--param (pgname param)
(setq param (gnus-group-find-parameter pgname param 'allow-list))
(if (vectorp param) (setq param (aref param 0)))
- (eval param))
+ (eval param t))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
(declare (debug (body)))
@@ -690,7 +690,7 @@ This variable is set by `nnmaildir-request-article'.")
"You must set \"directory\" in the select method")
(throw 'return nil))
(setq dir (cadr dir)
- dir (eval dir)
+ dir (eval dir t) ;FIXME: Why `eval'?
dir (expand-file-name dir)
dir (file-name-as-directory dir))
(unless (file-exists-p dir)
@@ -717,13 +717,13 @@ This variable is set by `nnmaildir-request-article'.")
(if x
(progn
(setq x (cadr x)
- x (eval x))
+ x (eval x t)) ;FIXME: Why `eval'?
(setf (nnmaildir--srv-target-prefix server) x))
(setq x (assq 'create-directory defs))
(if x
(progn
(setq x (cadr x)
- x (eval x)
+ x (eval x t) ;FIXME: Why `eval'?
x (file-name-as-directory x))
(setf (nnmaildir--srv-target-prefix server) x))
(setf (nnmaildir--srv-target-prefix server) "")))
@@ -1428,7 +1428,7 @@ This variable is set by `nnmaildir-request-article'.")
(nnmaildir--with-move-buffer
(erase-buffer)
(nnheader-insert-file-contents nnmaildir--file)
- (setq result (eval accept-form)))
+ (setq result (eval accept-form t)))
(unless (or (null result) (nnmaildir--param pgname 'read-only))
(nnmaildir--unlink nnmaildir--file)
(nnmaildir--expired-article group article))
@@ -1544,7 +1544,7 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
(let ((no-force (not force))
(group (nnmaildir--prepare server gname))
- pgname time boundary high low target dir nlist
+ pgname time boundary target dir nlist
didnt nnmaildir--file nnmaildir-article-file-name
deactivate-mark)
(catch 'return
@@ -1720,18 +1720,23 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir-close-group (gname &optional server)
(let ((group (nnmaildir--prepare server gname))
- pgname ls dir msgdir files flist dirs)
+ pgname ls dir msgdir files dirs
+ (fset (make-hash-table :test #'equal)))
(if (null group)
(progn
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
nil)
+ ;; Delete the now obsolete NOV files.
+ ;; FIXME: This can take a somewhat long time, so maybe it's better
+ ;; to do it asynchronously (i.e. in an idle timer).
(setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
msgdir (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new dir) (nnmaildir--cur dir))
+ ;; The dir with the NOV files.
dir (nnmaildir--nndir dir)
dirs (cons (nnmaildir--nov-dir dir)
(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
@@ -1744,14 +1749,15 @@ This variable is set by `nnmaildir-request-article'.")
(save-match-data
(dolist (file files)
(string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
- (push (match-string 1 file) flist)))
+ (puthash (match-string 1 file) t fset)))
+ ;; Not sure why, but we specifically avoid deleting the `:' file.
+ (puthash ":" t fset)
(dolist (dir dirs)
(setq files (cdr dir)
dir (file-name-as-directory (car dir)))
(dolist (file files)
- (unless (or (member file flist) (string= file ":"))
- (setq file (concat dir file))
- (delete-file file))))
+ (unless (gethash file fset)
+ (delete-file (concat dir file)))))
t)))
(defun nnmaildir-close-server (&optional server _defs)
diff --git a/lisp/ido.el b/lisp/ido.el
index 355be5e..7198649 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -4492,8 +4492,6 @@ For details of keybindings, see `ido-find-file'."
(ido-tidy))
(throw 'ido contents))))
-(defvar ido--overlay nil)
-
(defun ido-exhibit ()
"Post command hook for Ido."
;; Find matching files and display a list in the minibuffer.
@@ -4728,13 +4726,13 @@ For details of keybindings, see `ido-find-file'."
(let ((inf (ido-completions contents)))
(setq ido-show-confirm-message nil)
(ido-trace "inf" inf)
- (when ido--overlay
- (delete-overlay ido--overlay))
- (let ((o (make-overlay (point-max) (point-max) nil t t)))
- (when (> (length inf) 0)
- (put-text-property 0 1 'cursor t inf))
- (overlay-put o 'after-string inf)
- (setq ido--overlay o)))
+ (let ((pos (point)))
+ (insert inf)
+ (if (< pos (point-max))
+ ;; Tell set-minibuffer-message where to display the
+ ;; overlay with temporary messages.
+ (put-text-property pos (1+ pos) 'minibuffer-message t)))
+ )
))))
(defun ido-completions (name)
diff --git a/lisp/json.el b/lisp/json.el
index 18d7fda..055f3f5 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -227,6 +227,7 @@ Unlike `reverse', this keeps the property-value pairs
intact."
(define-error 'json-string-format "Bad string format" 'json-error)
(define-error 'json-key-format "Bad JSON object key" 'json-error)
(define-error 'json-object-format "Bad JSON object" 'json-error)
+(define-error 'json-array-format "Bad JSON array" 'json-error)
(define-error 'json-end-of-file "End of file while parsing JSON"
'(end-of-file json-error))
@@ -640,7 +641,7 @@ become JSON objects."
(when (/= (json-peek) ?\])
(if (= (json-peek) ?,)
(json-advance)
- (signal 'json-error (list 'bleah)))))
+ (signal 'json-array-format (list ?, (json-peek))))))
;; Skip over the "]"
(json-advance)
(pcase json-array-type
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 7b7cefa..0d7193c 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -1552,7 +1552,7 @@ in a buffer, try /bin/rmail instead of /bin/mail. If
/bin/rmail
exists, this can be accomplished by keeping the default nil setting of
`mail-interactive'. You might also like to consult local mail experts
for any other interesting command line possibilities. Some versions
-of UNIX have an rmail program which behaves differently than
+of UNIX have an rmail program which behaves differently from
/bin/rmail and complains if feedmail gives it a message on stdin. If
you don't know about such things and if there is no local expert to
consult, stick with /bin/mail or use one of the other buffer eating
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 91d097d..14adb5a 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1222,7 +1222,7 @@ external program defined by `sendmail-program'."
(delete-region (line-beginning-position)
(line-beginning-position 2))))
;; Apparently this causes a duplicate Sender.
- ;; ;; If the From is different than current user, insert Sender.
+ ;; ;; If the From is different from current user, insert Sender.
;; (goto-char (point-min))
;; (and (re-search-forward "^From:" delimline t)
;; (progn
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index b859534..986d0cf 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1311,7 +1311,7 @@ use it instead of `sc-citation-root-regexp'."
;; filling
(defun sc-fill-if-different (&optional prefix)
"Fill the region bounded by `sc-fill-begin' and point.
-Only fill if optional PREFIX is different than `sc-fill-line-prefix'.
+Only fill if optional PREFIX is different from `sc-fill-line-prefix'.
If `sc-auto-fill-region-p' is nil, do not fill region. If PREFIX is
not supplied, initialize fill variables. This is useful for a regi
`begin' frame-entry."
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 5c85b39..dd05d69 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -3380,13 +3380,14 @@ used to affect the behavior of MH-E in general or when
(defcustom-mh mh-show-mode-hook nil
"Hook run upon entry to `mh-show-mode'.
-This hook is called early on in the process of the message
-display. It is usually used to perform some action on the
-message's content. See `mh-show-hook'."
+This hook is called early on in the process of the message display,
+before the message contents have been inserted into the buffer.
+It is usually used to perform some action on the
+buffer itself. See also `mh-show-hook'."
:type 'hook
:group 'mh-hooks
:group 'mh-show
- :package-version '(MH-E . "6.0"))
+ :package-version '(MH-E . "8.7"))
(defcustom-mh mh-unseen-updated-hook nil
"Hook run after the unseen sequence has been updated.
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 952579f..3c07d42 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -63,7 +63,7 @@ you wish to see all of them, use the command
\\[mh-header-display].
Two hooks can be used to control how messages are displayed. The
first hook, `mh-show-mode-hook', is called early on in the
process of the message display. It is usually used to perform
-some action on the message's content. The second hook,
+some action on the message's buffer. The second hook,
`mh-show-hook', is the last thing called after messages are
displayed. It's used to affect the behavior of MH-E in general or
when `mh-show-mode-hook' is too early.
@@ -234,6 +234,9 @@ Sets the current buffer to the show buffer."
(mh-add-missing-mime-version-header)
(setf (mh-buffer-data) (mh-make-buffer-data))
(mh-mime-display))
+ (mh-show-unquote-From)
+ (mh-show-xface)
+ (mh-show-addr)
;; Header cleanup
(goto-char (point-min))
(cond (clean-message-header
@@ -840,9 +843,6 @@ See also `mh-folder-mode'.
(mh-tool-bar-init :show))
(set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
(setq paragraph-start (default-value 'paragraph-start))
- (mh-show-unquote-From)
- (mh-show-xface)
- (mh-show-addr)
(setq buffer-invisibility-spec '((vanish . t) t))
(set (make-local-variable 'line-move-ignore-invisible) t)
(make-local-variable 'font-lock-defaults)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0589211..49daabc 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -763,8 +763,21 @@ and `clear-minibuffer-message' called automatically via
(defvar minibuffer-message-timer nil)
(defvar minibuffer-message-overlay nil)
+(defun minibuffer--message-overlay-pos ()
+ "Return position where `set-minibuffer-message' shall put message overlay."
+ ;; Starting from point, look for non-nil 'minibuffer-message'
+ ;; property, and return its position. If none found, return the EOB
+ ;; position.
+ (let* ((pt (point))
+ (propval (get-text-property pt 'minibuffer-message)))
+ (if propval pt
+ (next-single-property-change pt 'minibuffer-message nil (point-max)))))
+
(defun set-minibuffer-message (message)
"Temporarily display MESSAGE at the end of the minibuffer.
+If some part of the minibuffer text has the `minibuffer-message' property,
+the message will be displayed before the first such character, instead of
+at the end of the minibuffer.
The text is displayed for `minibuffer-message-clear-timeout' seconds
\(if the value is a number), or until the next input event arrives,
whichever comes first.
@@ -784,8 +797,9 @@ via `set-message-function'."
(clear-minibuffer-message)
- (setq minibuffer-message-overlay
- (make-overlay (point-max) (point-max) nil t t))
+ (let ((ovpos (minibuffer--message-overlay-pos)))
+ (setq minibuffer-message-overlay
+ (make-overlay ovpos ovpos nil t t)))
(unless (zerop (length message))
;; The current C cursor code doesn't know to use the overlay's
;; marker's stickiness to figure out whether to place the cursor
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 7dd778d..9436f45 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -5,7 +5,7 @@
;; Author: Eric Ding <address@hidden>
;; Maintainer: address@hidden
;; Created: 15 Aug 1995
-;; Keywords: mh-e, www, mouse, mail
+;; Keywords: www, mouse, mail
;; This file is part of GNU Emacs.
@@ -32,10 +32,10 @@
;; INSTALLATION
;;
-;; To use goto-address in a particular mode (for example, while
-;; reading mail in mh-e), add this to your init file:
+;; To use goto-address in a particular mode (this example uses
+;; the fictional rich-text-mode), add this to your init file:
;;
-;; (add-hook 'mh-show-mode-hook 'goto-address)
+;; (add-hook 'rich-text-mode-hook 'goto-address)
;;
;; The mouse click method is bound to [mouse-2] on highlighted URLs or
;; e-mail addresses only; it functions normally everywhere else. To bind
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 92c9848..91ed546 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -197,13 +197,11 @@ Returns VALUE."
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) file
(tramp-file-name-hop key) nil)
- (maphash
- (lambda (property _value)
- (when (string-match-p
- "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
- property)
- (tramp-flush-file-property key file property)))
- (tramp-get-hash-table key)))))
+ (dolist (property (hash-table-keys (tramp-get-hash-table key)))
+ (when (string-match-p
+ "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
+ property)
+ (tramp-flush-file-property key file property))))))
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
@@ -234,14 +232,12 @@ Remove also properties of all files in subdirectories."
#'directory-file-name (list directory)))
(truename (tramp-get-file-property key directory "file-truename" nil)))
(tramp-message key 8 "%s" directory)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (stringp (tramp-file-name-localname key))
- (string-match-p (regexp-quote directory)
- (tramp-file-name-localname key)))
- (remhash key tramp-cache-data)))
- tramp-cache-data)
+ (dolist (key (hash-table-keys tramp-cache-data))
+ (when (and (tramp-file-name-p key)
+ (stringp (tramp-file-name-localname key))
+ (string-match-p (regexp-quote directory)
+ (tramp-file-name-localname key)))
+ (remhash key tramp-cache-data)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal directory (directory-file-name truename))))
@@ -365,11 +361,8 @@ used to cache connection properties of the local machine."
(tramp-file-name-hop key) nil))
(tramp-message
key 7 "%s %s" key
- (let ((hash (gethash key tramp-cache-data))
- properties)
- (when (hash-table-p hash)
- (maphash (lambda (x _y) (add-to-list 'properties x 'append)) hash))
- properties))
+ (let ((hash (gethash key tramp-cache-data)))
+ (when (hash-table-p hash) (hash-table-keys hash))))
(setq tramp-cache-data-changed t)
(remhash key tramp-cache-data))
@@ -411,15 +404,14 @@ used to cache connection properties of the local machine."
;;;###tramp-autoload
(defun tramp-list-connections ()
"Return all known `tramp-file-name' structs according to `tramp-cache'."
- (let (result tramp-verbose)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (null (tramp-file-name-localname key))
- (tramp-connection-property-p key "process-buffer"))
- (add-to-list 'result key)))
- tramp-cache-data)
- result))
+ (let ((tramp-verbose 0))
+ (delq nil (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (null (tramp-file-name-localname key))
+ (tramp-connection-property-p key "process-buffer")
+ key))
+ (hash-table-keys tramp-cache-data)))))
(defun tramp-dump-connection-properties ()
"Write persistent connection properties into file
`tramp-persistency-file-name'."
@@ -480,17 +472,14 @@ used to cache connection properties of the local machine."
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (let (res)
- (maphash
- (lambda (key _value)
- (if (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key)))
- (push (list (tramp-file-name-user key)
- (tramp-file-name-host key))
- res)))
- tramp-cache-data)
- res))
+ (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key))))
+ (hash-table-keys tramp-cache-data)))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 2c117fe..762c4fe 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1521,10 +1521,11 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(size (cdr (assoc "filesystem::size" attr)))
(used (cdr (assoc "filesystem::used" attr)))
(free (cdr (assoc "filesystem::free" attr))))
- (when (and (stringp size) (stringp used) (stringp free))
- (list (string-to-number size)
- (- (string-to-number size) (string-to-number used))
- (string-to-number free))))))
+ (when (or size used free)
+ (list (string-to-number (or size "0"))
+ (string-to-number (or free "0"))
+ (- (string-to-number (or size "0"))
+ (string-to-number (or used "0"))))))))
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -2344,16 +2345,13 @@ It checks for registered GNOME Online Accounts."
;; SERVICE might be encoded as a DNS-SD service.
(and (string-match tramp-dns-sd-service-regexp service)
(setq service (match-string 1 service)))
- (let (result)
- (maphash
- (lambda (key _value)
- (if (and (tramp-goa-account-p key)
- (string-equal service (tramp-goa-account-method key)))
- (push (list (tramp-goa-account-user key)
- (tramp-goa-account-host key))
- result)))
- tramp-cache-data)
- result))
+ (mapcar
+ (lambda (key)
+ (and (tramp-goa-account-p key)
+ (string-equal service (tramp-goa-account-method key))
+ (list (tramp-goa-account-user key)
+ (tramp-goa-account-host key))))
+ (hash-table-keys tramp-cache-data)))
;; Media devices functions.
@@ -2406,18 +2404,14 @@ It checks for mounted media devices."
;; SERVICE might be encoded as a DNS-SD service.
(and (string-match tramp-dns-sd-service-regexp service)
(setq service (match-string 1 service)))
- (let (result)
- (maphash
- (lambda (key _value)
- (if (and (tramp-media-device-p key)
- (string-equal service (tramp-media-device-method key))
- (tramp-get-connection-property key "vector" nil))
- (push
- (list nil (tramp-file-name-host
- (tramp-get-connection-property key "vector" nil)))
- result)))
- tramp-cache-data)
- result))
+ (mapcar
+ (lambda (key)
+ (and (tramp-media-device-p key)
+ (string-equal service (tramp-media-device-method key))
+ (tramp-get-connection-property key "vector" nil)
+ (list nil (tramp-file-name-host
+ (tramp-get-connection-property key "vector" nil)))))
+ (hash-table-keys tramp-cache-data)))
;; D-Bus zeroconf functions.
@@ -2465,7 +2459,8 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
(when tramp-gvfs-enabled
;; Suppress D-Bus error messages and Tramp traces.
- (let (tramp-gvfs-dbus-event-vector tramp-verbose fun)
+ (let ((tramp-verbose 0)
+ tramp-gvfs-dbus-event-vector fun)
;; Add completion functions for services announced by DNS-SD.
;; See <http://www.dns-sd.org/ServiceTypes.html> for valid service types.
(zeroconf-init tramp-gvfs-zeroconf-domain)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index b8f3c0d..5a3abc3 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -491,8 +491,8 @@ The string is used in `tramp-methods'.")
For every remote host, this variable will be set buffer local,
keeping the list of existing directories on that host.
-You can use `~' in this list, but when searching for a shell which groks
-tilde expansion, all directory names starting with `~' will be ignored.
+You can use \"~\" in this list, but when searching for a shell which groks
+tilde expansion, all directory names starting with \"~\" will be ignored.
`Default Directories' represent the list of directories given by
the command \"getconf PATH\". It is recommended to use this
@@ -537,12 +537,13 @@ based on the Tramp and Emacs versions, and should not be
set here."
;;;###tramp-autoload
(defcustom tramp-sh-extra-args
- '(("/bash\\'" . "-norc -noprofile")
+ '(("/bash\\'" . "-noediting -norc -noprofile")
("/zsh\\'" . "-f +Z -V"))
"Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
matching the shell file name and ARGS is a string specifying the
-arguments.
+arguments. These arguments shall disable line editing, see
+`tramp-open-shell'.
This variable is only used when Tramp needs to start up another shell
for tilde expansion. The extra arguments should typically prevent the
@@ -3952,7 +3953,7 @@ hosts, or files, disagree."
First arg VEC specifies the connection, PROGNAME is the program
to search for, and DIRLIST gives the list of directories to
search. If IGNORE-TILDE is non-nil, directory names starting
-with `~' will be ignored. If IGNORE-PATH is non-nil, searches
+with \"~\" will be ignored. If IGNORE-PATH is non-nil, searches
only in DIRLIST.
Returns the absolute file name of PROGNAME, if found, and nil otherwise.
@@ -4102,7 +4103,28 @@ file exists and nonzero exit status otherwise."
(with-tramp-progress-reporter
vec 5 (format-message "Opening remote shell `%s'" shell)
;; Find arguments for this shell.
- (let ((extra-args (tramp-get-sh-extra-args shell)))
+ (let ((extra-args (tramp-get-sh-extra-args shell))
+ (p (tramp-get-connection-process vec)))
+ ;; The readline library can disturb Tramp. For example, the
+ ;; very recent version of libedit, the *BSD implementation of
+ ;; readline, confuses Tramp. So we disable line editing. Since
+ ;; $EDITRC is not supported on all target systems, we must move
+ ;; ~/.editrc temporarily somewhere else. For bash and zsh we
+ ;; have disabled this already during shell invocation, see
+ ;; `tramp-sh-extra-args' (Bug#39399).
+ ;; The shell prompt might not be set yet, so we must read any
+ ;; prompt via `tramp-barf-if-no-shell-prompt'.
+ (unless extra-args
+ (tramp-send-command vec "rm -f ~/.editrc.tramp" t t)
+ (tramp-barf-if-no-shell-prompt p 10 "Couldn't find remote shell prompt")
+ (tramp-send-command
+ vec "test -e ~/.editrc && mv -f ~/.editrc ~/.editrc.tramp" t t)
+ (tramp-barf-if-no-shell-prompt p 10 "Couldn't find remote shell prompt")
+ (tramp-send-command vec "echo 'edit off' >~/.editrc" t t)
+ (tramp-barf-if-no-shell-prompt
+ p 10 "Couldn't find remote shell prompt"))
+ ;; It is useful to set the prompt in the following command
+ ;; because some people have a setting for $PS1 which /bin/sh
;; doesn't know about and thus /bin/sh will display a strange
;; prompt. For example, if $PS1 has "${CWD}" in the value, then
;; ksh will display the current working directory but /bin/sh
@@ -4136,6 +4158,11 @@ file exists and nonzero exit status otherwise."
(tramp-shell-quote-argument tramp-end-of-output)
shell (or extra-args ""))
t)
+ ;; Reset ~/.editrc.
+ (unless extra-args
+ (tramp-send-command vec "rm -f ~/.editrc" t)
+ (tramp-send-command
+ vec "test -e ~/.editrc.tramp && mv -f ~/.editrc.tramp ~/.editrc" t))
;; Check proper HISTFILE setting. We give up when not working.
(when (and (stringp tramp-histfile-override)
(file-name-directory tramp-histfile-override))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index a38b3c6..409e1f7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2555,7 +2555,7 @@ Add operations defined in `HANDLER-alist' to
`tramp-file-name-handler'."
"Check, whether it is possible to connect the remote host w/o side-effects.
This is true, if either the remote host is already connected, or if we are
not in completion mode."
- (let (tramp-verbose
+ (let ((tramp-verbose 0)
(vec
(cond
((tramp-file-name-p vec-or-filename) vec-or-filename)
@@ -3431,7 +3431,7 @@ User is always nil."
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(let (ls-lisp-use-insert-directory-program start)
;; Silence byte compiler.
- ls-lisp-use-insert-directory-program
+ (ignore ls-lisp-use-insert-directory-program)
(tramp-run-real-handler
#'insert-directory
(list filename switches wildcard full-directory-p))
@@ -3721,9 +3721,9 @@ support symbolic links."
(if (process-live-p p)
;; Display output.
(with-current-buffer output-buffer
- (display-buffer output-buffer '(nil (allow-no-window . t)))
(setq mode-line-process '(":%s"))
- (shell-mode)
+ (unless (eq major-mode 'shell-mode)
+ (shell-mode))
(set-process-filter p #'comint-output-filter)
(set-process-sentinel p #'shell-command-sentinel)
(when error-file
@@ -3733,7 +3733,8 @@ support symbolic links."
(with-current-buffer error-buffer
(insert-file-contents-literally
error-file nil nil nil 'replace))
- (delete-file error-file)))))
+ (delete-file error-file))))
+ (display-buffer output-buffer '(nil (allow-no-window . t))))
(when error-file
(delete-file error-file)))))
@@ -4848,7 +4849,12 @@ verbosity of 6."
"Read a password from user (compat function).
Consults the auth-source package.
Invokes `password-read' if available, `read-passwd' else."
- (let* ((case-fold-search t)
+ (let* (;; If `auth-sources' contains "~/.authinfo.gpg", and
+ ;; `exec-path' contains a relative file name like ".", it
+ ;; could happen that the "gpg" command is not found. So we
+ ;; adapt `default-directory'. (Bug#39389, Bug#39489)
+ (default-directory (tramp-compat-temporary-file-directory))
+ (case-fold-search t)
(key (tramp-make-tramp-file-name
;; In tramp-sh.el, we must use "password-vector" due to
;; multi-hop.
@@ -5000,10 +5006,12 @@ name of a process or buffer, or nil to default to the
current buffer."
(tramp-error proc 'error "Process %s is not active" proc)
(tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
;; This is for tramp-sh.el. Other backends do not support this (yet).
+ ;; Not all "kill" implementations support process groups by
+ ;; negative pid, so we try both variants.
(tramp-compat-funcall
'tramp-send-command
(process-get proc 'vector)
- (format "kill -2 -%d" pid))
+ (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid))
;; Wait, until the process has disappeared. If it doesn't,
;; fall back to the default implementation.
(while (tramp-accept-process-output proc 0))
@@ -5058,10 +5066,5 @@ name of a process or buffer, or nil to default to the
current buffer."
;; and friends, for most of the handlers this is the major
;; difference between the different backends. Other handlers but
;; *-process-file would profit from this as well.
-;;
-;; * Get rid of `shell-command'. In its primary implementation, it
-;; uses `process-file-shell-command' and
-;; `start-file-process-shell-command', which is sufficient due to
-;; connection-local `shell-file-name'.
;;; tramp.el ends here
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index b8becd7..cb3c0f2 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -256,17 +256,17 @@ supported keys depend on the service type.")
"Return all discovered Avahi service names as list."
(let (result)
(maphash
- (lambda (_key value) (add-to-list 'result (zeroconf-service-name value)))
+ (lambda (_key value) (push (zeroconf-service-name value) result))
zeroconf-services-hash)
- result))
+ (delete-dups result)))
(defun zeroconf-list-service-types ()
"Return all discovered Avahi service types as list."
(let (result)
(maphash
- (lambda (_key value) (add-to-list 'result (zeroconf-service-type value)))
+ (lambda (_key value) (push (zeroconf-service-type value) result))
zeroconf-services-hash)
- result))
+ (delete-dups result)))
(defun zeroconf-list-services (type)
"Return all discovered Avahi services for a given service type TYPE.
@@ -278,9 +278,9 @@ format of SERVICE."
(maphash
(lambda (_key value)
(when (equal type (zeroconf-service-type value))
- (add-to-list 'result value)))
+ (push value result)))
zeroconf-services-hash)
- result))
+ (delete-dups result)))
(defvar zeroconf-service-added-hooks-hash (make-hash-table :test 'equal)
"Hash table of hooks for newly added services.
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index 6148657..1ed305c 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -429,7 +429,7 @@ attachment-folder.
Change of attachment-folder due to unset might be if an ID
property is set on the node, or if a separate inherited
-DIR-property exists (that is different than the unset one)."
+DIR-property exists (that is different from the unset one)."
(interactive)
(let ((old (org-attach-dir))
(new
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 1581625..e8e1ef9 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -18682,13 +18682,14 @@ With prefix arg UNCOMPILED, load the uncompiled
versions."
(and (string= org-dir contrib-dir)
(org-load-noerror-mustsuffix (concat
contrib-dir f)))
(and (org-load-noerror-mustsuffix (concat
(org-find-library-dir f) f))
- (add-to-list 'load-uncore f 'append)
+ (push f load-uncore)
't)
f))
lfeat)))
(when load-uncore
(message "The following feature%s found in load-path, please check if
that's correct:\n%s"
- (if (> (length load-uncore) 1) "s were" " was") load-uncore))
+ (if (> (length load-uncore) 1) "s were" " was")
+ (reverse load-uncore)))
(if load-misses
(message "Some error occurred while reloading Org feature%s\n%s\nPlease
check *Messages*!\n%s"
(if (> (length load-misses) 1) "s" "") load-misses
(org-version nil 'full))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index c3cd31f..23fb1ef 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -388,14 +388,17 @@ comment at the start of cc-engine.el for more info."
(forward-char)
t)))
(let ((cand-EOM (point)))
- (if (and c-last-open-c-comment-start-on-line-re
+ (if (and c-open-c-comment-on-logical-line-re
(re-search-backward
- c-last-open-c-comment-start-on-line-re
- (c-point 'bol) t))
- (progn
- (goto-char (match-beginning 1))
- (and (c-forward-single-comment)
- (> (point) cand-EOM)))
+ c-open-c-comment-on-logical-line-re
+ nil t)
+ (match-beginning 1)
+ (progn
+ (goto-char (match-beginning 1))
+ (and (c-forward-single-comment)
+ (> (point) cand-EOM))))
+ t
+ (goto-char cand-EOM)
nil)))))
(when (and (car c-macro-cache)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 715af32..6675617 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -86,7 +86,7 @@
;; compiled runtime constants ready for use by (the byte compiled) CC
;; Mode, and the source definitions in this file don't have to be
;; loaded then. However, if a byte compiled package is loaded that
-;; has been compiled with a different version of CC Mode than the one
+;; has been compiled with a different version of CC Mode from the one
;; currently loaded, then the compiled-in values will be discarded and
;; new ones will be built when the mode is initialized. That will
;; automatically trig a load of the file(s) containing the source
@@ -1707,7 +1707,10 @@ ender."
(c-lang-const c-last-c-comment-end-on-line-re))
(c-lang-defconst c-last-open-c-comment-start-on-line-re
- "Regexp which matches the last block comment start on the
+ "Do NOT use this constant any more. Instead use
+`c-open-c-comment-on-logical-line-re' (2020-02-10).
+
+Regexp which matches the last block comment start on the
current ine, if any, or nil in those languages without block
comments. When a match is found, submatch 1 contains the comment
starter."
@@ -1715,6 +1718,20 @@ starter."
awk nil)
(c-lang-defvar c-last-open-c-comment-start-on-line-re
(c-lang-const c-last-open-c-comment-start-on-line-re))
+(make-obsolete-variable 'c-last-open-c-comment-start-on-line-re
+ 'c-open-c-comment-on-logical-line-re
+ "5.35")
+
+(c-lang-defconst c-open-c-comment-on-logical-line-re
+ "Regexp which matches an open block comment on the current logical line.
+It is intended for searching backwards from the end of a line.
+Such a search will stop at the first encountered non-escaped
+newline or open block comment. If the comment is found, submatch
+1 contains the comment starter."
+t "[^\\\n][\r\n]\\|\\(/\\*\\)\\([^*]\\|\\*+\\([^*/]\\|$\\)\\)*$"
+awk nil)
+(c-lang-defvar c-open-c-comment-on-logical-line-re
+ (c-lang-const c-open-c-comment-on-logical-line-re))
(c-lang-defconst c-literal-start-regexp
;; Regexp to match the start of comments and string literals.
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index e785acd..da5a2a5 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -105,13 +105,24 @@
(defvar speedbar-initial-expansion-list-name)
(defvar speedbar-frame)
-(defvar gdb-memory-address "main")
-(defvar gdb-memory-last-address nil
+(defvar-local gdb-memory-address-expression "main"
+ "This expression is passed to gdb.
+Possible value: main, $rsp, x+3.")
+(defvar-local gdb-memory-address nil
+ "Address of memory display.")
+(defvar-local gdb-memory-last-address nil
"Last successfully accessed memory address.")
(defvar gdb-memory-next-page nil
"Address of next memory page for program memory buffer.")
(defvar gdb-memory-prev-page nil
"Address of previous memory page for program memory buffer.")
+(defvar-local gdb--memory-display-warning nil
+ "Display warning on memory header if t.
+
+When error occurs when retrieving memory, gdb-mi displays the
+last successful page. In that case the expression might not
+match the memory displayed. We want to let the user be aware of
+that, so display a warning exclamation mark in the header line.")
(defvar gdb-thread-number nil
"Main current thread.
@@ -3450,7 +3461,7 @@ line."
(def-gdb-trigger-and-handler
gdb-invalidate-memory
(format "-data-read-memory %s %s %d %d %d"
- gdb-memory-address
+ (gdb-mi-quote gdb-memory-address-expression)
gdb-memory-format
gdb-memory-unit
gdb-memory-rows
@@ -3490,6 +3501,9 @@ in `gdb-memory-format'."
(err-msg (bindat-get-field res 'msg)))
(if (not err-msg)
(let ((memory (bindat-get-field res 'memory)))
+ (when gdb-memory-last-address
+ ;; Nil means last retrieve emits error or just started the session.
+ (setq gdb--memory-display-warning nil))
(setq gdb-memory-address (bindat-get-field res 'addr))
(setq gdb-memory-next-page (bindat-get-field res 'next-page))
(setq gdb-memory-prev-page (bindat-get-field res 'prev-page))
@@ -3503,10 +3517,15 @@ in `gdb-memory-format'."
gdb-memory-format)))))
(newline)))
;; Show last page instead of empty buffer when out of bounds
- (progn
- (let ((gdb-memory-address gdb-memory-last-address))
+ (when gdb-memory-last-address
+ (let ((gdb-memory-address-expression gdb-memory-last-address))
+ ;; If we don't set `gdb-memory-last-address' to nil,
+ ;; `gdb-invalidate-memory' eventually calls
+ ;; `gdb-read-memory-custom', making an infinite loop.
+ (setq gdb-memory-last-address nil
+ gdb--memory-display-warning t)
(gdb-invalidate-memory 'update)
- (error err-msg))))))
+ (user-error "Error when retrieving memory: %s Displaying last
successful page" err-msg))))))
(defvar gdb-memory-mode-map
(let ((map (make-sparse-keymap)))
@@ -3540,7 +3559,7 @@ in `gdb-memory-format'."
"Set the start memory address."
(interactive)
(let ((arg (read-from-minibuffer "Memory address: ")))
- (setq gdb-memory-address arg))
+ (setq gdb-memory-address-expression arg))
(gdb-invalidate-memory 'update))
(defmacro def-gdb-set-positive-number (name variable echo-string &optional doc)
@@ -3723,7 +3742,19 @@ DOC is an optional documentation string."
(defvar gdb-memory-header
'(:eval
(concat
- "Start address["
+ "Start address "
+ ;; If `gdb-memory-address-expression' is nil, `propertize' would error.
+ (propertize (or gdb-memory-address-expression "N/A")
+ 'face font-lock-warning-face
+ 'help-echo "mouse-1: set start address"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1
+ #'gdb-memory-set-address-event))
+ (if gdb--memory-display-warning
+ (propertize " !" 'face '(:inherit error :weight bold))
+ "")
+ " ["
(propertize "-"
'face font-lock-warning-face
'help-echo "mouse-1: decrement address"
@@ -3740,13 +3771,9 @@ DOC is an optional documentation string."
'mouse-1
#'gdb-memory-show-next-page))
"]: "
- (propertize gdb-memory-address
- 'face font-lock-warning-face
- 'help-echo "mouse-1: set start address"
- 'mouse-face 'mode-line-highlight
- 'local-map (gdb-make-header-line-mouse-map
- 'mouse-1
- #'gdb-memory-set-address-event))
+ ;; If `gdb-memory-address' is nil, `propertize' would error.
+ (propertize (or gdb-memory-address "N/A")
+ 'face font-lock-warning-face)
" Rows: "
(propertize (number-to-string gdb-memory-rows)
'face font-lock-warning-face
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index e21bbae..dba70cb 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -3502,7 +3502,7 @@ Returns nil if frame not found."
(defun idlwave-shell-new-bp (bp)
"Find the new breakpoint in IDL's list and update with DATA.
-The actual line number for a breakpoint in IDL may be different than
+The actual line number for a breakpoint in IDL may be different from
the line number used with the IDL breakpoint command.
Looks for a new breakpoint index number in the list. This is
considered the new breakpoint if the file name of frame matches."
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 5f6e1cf..ace3001 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -3046,7 +3046,7 @@ See also `ps-use-face-background'."
(defcustom ps-fg-list nil
"Specify foreground color list.
-This list is used to chose a text foreground color which is different than the
+This list is used to chose a text foreground color which is different from the
background color. It'll be used the first foreground color in `ps-fg-list'
which is different from the background color.
@@ -6028,8 +6028,8 @@ to the equivalent Latin-1 characters.")
;; Specify a foreground color only if:
;; one's specified,
- ;; it's different than the background (if `ps-fg-validate-p' is non-nil)
- ;; and it's different than the current.
+ ;; it's different from the background (if `ps-fg-validate-p' is non-nil)
+ ;; and it's different from the current.
(let ((fg (or fg-color ps-default-foreground)))
(if ps-fg-validate-p
(let ((bg (or bg-color ps-default-background))
diff --git a/lisp/simple.el b/lisp/simple.el
index 0944790..688dbcc 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2532,6 +2532,11 @@ A redo record for ordinary undo maps to the following
(earlier) undo.")
"Within a run of consecutive undo commands, list remaining to be undone.
If t, we undid all the way to the end of it.")
+(defun undo--last-change-was-undo-p (undo-list)
+ (while (and (consp undo-list) (eq (car undo-list) nil))
+ (setq undo-list (cdr undo-list)))
+ (gethash undo-list undo-equiv-table))
+
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
@@ -2567,12 +2572,7 @@ as an argument limits undo to changes within the current
region."
(or (eq pending-undo-list t)
;; If something (a timer or filter?) changed the buffer
;; since the previous command, don't continue the undo seq.
- (let ((list buffer-undo-list))
- (while (eq (car list) nil)
- (setq list (cdr list)))
- ;; If the last undo record made was made by undo
- ;; it shows nothing else happened in between.
- (gethash list undo-equiv-table))))
+ (undo--last-change-was-undo-p buffer-undo-list)))
(setq undo-in-region
(and (or (region-active-p) (and arg (not (numberp arg))))
(not inhibit-region)))
@@ -2662,6 +2662,25 @@ Contrary to `undo', this will not redo a previous undo."
(interactive "*p")
(let ((undo-no-redo t)) (undo arg)))
+(defun undo-redo (&optional arg)
+ "Undo the last ARG undos."
+ (interactive "*p")
+ (cond
+ ((not (undo--last-change-was-undo-p buffer-undo-list))
+ (user-error "No undo to undo"))
+ (t
+ (let* ((ul buffer-undo-list)
+ (new-ul
+ (let ((undo-in-progress t))
+ (while (and (consp ul) (eq (car ul) nil))
+ (setq ul (cdr ul)))
+ (primitive-undo arg ul)))
+ (new-pul (undo--last-change-was-undo-p new-ul)))
+ (message "Redo%s" (if undo-in-region " in region" ""))
+ (setq this-command 'undo)
+ (setq pending-undo-list new-pul)
+ (setq buffer-undo-list new-ul)))))
+
(defvar undo-in-progress nil
"Non-nil while performing an undo.
Some change-hooks test this variable to do something different.")
@@ -2751,7 +2770,7 @@ Return what remains of the list."
;; said it would do.
(unless (and (= start start-mark)
(= (+ delta end) end-mark))
- (error "Changes to be undone by function different than
announced"))
+ (error "Changes to be undone by function different from
announced"))
(set-marker start-mark nil)
(set-marker end-mark nil))
(apply fun-args))
diff --git a/lisp/subr.el b/lisp/subr.el
index 0e09228..b5ec0de 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1845,6 +1845,7 @@ COMPARE-FN if that's non-nil.
If ELEMENT is added, it is added at the beginning of the list,
unless the optional argument APPEND is non-nil, in which case
ELEMENT is added at the end.
+LIST-VAR should not refer to a lexical variable.
The return value is the new value of LIST-VAR.
@@ -1934,6 +1935,7 @@ of ELEMENT if it has one.
The list order for each element is stored in LIST-VAR's
`list-order' property.
+LIST-VAR cannot refer to a lexical variable.
The return value is the new value of LIST-VAR."
(let ((ordering (get list-var 'list-order)))
@@ -1962,7 +1964,8 @@ variable. The possible values of maximum length have the
same meaning as
the values of `history-length'.
Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil.
If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even
-if it is empty or duplicates the most recent entry in the history."
+if it is empty or duplicates the most recent entry in the history.
+HISTORY-VAR cannot refer to a lexical variable."
(unless maxelt
(setq maxelt (or (get history-var 'history-length)
history-length)))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index ebb0c56..873f54a 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -51,11 +51,11 @@
:version "27.1")
(defface tab-bar
- '((((type x w32 ns) (class color))
+ '((((class color) (min-colors 88))
:inherit variable-pitch
:background "grey85"
:foreground "black")
- (((type x) (class mono))
+ (((class mono))
:background "grey")
(t
:inverse-video t))
@@ -1467,8 +1467,7 @@ This is an action function for buffer display, see Info
node `(elisp) Buffer Display Action Functions'. It should be
called only by `display-buffer' or a function directly or
indirectly called by the latter."
- (let* ((tab-name (alist-get 'tab-name alist))
- (reusable-frames (alist-get 'reusable-frames alist))
+ (let* ((reusable-frames (alist-get 'reusable-frames alist))
(reusable-tab (when reusable-frames
(tab-bar-get-buffer-tab buffer reusable-frames))))
(if reusable-tab
@@ -1480,26 +1479,55 @@ indirectly called by the latter."
(tab-bar-select-tab (1+ index)))
(when (get-buffer-window buffer frame)
(select-window (get-buffer-window buffer frame))))
+ (let ((tab-name (alist-get 'tab-name alist)))
+ (when (functionp tab-name)
+ (setq tab-name (funcall tab-name buffer alist)))
+ (if tab-name
+ (let ((tab-index (tab-bar--tab-index-by-name tab-name)))
+ (if tab-index
+ (progn
+ (tab-bar-select-tab (1+ tab-index))
+ (when (get-buffer-window buffer)
+ (select-window (get-buffer-window buffer))))
+ (display-buffer-in-new-tab buffer alist)))
+ (display-buffer-in-new-tab buffer alist))))))
+
+(defun display-buffer-in-new-tab (buffer alist)
+ "Display BUFFER in a new tab.
+ALIST is an association list of action symbols and values. See
+Info node `(elisp) Buffer Display Action Alists' for details of
+such alists.
+
+Like `display-buffer-in-tab', but always creates a new tab unconditionally,
+without checking if a suitable tab already exists.
+
+If ALIST contains a `tab-name' entry, it creates a new tab with that name
+and displays BUFFER in a new tab. The `tab-name' entry can be a function,
+then it is called with two arguments: BUFFER and ALIST, and should return
+the tab name. When a `tab-name' entry is omitted, create a new tab without
+an explicit name.
+
+This is an action function for buffer display, see Info
+node `(elisp) Buffer Display Action Functions'. It should be
+called only by `display-buffer' or a function directly or
+indirectly called by the latter."
+ (let ((tab-bar-new-tab-choice t))
+ (tab-bar-new-tab)
+ (let ((tab-name (alist-get 'tab-name alist)))
(when (functionp tab-name)
(setq tab-name (funcall tab-name buffer alist)))
- (if tab-name
- (let ((tab-index (tab-bar--tab-index-by-name tab-name)))
- (if tab-index
- (tab-bar-select-tab (1+ tab-index))
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab)
- (tab-bar-rename-tab tab-name))))
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab))))))
+ (when tab-name
+ (tab-bar-rename-tab tab-name)))
+ (window--display-buffer buffer (selected-window) 'tab alist)))
(defun switch-to-buffer-other-tab (buffer-or-name &optional norecord)
"Switch to buffer BUFFER-OR-NAME in another tab.
Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other tab: ")))
- (display-buffer buffer-or-name '((display-buffer-in-tab
- display-buffer-same-window)
- (inhibit-same-window . nil))
+ (display-buffer buffer-or-name '((display-buffer-in-tab)
+ (inhibit-same-window . nil)
+ (reusable-frames . t))
norecord))
(defun find-file-other-tab (filename &optional wildcards)
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 149fe82..8f1221a 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -42,12 +42,12 @@
:version "27.1")
(defface tab-line
- '((((type x w32 ns) (class color))
+ '((((class color) (min-colors 88))
:inherit variable-pitch
:height 0.9
:background "grey85"
:foreground "black")
- (((type x) (class mono))
+ (((class mono))
:background "grey")
(t
:inverse-video t))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 2dbab80..d61c363 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -2719,7 +2719,9 @@ hunk text is not found in the source file."
(cl-assert (null buffer-file-name))
(let ((enable-local-variables :safe) ;; to find `mode:'
(buffer-file-name file))
- (set-auto-mode)
+ ;; Don't run hooks that might assume buffer-file-name
+ ;; really associates buffer with a file (bug#39190).
+ (delay-mode-hooks (set-auto-mode))
;; FIXME: Is this really worth the trouble?
(when (and (fboundp 'generic-mode-find-file-hook)
(memq #'generic-mode-find-file-hook
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index a8af9ba..5f8a4a8 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1540,10 +1540,10 @@ the width of the A/B/C windows."
;; hscrolling.
(if (= last-command-event ?<)
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-left)))
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-right))))
;; calculate argument to scroll-left/right
;; if there is an explicit argument
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 0c29352..033cb27 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -649,7 +649,7 @@ line."
(defun vc-dir-mark-all-files (arg)
"Mark all files with the same state as the current one.
-With a prefix argument mark all files.
+With a prefix argument mark all files (not directories).
If the current entry is a directory, mark all child files.
The commands operate on files that are on the same state.
@@ -670,7 +670,8 @@ share the same state."
vc-ewoc)
(ewoc-map
(lambda (filearg)
- (unless (vc-dir-fileinfo->marked filearg)
+ (unless (or (vc-dir-fileinfo->directory filearg)
+ (vc-dir-fileinfo->marked filearg))
(setf (vc-dir-fileinfo->marked filearg) t)
t))
vc-ewoc))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index eac9a6f..40d7573 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1352,14 +1352,17 @@ REV is the revision to check out into WORKFILE."
;; Follows vc-exec-after.
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
-(defun vc-hg-dir-status-files (_dir files update-function)
+(defun vc-hg-dir-status-files (dir files update-function)
;; XXX: We can't pass DIR directly to 'hg status' because that
;; returns all ignored files if FILES is non-nil (bug#22481).
- ;; If honoring DIR ever becomes important, try using '-I DIR/'.
- (vc-hg-command (current-buffer) 'async files
- "status"
- (concat "-mardu" (if files "i"))
- "-C")
+ (let ((default-directory dir))
+ ;; TODO: Use "--config 'status.relative=1'" instead of "re:"
+ ;; when we're allowed to depend on Mercurial 4.2+
+ ;; (it's a bit faster).
+ (vc-hg-command (current-buffer) 'async files
+ "status" "re:" "-I" "."
+ (concat "-mardu" (if files "i"))
+ "-C"))
(vc-run-delayed
(vc-hg-after-dir-status update-function)))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index f64b6c0..ec252b7 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -2098,7 +2098,9 @@ Unlike `vc-find-revision-save', doesn't save the buffer
to the file."
;; For non-interactive, skip any questions
(let ((enable-local-variables :safe) ;; to find `mode:'
(buffer-file-name file))
- (ignore-errors (set-auto-mode)))
+ ;; Don't run hooks that might assume buffer-file-name
+ ;; really associates buffer with a file (bug#39190).
+ (ignore-errors (delay-mode-hooks (set-auto-mode))))
(normal-mode))
(set-buffer-modified-p nil)
(setq buffer-read-only t))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index fde7329..0137ddc 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1684,7 +1684,7 @@ cleaning up these problems."
(mapcar
#'(lambda (option)
(when force
- (add-to-list 'style (car option)))
+ (push (car option) style))
(goto-char rstart)
(let ((regexp
(cond
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 6284652..284fd1d 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -236,8 +236,7 @@ minibuffer."
;; Construct a menu of the choices
;; and then use it for prompting for a single character.
(let* ((next-digit ?0)
- (map (make-sparse-keymap))
- choice some-choice-enabled value)
+ alist choice some-choice-enabled value)
(with-current-buffer (get-buffer-create " widget-choose")
(erase-buffer)
(insert "Available choices:\n\n")
@@ -247,7 +246,7 @@ minibuffer."
(let* ((name (substitute-command-keys (car choice)))
(function (cdr choice)))
(insert (format "%c = %s\n" next-digit name))
- (define-key map (vector next-digit) function)
+ (push (cons next-digit function) alist)
(setq some-choice-enabled t)))
;; Allocate digits to disabled alternatives
;; so that the digit of a given alternative never varies.
@@ -257,33 +256,17 @@ minibuffer."
(forward-line))
(or some-choice-enabled
(error "None of the choices is currently meaningful"))
- (define-key map [?\M-\C-v] 'scroll-other-window)
- (define-key map [?\M--] 'negative-argument)
(save-window-excursion
- (let ((buf (get-buffer " widget-choose")))
- (display-buffer buf
- '(display-buffer-in-direction
- (direction . bottom)
- (window-height . fit-window-to-buffer)))
- (let ((cursor-in-echo-area t)
- (arg 1))
- (while (not value)
- (setq value (lookup-key map (read-key-sequence (format "%s:
" title))))
- (unless value
- (user-error "Canceled"))
- (when
- (cond ((eq value 'scroll-other-window)
- (let ((minibuffer-scroll-window
- (get-buffer-window buf)))
- (if (> 0 arg)
- (scroll-other-window-down
- (window-height minibuffer-scroll-window))
- (scroll-other-window))
- (setq arg 1)))
- ((eq value 'negative-argument)
- (setq arg -1)))
- (setq value nil))))))
- value))))
+ ;; Select window to be able to scroll it from minibuffer
+ (with-selected-window
+ (display-buffer (get-buffer " widget-choose")
+ '(display-buffer-in-direction
+ (direction . bottom)
+ (window-height . fit-window-to-buffer)))
+ (setq value (read-char-from-minibuffer
+ (format "%s: " title)
+ (mapcar #'car alist)))))
+ (cdr (assoc value alist))))))
;;; Widget text specifications.
;;
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 6e62e16..40adb49 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -467,18 +467,19 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(minibuffer-depth (minibuffer-depth))
(action (lambda (buffer alist)
(unless (> (minibuffer-depth) minibuffer-depth)
- (let ((window (cond
- ((eq dir 'new-tab)
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab))
- (selected-window))
- ((eq dir 'same-window)
- (selected-window))
- (t (window-in-direction
- dir nil nil
- (and arg (prefix-numeric-value arg))
- windmove-wrap-around))))
- (type 'reuse))
+ (let* ((type 'reuse)
+ (window (cond
+ ((eq dir 'new-tab)
+ (let ((tab-bar-new-tab-choice t))
+ (tab-bar-new-tab))
+ (setq type 'tab)
+ (selected-window))
+ ((eq dir 'same-window)
+ (selected-window))
+ (t (window-in-direction
+ dir nil nil
+ (and arg (prefix-numeric-value arg))
+ windmove-wrap-around)))))
(unless window
(setq window (split-window nil nil dir) type 'window))
(setq new-window (window--display-buffer buffer window
diff --git a/lisp/window.el b/lisp/window.el
index 40c4bf5..bd825c0 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -5009,6 +5009,13 @@ nil means to not handle the buffer in a particular way.
This
quad entry)
(cond
((and (not prev-buffer)
+ (eq (nth 1 quit-restore) 'tab)
+ (eq (nth 3 quit-restore) buffer))
+ (tab-bar-close-tab)
+ ;; If the previously selected window is still alive, select it.
+ (when (window-live-p (nth 2 quit-restore))
+ (select-window (nth 2 quit-restore))))
+ ((and (not prev-buffer)
(or (eq (nth 1 quit-restore) 'frame)
(and (eq (nth 1 quit-restore) 'window)
;; If the window has been created on an existing
@@ -6367,7 +6374,12 @@ fourth element is BUFFER."
;; WINDOW has been created on a new frame.
(set-window-parameter
window 'quit-restore
- (list 'frame 'frame (selected-window) buffer)))))
+ (list 'frame 'frame (selected-window) buffer)))
+ ((eq type 'tab)
+ ;; WINDOW has been created on a new tab.
+ (set-window-parameter
+ window 'quit-restore
+ (list 'tab 'tab (selected-window) buffer)))))
(defcustom display-buffer-function nil
"If non-nil, function to call to handle `display-buffer'.
@@ -7034,7 +7046,7 @@ Return WINDOW if BUFFER and WINDOW are live."
;; use that.
(display-buffer-mark-dedicated
(set-window-dedicated-p window display-buffer-mark-dedicated))))
- (when (memq type '(window frame))
+ (when (memq type '(window frame tab))
(set-window-prev-buffers window nil))
(let ((quit-restore (window-parameter window 'quit-restore))
(height (cdr (assq 'window-height alist)))
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 276ed1a..b4795c1 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 47
+# gnulib-common.m4 serial 48
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -31,7 +31,10 @@ AC_DEFUN([gl_COMMON_BODY], [
# define _Noreturn [[noreturn]]
# elif ((!defined __cplusplus || defined __clang__) \
&& (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)))
+ || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))
/* _Noreturn works as-is. */
# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index d63df9e..a5f35d4 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,4 +1,4 @@
-# sys_stat_h.m4 serial 31 -*- Autoconf -*-
+# sys_stat_h.m4 serial 32 -*- Autoconf -*-
dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -88,9 +88,11 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
HAVE_MKNOD=1; AC_SUBST([HAVE_MKNOD])
HAVE_MKNODAT=1; AC_SUBST([HAVE_MKNODAT])
HAVE_UTIMENSAT=1; AC_SUBST([HAVE_UTIMENSAT])
+ REPLACE_FCHMODAT=0; AC_SUBST([REPLACE_FCHMODAT])
REPLACE_FSTAT=0; AC_SUBST([REPLACE_FSTAT])
REPLACE_FSTATAT=0; AC_SUBST([REPLACE_FSTATAT])
REPLACE_FUTIMENS=0; AC_SUBST([REPLACE_FUTIMENS])
+ REPLACE_LCHMOD=0; AC_SUBST([REPLACE_LCHMOD])
REPLACE_LSTAT=0; AC_SUBST([REPLACE_LSTAT])
REPLACE_MKDIR=0; AC_SUBST([REPLACE_MKDIR])
REPLACE_MKFIFO=0; AC_SUBST([REPLACE_MKFIFO])
diff --git a/src/buffer.c b/src/buffer.c
index 5c65d4d..cc7d4e4 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -6247,6 +6247,9 @@ Values are interpreted as follows:
t use the cursor specified for the frame
nil don't display a cursor
box display a filled box cursor
+ (box . SIZE) display a filled box cursor, but make it
+ hollow if cursor is under masked image larger than
+ SIZE pixels in either dimension.
hollow display a hollow box cursor
bar display a vertical bar cursor with default width
(bar . WIDTH) display a vertical bar cursor with width WIDTH
diff --git a/src/cmds.c b/src/cmds.c
index 462cb66..5d7a45e 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -159,7 +159,7 @@ With argument N not nil or 1, move forward N - 1 lines
first.
If point reaches the beginning or end of buffer, it stops there.
This function constrains point to the current field unless this moves
-point to a different line than the original, unconstrained result.
+point to a different line from the original, unconstrained result.
If N is nil or 1, and a front-sticky field starts at point, the point
does not move. To ignore field boundaries bind
`inhibit-field-text-motion' to t, or use the `forward-line' function
@@ -184,7 +184,7 @@ If point reaches the beginning or end of buffer, it stops
there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
This function constrains point to the current field unless this moves
-point to a different line than the original, unconstrained result. If
+point to a different line from the original, unconstrained result. If
N is nil or 1, and a rear-sticky field ends at point, the point does
not move. To ignore field boundaries bind `inhibit-field-text-motion'
to t. */)
diff --git a/src/composite.c b/src/composite.c
index 53e6930..05365cf 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1746,7 +1746,18 @@ should be ignored. */)
CHECK_STRING (string);
validate_subarray (string, from, to, SCHARS (string), &frompos, &topos);
if (! STRING_MULTIBYTE (string))
- error ("Attempt to shape unibyte text");
+ {
+ ptrdiff_t i;
+
+ for (i = SBYTES (string) - 1; i >= 0; i--)
+ if (!ASCII_CHAR_P (SREF (string, i)))
+ error ("Attempt to shape unibyte text");
+ /* STRING is a pure-ASCII string, so we can convert it (or,
+ rather, its copy) to multibyte and use that thereafter. */
+ Lisp_Object string_copy = Fconcat (1, &string);
+ STRING_SET_MULTIBYTE (string_copy);
+ string = string_copy;
+ }
frombyte = string_char_to_byte (string, frompos);
}
diff --git a/src/editfns.c b/src/editfns.c
index 3f1b3aa..05ad392 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -717,7 +717,7 @@ position of the first character in logical order, i.e. the
smallest
character position on the line.
This function constrains the returned position to the current field
-unless that position would be on a different line than the original,
+unless that position would be on a different line from the original,
unconstrained result. If N is nil or 1, and a front-sticky field
starts at point, the scan stops as soon as it starts. To ignore field
boundaries, bind `inhibit-field-text-motion' to t.
@@ -750,7 +750,7 @@ position of the last character in logical order, i.e. the
largest
character position on the line.
This function constrains the returned position to the current field
-unless that would be on a different line than the original,
+unless that would be on a different line from the original,
unconstrained result. If N is nil or 1, and a rear-sticky field ends
at point, the scan stops as soon as it starts. To ignore field
boundaries bind `inhibit-field-text-motion' to t.
diff --git a/src/fontset.c b/src/fontset.c
index 22b7618..bca9452 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -353,7 +353,7 @@ fontset_add (Lisp_Object fontset, Lisp_Object range,
Lisp_Object elt, Lisp_Objec
(NILP (args[idx]) ? args[1 - idx]
: CALLMANY (Fvconcat, args)));
from = to1 + 1;
- } while (from < to);
+ } while (from <= to);
}
else
{
diff --git a/src/frame.h b/src/frame.h
index 68dc0ce..641bb43 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -108,7 +108,7 @@ struct frame
to redirect keystrokes to a surrogate minibuffer frame when
needed.
- Note that a value of nil is different than having the field point
+ Note that a value of nil is different from having the field point
to the frame itself. Whenever the Fselect_frame function is used
to shift from one frame to the other, any redirections to the
original frame are shifted to the newly selected frame; if
diff --git a/src/lread.c b/src/lread.c
index 2cf7548..060a26a 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -152,12 +152,6 @@ static ptrdiff_t prev_saved_doc_string_length;
/* This is the file position that string came from. */
static file_offset prev_saved_doc_string_position;
-/* True means inside a new-style backquote with no surrounding
- parentheses. Fread initializes this to the value of
- `force_new_style_backquotes', so we need not specbind it or worry
- about what happens to it when there is an error. */
-static bool new_backquote_flag;
-
/* A list of file names for files being loaded in Fload. Used to
check for recursive loads. */
@@ -1035,18 +1029,6 @@ load_error_handler (Lisp_Object data)
return Qnil;
}
-static AVOID
-load_error_old_style_backquotes (void)
-{
- if (NILP (Vload_file_name))
- xsignal1 (Qerror, build_string ("Old-style backquotes detected!"));
- else
- {
- AUTO_STRING (format, "Loading `%s': old-style backquotes detected!");
- xsignal1 (Qerror, CALLN (Fformat_message, format, Vload_file_name));
- }
-}
-
static void
load_warn_unescaped_character_literals (Lisp_Object file)
{
@@ -2303,7 +2285,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object
start, Lisp_Object end)
Lisp_Object retval;
readchar_count = 0;
- new_backquote_flag = force_new_style_backquotes;
/* We can get called from readevalloop which may have set these
already. */
if (! HASH_TABLE_P (read_objects_map)
@@ -3291,70 +3272,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
return list2 (Qquote, read0 (readcharfun));
case '`':
- {
- int next_char = READCHAR;
- UNREAD (next_char);
- /* Transition from old-style to new-style:
- If we see "(`" it used to mean old-style, which usually works
- fine because ` should almost never appear in such a position
- for new-style. But occasionally we need "(`" to mean new
- style, so we try to distinguish the two by the fact that we
- can either write "( `foo" or "(` foo", where the first
- intends to use new-style whereas the second intends to use
- old-style. For Emacs-25, we should completely remove this
- first_in_list exception (old-style can still be obtained via
- "(\`" anyway). */
- if (!new_backquote_flag && first_in_list && next_char == ' ')
- load_error_old_style_backquotes ();
- else
- {
- Lisp_Object value;
- bool saved_new_backquote_flag = new_backquote_flag;
-
- new_backquote_flag = 1;
- value = read0 (readcharfun);
- new_backquote_flag = saved_new_backquote_flag;
+ return list2 (Qbackquote, read0 (readcharfun));
- return list2 (Qbackquote, value);
- }
- }
case ',':
{
- int next_char = READCHAR;
- UNREAD (next_char);
- /* Transition from old-style to new-style:
- It used to be impossible to have a new-style , other than within
- a new-style `. This is sufficient when ` and , are used in the
- normal way, but ` and , can also appear in args to macros that
- will not interpret them in the usual way, in which case , may be
- used without any ` anywhere near.
- So we now use the same heuristic as for backquote: old-style
- unquotes are only recognized when first on a list, and when
- followed by a space.
- Because it's more difficult to peek 2 chars ahead, a new-style
- ,@ can still not be used outside of a `, unless it's in the middle
- of a list. */
- if (new_backquote_flag
- || !first_in_list
- || (next_char != ' ' && next_char != '@'))
- {
- Lisp_Object comma_type = Qnil;
- Lisp_Object value;
- int ch = READCHAR;
-
- if (ch == '@')
- comma_type = Qcomma_at;
- else
- {
- if (ch >= 0) UNREAD (ch);
- comma_type = Qcomma;
- }
+ Lisp_Object comma_type = Qnil;
+ Lisp_Object value;
+ int ch = READCHAR;
- value = read0 (readcharfun);
- return list2 (comma_type, value);
- }
+ if (ch == '@')
+ comma_type = Qcomma_at;
else
- load_error_old_style_backquotes ();
+ {
+ if (ch >= 0) UNREAD (ch);
+ comma_type = Qcomma;
+ }
+
+ value = read0 (readcharfun);
+ return list2 (comma_type, value);
}
case '?':
{
@@ -5090,17 +5025,6 @@ Note that if you customize this, obviously it will not
affect files
that are loaded before your customizations are read! */);
load_prefer_newer = 0;
- DEFVAR_BOOL ("force-new-style-backquotes", force_new_style_backquotes,
- doc: /* Non-nil means to always use the current syntax for
backquotes.
-If nil, `load' and `read' raise errors when encountering some
-old-style variants of backquote and comma. If non-nil, these
-constructs are always interpreted as described in the Info node
-`(elisp)Backquote', even if that interpretation is incompatible with
-previous versions of Emacs. Setting this variable to non-nil makes
-Emacs compatible with the behavior planned for Emacs 28. In Emacs 28,
-this variable will become obsolete. */);
- force_new_style_backquotes = false;
-
/* Vsource_directory was initialized in init_lread. */
DEFSYM (Qcurrent_load_list, "current-load-list");
diff --git a/src/nsterm.h b/src/nsterm.h
index 980ca53..7c6197f 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -418,7 +418,7 @@ typedef id instancetype;
NSWindow *nonfs_window;
BOOL fs_is_native;
#ifdef NS_IMPL_COCOA
- NSBitmapImageRep *drawingBuffer;
+ CGContextRef drawingBuffer;
#endif
@public
struct frame *emacsframe;
@@ -464,7 +464,7 @@ typedef id instancetype;
- (void)focusOnDrawingBuffer;
#endif
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
-- (void)createDrawingBufferWithRect:(NSRect)rect;
+- (void)createDrawingBuffer;
/* Non-notification versions of NSView methods. Used for direct calls. */
- (void)windowWillEnterFullScreen;
diff --git a/src/nsterm.m b/src/nsterm.m
index 9d427b9..2cf6774 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1141,7 +1141,6 @@ ns_update_end (struct frame *f)
#ifdef NS_IMPL_COCOA
[NSGraphicsContext setCurrentContext:nil];
- [view display];
#else
block_input ();
@@ -2853,7 +2852,9 @@ ns_clear_frame (struct frame *f)
ns_unfocus (f);
/* as of 2006/11 or so this is now needed */
- ns_redraw_scroll_bars (f);
+ /* FIXME: I don't see any reason for this and removing it makes no
+ difference here. Do we need it for GNUstep? */
+ //ns_redraw_scroll_bars (f);
unblock_input ();
}
@@ -3169,18 +3170,6 @@ ns_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
NSTRACE_RECT ("fromRect", fromRect);
- /* Because we're drawing into an offscreen buffer which isn't
- flipped, the images come out upside down. To work around it
- we need to do some fancy transforms. */
- {
- NSAffineTransform *transform = [NSAffineTransform transform];
- [transform translateXBy:0 yBy:NSMaxY(imageRect)];
- [transform scaleXBy:1 yBy:-1];
- [transform concat];
-
- imageRect.origin.y = 0;
- }
-
[img drawInRect: imageRect
fromRect: fromRect
operation: NSCompositingOperationSourceOver
@@ -3938,11 +3927,6 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
NSAffineTransform *doTransform = [NSAffineTransform transform];
- /* We have to flip the image around the X axis as the offscreen
- bitmap we're drawing to is flipped. */
- [doTransform scaleXBy:1 yBy:-1];
- [doTransform translateXBy:0 yBy:-[img size].height];
-
/* ImageMagick images don't have transforms. */
if (img->transform)
[doTransform appendTransform:img->transform];
@@ -7104,7 +7088,7 @@ not_in_argv (NSString *arg)
from non-native fullscreen, in other circumstances it appears
to be a noop. (bug#28872) */
wr = NSMakeRect (0, 0, neww, newh);
- [self createDrawingBufferWithRect:wr];
+ [self createDrawingBuffer];
[view setFrame: wr];
// To do: consider using [NSNotificationCenter postNotificationName:].
@@ -7444,7 +7428,7 @@ not_in_argv (NSString *arg)
maximizing_resize = NO;
#endif
- [self createDrawingBufferWithRect:r];
+ [self createDrawingBuffer];
win = [[EmacsWindow alloc]
initWithContentRect: r
@@ -8229,52 +8213,65 @@ not_in_argv (NSString *arg)
}
-- (void)createDrawingBufferWithRect:(NSRect)rect
- /* Create and store a new NSBitmapImageRep for Emacs to draw
- into.
+#ifdef NS_IMPL_COCOA
+- (void)createDrawingBuffer
+ /* Create and store a new CGGraphicsContext for Emacs to draw into.
- Drawing to an offscreen bitmap doesn't work in GNUstep as there's
- a bug in graphicsContextWithBitmapImageRep
- (https://savannah.gnu.org/bugs/?38405). So under GNUstep we
- retain the old method of drawing direct to the EmacsView. */
+ We can't do this in GNUstep as there's no equivalent, so under
+ GNUstep we retain the old method of drawing direct to the
+ EmacsView. */
{
-#ifdef NS_IMPL_COCOA
+ NSTRACE ("EmacsView createDrawingBuffer]");
+
+ NSGraphicsContext *screen;
+ CGColorSpaceRef colorSpace = [[[self window] colorSpace] CGColorSpace];
+ CGFloat scale = [[self window] backingScaleFactor];
+ NSRect frame = [self frame];
+
if (drawingBuffer != nil)
- [drawingBuffer release];
+ CGContextRelease (drawingBuffer);
- drawingBuffer = [[self bitmapImageRepForCachingDisplayInRect:rect] retain];
-#endif
+ drawingBuffer = CGBitmapContextCreate (nil, NSWidth (frame) * scale,
NSHeight (frame) * scale,
+ 8, 0, colorSpace,
+ kCGImageAlphaPremultipliedFirst |
kCGBitmapByteOrder32Host);
+
+ /* This fixes the scale to match the backing scale factor, and flips the
image. */
+ CGContextTranslateCTM(drawingBuffer, 0, NSHeight (frame) * scale);
+ CGContextScaleCTM(drawingBuffer, scale, -scale);
}
-#ifdef NS_IMPL_COCOA
- (void)focusOnDrawingBuffer
{
- /* Creating the graphics context each time is very slow, but it
- doesn't seem possible to cache and reuse it. */
- [NSGraphicsContext
- setCurrentContext:
- [NSGraphicsContext graphicsContextWithBitmapImageRep:drawingBuffer]];
+ NSTRACE ("EmacsView focusOnDrawingBuffer]");
+
+ NSGraphicsContext *buf =
+ [NSGraphicsContext
+ graphicsContextWithCGContext:drawingBuffer flipped:YES];
+
+ [NSGraphicsContext setCurrentContext:buf];
}
- (void)windowDidChangeBackingProperties:(NSNotification *)notification
/* Update the drawing buffer when the backing scale factor changes. */
{
- CGFloat old = [[[notification userInfo]
+ NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
+
+ CGFloat old = [[[notification userInfo]
objectForKey:@"NSBackingPropertyOldScaleFactorKey"]
- doubleValue];
- CGFloat new = [[self window] backingScaleFactor];
+ doubleValue];
+ CGFloat new = [[self window] backingScaleFactor];
- if (old != new)
- {
- NSRect frame = [self frame];
- [self createDrawingBufferWithRect:frame];
- ns_clear_frame (emacsframe);
- expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
- }
+ if (old != new)
+ {
+ NSRect frame = [self frame];
+ [self createDrawingBuffer];
+ ns_clear_frame (emacsframe);
+ expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
+ }
}
-#endif
+#endif /* NS_IMPL_COCOA */
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect
@@ -8284,13 +8281,31 @@ not_in_argv (NSString *arg)
NSTRACE_RECT ("Destination", dstRect);
#ifdef NS_IMPL_COCOA
- [drawingBuffer drawInRect:dstRect
- fromRect:srcRect
- operation:NSCompositingOperationCopy
- fraction:1.0
- respectFlipped:NO
- hints:nil];
+ CGImageRef copy;
+ NSRect frame = [self frame];
+ NSAffineTransform *setOrigin = [NSAffineTransform transform];
+
+ [[NSGraphicsContext currentContext] saveGraphicsState];
+
+ /* Set the clipping before messing with the buffer's
+ orientation. */
+ NSRectClip (dstRect);
+
+ /* Unflip the buffer as the copied image will be unflipped, and
+ offset the top left so when we draw back into the buffer the
+ correct part of the image is drawn. */
+ CGContextScaleCTM(drawingBuffer, 1, -1);
+ CGContextTranslateCTM(drawingBuffer, 0, -NSHeight (frame)
+ - (NSMinY (dstRect) - NSMinY (srcRect)));
+
+ /* Take a copy of the buffer and then draw it back to the buffer,
+ limited by the clipping rectangle. */
+ copy = CGBitmapContextCreateImage (drawingBuffer);
+ CGContextDrawImage (drawingBuffer, frame, copy);
+
+ CGImageRelease (copy);
+ [[NSGraphicsContext currentContext] restoreGraphicsState];
[self setNeedsDisplayInRect:dstRect];
#else
hide_bell(); // Ensure the bell image isn't scrolled.
@@ -8304,6 +8319,24 @@ not_in_argv (NSString *arg)
}
+#ifdef NS_IMPL_COCOA
+- (BOOL)wantsUpdateLayer
+{
+ return YES;
+}
+
+
+- (void)updateLayer
+{
+ NSTRACE ("EmacsView updateLayer]");
+
+ CGImageRef contentsImage = CGBitmapContextCreateImage(drawingBuffer);
+ [[self layer] setContents:(id)contentsImage];
+ CGImageRelease(contentsImage);
+}
+#endif
+
+
- (void)drawRect: (NSRect)rect
{
NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
@@ -8312,14 +8345,6 @@ not_in_argv (NSString *arg)
if (!emacsframe || !emacsframe->output_data.ns)
return;
-#ifdef NS_IMPL_COCOA
- [drawingBuffer drawInRect:rect
- fromRect:rect
- operation:NSCompositingOperationSourceOver
- fraction:1
- respectFlipped:NO
- hints:nil];
-#else
int x = NSMinX (rect), y = NSMinY (rect);
int width = NSWidth (rect), height = NSHeight (rect);
@@ -8327,7 +8352,6 @@ not_in_argv (NSString *arg)
block_input ();
expose_frame (emacsframe, x, y, width, height);
unblock_input ();
-#endif
}
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 552216c..694431c 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -3932,7 +3932,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
allocate space for that if we're not allocating space for anything
else (see below). Also, we never need info about register 0 for
any of the other register vectors, and it seems rather a kludge to
- treat 'best_regend' differently than the rest. So we keep track of
+ treat 'best_regend' differently from the rest. So we keep track of
the end of the best match so far in a separate variable. We
initialize this to NULL so that when we backtrack the first time
and need to test it, it's not garbage. */
diff --git a/src/systhread.c b/src/systhread.c
index c649ae8..0d600d6 100644
--- a/src/systhread.c
+++ b/src/systhread.c
@@ -214,11 +214,13 @@ sys_thread_set_name (const char *name)
char p_name[TASK_COMM_LEN];
strncpy (p_name, name, TASK_COMM_LEN - 1);
p_name[TASK_COMM_LEN - 1] = '\0';
- #ifdef HAVE_PTHREAD_SETNAME_NP_1ARG
+# ifdef HAVE_PTHREAD_SETNAME_NP_1ARG
pthread_setname_np (p_name);
- #else
+# elif defined HAVE_PTHREAD_SETNAME_NP_3ARG
+ pthread_setname_np (pthread_self (), "%s", p_name);
+# else
pthread_setname_np (pthread_self (), p_name);
- #endif
+# endif
#endif
}
diff --git a/src/xdisp.c b/src/xdisp.c
index 68a504f..e41ceaf 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -30741,14 +30741,6 @@ get_specified_cursor_type (Lisp_Object arg, int *width)
return BAR_CURSOR;
}
- if (CONSP (arg)
- && EQ (XCAR (arg), Qbar)
- && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX))
- {
- *width = XFIXNUM (XCDR (arg));
- return BAR_CURSOR;
- }
-
if (EQ (arg, Qhbar))
{
*width = 2;
@@ -30756,11 +30748,16 @@ get_specified_cursor_type (Lisp_Object arg, int
*width)
}
if (CONSP (arg)
- && EQ (XCAR (arg), Qhbar)
&& RANGED_FIXNUMP (0, XCDR (arg), INT_MAX))
{
*width = XFIXNUM (XCDR (arg));
- return HBAR_CURSOR;
+
+ if (EQ (XCAR (arg), Qbox))
+ return FILLED_BOX_CURSOR;
+ else if (EQ (XCAR (arg), Qbar))
+ return BAR_CURSOR;
+ else if (EQ (XCAR (arg), Qhbar))
+ return HBAR_CURSOR;
}
/* Treat anything unknown as "hollow box cursor".
@@ -30887,23 +30884,28 @@ get_window_cursor_type (struct window *w, struct
glyph *glyph, int *width,
if (!w->cursor_off_p)
{
if (glyph != NULL && glyph->type == XWIDGET_GLYPH)
- return NO_CURSOR;
+ return NO_CURSOR;
if (glyph != NULL && glyph->type == IMAGE_GLYPH)
{
if (cursor_type == FILLED_BOX_CURSOR)
{
- /* Using a block cursor on large images can be very annoying.
- So use a hollow cursor for "large" images.
- If image is not transparent (no mask), also use hollow cursor.
*/
+ /* Using a block cursor on large images can be very
+ annoying. So use a hollow cursor for "large" images.
+ If image is not transparent (no mask), also use
+ hollow cursor. */
struct image *img = IMAGE_OPT_FROM_ID (f, glyph->u.img_id);
if (img != NULL && IMAGEP (img->spec))
{
- /* Arbitrarily, interpret "Large" as >32x32 and >NxN
- where N = size of default frame font size.
- This should cover most of the "tiny" icons people may use.
*/
+ /* Interpret "large" as >SIZExSIZE and >NxN where
+ SIZE is the value from cursor-type of the form
+ (box . SIZE), where N = size of default frame
+ font size. So, setting cursor-type to (box . 32)
+ should cover most of the "tiny" icons people may
+ use. */
if (!img->mask
- || img->width > max (32, WINDOW_FRAME_COLUMN_WIDTH (w))
- || img->height > max (32, WINDOW_FRAME_LINE_HEIGHT (w)))
+ || (CONSP (BVAR (b, cursor_type))
+ && img->width > max (*width,
WINDOW_FRAME_COLUMN_WIDTH (w))
+ && img->height > max (*width,
WINDOW_FRAME_LINE_HEIGHT (w))))
cursor_type = HOLLOW_BOX_CURSOR;
}
}
diff --git a/src/xfaces.c b/src/xfaces.c
index 3689b9e..91a7a85 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -4940,7 +4940,7 @@ DEFUN ("face-attributes-as-vector",
Fface_attributes_as_vector,
that a face containing all the attributes in ATTRS, when merged with the
default face for display, can be represented in a way that's
- (1) different in appearance than the default face, and
+ (1) different in appearance from the default face, and
(2) `close in spirit' to what the attributes specify, if not exact. */
static bool
@@ -5043,7 +5043,7 @@ gui_supports_face_attributes_p (struct frame *f,
that a face containing all the attributes in ATTRS, when merged
with the default face for display, can be represented in a way that's
- (1) different in appearance than the default face, and
+ (1) different in appearance from the default face, and
(2) `close in spirit' to what the attributes specify, if not exact.
Point (2) implies that a `:weight black' attribute will be satisfied
@@ -5160,7 +5160,7 @@ tty_supports_face_attributes_p (struct frame *f,
> TTY_SAME_COLOR_THRESHOLD)
return false; /* displayed color is too different */
else
- /* Make sure the color is really different than the default. */
+ /* Make sure the color is really different from the default. */
{
Emacs_Color def_fg_color;
if (tty_lookup_color (f, def_fg, &def_fg_color, 0)
@@ -5184,7 +5184,7 @@ tty_supports_face_attributes_p (struct frame *f,
> TTY_SAME_COLOR_THRESHOLD)
return false; /* displayed color is too different */
else
- /* Make sure the color is really different than the default. */
+ /* Make sure the color is really different from the default. */
{
Emacs_Color def_bg_color;
if (tty_lookup_color (f, def_bg, &def_bg_color, 0)
@@ -5226,7 +5226,7 @@ The definition of `supported' is somewhat heuristic, but
basically means
that a face containing all the attributes in ATTRIBUTES, when merged
with the default face for display, can be represented in a way that's
- (1) different in appearance than the default face, and
+ (1) different in appearance from the default face, and
(2) `close in spirit' to what the attributes specify, if not exact.
Point (2) implies that a `:weight black' attribute will be satisfied by
diff --git a/test/lisp/emacs-lisp/map-tests.el
b/test/lisp/emacs-lisp/map-tests.el
index 06fd55f..1888baf 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -227,7 +227,7 @@ Evaluate BODY for each created map.
(with-maps-do map
(let ((result nil))
(map-do (lambda (k v)
- (add-to-list 'result (list (int-to-string k) v)))
+ (push (list (int-to-string k) v) result))
map)
(should (equal result '(("2" 5) ("1" 4) ("0" 3)))))))
@@ -376,5 +376,11 @@ Evaluate BODY for each created map.
'((1 . 1) (2 . 5) (3 . 0)))
'((3 . 0) (2 . 9) (1 . 6)))))
+(ert-deftest test-map-plist-pcase ()
+ (let ((plist '(:one 1 :two 2)))
+ (should (equal (pcase-let (((map :one (:two two)) plist))
+ (list one two))
+ '(1 2)))))
+
(provide 'map-tests)
;;; map-tests.el ends here
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index 7d354d6..05770d6 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -349,49 +349,108 @@ Must called from within a `tar-mode' buffer."
(goto-char (point-min))
(should (re-search-forward re nil t)))))))
+
+;;; Package Menu tests
+
+(defmacro with-package-menu-test (&rest body)
+ "Set up Package Menu (\"*Packages*\") buffer for testing."
+ (declare (indent 0) (debug (([&rest form]) body)))
+ `(with-package-test ()
+ (let ((buf (package-list-packages)))
+ (unwind-protect
+ (progn ,@body)
+ (kill-buffer buf)))))
+
(ert-deftest package-test-update-listing ()
"Ensure installed package status is updated."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (search-forward-regexp "^ +simple-single")
- (package-menu-mark-install)
- (package-menu-execute)
- (run-hooks 'post-command-hook)
- (should (package-installed-p 'simple-single))
- (switch-to-buffer "*Packages*")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed"
nil t))
- (goto-char (point-min))
- (should-not (re-search-forward
"^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))
- (kill-buffer buf))))
+ (with-package-menu-test
+ (search-forward-regexp "^ +simple-single")
+ (package-menu-mark-install)
+ (package-menu-execute)
+ (run-hooks 'post-command-hook)
+ (should (package-installed-p 'simple-single))
+ (switch-to-buffer "*Packages*")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil
t))
+ (goto-char (point-min))
+ (should-not (re-search-forward
"^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))))
+
+(ert-deftest package-test-list-filter-by-archive ()
+ "Ensure package list is filtered correctly by archive version."
+ (with-package-menu-test
+ ;; TODO: Add another package archive to test filtering, because
+ ;; the testing environment currently only has one.
+ (package-menu-filter-by-archive "gnu")
+ (goto-char (point-min))
+ (should (looking-at "^\\s-+multi-file"))
+ (should (= (count-lines (point-min) (point-max)) 4))
+ (should-error (package-menu-filter-by-archive "non-existent archive"))))
+
+(ert-deftest package-test-list-filter-by-keyword ()
+ "Ensure package list is filtered correctly by package keyword."
+ (with-package-menu-test
+ (package-menu-filter-by-keyword "frobnicate")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+simple-single" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (should-error (package-menu-filter-by-keyword "non-existent-keyword"))))
(ert-deftest package-test-list-filter-by-name ()
"Ensure package list is filtered correctly by package name."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (package-menu-filter-by-name "tetris")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+tetris" nil t))
- (should (= (count-lines (point-min) (point-max)) 1))
- (kill-buffer buf))))
+ (with-package-menu-test ()
+ (package-menu-filter-by-name "tetris")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+tetris" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))))
+
+(ert-deftest package-test-list-filter-by-status ()
+ "Ensure package list is filtered correctly by package status."
+ (with-package-menu-test
+ (package-menu-filter-by-status "available")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+multi-file" nil t))
+ (should (= (count-lines (point-min) (point-max)) 4))
+ ;; No installed packages in default environment.
+ (should-error (package-menu-filter-by-status "installed"))))
+
+(ert-deftest package-test-list-filter-by-version ()
+ (with-package-menu-test
+ (should-error (package-menu-filter-by-version "1.1" 'unknown-symbol))) )
+
+(defun package-test-filter-by-version (version predicate name)
+ (with-package-menu-test
+ (package-menu-filter-by-version version predicate)
+ (goto-char (point-min))
+ ;; We just check that the given package is included in the
+ ;; listing. One could be more ambitious.
+ (should (re-search-forward name))))
+
+(ert-deftest package-test-list-filter-by-version-= ()
+ "Ensure package list is filtered correctly by package version (=)."
+ (package-test-filter-by-version "1.1" '= "^\\s-+simple-two-depend"))
+
+(ert-deftest package-test-list-filter-by-version-< ()
+ "Ensure package list is filtered correctly by package version (<)."
+ (package-test-filter-by-version "1.2" '< "^\\s-+simple-two-depend"))
+
+(ert-deftest package-test-list-filter-by-version-> ()
+ "Ensure package list is filtered correctly by package version (>)."
+ (package-test-filter-by-version "1.0" '> "^\\s-+simple-two-depend"))
(ert-deftest package-test-list-clear-filter ()
"Ensure package list filter is cleared correctly."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (let ((num-packages (count-lines (point-min) (point-max))))
- (should (> num-packages 1))
- (package-menu-filter-by-name "tetris")
- (should (= (count-lines (point-min) (point-max)) 1))
- (package-menu-clear-filter)
- (should (= (count-lines (point-min) (point-max)) num-packages)))
- (kill-buffer buf))))
+ (with-package-menu-test
+ (let ((num-packages (count-lines (point-min) (point-max))))
+ (package-menu-filter-by-name "tetris")
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (package-menu-clear-filter)
+ (should (= (count-lines (point-min) (point-max)) num-packages)))))
(ert-deftest package-test-update-archives ()
"Test updating package archives."
(with-package-test ()
(let ((buf (package-list-packages)))
- (package-menu-refresh)
+ (revert-buffer)
(search-forward-regexp "^ +simple-single")
(package-menu-mark-install)
(package-menu-execute)
@@ -399,7 +458,7 @@ Must called from within a `tar-mode' buffer."
(let ((package-test-data-dir
(expand-file-name "package-resources/newer-versions"
package-test-file-dir)))
(setq package-archives `(("gnu" . ,package-test-data-dir)))
- (package-menu-refresh)
+ (revert-buffer)
;; New version should be available and old version should be installed
(goto-char (point-min))
@@ -411,7 +470,7 @@ Must called from within a `tar-mode' buffer."
(package-menu-mark-upgrades)
(package-menu-execute)
- (package-menu-refresh)
+ (revert-buffer)
(should (package-installed-p 'simple-single '(1 4)))))))
(ert-deftest package-test-update-archives-async ()
@@ -573,7 +632,7 @@ Must called from within a `tar-mode' buffer."
(should (progn (package-install 'signed-bad) 'noerror)))
;; Check if the installed package status is updated.
(let ((buf (package-list-packages)))
- (package-menu-refresh)
+ (revert-buffer)
(should (re-search-forward
"^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
nil t))
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index e19e626..a6c172a 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -43,7 +43,7 @@
(should (equal (rx (or "ab" (| "c" nonl) "de"))
"ab\\|c\\|.\\|de"))
(should (equal (rx (or "ab" "abc" "a"))
- "\\(?:ab\\|abc\\|a\\)"))
+ "\\(?:a\\(?:bc?\\)?\\)"))
(should (equal (rx (| nonl "a") (| "b" blank))
"\\(?:.\\|a\\)\\(?:b\\|[[:blank:]]\\)"))
(should (equal (rx (|))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 08f5c60..9409cc2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -50,6 +50,7 @@
(require 'vc-hg)
(declare-function tramp-find-executable "tramp-sh")
+(declare-function tramp-get-remote-gid "tramp-sh")
(declare-function tramp-get-remote-path "tramp-sh")
(declare-function tramp-get-remote-perl "tramp-sh")
(declare-function tramp-get-remote-stat "tramp-sh")
@@ -2216,11 +2217,10 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; Bug#10085.
(when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
- (dolist (n-e '(nil t))
+ (dolist (non-essential '(nil t))
;; We must clear `tramp-default-method'. On hydra, it is "ftp",
;; which ruins the tests.
- (let ((non-essential n-e)
- (tramp-default-method
+ (let ((tramp-default-method
(file-remote-p tramp-test-temporary-file-directory 'method))
(host (file-remote-p tramp-test-temporary-file-directory 'host)))
(dolist
@@ -3113,22 +3113,38 @@ This tests also `access-file', `file-readable-p',
(file-remote-p tmp-name1)
(replace-regexp-in-string
"/" "//" (file-remote-p tmp-name1 'localname))))
+ ;; `file-ownership-preserved-p' is implemented only in tramp-sh.el.
+ (test-file-ownership-preserved-p (tramp--test-sh-p))
attr)
(unwind-protect
(progn
+ ;; A sticky bit could damage the `file-ownership-preserved-p' test.
+ (when
+ (and test-file-ownership-preserved-p
+ (zerop (logand
+ #o1000
+ (file-modes tramp-test-temporary-file-directory))))
+ (write-region "foo" nil tmp-name1)
+ (setq test-file-ownership-preserved-p
+ (= (tramp-compat-file-attribute-group-id
+ (file-attributes tmp-name1))
+ (tramp-get-remote-gid
+ (tramp-dissect-file-name tmp-name1) 'integer)))
+ (delete-file tmp-name1))
+
(should-error
(access-file tmp-name1 "error")
:type tramp-file-missing)
;; `file-ownership-preserved-p' should return t for
- ;; non-existing files. It is implemented only in tramp-sh.el.
- (when (tramp--test-sh-p)
+ ;; non-existing files.
+ (when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 "error"))
- (when (tramp--test-sh-p)
+ (when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
;; We do not test inodes and device numbers.
@@ -3158,16 +3174,16 @@ This tests also `access-file', `file-readable-p',
(should (stringp (tramp-compat-file-attribute-group-id attr)))
(tramp--test-ignore-make-symbolic-link-error
- (should-error
- (access-file tmp-name2 "error")
- :type tramp-file-missing)
- (when (tramp--test-sh-p)
+ (should-error
+ (access-file tmp-name2 "error")
+ :type tramp-file-missing)
+ (when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
(should-not (access-file tmp-name2 "error"))
- (when (tramp--test-sh-p)
+ (when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
(should
@@ -3198,7 +3214,7 @@ This tests also `access-file', `file-readable-p',
(tramp-dissect-file-name tmp-name3))))
(delete-file tmp-name2))
- (when (tramp--test-sh-p)
+ (when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(delete-file tmp-name1)
(make-directory tmp-name1)
@@ -3206,7 +3222,7 @@ This tests also `access-file', `file-readable-p',
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 ""))
- (when (tramp--test-sh-p)
+ (when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
(should (eq (tramp-compat-file-attribute-type attr) t)))
@@ -4018,10 +4034,9 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Cleanup.
(tramp-change-syntax orig-syntax))))
- (dolist (n-e '(nil t))
+ (dolist (non-essential '(nil t))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
- (let ((non-essential n-e)
- (tmp-name (tramp--test-make-temp-name nil quoted)))
+ (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
@@ -4179,7 +4194,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(setq proc (start-file-process "test1" (current-buffer) "cat"))
(should (processp proc))
(should (equal (process-status proc) 'run))
- (process-send-string proc "foo")
+ (process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@@ -4222,7 +4237,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(set-process-filter
proc
(lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
- (process-send-string proc "foo")
+ (process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@@ -4260,7 +4275,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
- (process-send-string proc "foo")
+ (process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@@ -4309,7 +4324,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
- (process-send-string proc "foo")
+ (process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@@ -4335,7 +4350,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
- (process-send-string proc "foo")
+ (process-send-string proc "foo\n")
(process-send-eof proc)
(delete-process proc)
;; Read output.
@@ -4343,8 +4358,13 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(while (accept-process-output proc 0 nil t)))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string. And a remote macOS sends
- ;; a slightly modified string.
- (should (string-match "killed.*\n\\'" (buffer-string))))
+ ;; a slightly modified string. On MS-Windows,
+ ;; `delete-process' sends an unknown signal.
+ (should
+ (string-match
+ (if (eq system-type 'windows-nt)
+ "unknown signal\n\\'" "killed.*\n\\'")
+ (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4357,7 +4377,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-no-warnings
(make-process
:name "test5" :buffer (current-buffer)
- :command '("cat" "/")
+ :command '("cat" "/does-not-exist")
:stderr stderr
:file-handler t)))
(should (processp proc))
@@ -4367,7 +4387,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(delete-process proc)
(with-current-buffer stderr
(should
- (string-match "cat:.* Is a directory" (buffer-string)))))
+ (string-match
+ "cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
@@ -4381,7 +4402,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-no-warnings
(make-process
:name "test6" :buffer (current-buffer)
- :command '("cat" "/")
+ :command '("cat" "/does-not-exist")
:stderr tmpfile
:file-handler t)))
(should (processp proc))
@@ -4392,7 +4413,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-temp-buffer
(insert-file-contents tmpfile)
(should
- (string-match "cat:.* Is a directory" (buffer-string)))))
+ (string-match
+ "cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
@@ -4400,9 +4422,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
- ;; The test fails from time to time, w/o a reproducible pattern. So
- ;; we mark it as unstable.
- :tags '(:expensive-test :unstable)
+ :tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
;; Since Emacs 26.1.
@@ -4416,7 +4436,9 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
kill-buffer-query-functions proc)
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process "test" (current-buffer) "sleep" "10"))
+ (setq proc (start-file-process-shell-command
+ "test" (current-buffer)
+ "trap 'echo boom; exit 1' 2; sleep 100"))
(should (processp proc))
(should (process-live-p proc))
(should (equal (process-status proc) 'run))
@@ -4541,6 +4563,7 @@ INPUT, if non-nil, is a string sent to the process."
;; but seems to work since Emacs 27.1 only.
(when (and (tramp--test-sh-p) (tramp--test-emacs27-p))
(let* ((async-shell-command-width 1024)
+ (default-directory tramp-test-temporary-file-directory)
(cols (ignore-errors
(read (tramp--test-shell-command-to-string-asynchronously
"tput cols")))))
@@ -5844,7 +5867,7 @@ Use the `ls' command."
;; Since Emacs 27.1.
(skip-unless (fboundp 'file-system-info))
- ;; `file-system-info' exists since Emacs 27. We don't want to see
+ ;; `file-system-info' exists since Emacs 27.1. We don't want to see
;; compiler warnings for older Emacsen.
(let ((fsi (with-no-warnings
(file-system-info tramp-test-temporary-file-directory))))
@@ -6284,9 +6307,7 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
-;; * Fix `tramp-test29-start-file-process' and
-;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
-;; * Implement `tramp-test31-interrupt-process' for `adb'. Fix `:unstable'.
+;; * Implement `tramp-test31-interrupt-process' for `adb'.
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote
;; file name operation cannot run in the timer. Remove `:unstable' tag?
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index ae20146..eb3b029 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -392,6 +392,48 @@ See bug#35036."
(should (equal ?\s (char-syntax ?\n))))))
+;;; undo tests
+
+(defun simple-tests--exec (cmds)
+ (dolist (cmd cmds)
+ (setq last-command this-command)
+ (setq this-command cmd)
+ (run-hooks 'pre-command-hook)
+ (command-execute cmd)
+ (run-hooks 'post-command-hook)
+ (undo-boundary)))
+
+(ert-deftest simple-tests--undo ()
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (dolist (x '("a" "b" "c" "d" "e"))
+ (insert x)
+ (undo-boundary))
+ (should (equal (buffer-string) "abcde"))
+ (simple-tests--exec '(undo undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "abcd"))
+ (simple-tests--exec '(undo))
+ (should (equal (buffer-string) "abcde"))
+ (simple-tests--exec '(backward-char undo undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo-redo))
+ (should (equal (buffer-string) "abcd"))
+ (simple-tests--exec '(undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo-redo undo-redo))
+ (should (equal (buffer-string) "abcde"))
+ (simple-tests--exec '(undo undo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo-only undo-only))
+ (should (equal (buffer-string) "a"))
+ (simple-tests--exec '(backward-char undo-redo undo-redo))
+ (should (equal (buffer-string) "abc"))
+ (simple-tests--exec '(backward-char undo-redo undo-redo))
+ (should (equal (buffer-string) "abcde"))
+ ))
+
;;; undo auto-boundary tests
(ert-deftest undo-auto-boundary-timer ()
(should
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 1426b01..6efd8be 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -157,22 +157,6 @@ literals (Bug#20852)."
(load "somelib" nil t)
(should (string-suffix-p "/somelib.el" (caar load-history)))))
-(ert-deftest lread-tests--old-style-backquotes ()
- "Check that loading doesn't accept old-style backquotes."
- (lread-tests--with-temp-file file-name
- (write-region "(` (a b))" nil file-name)
- (let ((data (should-error (load file-name nil :nomessage :nosuffix))))
- (should (equal (cdr data)
- (list (concat (format-message "Loading `%s': " file-name)
- "old-style backquotes detected!")))))))
-
-(ert-deftest lread-tests--force-new-style-backquotes ()
- (let ((data (should-error (read "(` (a b))"))))
- (should (equal (cdr data) '("Old-style backquotes detected!"))))
- (should (equal (let ((force-new-style-backquotes t))
- (read "(` (a b))"))
- '(`(a b)))))
-
(ert-deftest lread-lread--substitute-object-in-subtree ()
(let ((x (cons 0 1)))
(setcar x x)
- feature/native-comp updated (d71801e -> 4b4c753), Andrea Corallo, 2020/02/15
- feature/native-comp 0c6f4ca 3/6: Clean-up old gc disable refuse in comp-tests-non-locals, Andrea Corallo, 2020/02/15
- feature/native-comp fe9e4c4 2/6: Better function naming for comp-function-call-maybe-remove, Andrea Corallo, 2020/02/15
- feature/native-comp 3b3525b 5/6: Backward propagate only once, Andrea Corallo, 2020/02/15
- feature/native-comp 4b4c753 6/6: Speed 2 goes default, Andrea Corallo, 2020/02/15
- feature/native-comp c27394d 4/6: Rework frame layout, Andrea Corallo, 2020/02/15
- feature/native-comp f1bc8e4 1/6: Merge remote-tracking branch 'savannah/master' into HEAD,
Andrea Corallo <=