[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 5a8be17 1/3: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 5a8be17 1/3: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Mon, 21 Sep 2020 16:05:53 -0400 (EDT) |
branch: feature/native-comp
commit 5a8be1719a80031ea3833749b1e82de8d5a39787
Merge: 5b41545 fb68645
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
admin/unidata/unidata-gen.el | 4 +-
configure.ac | 2 +-
doc/emacs/basic.texi | 8 +
doc/emacs/buffers.texi | 11 +
doc/emacs/files.texi | 14 +
doc/emacs/help.texi | 7 +-
doc/emacs/misc.texi | 5 +
doc/emacs/programs.texi | 6 +
doc/emacs/search.texi | 12 +
doc/lispref/buffers.texi | 4 +-
doc/lispref/customize.texi | 5 +
doc/lispref/display.texi | 21 +-
doc/lispref/internals.texi | 46 +-
doc/lispref/intro.texi | 3 +-
doc/lispref/minibuf.texi | 25 +-
doc/lispref/modes.texi | 23 +
doc/lispref/processes.texi | 5 +
doc/lispref/searching.texi | 7 +-
doc/lispref/syntax.texi | 27 +-
doc/lispref/text.texi | 2 +-
doc/misc/dbus.texi | 64 ++-
doc/misc/eww.texi | 10 +-
doc/misc/gnus.texi | 55 ++-
etc/NEWS | 143 +++++-
etc/NEWS.27 | 2 +-
etc/PROBLEMS | 13 +
etc/refcards/cs-refcard.tex | 1 -
etc/refcards/cs-survival.tex | 1 -
etc/refcards/de-refcard.tex | 1 -
etc/refcards/fr-refcard.tex | 1 -
etc/refcards/fr-survival.tex | 1 -
etc/refcards/pl-refcard.tex | 2 -
etc/refcards/pt-br-refcard.tex | 1 -
etc/refcards/refcard.tex | 5 +-
etc/refcards/ru-refcard.tex | 1 -
etc/refcards/sk-refcard.tex | 1 -
etc/refcards/sk-survival.tex | 1 -
etc/refcards/survival.tex | 1 -
etc/tutorials/TUTORIAL | 1 +
etc/tutorials/TUTORIAL.he | 5 +-
lib-src/ebrowse.c | 2 +-
lisp/bindings.el | 93 ++--
lisp/calc/calc-comb.el | 42 +-
lisp/calc/calccomp.el | 3 +-
lisp/cedet/ede/emacs.el | 27 +-
lisp/cedet/semantic/bovine/el.el | 2 +-
lisp/cedet/semantic/db-find.el | 4 +-
lisp/cedet/semantic/db.el | 4 +-
lisp/cedet/semantic/lex.el | 2 +-
lisp/composite.el | 2 +-
lisp/cus-edit.el | 31 +-
lisp/descr-text.el | 2 +-
lisp/dired-aux.el | 166 +++++--
lisp/dired.el | 24 +-
lisp/emacs-lisp/autoload.el | 1 +
lisp/emacs-lisp/easy-mmode.el | 3 +
lisp/emacs-lisp/eieio.el | 2 +-
lisp/emacs-lisp/eldoc.el | 17 +-
lisp/emacs-lisp/ert-x.el | 12 +
lisp/emacs-lisp/ewoc.el | 48 +-
lisp/emacs-lisp/find-func.el | 20 +-
lisp/emacs-lisp/pcase.el | 4 +-
lisp/emacs-lisp/re-builder.el | 2 +-
lisp/emacs-lisp/syntax.el | 9 +-
lisp/epa.el | 2 +-
lisp/erc/erc-networks.el | 2 +-
lisp/eshell/em-unix.el | 27 +-
lisp/eshell/em-xtra.el | 30 --
lisp/eshell/esh-util.el | 59 +--
lisp/ffap.el | 8 +
lisp/files.el | 82 +++-
lisp/gnus/gnus-agent.el | 2 +-
lisp/gnus/gnus-art.el | 10 +-
lisp/gnus/gnus-msg.el | 24 +-
lisp/gnus/gnus-score.el | 54 ++-
lisp/gnus/gnus-sum.el | 8 +-
lisp/gnus/message.el | 8 +-
lisp/gnus/mm-view.el | 2 +-
lisp/gnus/nndiary.el | 2 +-
lisp/gnus/nnir.el | 2 +-
lisp/help.el | 1 +
lisp/htmlfontify.el | 2 +-
lisp/info.el | 7 +-
lisp/international/ucs-normalize.el | 2 +-
lisp/isearch.el | 120 ++++-
lisp/json.el | 4 +-
lisp/jsonrpc.el | 4 +-
lisp/kmacro.el | 2 +-
lisp/language/korea-util.el | 4 +-
lisp/mail/emacsbug.el | 116 ++---
lisp/mail/mailclient.el | 2 +-
lisp/mail/rfc2047.el | 6 +-
lisp/man.el | 7 +-
lisp/menu-bar.el | 123 +++--
lisp/mh-e/mh-limit.el | 4 +-
lisp/mh-e/mh-speed.el | 2 +-
lisp/minibuf-eldef.el | 4 +-
lisp/minibuffer.el | 14 +-
lisp/mwheel.el | 4 +-
lisp/net/dbus.el | 234 +++++----
lisp/net/eww.el | 14 +-
lisp/net/shr.el | 21 +-
lisp/net/tramp.el | 4 +-
lisp/pcmpl-unix.el | 23 +
lisp/pcmpl-x.el | 32 ++
lisp/pcomplete.el | 44 ++
lisp/play/5x5.el | 2 +-
lisp/profiler.el | 2 +-
lisp/progmodes/cc-engine.el | 8 +-
lisp/progmodes/cc-fonts.el | 63 ++-
lisp/progmodes/cc-langs.el | 13 +-
lisp/progmodes/compile.el | 3 +-
lisp/progmodes/cperl-mode.el | 46 +-
lisp/progmodes/elisp-mode.el | 2 +-
lisp/progmodes/etags.el | 2 +-
lisp/progmodes/flymake.el | 8 +-
lisp/progmodes/gdb-mi.el | 12 +-
lisp/progmodes/gud.el | 22 +-
lisp/progmodes/hideif.el | 8 +-
lisp/progmodes/make-mode.el | 2 +-
lisp/progmodes/project.el | 8 +-
lisp/progmodes/python.el | 39 +-
lisp/progmodes/verilog-mode.el | 2 +-
lisp/replace.el | 4 +-
lisp/reveal.el | 22 +-
lisp/ses.el | 4 +-
lisp/simple.el | 16 +-
lisp/so-long.el | 2 +-
lisp/subr.el | 60 ++-
lisp/tab-bar.el | 16 +-
lisp/textmodes/flyspell.el | 16 +-
lisp/textmodes/sgml-mode.el | 7 +-
lisp/textmodes/table.el | 2 +-
lisp/time.el | 16 +-
lisp/uniquify.el | 21 +-
lisp/vc/diff.el | 2 +
lisp/vc/ediff-util.el | 8 +-
lisp/vc/vc-dir.el | 6 +-
lisp/vc/vc-git.el | 13 +-
lisp/vc/vc.el | 13 +-
lisp/wid-browse.el | 2 +-
lisp/wid-edit.el | 162 ++++---
lisp/window.el | 5 +-
lisp/xt-mouse.el | 5 +-
lisp/xwidget.el | 8 +-
nt/inc/ms-w32.h | 26 +
src/data.c | 9 +
src/dbusbind.c | 158 +++---
src/dispextern.h | 4 +-
src/emacs-module.c | 23 +-
src/eval.c | 9 +
src/font.c | 15 +-
src/frame.c | 2 +-
src/keyboard.c | 99 +++-
src/lisp.h | 2 +
src/lread.c | 3 +
src/module-env-28.h | 4 +
src/nsterm.m | 8 +-
src/nsxwidget.m | 6 +-
src/pdumper.c | 4 +-
src/print.c | 17 +-
src/process.c | 4 +-
src/syntax.c | 25 +-
src/term.c | 45 +-
src/termchar.h | 2 +
src/terminfo.c | 5 +-
src/w32fns.c | 10 +-
src/w32heap.c | 2 +-
src/w32menu.c | 2 +-
src/w32term.c | 2 +-
src/w32term.h | 2 +-
src/xdisp.c | 21 +-
src/xfaces.c | 12 +-
src/xfns.c | 2 +-
src/xterm.h | 2 +-
test/ChangeLog.1 | 2 +-
test/data/emacs-module/mod-test.c | 21 +
test/lisp/calc/calc-tests.el | 67 +++
test/lisp/comint-tests.el | 78 +--
test/lisp/dired-aux-tests.el | 47 +-
.../faceup-resources/faceup-test-mode.el | 2 +-
.../faceup-resources/files/test1.txt.faceup | 2 +-
test/lisp/emacs-lisp/find-func-tests.el | 45 ++
test/lisp/emacs-lisp/lisp-mode-tests.el | 14 +-
test/lisp/files-tests.el | 66 +++
test/lisp/gnus/mml-sec-tests.el | 2 +-
test/lisp/international/mule-tests.el | 11 +-
test/lisp/jsonrpc-tests.el | 2 +-
test/lisp/net/dbus-tests.el | 539 ++++++++++++++++++---
test/lisp/nxml/nxml-mode-tests.el | 21 +
.../cperl-mode-resources/cperl-indent-styles.pl | 44 ++
test/lisp/progmodes/cperl-mode-tests.el | 31 ++
test/lisp/progmodes/elisp-mode-tests.el | 12 +
.../progmodes/opascal-tests.el} | 43 +-
test/lisp/progmodes/ps-mode-tests.el | 24 +
.../progmodes/ruby-mode-resources}/ruby.rb | 2 +-
test/lisp/progmodes/ruby-mode-tests.el | 19 +
test/lisp/progmodes/scheme-tests.el | 50 ++
test/lisp/subr-tests.el | 18 +
test/lisp/textmodes/css-mode-tests.el | 2 +
test/lisp/vc/vc-bzr-tests.el | 19 +-
test/manual/etags/c-src/emacs/src/keyboard.c | 2 +-
test/manual/etags/y-src/parse.c | 2 +-
test/manual/etags/y-src/parse.y | 2 +-
test/manual/indent/elisp.el | 6 -
test/manual/indent/lisp.lisp | 5 -
test/manual/indent/nxml.xml | 10 -
test/manual/indent/opascal.pas | 12 -
test/manual/indent/ps-mode.ps | 14 -
test/manual/indent/scheme.scm | 9 -
test/src/emacs-module-tests.el | 32 ++
test/src/keyboard-tests.el | 15 +
test/src/print-tests.el | 28 ++
213 files changed, 3469 insertions(+), 1219 deletions(-)
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 73453cb..510bb79 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -77,7 +77,7 @@
;; 2nd: function to call to get a property value,
;; or an index number of C function to decode the value,
;; or nil if the value can be directly got from the table.
-;; 3nd: function to call to put a property value,
+;; 3rd: function to call to put a property value,
;; or an index number of C function to encode the value,
;; or nil if the value can be directly stored in the table.
;; 4th: function to call to get a description of a property value, or nil
@@ -1177,7 +1177,7 @@ Property value is a symbol `o' (Open), `c' (Close), or
`n' (None)."
(defun unidata-describe-general-category (val)
(cdr (assq val
- '((nil . "Uknown")
+ '((nil . "Unknown")
(Lu . "Letter, Uppercase")
(Ll . "Letter, Lowercase")
(Lt . "Letter, Titlecase")
diff --git a/configure.ac b/configure.ac
index a3d1d71..990933a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -725,7 +725,7 @@ case "${canonical}" in
*-apple-darwin* )
case "${canonical}" in
*-apple-darwin[0-9].*) unported=yes ;;
- i[3456]86-* | x86_64-* | arm-* ) ;;
+ i[3456]86-* | x86_64-* | arm-* | aarch64-* ) ;;
* ) unported=yes ;;
esac
opsys=darwin
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index 0b685fa..444b246 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -461,6 +461,14 @@ Normally, this command undoes the last change, moving
point back to
where it was before the change. The undo command applies only to
changes in the buffer; you can't use it to undo cursor motion.
+ On a graphics terminal (including text-mode frames displayed by a
+terminal emulator, such as @command{xterm}), the easiest way to invoke
+@code{undo} is with @kbd{C-/}; that doesn't need the Shift key. On a
+text terminal, @kbd{C-/} does not exist, but in many cases you can type
+@kbd{C-_} without the Shift key (in effect pressing @kbd{C--}) and it
+will work anyway, at least with keyboards that produce the US ASCII
+character set.
+
Although each editing command usually makes a separate entry in the
undo records, very simple commands may be grouped together.
Sometimes, an entry may cover just part of a complex command.
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 89ed470..537c653 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -697,6 +697,17 @@ forward order after the file name, as in
@samp{file|top/middle}. If
@code{uniquify-buffer-name-style} is set to @code{nil}, the buffer
names simply get @samp{<2>}, @samp{<3>}, etc.@: appended.
+ The value of @code{uniquify-buffer-name-style} can be set to a
+customized function with two arguments @var{base} and
+@var{extra-strings} where @var{base} is a string and
+@var{extra-strings} is a list of strings. For example the current
+implementation for @code{post-forward-angle-brackets} could be:
+
+@example
+(defun my-post-forward-angle-brackets (base extra-string)
+ (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\"))
+@end example
+
Which rule to follow for putting the directory names in the buffer
name is not very important if you are going to @emph{look} at the
buffer names before you type one. But as an experienced user, if you
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 2fa1ecc..51e8bd1 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -921,6 +921,7 @@ Manual}). For customizations, see the Custom group
@code{time-stamp}.
@node Reverting
@section Reverting a Buffer
@findex revert-buffer
+@findex revert-buffer-with-fine-grain
@cindex drastic changes
@cindex reread a file
@@ -941,6 +942,19 @@ reverted changes as a single modification to the buffer's
undo history
aliases to bring the reverted changes back, if you happen to change
your mind.
+@vindex revert-buffer-with-fine-grain-max-seconds
+ To revert a buffer more conservatively, you can use the command
+@code{revert-buffer-with-fine-grain}. This command acts like
+@code{revert-buffer}, but it tries to be as non-destructive as
+possible, making an effort to preserve all markers, properties and
+overlays in the buffer. Since reverting this way can be very slow
+when you have made a large number of changes, you can modify the
+variable @code{revert-buffer-with-fine-grain-max-seconds} to
+specify a maximum amount of seconds that replacing the buffer
+contents this way should take. Note that it is not ensured that the
+whole execution of @code{revert-buffer-with-fine-grain} won't take
+longer than this.
+
Some kinds of buffers that are not associated with files, such as
Dired buffers, can also be reverted. For them, reverting means
recalculating their contents. Buffers created explicitly with
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 06ad5a5..232b611 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -573,10 +573,13 @@ command works depend on the major mode.
@kindex C-h l
@findex view-lossage
+@findex lossage-size
If something surprising happens, and you are not sure what you typed,
use @kbd{C-h l} (@code{view-lossage}). @kbd{C-h l} displays your last
-300 input keystrokes and the commands they invoked. If you see
-commands that you are not familiar with, you can use @kbd{C-h k} or
+input keystrokes and the commands they invoked. By default, Emacs
+stores the last 300 keystrokes; if you wish, you can change this number with
+the command @code{lossage-size}.
+If you see commands that you are not familiar with, you can use @kbd{C-h k} or
@kbd{C-h f} to find out what they do.
@kindex C-h e
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index c8b21e7..4865ee1 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -3028,6 +3028,11 @@ point (@code{dired-at-point}).
@code{find-file-read-only-other-frame}.
@item C-x 5 d @var{directory} @key{RET}
@code{ffap-dired-other-frame}, analogous to @code{dired-other-frame}.
+@kindex C-x t C-f @r{(FFAP)}
+@item C-x t C-f @var{filename} @key{return}
+@code{ffap-other-tab}, analogous to @code{find-file-other-tab}.
+@item C-x t C-r @var{filename} @key{return}
+@code{ffap-read-only-other-tab}, analogous to
@code{find-file-read-only-other-tab}.
@item M-x ffap-next
Search buffer for next file name or URL, then find that file or URL.
@item S-mouse-3
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 1c33d7d..f0dd62d 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1291,6 +1291,12 @@ ways.
This abnormal hook holds documentation functions. It acts as a
collection of backends for ElDoc. This is what modes should use to
register their documentation functions with ElDoc.
+
+@vindex eldoc-display-truncation-message
+@item eldoc-display-truncation-message
+If non-@code{nil} (the default), display a verbose message about how
+to view a complete documentation (if it has been truncated in the echo
+area). If @code{nil}, just mark truncated messages with @samp{...}.
@end table
@node Hideshow
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 2e094f3..d44d7be 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1977,6 +1977,18 @@ performs case folding and lax-whitespace matching.
using the @code{isearch} face. This highlighting can be disabled by
setting the variable @code{search-highlight} to @code{nil}.
+@vindex search-highlight-submatches
+ When searching for regular expressions (with @kbd{C-M-s}, for
+instance), subexpressions receive special highlighting depending on
+the @code{search-highlight-submatches} variable. If this variable's
+value is @code{nil}, no special highlighting is done, but if the value
+is non-@code{nil}, text that matches @samp{\( @dots{} \)} constructs
+(a.k.a.@: ``subexpressions'') in the regular expression will be
+highlighted with distinct faces, named @code{isearch-group-@var{n}}.
+For instance, when searching for @samp{foo-\([0-9]+\)}, the part
+matched by @samp{[0-9]+} will be highlighted with the
+@code{isearch-group-1} face.
+
@cindex lazy highlighting customizations
@vindex isearch-lazy-highlight
@cindex @code{lazy-highlight} face
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 33528fc..2860343 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -596,8 +596,8 @@ and features that react to buffer modifications, use the
Execute @var{body} pretending it does not modify the buffer. This
includes checking whether the buffer's file is locked (@pxref{File
Locks}), running buffer modification hooks (@pxref{Change Hooks}),
-etc. Note that if @var{body} actually modifies the buffer text, its
-undo data may become corrupted.
+etc. Note that if @var{body} actually modifies the buffer text (as
+opposed to its text properties), its undo data may become corrupted.
@end defmac
@node Modification Time
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index c35444f..8591247 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -124,6 +124,11 @@ Link to the documentation of a variable; @var{variable} is
a string
which specifies the name of the variable to describe with
@code{describe-variable} when the user invokes this link.
+@item (face-link @var{face})
+Link to the documentation of a face; @var{face} is a string which
+specifies the name of the face to describe with @code{describe-face}
+when the user invokes this link.
+
@item (custom-group-link @var{group})
Link to another customization group. Invoking it creates a new
customization buffer for @var{group}.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index e549400..40978b4 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2182,21 +2182,24 @@ actual line height can never be less than the default.
@kindex line-height @r{(text property)}
A newline can have a @code{line-height} text or overlay property
that controls the total height of the display line ending in that
-newline.
+newline. The property value can be one of several forms:
- If the property value is @code{t}, the newline character has no
+@table @code
+@item t
+If the property value is @code{t}, the newline character has no
effect on the displayed height of the line---the visible contents
alone determine the height. The @code{line-spacing} property,
described below, is also ignored in this case. This is useful for
tiling small images (or image slices) without adding blank areas
between the images.
-
- If the property value is a list of the form @code{(@var{height}
-@var{total})}, that adds extra space @emph{below} the display line.
-First Emacs uses @var{height} as a height spec to control extra space
-@emph{above} the line; then it adds enough space @emph{below} the line
-to bring the total line height up to @var{total}. In this case, any
-value of @code{line-spacing} property for the newline is ignored.
+@item (@var{height} @var{total})
+If the property value is a list of the form shown, that adds extra
+space @emph{below} the display line. First Emacs uses @var{height} as
+a height spec to control extra space @emph{above} the line; then it
+adds enough space @emph{below} the line to bring the total line height
+up to @var{total}. In this case, any value of @code{line-spacing}
+property for the newline is ignored.
+@end table
@cindex height spec
Any other kind of property value is a height spec, which translates
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index d70c354..cc18b85 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1425,28 +1425,46 @@ violations of the above requirements. @xref{Initial
Options,,,emacs,
The GNU Emacs Manual}.
Using the module @acronym{API}, it is possible to define more complex
-function and data types: interactive functions, inline functions,
-macros, etc. However, the resulting C code will be cumbersome and
-hard to read. Therefore, we recommend that you limit the module code
-which creates functions and data structures to the absolute minimum,
-and leave the rest for a Lisp package that will accompany your module,
-because doing these additional tasks in Lisp is much easier, and will
-produce a much more readable code. For example, given a module
-function @code{module-func} defined as above, one way of making an
-interactive command @code{module-cmd} based on it is with the
-following simple Lisp wrapper:
+function and data types: inline functions, macros, etc. However, the
+resulting C code will be cumbersome and hard to read. Therefore, we
+recommend that you limit the module code which creates functions and
+data structures to the absolute minimum, and leave the rest for a Lisp
+package that will accompany your module, because doing these
+additional tasks in Lisp is much easier, and will produce a much more
+readable code. For example, given a module function
+@code{module-func} defined as above, one way of making a macro
+@code{module-macro} based on it is with the following simple Lisp
+wrapper:
@lisp
-(defun module-cmd (&rest args)
- "Documentation string for the command."
- (interactive @var{spec})
- (apply 'module-func args))
+(defmacro module-macro (&rest args)
+ "Documentation string for the macro."
+ (module-func args))
@end lisp
The Lisp package which goes with your module could then load the
module using the @code{load} primitive (@pxref{Dynamic Modules}) when
the package is loaded into Emacs.
+By default, module functions created by @code{make_function} are not
+interactive. To make them interactive, you can use the following
+function.
+
+@deftypefun void make_interactive (emacs_env *@var{env}, emacs_value
@var{function}, emacs_value @var{spec})
+This function, which is available since Emacs 28, makes the function
+@var{function} interactive using the interactive specification
+@var{spec}. Emacs interprets @var{spec} like the argument to the
+@code{interactive} form. @ref{Using Interactive}, and
+@pxref{Interactive Codes}. @var{function} must be an Emacs module
+function returned by @code{make_function}.
+@end deftypefun
+
+Note that there is no native module support for retrieving the
+interactive specification of a module function. Use the function
+@code{interactive-form} for that. @ref{Using Interactive}. It is not
+possible to make a module function non-interactive once you have made
+it interactive using @code{make_interactive}.
+
@anchor{Module Function Finalizers}
If you want to run some code when a module function object (i.e., an
object returned by @code{make_function}) is garbage-collected, you can
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 254d4e9..a4b4795 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -251,7 +251,8 @@ indicated with @samp{@equiv{}}.
Many of the examples in this manual print text when they are
evaluated. If you execute example code in a Lisp Interaction buffer
-(such as the buffer @file{*scratch*}), the printed text is inserted into
+(such as the buffer @file{*scratch*}) by typing @kbd{C-j} after the
+closing parenthesis of the example, the printed text is inserted into
the buffer. If you execute the example by other means (such as by
evaluating the function @code{eval-region}), the printed text is
displayed in the echo area.
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index d30114f..d00acd0 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -316,8 +316,22 @@ input before returning it. However,
@code{read-no-blanks-input} (see below), as well as
@code{read-minibuffer} and related functions (@pxref{Object from
Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all
-functions that do minibuffer input with completion, discard text
-properties unconditionally, regardless of the value of this variable.
+functions that do minibuffer input with completion, remove the @code{face}
+property unconditionally, regardless of the value of this variable.
+
+If this variable is non-@code{nil}, most text properties on strings
+from the completion table are preserved---but only on the part of the
+strings that were completed.
+
+@lisp
+(let ((minibuffer-allow-text-properties t))
+ (completing-read "String: " (list (propertize "foobar" 'data 'zot))))
+=> #("foobar" 3 6 (data zot))
+@end lisp
+
+In this example, the user typed @samp{foo} and then hit the @kbd{TAB}
+key, so the text properties are only preserved on the last three
+characters.
@end defvar
@defvar minibuffer-local-map
@@ -2460,9 +2474,10 @@ changes size automatically. In that case the window
resizing commands
@defopt max-mini-window-height
This option provides a maximum height for resizing minibuffer windows
-automatically. A floating-point number specifies a fraction of the
-frame's height; an integer specifies the maximum number of lines. The
-default value is 0.25.
+automatically. A floating-point number specifies the maximum height
+as a fraction of the frame's height; an integer specifies the maximum
+height in units of the frame's canonical character height
+(@pxref{Frame Font}). The default value is 0.25.
@end defopt
Note that the values of the above two variables take effect at display
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index fa5f18e..1652cb6 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -2166,6 +2166,29 @@ Mode line construct for miscellaneous information. By
default, this
shows the information specified by @code{global-mode-string}.
@end defvar
+@defvar mode-line-position-line-format
+The format used to display line numbers when @code{line-number-mode}
+(@pxref{Optional Mode Line,,, emacs, The GNU Emacs Manual}) is
+switched on. @samp{%l} in the format will be replaced with the line
+number.
+@end defvar
+
+@defvar mode-line-position-column-format
+The format used to display column numbers when
+@code{column-number-mode} (@pxref{Optional Mode Line,,, emacs, The GNU
+Emacs Manual}) is switched on. @samp{%c} in the format will be
+replaced with the column number, and this is zero-based if
+@code{column-number-indicator-zero-based} is non-@code{nil}, and
+one-based if @code{column-number-indicator-zero-based} is @code{nil}.
+@end defvar
+
+@defvar mode-line-position-column-line-format
+The format used to display column numbers when both
+@code{line-number-mode} and @code{column-number-mode} are switched on.
+See the previous two variables for the meaning of the @samp{%l} and
+@samp{%c} format specs.
+@end defvar
+
@defvar minor-mode-alist
@anchor{Definition of minor-mode-alist}
This variable holds an association list whose elements specify how the
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 4002004..4556f8a 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -603,6 +603,11 @@ This function works by calling @code{call-process}, so
program output
is decoded in the same way as for @code{call-process}.
@end defun
+@defun process-lines-ignore-status program &rest args
+This function is just like @code{process-lines}, but does not signal
+an error if @var{program} exits with a non-zero exit status.
+@end defun
+
@node Asynchronous Processes
@section Creating an Asynchronous Process
@cindex asynchronous subprocess
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index b6242c5..a217c6e 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -2542,7 +2542,7 @@ and replace them, the best way is to write an explicit
loop using
description of @code{replace-match}.
However, replacing matches in a string is more complex, especially
-if you want to do it efficiently. So Emacs provides a function to do
+if you want to do it efficiently. So Emacs provides two functions to do
this.
@defun replace-regexp-in-string regexp rep string &optional fixedcase literal
subexp start
@@ -2566,6 +2566,11 @@ replacement string. The match data at this point are
the result
of matching @var{regexp} against a substring of @var{string}.
@end defun
+@defun replace-in-string fromstring tostring instring
+This function copies @var{instring} and replaces any occurrences of
+@var{fromstring} with @var{tostring}.
+@end defun
+
If you want to write a command along the lines of @code{query-replace},
you can use @code{perform-replace} to do the work.
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index 9eb99a0..b99b5de 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -256,10 +256,11 @@ look in the standard syntax table to find the syntax of
this
character.
@item Generic comment delimiters: @samp{!}
-Characters that start or end a special kind of comment. @emph{Any}
-generic comment delimiter matches @emph{any} generic comment
-delimiter, but they cannot match a comment starter or comment ender;
-generic comment delimiters can only match each other.
+(This syntax class is also known as ``comment-fence''.) Characters
+that start or end a special kind of comment. @emph{Any} generic
+comment delimiter matches @emph{any} generic comment delimiter, but
+they cannot match a comment starter or comment ender; generic comment
+delimiters can only match each other.
This syntax class is primarily meant for use with the
@code{syntax-table} text property (@pxref{Syntax Properties}). You
@@ -268,10 +269,11 @@ first and last characters of the range
@code{syntax-table} properties
identifying them as generic comment delimiters.
@item Generic string delimiters: @samp{|}
-Characters that start or end a string. This class differs from the
-string quote class in that @emph{any} generic string delimiter can
-match any other generic string delimiter; but they do not match
-ordinary string quote characters.
+(This syntax class is also known as ``string-fence''.) Characters
+that start or end a string. This class differs from the string quote
+class in that @emph{any} generic string delimiter can match any other
+generic string delimiter; but they do not match ordinary string quote
+characters.
This syntax class is primarily meant for use with the
@code{syntax-table} text property (@pxref{Syntax Properties}). You
@@ -575,6 +577,15 @@ position before @var{end}. However, it should not call
@code{syntax-ppss-flush-cache}; so, it is not allowed to call
@code{syntax-ppss} on some position and later modify the buffer at an
earlier position.
+
+@strong{Caution:} When this variable is non-@code{nil}, Emacs removes
+@code{syntax-table} text properties arbitrarily and relies on
+@code{syntax-propertize-function} to reapply them. Thus if this
+facility is used at all, the function must apply @strong{all}
+@code{syntax-table} text properties used by the major mode. In
+particular, Modes derived from a CC Mode mode must not use this
+variable, since CC Mode uses other means to apply and remove these
+text properties.
@end defvar
@defvar syntax-propertize-extend-region-functions
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 3a4cf6b..722c044 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3069,7 +3069,7 @@ construct each part with @code{propertize} and then
combine them with
@code{buffer-substring-no-properties}, which copies text from the
buffer but does not copy its properties.
-@findex with-silent-modifications
+@findex with-silent-modifications, and changes in text properties
If you wish to add text properties to a buffer or remove them
without marking the buffer as modified, you can wrap the calls above
in the @code{with-silent-modifications} macro. @xref{Buffer
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 1d4db7e..95d6523 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -732,8 +732,8 @@ A @var{property} value can be retrieved by the function
@defun dbus-get-property bus service path interface property
This function returns the value of @var{property} of @var{interface}.
It will be checked at @var{bus}, @var{service}, @var{path}. The
-result can be any valid D-Bus value, or @code{nil} if there is no
-@var{property}. Example:
+result can be any valid D-Bus value. If there is no @var{property},
+or @var{property} cannot be read, an error is raised. Example:
@lisp
(dbus-get-property
@@ -749,7 +749,7 @@ This function sets the value of @var{property} of
@var{interface} to
@var{value}. It will be checked at @var{bus}, @var{service},
@var{path}. @var{value} can be preceded by a @var{type} symbol. When
the value is successfully set, this function returns @var{value}.
-Otherwise, it returns @code{nil}. Example:
+Example:
@lisp
(dbus-set-property
@@ -761,10 +761,11 @@ Otherwise, it returns @code{nil}. Example:
@end defun
@defun dbus-get-all-properties bus service path interface
-This function returns all properties of @var{interface}. It will be
-checked at @var{bus}, @var{service}, @var{path}. The result is a list
-of cons. Every cons contains the name of the property, and its value.
-If there are no properties, @code{nil} is returned. Example:
+This function returns all readable properties of @var{interface}. It
+will be checked at @var{bus}, @var{service}, @var{path}. The result
+is a list of cons cells. Every cons cell contains the name of the
+property, and its value. If there are no properties, @code{nil} is
+returned. Example:
@lisp
(dbus-get-all-properties
@@ -782,9 +783,9 @@ If there are no properties, @code{nil} is returned.
Example:
@defun dbus-get-all-managed-objects bus service path
This function returns all objects at @var{bus}, @var{service},
@var{path}, and the children of @var{path}. The result is a list of
-objects. Every object is a cons of an existing path name, and the
-list of available interface objects. An interface object is another
-cons, whose car is the interface name and cdr is the list of
+objects. Every object is a cons cell of an existing path name, and
+the list of available interface objects. An interface object is
+another cons, whose car is the interface name and cdr is the list of
properties as returned by @code{dbus-get-all-properties} for that path
and interface. Example:
@@ -1024,12 +1025,19 @@ but different to
(dbus-call-method @dots{} :int32 @var{nat-number} :signature @var{string})
@end lisp
-The value for a byte D-Bus type can be any integer in the range 0
-through 255. If a character is used as argument, modifiers
-represented outside this range are stripped off. For example,
-@code{:byte ?x} is equal to @code{:byte ?\M-x}, but it is not equal to
-@code{:byte ?\C-x} or @code{:byte ?\M-\C-x}. Signed and unsigned
-integer D-Bus types expect a corresponding integer value.
+The value for a D-Bus byte type can be any natural number. If the
+number is larger than 255, it is truncated to the least significant
+byte. For example, @code{:byte 1025} is equal to @code{:byte 1}. If
+a character is used as argument, modifiers represented outside this
+range are stripped off. For example, @code{:byte ?x} is equal to
+@code{:byte ?\M-x}, but it is not equal to @code{:byte ?\C-x} or
+@code{:byte ?\M-\C-x}.
+
+Signed and unsigned D-Bus integer types expect a corresponding integer
+value. A unix file descriptor is restricted to the values 0@dots{}9.
+
+If typed explicitly, a non-@code{nil} boolean value like
+@code{:boolean 'symbol} is handled like @code{t} or @code{:boolean t}.
A D-Bus compound type is always represented as a list. The @sc{car}
of this list can be the type symbol @code{:array}, @code{:variant},
@@ -1070,7 +1078,7 @@ elements of this array. Example:
(format ; Body.
"This is a test notification, raised from\n%S" (emacs-version))
'(:array) ; No actions (empty array of strings).
- '(:array :signature "@{sv@}") ; No hints
+ '(:array :signature "@{sv@}") ; No hints
; (empty array of dictionary entries).
:int32 -1) ; Default timeout.
@@ -1346,6 +1354,8 @@ message arrives, and @var{handler} is called. Example:
@cindex method calls, returning
@cindex returning method calls
+@c https://wiki.ubuntu.com/DebuggingDBus
+
You can offer an own service in D-Bus, which will be visible by other
D-Bus clients. See
@uref{https://dbus.freedesktop.org/doc/dbus-api-design.html}
for a discussion of the design.
@@ -1953,8 +1963,9 @@ appended to the @code{dbus-error}.
@defspec dbus-ignore-errors forms@dots{}
This executes @var{forms} exactly like a @code{progn}, except that
-@code{dbus-error} errors are ignored during the @var{forms}. These
-errors can be made visible when @code{dbus-debug} is set to @code{t}.
+@code{dbus-error} errors are ignored during the @var{forms} (the macro
+returns @code{nil} then). These errors can be made visible when
+@code{dbus-debug} is set to non-@code{nil}.
@end defspec
Incoming D-Bus messages are handled as Emacs events, @pxref{Misc
@@ -1981,8 +1992,10 @@ of the D-Bus object emitting the message.
@var{interface} and
@var{member} denote the message which has been sent.
@var{handler} is the callback function which has been registered for
-this message (@pxref{Signals}). When a @code{dbus-event} event
-arrives, @var{handler} is called with @var{args} as arguments.
+this message (@pxref{Signals}). @var{args} are the typed arguments as
+returned from the message. They are passed to @var{handler} without
+type information, when it is called during event handling in
+@code{dbus-handle-event}.
In order to inspect the @code{dbus-event} data, you could extend the
definition of the callback function in @ref{Signals}:
@@ -2031,11 +2044,10 @@ This function returns the member name of the D-Bus
object @var{event}
is coming from. It is either a signal name or a method name.
@end defun
-@vindex dbus-show-dbus-errors
-D-Bus error messages are not propagated during event handling, because
-it is usually not desired. D-Bus errors in events can be made visible
-by setting the user option @code{dbus-show-dbus-errors} to
-non-@code{nil}. They can also be handled by a hook function.
+D-Bus errors are not propagated during event handling, because it is
+usually not desired. D-Bus errors in events can be made visible by
+setting the variable @code{dbus-debug} to non-@code{nil}. They can
+also be handled by a hook function.
@defvar dbus-event-error-functions
This hook variable keeps a list of functions, which are called when a
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 4ae2c86..1bccbd7 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -93,14 +93,20 @@ default one, which is normally called @file{*eww*}.
@findex eww-quit
@findex eww-reload
@findex eww-copy-page-url
+@findex shr-maybe-probe-and-copy-url
@kindex q
@kindex w
@kindex g
If loading the URL was successful the buffer @file{*eww*} is opened
and the web page is rendered in it. You can leave EWW by pressing
@kbd{q} or exit the browser by calling @kbd{eww-quit}. To reload the
-web page hit @kbd{g} (@code{eww-reload}). Pressing @kbd{w}
-(@code{eww-copy-page-url}) will copy the current URL to the kill ring.
+web page hit @kbd{g} (@code{eww-reload}).
+
+ Pressing @kbd{w} when point is on a link will call
+@code{shr-maybe-probe-and-copy-url}, which copies this link's
+@acronym{URL} to the kill ring. If point is not on a link, pressing
+@kbd{w} calls @code{eww-copy-page-url}, which will copy the current
+page's URL to the kill ring instead.
@findex eww-open-in-new-buffer
@kindex M-RET
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 50eeb3e..a1c8b32 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -11979,6 +11979,11 @@ anything that isn't a newsgroup. This means that no
external images
will be fetched as a result of reading mail, so that nobody can use
web bugs (and the like) to track whether you've read email.
+@vindex gnus-global-groups
+If you have specific private groups that you want to have treated as
+if they were public groups, you can add the name of that group to the
+@code{gnus-global-groups} list.
+
Also @pxref{Misc Article} for @code{gnus-inhibit-images}.
@item gnus-html-cache-directory
@@ -19907,7 +19912,7 @@ Substring matching.
Fuzzy matching (@pxref{Fuzzy Matching}).
@item r
-Regexp matching
+Regexp matching.
@end table
@item date
@@ -19935,6 +19940,21 @@ Equal to number.
@item >
Greater than number.
@end table
+
+@item body-strings
+
+These match types are available on the @samp{head} and @code{body}
+``header types''.
+
+@table @kbd
+
+@item z
+Substring matching.
+
+@item p
+Regexp matching.
+@end table
+
@end table
@item
@@ -19970,7 +19990,8 @@ To make things a bit more complicated, there are
shortcuts. If you use
a capital letter on either the second or third keys, Gnus will use
defaults for the remaining one or two keystrokes. The defaults are
``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s
-t}, and @kbd{I a R} is the same as @kbd{I a r t}.
+t}, and @kbd{I a R} is the same as @kbd{I a r t}. (These shortcuts
+are not available for the body matches.)
These functions take both the numerical prefix and the symbolic prefix
(@pxref{Symbolic Prefixes}). A numerical prefix says how much to lower
@@ -20394,6 +20415,36 @@ key will lead to creation of @file{ADAPT} files.)
@end enumerate
@cindex score file atoms
+@item score-fn
+The value of this entry should be one or more user-defined function
+names in parentheses. Each function will be called in order and the
+returned value is required to be an integer.
+
+@example
+(score-fn (custom-scoring))
+@end example
+
+The user-defined function is called with an associative list with the
+keys @code{number subject from date id refs chars lines xref extra}
+followed by the article's score before the function is run.
+
+The following (somewhat contrived) example shows how to use a
+user-defined function that increases an article's score by 10 if the
+year of the article's date is also mentioned in its subject.
+
+@example
+(defun custom-scoring (article-alist score)
+ (let ((subject (cdr (assoc 'subject article-alist)))
+ (date (cdr (assoc 'date article-alist))))
+ (if (string-match (number-to-string
+ (nth 5 (parse-time-string date)))
+ subject)
+ 10)))
+@end example
+
+@code{score-fn} entries are permanent and can only be added or
+modified directly in the @code{SCORE} file.
+
@item mark
The value of this entry should be a number. Any articles with a score
lower than this number will be marked as read.
diff --git a/etc/NEWS b/etc/NEWS
index 8f10a62..6bfe45a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -85,9 +85,16 @@ useful on systems such as FreeBSD which ships only with
"etc/termcap".
* Changes in Emacs 28.1
+---
+** Support for the 'strike-through' face attribute on TTY frames.
+If your terminal's termcap or terminfo database entry has the 'smxx'
+capability defined, Emacs will now emit the prescribed escape
+sequences necessary to render faces with the 'strike-through'
+attribute on TTY frames.
+
+++
*** Emacs now defaults to UTF-8 instead of ISO-8859-1.
-This is only for the default, where the user has set no LANG (or
+This is only for the default, where the user has set no 'LANG' (or
similar) variable or environment. This change should lead to no
user-visible changes for normal usage.
@@ -127,6 +134,17 @@ the mouse cursor is on the scroll bars, fringes, margins,
header line,
and mode line. ('mwheel-mode' is enabled by default on most graphical
displays.)
+---
+** The default value of 'frame-title-format' and 'icon-title-format' has
changed.
+These variables are used to display the title bar of visible frames
+and the title bar of an iconified frame. They now show the name of
+the current buffer and the text "GNU Emacs" instead of the value of
+'invocation-name'. To get the old behavior back, add the following to
+your init file:
+
+ (setq frame-title-format '(multiple-frames "%b"
+ ("" invocation-name "@" system-name)))
+
* Editing Changes in Emacs 28.1
@@ -175,6 +193,14 @@ Completion of command names now considers obsolete aliases
as
candidates. Invoking a command via an obsolete alias now mentions the
obsolescence fact and shows the new name of the command.
++++
+** New command 'revert-buffer-with-fine-grain'.
+Revert a buffer trying to be as non-destructive as possible,
+preserving markers, properties and overlays. The new variable
+'revert-buffer-with-fine-grain-max-seconds' specifies the maximum
+number of seconds that 'revert-buffer-with-fine-grain' should spend
+trying to be non-destructive.
+
* Changes in Specialized Modes and Packages in Emacs 28.1
@@ -213,6 +239,9 @@ of the next command to be displayed in a new frame.
It's bound to the command 'other-tab-prefix' that requests the buffer
of the next command to be displayed in a new tab.
++++
+*** New command 'C-x t C-r' to open file read-only in other tab.
+
*** The tab bar is frame-local when 'tab-bar-show' is a number.
Show/hide the tab bar independently for each frame, according to the
value of 'tab-bar-show'.
@@ -302,14 +331,14 @@ details of marking the file at the end of the region.
directories with the help of new command 'dired-vc-next-action'.
+++
-*** 'dired-jump' and 'dired-jump-other-window' moved from dired-x to dired.
+*** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'.
The 'dired-jump' and 'dired-jump-other-window' commands have been
moved from the 'dired-x' package to 'dired'. The user option
'dired-bind-jump' no longer has any effect and is now obsolete.
The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default.
To get the old behavior of 'dired-bind-jump' back and unbind the above
-keys, add the following to your Init file:
+keys, add the following to your init file:
(global-set-key "\C-x\C-j" nil)
(global-set-key "\C-x4\C-j" nil)
@@ -346,11 +375,24 @@ tags to be considered as well.
** Gnus
+++
+*** New user option 'gnus-global-groups'.
+Gnus handles private groups differently from public (i.e., NNTP-like)
+groups. Most importantly, Gnus doesn't download external images from
+mail-like groups. This can be overridden by putting group names in
+'gnus-global-groups': Any group present in that list will be treated
+like a public group.
+
++++
*** New scoring types for the Date header.
You can now score based on the relative age of an article with the new
'<' and '>' date scoring types.
+++
+*** User-defined scoring is now possible.
+The new type is 'score-fn'. More information in the Gnus manual node
+"(gnus) Score File Format".
+
++++
*** New backend 'nnselect'.
The newly added 'nnselect' backend allows creating groups from an
arbitrary list of articles that may come from multiple groups and
@@ -461,6 +503,11 @@ authentication mechanism by setting a value for the key
'smtp-auth'.
+++
*** New command 'describe-keymap' describes keybindings in a keymap.
++++
+** New command 'lossage-size'.
+It allows users to set the maximum number of keystrokes and commands
+recorded for the purpose of 'view-lossage'.
+
---
*** The command 'view-lossage' can now be invoked from the menu bar.
The menu-bar Help menu now has a "Show Recent Inputs" item under the
@@ -498,9 +545,16 @@ supplied error message.
which appends a unique suffix to the Edebug name of the current
definition.
-+++
** ElDoc
++++
+*** New user option 'eldoc-display-truncation-message'.
+If non-nil (the default), eldoc will display a message saying
+something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
+to see rest" when a message has been truncated. If nil, truncated
+messages will be marked with just "..." at the end.
+
++++
*** New hook 'eldoc-documentation-functions'.
This hook is intended to be used for registering doc string functions.
These functions don't need to produce the doc string right away, they
@@ -508,6 +562,7 @@ may arrange for it to be produced asynchronously. The
results of all
doc string functions are accessible to the user through the user
option 'eldoc-documentation-strategy'.
++++
*** New user option 'eldoc-documentation-strategy'.
The built-in choices available for this user option let users compose
the results of 'eldoc-documentation-functions' in various ways, even
@@ -814,7 +869,7 @@ background colors or transparency, such as xbm, pbm, svg,
png and gif.
** EWW
+++
-*** New variable 'eww-retrieve-command'.
+*** New user option 'eww-retrieve-command'.
This can be used to download data via an external command. If nil
(the default), then 'url-retrieve' is used.
@@ -988,9 +1043,29 @@ window after starting). This variable defaults to nil.
** Miscellaneous
+++
+*** Interactive regular expression search now uses faces for sub-groups.
+E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face
+on the part of the regexp that matches the sub-expression "[0-9]+".
+This is controlled by the 'search-highlight-submatches' variable.
+
+---
+*** New user option 'reveal-auto-hide'.
+If non-nil (the default), revealed text is automatically hidden when
+point leaves the text. If nil, the text is not hidden again. Instead
+'M-x reveal-hide-revealed' can be used to hide all the revealed text.
+
++++
+*** New user options to control the look of line/column numbers in the mode
line.
+'mode-line-position-line-format' is the line number format (when
+'line-number-mode' is on), 'mode-line-position-column-format' is
+the column number format (when 'column-number-mode' is on), and
+'mode-line-position-column-line-format' is the combined format (when
+both modes are on).
+
++++
*** New command 'submit-emacs-patch'.
-This works along the lines of 'report-emacs-bug', but is more geared
-towards sending a patch to the Emacs issue tracker.
+This works like 'report-emacs-bug', but is more geared towards sending
+patches to the Emacs issue tracker.
+++
*** New minor mode 'button-mode'.
@@ -1103,6 +1178,10 @@ easily bind this menu to 'down-mouse-3' (usually the
right mouse button)
instead of 'mouse-2' (the default) by customizing the new user option
'flyspell-use-mouse-3-for-menu'.
+---
+*** The current dictionary is now displayed in the minor mode lighter.
+Clicking the dictionary name changes the current dictionary.
+
** Time
---
@@ -1133,7 +1212,7 @@ The old names are now obsolete.
+++
*** Property values can be typed explicitly.
'dbus-register-property' and 'dbus-set-property' accept now optional
-type symbols.
+type symbols. Both functions propagate D-Bus errors.
+++
*** Registered properties can have the new access type ':write'.
@@ -1143,9 +1222,18 @@ type symbols.
+++
*** D-Bus errors, which have been converted from incoming D-Bus error
-messages, contain the error name of that message now. They can be
-made visible by setting user variable 'dbus-show-dbus-errors' to
-non-nil, even if protected by 'dbus-ignore-errors' otherwise.
+messages, contain the error name of that message now.
+
+---
+*** D-Bus events keep the type information of their arguments.
+
+** CPerl Mode
+
+---
+*** The command 'cperl-set-style' offers the new value "PBP".
+This value customizes Emacs to use the style recommended in Damian
+Conway's book "Perl Best Practices" for indentation and formatting
+of conditionals.
* New Modes and Packages in Emacs 28.1
@@ -1179,6 +1267,12 @@ directory instead of the default directory.
* Incompatible Lisp Changes in Emacs 28.1
++++
+** Some properties from completion tables are now preserved.
+If 'minibuffer-allow-text-properties' is non-nil, doing completion
+over a table of strings with properties will no longer remove all the
+properties before returning. This affects things like 'completing-read'.
+
** 'equal' no longer examines some contents of window configurations.
Instead, it considers window configurations to be equal only if they
are 'eq'. To compare contents, use 'compare-window-configurations'
@@ -1281,7 +1375,7 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'semantic-flex-token-start', 'semantic-flex-token-text',
'semantic-imenu-bucketize-type-parts',
'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token',
-'semantic-init-db-hooks)', 'semantic-init-hooks',
+'semantic-init-db-hooks', 'semantic-init-hooks',
'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal',
'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name',
'semantic-nonterminal-leaf', 'semantic-nonterminal-protection',
@@ -1300,6 +1394,18 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
* Lisp Changes in Emacs 28.1
++++
+*** New function 'process-lines-ignore-status'.
+This is like 'process-lines', but does not signal an error if the
+return status is non-zero. 'process-lines-handling-status' has also
+been added, and takes a callback to handle the return status.
+
++++
+*** New function 'replace-in-string'.
+This function works along the line of 'replace-regexp-in-string', but
+matching on strings instead of regexps, and does not change the global
+match state.
+
---
*** 'ascii' is now a coding system alias for 'us-ascii'.
@@ -1336,6 +1442,10 @@ This removes the final remaining trace of old-style
backquotes.
'emacs_function' and 'emacs_finalizer' for module functions and
finalizers, respectively.
+** Module functions can now be made interactive.
+Use 'make_interactive' to give a module function an interactive
+specification.
+
** Module functions can now install an optional finalizer that is
called when the function object is garbage-collected. Use
'set_function_finalizer' to set the finalizer and
@@ -1404,6 +1514,12 @@ truncating precision field, such as "%.2a".
This can be used to parse RGB color specs in several formats and
convert them to a list '(R G B)' of primary color values.
+---
+** User option 'uniquify-buffer-name-style' can now be a function.
+This user option can be one of the predefined styles or a function to
+personalize the uniquified buffer name.
+
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
@@ -1445,6 +1561,9 @@ To turn this on, set the variable
'w32-use-native-image-API' to a
non-nil value. Please report any bugs you find while using the native
image API via 'M-x report-emacs-bug'.
+---
+** The user option 'make-pointer-invisible' is now honored on macOS.
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index 5ef5430..32ac05d 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -622,7 +622,7 @@ same as the 'C-x C-+' and 'C-x C--' commands.
This new command (which inserts an <a id="foo">_</a> skeleton) is
bound to 'C-c C-c #'.
-** New command 'font-lock-refontify'.
+** New command 'font-lock-debug-fontify'.
This is an interactive convenience function to be used when developing
font locking for a mode. It recomputes the font locking data and then
re-fontifies the buffer.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 67537f6..dada27f 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -967,6 +967,19 @@ index 5504171..431adf8 100644
If you can't modify that file directly, copy it to the directory
~/.m17n.d/ (create it if it doesn't exist), and apply the patch.
+** On MS-Windows, some characters display as boxes with hex code.
+
+Also, some characters could display with wrong fonts.
+
+This can happen if Emacs was compiled without HarfBuzz support, and/or
+if the HarfBuzz DLLs are not available at run time. Emacs will then
+fall back to the Uniscribe as its shaping engine; Uniscribe was
+deprecated by Microsoft, and sometimes fails to display correctly when
+modern fonts are used, such as Noto Emoji or Ebrima.
+
+The solution is to switch to a configuration that uses HarfBuzz as its
+shaping engine, where these problems don't exist.
+
* Internationalization problems
** M-{ does not work on a Spanish PC keyboard.
diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex
index 3b299bd..5a3adb8 100644
--- a/etc/refcards/cs-refcard.tex
+++ b/etc/refcards/cs-refcard.tex
@@ -494,7 +494,6 @@ z~minibufferu. Stiskněte \kbd{F10} pro aktivaci menu
v~minibufferu.
\section{Tagy}
\key{najít tag (definici)}{M-.}
-\key{najít další výskyt tagu}{C-u M-.}
\metax{zadat soubor s novými tagy}{M-x visit-tags-table}
\metax{vyhledat reg.\ výraz v~souborech s~tagy}{M-x tags-search}
diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex
index 21f2747..699dd90 100644
--- a/etc/refcards/cs-survival.tex
+++ b/etc/refcards/cs-survival.tex
@@ -255,7 +255,6 @@ proměnných, datových typů a dalšího. Pro vytvoření tabulky
značek spus
příkaz `{\tt etags} {\it vstupní\_soubory}' v příkazovém interpretu.
\askip
\key{M-.} najdi definici
-\key{C-u M-.} najdi další výskyt definice
\key{M-*} běž tam, odkud byla volána poslední \kbd{M-.}
\mkey{M-x tags-query-replace} spusť query-replace na všech souborech
zaznamenaných v tabulce značek.
diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex
index 6d972ee..29ddf12 100644
--- a/etc/refcards/de-refcard.tex
+++ b/etc/refcards/de-refcard.tex
@@ -497,7 +497,6 @@ und zu wiederholen, der im Minipuffer aus\-gef\"uhrt wurde.
Dr\"u\-cken Sie
\section{Tags}
\key{Tag finden (Definition)}{M-.}
-\key{n\"achstes Vorkommen von Tag finden}{C-u M-.}
\metax{neue Tagsdatei angeben}{M-x visit-tags-table}
\metax{regul\"aren Ausdruck in Dateien suchen}{M-x tags-search}
diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex
index 787556d..fe303ee 100644
--- a/etc/refcards/fr-refcard.tex
+++ b/etc/refcards/fr-refcard.tex
@@ -500,7 +500,6 @@ utiliser la barre de menu sur un terminal en utilisant le
mini-tampon.
\section{Tags}
\key{Trouver un tag (une d\'efinition)}{M-.}
-\key{Passer \`a l'occurrence suivante du tag}{C-u M-.}
\metax{Sp\'ecifier un autre fichier de tags}{M-x visit-tags-table}
\metax{Rechercher dans tous les fichiers des tags}{M-x tags-search}
diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex
index 0aa5df3..1cd6852 100644
--- a/etc/refcards/fr-survival.tex
+++ b/etc/refcards/fr-survival.tex
@@ -251,7 +251,6 @@ types de donn\'ees et de tout ce qui peut \^etre pratique.
Pour cr\'eer un
tel fichier, tapez `{\tt etags} {\it fichier\_entr\'ee}' \`a l'invite du shell.
\askip
\key{M-.} trouve une d\'efinition
-\key{C-u M-.} trouve l'occurrence suivante de la d\'efinition
\key{M-*} revient o\`u \kbd{M-.} a \'et\'e appel\'e pour la derni\`ere fois
\mkey{M-x tags-query-replace} lance query-replace sur tous les
fichiers enregistr\'es dans le tableau des marqueurs
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index 68acac9..2b92fb5 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -690,10 +690,8 @@ Napisz \kbd{F10} aby uaktywni/c menu w minibuforze.
\section{Tags}
%\key{find a tag (a definition)}{M-.}
-%\key{find next occurrence of tag}{C-u M-.}
%\metax{specify a new tags file}{M-x visit-tags-table}
\key{znajd/x okre/slenie (definicj/e)}{M-.}
-\key{znajd/x nast/epne wyst/apienie definicji}{C-u M-.}
\metax{podaj nowy plik TAGS}{M-x visit-tags-table}
%\metax{regexp search on all files in tags table}{M-x tags-search}
diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex
index c75fd2f..d4e3123 100644
--- a/etc/refcards/pt-br-refcard.tex
+++ b/etc/refcards/pt-br-refcard.tex
@@ -506,7 +506,6 @@ utilizado. Tecle \kbd{F10} para ativar o menu.
\section{Tags}
\key{busca uma tag (uma defini{\c{c}}{\~a}o)}{M-.}
-\key{encontra a pr{\'o}xima ocorr{\^e}ncia da tag}{C-u M-.}
\metax{especifica um novo arquivo de tags}{M-x visit-tags-table}
\metax{busca por regexp em todos arquivos}{M-x tags-search}
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index afae238..6cac28f 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -511,7 +511,6 @@ minibuffer. Type \kbd{F10} to activate menu bar items on
text terminals.
\section{Tags}
\key{find a tag (a definition)}{M-.}
-\key{find next occurrence of tag}{C-u M-.}
\metax{specify a new tags file}{M-x visit-tags-table}
\metax{regexp search on all files in tags table}{M-x tags-search}
@@ -562,8 +561,8 @@ minibuffer. Type \kbd{F10} to activate menu bar items on
text terminals.
\key{quote regular expression special character {\it c\/}}{\\{\it c}}
\key{alternative (``or'')}{\\|}
\key{grouping}{\\( {\rm$\ldots$} \\)}
-\key{shy grouping}{\\(:? {\rm$\ldots$} \\)}
-\key{explicit numbered grouping}{\\(:NUM {\rm$\ldots$} \\)}
+\key{shy grouping}{\\(?: {\rm$\ldots$} \\)}
+\key{explicit numbered grouping}{\\(?NUM: {\rm$\ldots$} \\)}
\key{same text as {\it n\/}th group}{\\{\it n}}
\key{at word break}{\\b}
\key{not at word break}{\\B}
diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex
index 0d210b4..165c00d 100644
--- a/etc/refcards/ru-refcard.tex
+++ b/etc/refcards/ru-refcard.tex
@@ -340,7 +340,6 @@ apropos: показать команды, соответствующие стр
\begin{tabular}{p{\ColWidth}l}
найти определение тега & \kbd{M-.} \\
-найти следующее вхождение тега & \kbd{C-u M-.} \\
использовать новый файл с тегами & \kbd{M-x visit-tags-table} \\
поиск по шаблону по всей таблице тегов & \kbd{M-x tags-search} \\
diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex
index 9302e18..b232ea8 100644
--- a/etc/refcards/sk-refcard.tex
+++ b/etc/refcards/sk-refcard.tex
@@ -494,7 +494,6 @@ z~minibufferu. Stlačte \kbd{F10} pre aktiváciu menu
v~minibufferi.
\section{Tagy}
\key{nájsť tag (definíciu)}{M-.}
-\key{nájsť ďalší výskyt tagu}{C-u M-.}
\metax{zadať súbor s novými tagmi}{M-x visit-tags-table}
\metax{vyhľadať reg.\ výraz v~súboroch s~tagmi}{M-x tags-search}
diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex
index 5f06c2d..8e5d85f4 100644
--- a/etc/refcards/sk-survival.tex
+++ b/etc/refcards/sk-survival.tex
@@ -258,7 +258,6 @@ premenných, dátových typov a iných. Pre vytvorenie tabuľky
značiek spustit
príkaz `{\tt etags} {\it vstupné\_súbory}' v príkazovom interprétereri.
\askip
\key{M-.} nájdi definícu
-\key{C-u M-.} nájdi ďalší výskyt definície
\key{M-*} choď tam, odkiaľ bola volaná posledná \kbd{M-.}
\mkey{M-x tags-query-replace} spusti query-replace na všetkých súboroch
zaznamenaných v tabuľke značiek.
diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex
index 5e73a45..24204e5 100644
--- a/etc/refcards/survival.tex
+++ b/etc/refcards/survival.tex
@@ -243,7 +243,6 @@ else convenient. To create a tags table file, type
`{\tt etags} {\it input\_files}' as a shell command.
\askip
\key{M-.} find a definition
-\key{C-u M-.} find next occurrence of definition
\key{M-*} pop back to where \kbd{M-.} was last invoked
\mkey{M-x tags-query-replace} run query-replace on all files
recorded in tags table
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL
index 227c13f..319ba52 100644
--- a/etc/tutorials/TUTORIAL
+++ b/etc/tutorials/TUTORIAL
@@ -473,6 +473,7 @@ to undo insertion of text.)
>> Kill this line with C-k, then type C-/ and it should reappear.
C-_ is an alternative undo command; it works exactly the same as C-/.
+On some text terminals, you can omit the shift key when you type C-_.
On some text terminals, typing C-/ actually sends C-_ to Emacs.
Alternatively, C-x u also works exactly like C-/, but is a little less
convenient to type.
diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he
index a6e6f25..907da24 100644
--- a/etc/tutorials/TUTORIAL.he
+++ b/etc/tutorials/TUTORIAL.he
@@ -419,8 +419,9 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא
>> גזרו שורה זו עם C-k, אחר־כך הקישו C-/ והיא תופיע שוב.
C-_ הינה דרך חלופית להפעיל את פקודת הביטול. היא פועלת בדיוק כמו C-/.
-במקלדות אחדות הקשה על C-/ שולחת ל־Emacs את התו C-_. חלופה נוספת היא
-C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו.
+במקלדות אחדות אפשר לא ללחוץ על shift כשמקישים C-_.
+במקלדות אחדות הקשה על C-/ שולחת ל־Emacs את התו C-_.
+חלופה נוספת היא C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו.
ארגומנט נומרי ל־C-/ או ל־C-_ או ל־C-x u משמש כמספר החזרות על הפקודה.
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 70eb22b..7d0650a 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -1875,7 +1875,7 @@ yylex (void)
/* Actually local to matching_regexp. These variables must be in
- global scope for the case that `static' get's defined away. */
+ global scope for the case that `static' gets defined away. */
static char *matching_regexp_buffer, *matching_regexp_end_buf;
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 20342bc..f31c6cc 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -411,6 +411,8 @@ zero, otherwise they start from one."
:type 'boolean
:group 'mode-line
:version "26.1")
+(make-obsolete-variable 'column-number-indicator-zero-based
+ 'mode-line-position-column-format "28.1")
(defcustom mode-line-percent-position '(-3 "%p")
"Specification of \"percentage offset\" of window through buffer.
@@ -431,6 +433,41 @@ displayed in `mode-line-position', a component of the
default
:group 'mode-line)
(put 'mode-line-percent-position 'risky-local-variable t)
+(defcustom mode-line-position-line-format '(" L%l")
+ "Format used to display line numbers in the mode line.
+This is used when `line-number-mode' is switched on. The \"%l\"
+format spec will be replaced by the line number."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defcustom mode-line-position-column-format '(" C%c")
+ "Format used to display column numbers in the mode line.
+This is used when `column-number-mode' is switched on. The
+\"%c\" format spec will be replaced by the column number, which
+is zero-based if `column-number-indicator-zero-based' is non-nil,
+and one-based if `column-number-indicator-zero-based' is nil."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defcustom mode-line-position-column-line-format '(" (%l,%c)")
+ "Format used to display combined line/column numbers in the mode line.
+This is used when `column-number-mode' and `line-number-mode' are
+switched on. The \"%c\" format spec will be replaced by the
+column number, which is zero-based if
+`column-number-indicator-zero-based' is non-nil, and one-based if
+`column-number-indicator-zero-based' is nil."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defconst mode-line-position--column-line-properties
+ (list 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Line number and Column number\n\
+mouse-1: Display Line and Column Mode Menu"))
+
(defvar mode-line-position
`((:propertize
mode-line-percent-position
@@ -450,38 +487,30 @@ mouse-1: Display Line and Column Mode Menu")))
(line-number-mode
((column-number-mode
(column-number-indicator-zero-based
- (10 ,(propertize
- " (%l,%c)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
-mouse-1: Display Line and Column Mode Menu"))
- (10 ,(propertize
- " (%l,%C)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
-mouse-1: Display Line and Column Mode Menu")))
- (6 ,(propertize
- " L%l"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line Number\n\
-mouse-1: Display Line and Column Mode Menu"))))
- ((column-number-mode
- (column-number-indicator-zero-based
- (5 ,(propertize
- " C%c"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu"))
- (5 ,(propertize
- " C%C"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu")))))))
+ (10
+ (:propertize
+ mode-line-position-column-line-format
+ ,@mode-line-position--column-line-properties))
+ (10
+ (:propertize
+ (:eval (replace-in-string
+ "%c" "%C" (car mode-line-position-column-line-format)))
+ ,@mode-line-position--column-line-properties)))
+ (6
+ (:propertize
+ mode-line-position-line-format
+ ,@mode-line-position--column-line-properties))))
+ (column-number-mode
+ (column-number-indicator-zero-based
+ (6
+ (:propertize
+ mode-line-position-column-format
+ (,@mode-line-position--column-line-properties)))
+ (6
+ (:propertize
+ (:eval (replace-in-string
+ "%c" "%C" (car mode-line-position-column-format)))
+ ,@mode-line-position--column-line-properties))))))
"Mode line construct for displaying the position in the buffer.
Normally displays the buffer percentage and, optionally, the
buffer size, the line number and the column number.")
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index 2efeb7f..f7e29c6 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -439,12 +439,25 @@
(math-div (calcFunc-fact (math-float n))
(math-mul (calcFunc-fact m)
(calcFunc-fact (math-sub n m))))))
- ((math-negp m) 0)
- ((math-negp n)
- (let ((val (calcFunc-choose (math-add (math-add n m) -1) m)))
+ ;; For the extension to negative integer arguments we follow
+ ;; M. J. Kronenburg, The Binomial Coefficient for Negative Arguments,
+ ;; arXiv:1105.3689v2
+ ((and (math-negp n) (not (math-negp m)))
+ ;; n<0≤m: (n choose m) = (-1)^m (-n+m-1 choose m)
+ (let ((val (calcFunc-choose (math-add (math-sub m n) -1) m)))
(if (math-evenp (math-trunc m))
val
(math-neg val))))
+ ((and (math-negp n) (math-num-integerp n))
+ (if (math-lessp n m)
+ 0
+ ;; m≤n<0: (n choose m) = (-1)^(n-m) (-m-1 choose n-m)
+ (let ((val (calcFunc-choose (math-sub (math-neg m) 1)
+ (math-sub n m))))
+ (if (math-evenp (math-sub n m))
+ val
+ (math-neg val)))))
+ ((math-negp m) 0)
((and (math-num-integerp n)
(Math-lessp n m))
0)
@@ -461,20 +474,23 @@
(math-choose-float-iter tm n 1 1)))))))
(defun math-choose-iter (m n i c)
- (if (and (= (% i 5) 1) (> i 5))
+ (while (<= i m)
+ (when (and (= (% i 5) 1) (> i 5))
(math-working (format "choose(%d)" (1- i)) c))
- (if (<= i m)
- (math-choose-iter m (1- n) (1+ i)
- (math-quotient (math-mul c n) i))
- c))
+ (setq c (math-quotient (math-mul c n) i))
+ (setq n (1- n))
+ (setq i (1+ i)))
+ c)
(defun math-choose-float-iter (count n i c)
- (if (= (% i 5) 1)
+ (while (> count 0)
+ (when (= (% i 5) 1)
(math-working (format "choose(%d)" (1- i)) c))
- (if (> count 0)
- (math-choose-float-iter (1- count) (math-sub n 1) (1+ i)
- (math-div (math-mul c n) i))
- c))
+ (setq c (math-div (math-mul c n) i))
+ (setq n (math-sub n 1))
+ (setq i (1+ i))
+ (setq count (1- count)))
+ c)
;;; Stirling numbers.
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 0367c53..1f3ae84 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1018,7 +1018,8 @@
(make-string (+ w 2) ?\_))
(list 'horiz
(if (= h 1)
- "V"
+ (if (char-displayable-p ?√)
+ "√" "V")
(append (list 'vleft (1- a))
(make-list (1- h) " |")
'("\\|")))
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index bfcbd40..a052c5c 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -234,20 +234,19 @@ All files need the macros from lisp.h!"
(let* ((D (car dirs))
(ed (expand-file-name D base))
(ef (expand-file-name name ed)))
- (if (file-exists-p ef)
- (setq ans ef)
- ;; Not in this dir? How about subdirs?
- (let ((dirfile (directory-files ed t))
- (moredirs nil)
- )
- ;; Get all the subdirs.
- (dolist (DF dirfile)
- (when (and (file-directory-p DF)
- (not (string-match "\\.$" DF)))
- (push DF moredirs)))
- ;; Try again.
- (setq ans (ede-emacs-find-in-directories name ed moredirs))
- ))
+ (when (file-exists-p ed)
+ (if (file-exists-p ef)
+ (setq ans ef)
+ ;; Not in this dir? How about subdirs?
+ (let ((dirfile (directory-files ed t))
+ (moredirs nil))
+ ;; Get all the subdirs.
+ (dolist (DF dirfile)
+ (when (and (file-directory-p DF)
+ (not (string-match "\\.$" DF)))
+ (push DF moredirs)))
+ ;; Try again.
+ (setq ans (ede-emacs-find-in-directories name ed moredirs)))))
(setq dirs (cdr dirs))))
ans))
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 822ec17..bbed1d9 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -649,7 +649,7 @@ define-mode-overload\\)\
))
(when fun
;; Do not return FUN IFF the cursor is on FUN.
- ;; Huh? Thats because if cursor is on fun, it is
+ ;; Huh? That's because if cursor is on fun, it is
;; the current symbol, and not the current function.
(if (save-excursion
(condition-case nil
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 510f931..86ccf28 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1245,7 +1245,7 @@ See `semanticdb-find-translate-path' for details on PATH.
The argument BRUTISH will be set so that searching includes all tables
in the current project.
FIND-FILE-MATCH indicates that any time a match is found, the file
-associated wit that tag should be loaded into a buffer."
+associated with that tag should be loaded into a buffer."
(semanticdb-find-tags-collector
(lambda (table tags)
(semanticdb-deep-find-tags-by-name-method table name tags))
@@ -1257,7 +1257,7 @@ See `semanticdb-find-translate-path' for details on PATH.
The argument BRUTISH will be set so that searching includes all tables
in the current project.
FIND-FILE-MATCH indicates that any time a match is found, the file
-associated wit that tag should be loaded into a buffer."
+associated with that tag should be loaded into a buffer."
(semanticdb-find-tags-collector
(lambda (table tags)
(semanticdb-deep-find-tags-for-completion-method table prefix tags))
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index aaf43a1..60a65b1 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -89,7 +89,7 @@ same major mode as the current buffer.")
:documentation "The tags belonging to this table.")
(db-refs :initform nil
:documentation
- "List of `semanticdb-table' objects refering to this one.
+ "List of `semanticdb-table' objects referring to this one.
These aren't saved, but are instead recalculated after load.
See the file semanticdb-ref.el for how this slot is used.")
(index :type semanticdb-abstract-search-index
@@ -764,7 +764,7 @@ If a particular major mode wants to search any mode, put the
Do not set the value of this variable permanently.")
(defmacro semanticdb-with-match-any-mode (&rest body)
- "A Semanticdb search occurring withing BODY will search tags in all modes.
+ "A Semanticdb search occurring within BODY will search tags in all modes.
This temporarily sets `semanticdb-match-any-mode' while executing BODY."
(declare (indent 0) (debug t))
`(let ((semanticdb-match-any-mode t))
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 3e090c0..799aa45 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1069,7 +1069,7 @@ Only in effect if `debug-on-error' is also non-nil."
"For SYNTAX, execute FORMS with protection for unterminated syntax.
If FORMS throws an error, treat this as a syntax problem, and
execute the unterminated syntax code. FORMS should return a position.
-Irregardless of an error, the cursor should be moved to the end of
+Regardless of an error, the cursor should be moved to the end of
the desired syntax, and a position returned.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
diff --git a/lisp/composite.el b/lisp/composite.el
index 77c5cd8..47d91c5 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -660,7 +660,7 @@ All non-spacing characters have this function in
;; align it at the center of the glyph of the
;; enclosing mark hoping that the enclosing mark
;; is big enough. We also have to adjust the
- ;; x-offset and width of the mark ifself properly
+ ;; x-offset and width of the mark itself properly
;; depending on how the glyph is designed.
;; (non-spacing or not). For instance, when we
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 6d0ec5d..a62b623 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -3560,19 +3560,24 @@ the present value is saved to its :shown-value property
instead."
(widget-put widget :buttons buttons))
;; Draw an ordinary `custom-face' widget
- (let ((opoint (point)))
- ;; Visibility indicator.
- (push (widget-create-child-and-convert
- widget 'custom-visibility
- :help-echo "Hide or show this face."
- :on "Hide" :off "Show"
- :on-glyph "down" :off-glyph "right"
- :action 'custom-toggle-hide-face
- (not hiddenp))
- buttons)
- ;; Face name (tag).
- (insert " " tag)
- (widget-specify-sample widget opoint (point)))
+ ;; Visibility indicator.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide or show this face."
+ :on "Hide" :off "Show"
+ :on-glyph "down" :off-glyph "right"
+ :action 'custom-toggle-hide-face
+ (not hiddenp))
+ buttons)
+ ;; Face name (tag).
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'face-link
+ :button-face 'link
+ :tag tag
+ :action (lambda (&rest _x)
+ (find-face-definition symbol)))
+ buttons)
(insert
(cond ((eq custom-buffer-style 'face) " ")
((string-match-p "face\\'" tag) ":")
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index d6da428..9305664 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -953,7 +953,7 @@ This function can be used as a value of
;; exclusively, we could call the (now unused) argument
;; _CALLBACK with hints on how to shorten the string if needed,
;; or with multiple usable strings which ElDoc picks according
- ;; to its space contraints.
+ ;; to its space constraints.
(describe-char-eldoc--format
ch
(unless (eq eldoc-echo-area-use-multiline-p t)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 3ee877e..df25a64 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,24 +60,132 @@ Isolated means that STRING is surrounded by spaces or at
the beginning/end
of a string followed/prefixed with an space.
The regexp capture the preceding blank, STRING and the following blank as
the groups 1, 2 and 3 respectively."
- (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
+ (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string))
-(defun dired--star-or-qmark-p (string match &optional keep)
+(defun dired--star-or-qmark-p (string match &optional keep start)
"Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter
means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
If optional arg KEEP is non-nil, then preserve the match data. Otherwise,
this function changes it and saves MATCH as the second match group.
+START is the position to start matching from.
Isolated means that MATCH is surrounded by spaces or at the beginning/end
of STRING followed/prefixed with an space. A match to `\\=`?\\=`',
isolated or not, is also valid."
- (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote
match) "[*?]")))))
+ (let ((regexp (dired-isolated-string-re (if match (regexp-quote match)
"[*?]"))))
(when (or (null match) (equal match "?"))
- (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
- (cl-some (lambda (x)
- (funcall (if keep #'string-match-p #'string-match) x string))
- regexps)))
+ (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)"))
+ (funcall (if keep #'string-match-p #'string-match) regexp string start)))
+
+(defun dired--need-confirm-positions (command string)
+ "Search for non-isolated matches of STRING in COMMAND.
+Return a list of positions that match STRING, but would not be
+considered \"isolated\" by `dired--star-or-qmark-p'."
+ (cl-assert (= (length string) 1))
+ (let ((start 0)
+ (isolated-char-positions nil)
+ (confirm-positions nil)
+ (regexp (regexp-quote string)))
+ ;; Collect all ? and * surrounded by spaces and `?`.
+ (while (dired--star-or-qmark-p command string nil start)
+ (push (cons (match-beginning 2) (match-end 2))
+ isolated-char-positions)
+ (setq start (match-end 2)))
+ ;; Now collect any remaining ? and *.
+ (setq start 0)
+ (while (string-match regexp command start)
+ (unless (cl-member (match-beginning 0) isolated-char-positions
+ :test (lambda (pos match)
+ (<= (car match) pos (cdr match))))
+ (push (match-beginning 0) confirm-positions))
+ (setq start (match-end 0)))
+ confirm-positions))
+
+(defun dired--mark-positions (positions)
+ (let ((markers (make-string
+ (1+ (apply #'max positions))
+ ?\s)))
+ (dolist (pos positions)
+ (setf (aref markers pos) ?^))
+ markers))
+
+(defun dired--highlight-no-subst-chars (positions command mark)
+ (cl-callf substring-no-properties command)
+ (dolist (pos positions)
+ (add-face-text-property pos (1+ pos) 'warning nil command))
+ (if mark
+ (concat command "\n" (dired--mark-positions positions))
+ command))
+
+(defun dired--no-subst-explain (buf char-positions command mark-positions)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert
+ (format-message "\
+If your command contains occurrences of `*' surrounded by
+whitespace, `dired-do-shell-command' substitutes them for the
+entire file list to process. Otherwise, if your command contains
+occurrences of `?' surrounded by whitespace or `%s', Dired will
+run the command once for each file, substituting `?' for each
+file name.
+
+Your command contains occurrences of `%s' that will not be
+substituted, and will be passed through normally to the shell.
+
+%s
+
+(Press ^ to %s markers below these occurrences.)
+"
+ "`"
+ (string (aref command (car char-positions)))
+ (dired--highlight-no-subst-chars char-positions command mark-positions)
+ (if mark-positions "remove" "add")))))
+
+(defun dired--no-subst-ask (char nb-occur details)
+ (let ((hilit-char (propertize (string char) 'face 'warning))
+ (choices `(?y ?n ?? ,@(when details '(?^)))))
+ (read-char-from-minibuffer
+ (format-message
+ (ngettext
+ "%d occurrence of `%s' will not be substituted. Proceed? (%s) "
+ "%d occurrences of `%s' will not be substituted. Proceed? (%s) "
+ nb-occur)
+ nb-occur hilit-char (mapconcat #'string choices ", "))
+ choices)))
+
+(defun dired--no-subst-confirm (char-positions command)
+ (let ((help-buf (get-buffer-create "*Dired help*"))
+ (char (aref command (car char-positions)))
+ (nb-occur (length char-positions))
+ (done nil)
+ (details nil)
+ (markers nil)
+ proceed)
+ (unwind-protect
+ (save-window-excursion
+ (while (not done)
+ (cl-case (dired--no-subst-ask char nb-occur details)
+ (?y
+ (setq done t
+ proceed t))
+ (?n
+ (setq done t
+ proceed nil))
+ (??
+ (if details
+ (progn
+ (quit-window nil details)
+ (setq details nil))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)
+ (setq details (display-buffer help-buf))))
+ (?^
+ (setq markers (not markers))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)))))
+ (kill-buffer help-buf))
+ proceed))
;;;###autoload
(defun dired-diff (file &optional switches)
@@ -772,28 +880,19 @@ prompted for the shell command to use interactively."
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (cl-flet ((need-confirm-p
- (cmd str)
- (let ((res cmd)
- (regexp (regexp-quote str)))
- ;; Drop all ? and * surrounded by spaces and `?`.
- (while (and (string-match regexp res)
- (dired--star-or-qmark-p res str))
- (setq res (replace-match "" t t res 2)))
- (string-match regexp res))))
(let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
(no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
+ (confirmations nil)
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
- (ok (cond ((not (or on-each no-subst))
- (error "You can not combine `*' and `?' substitution
marks"))
- ((need-confirm-p command "*")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `*' as a wildcard?
")))
- ((need-confirm-p command "?")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `?' as a wildcard?
")))
- (t))))
+ (ok (cond
+ ((not (or on-each no-subst))
+ (error "You can not combine `*' and `?' substitution marks"))
+ ((setq confirmations (dired--need-confirm-positions command "*"))
+ (dired--no-subst-confirm confirmations command))
+ ((setq confirmations (dired--need-confirm-positions command "?"))
+ (dired--no-subst-confirm confirmations command))
+ (t))))
(cond ((not ok) (message "Command canceled"))
(t
(if on-each
@@ -804,7 +903,7 @@ prompted for the shell command to use interactively."
nil file-list)
;; execute the shell command
(dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg))))))))
+ (dired-shell-stuff-it command file-list nil arg)))))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
@@ -2718,12 +2817,6 @@ When called interactively and not on a subdir line, go
to this subdir's line."
(if (dired-get-subdir) 1 0))))
(dired-next-subdir (- arg) no-error-if-not-found no-skip))
-(defun dired-subdir-min ()
- (save-excursion
- (if (not (dired-prev-subdir 0 t t))
- (error "Not in a subdir!")
- (point))))
-
;;;###autoload
(defun dired-goto-subdir (dir)
"Go to end of header line of DIR in this dired buffer.
@@ -2816,15 +2909,6 @@ Lower levels are unaffected."
;;; hiding
-(defun dired-unhide-subdir ()
- (with-silent-modifications
- (dired--unhide (dired-subdir-min) (dired-subdir-max))))
-
-(defun dired-subdir-hidden-p (dir)
- (save-excursion
- (dired-goto-subdir dir)
- (dired--hidden-p)))
-
;;;###autoload
(defun dired-hide-subdir (arg)
"Hide or unhide the current subdirectory and move to next directory.
diff --git a/lisp/dired.el b/lisp/dired.el
index 15592ce..7839ace 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2585,6 +2585,21 @@ Otherwise, display it in another buffer."
;;; Functions for extracting and manipulating file names in Dired buffers.
+(defun dired-unhide-subdir ()
+ (with-silent-modifications
+ (dired--unhide (dired-subdir-min) (dired-subdir-max))))
+
+(defun dired-subdir-hidden-p (dir)
+ (save-excursion
+ (dired-goto-subdir dir)
+ (dired--hidden-p)))
+
+(defun dired-subdir-min ()
+ (save-excursion
+ (if (not (dired-prev-subdir 0 t t))
+ (error "Not in a subdir!")
+ (point))))
+
(defun dired-get-filename (&optional localp no-error-if-not-filep)
"In Dired, return name of file mentioned on this line.
Value returned normally includes the directory name.
@@ -2595,10 +2610,17 @@ it occurs in the buffer, and a value of t means
construct name relative to
Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
regular filenames and return nil if no filename on this line.
Otherwise, an error occurs in these cases."
- (let (case-fold-search file p1 p2 already-absolute)
+ (let ((hidden (and dired-subdir-alist
+ (dired-subdir-hidden-p
+ (dired-current-directory))))
+ case-fold-search file p1 p2 already-absolute)
+ (when hidden
+ (dired-unhide-subdir))
(save-excursion
(if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
+ (when hidden
+ (dired-hide-subdir 1))
;; nil if no file on this line, but no-error-if-not-filep is t:
(if (setq file (and p1 p2 (buffer-substring p1 p2)))
(progn
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 592f1b6..4bdbc95 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -260,6 +260,7 @@ expression, in which case we want to handle forms
differently."
"Visit the autoload file for the current buffer, and return its buffer."
(let ((enable-local-variables :safe)
(enable-local-eval nil)
+ (find-file-hook nil)
(delay-mode-hooks t)
(file (autoload-generated-file)))
;; We used to use `raw-text' to read this file, but this causes
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index e3eb929..fdc1233 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -335,6 +335,9 @@ or call the function `%s'."))))
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
modefun)))
+ ;; Allow using using `M-x customize-variable' on the hook.
+ (put ',hook 'custom-type 'hook)
+ (put ',hook 'standard-value (list nil))
;; Define the minor-mode keymap.
,(unless (symbolp keymap) ;nil is also a symbol.
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index b75410e..810affa 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -875,7 +875,7 @@ this object."
;; Now output readable lisp to recreate this object
;; It should look like this:
;; (<constructor> <name> <slot> <slot> ... )
- ;; Each slot's slot is writen using its :writer.
+ ;; Each slot's slot is written using its :writer.
(when eieio-print-indentation
(princ (make-string (* eieio-print-depth 2) ? )))
(princ "(")
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 772c907..8fc8db6 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -67,6 +67,12 @@ If this variable is set to 0, no idle time is required."
Changing the value requires toggling `eldoc-mode'."
:type 'boolean)
+(defcustom eldoc-display-truncation-message t
+ "If non-nil, provide verbose help when a message has been truncated.
+If nil, truncated messages will just have \"...\" appended."
+ :type 'boolean
+ :version "28.1")
+
;;;###autoload
(defcustom eldoc-minor-mode-string (purecopy " ElDoc")
"String to display in mode line when ElDoc Mode is enabled; nil for none."
@@ -415,7 +421,7 @@ pairs of the form (:KEY VALUE :KEY2 VALUE2...). KEY can be:
* `:thing', VALUE is a short string or symbol designating what is
being reported on. The documentation display engine can elect
- to remove this information depending on space contraints;
+ to remove this information depending on space constraints;
* `:face', VALUE is a symbol designating a face to use when
displaying `:thing''s value.
@@ -524,10 +530,13 @@ Honor most of `eldoc-echo-area-use-multiline-p'."
(cl-return
(concat
(buffer-substring (point-min) (point))
- (and truncated
+ (and
+ truncated
+ (if eldoc-display-truncation-message
(format
"\n(Documentation truncated. Use `%s' to see rest)"
- (substitute-command-keys
"\\[eldoc-doc-buffer]")))))))))
+ (substitute-command-keys "\\[eldoc-doc-buffer]"))
+ "..."))))))))
((= available 1)
;; Truncate "brutally." ; FIXME: use `eldoc-prefer-doc-buffer'
too?
(with-current-buffer (eldoc-doc-buffer)
@@ -710,7 +719,7 @@ Other third-party strategy functions do not use
produce callbacks to feed to `eldoc-documentation-function' and
should endeavour to display the docstrings eventually produced."
(let* (;; How many callbacks have been created by the strategy
- ;; fucntion and passed to elements of
+ ;; function and passed to elements of
;; `eldoc-documentation-functions'.
(howmany 0)
;; How many calls to callbacks we're still waiting on. Used
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 622f565..6569b8c 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -177,6 +177,18 @@ test for `called-interactively' in the command will fail."
(cl-assert (not unread-command-events) t)
return-value))
+(defmacro ert-simulate-keys (keys &rest body)
+ "Execute BODY with KEYS as pseudo-interactive input."
+ (declare (debug t) (indent 1))
+ `(let ((unread-command-events
+ ;; Add some C-g to try and make sure we still exit
+ ;; in case something goes wrong.
+ (append ,keys '(?\C-g ?\C-g ?\C-g)))
+ ;; Tell `read-from-minibuffer' not to read from stdin when in
+ ;; batch mode.
+ (executing-kbd-macro t))
+ ,@body))
+
(defun ert-run-idle-timers ()
"Run all idle timers (from `timer-idle-list')."
(dolist (timer (copy-sequence timer-idle-list))
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index 78ada3e..5112322 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -205,15 +205,26 @@ NODE and leaving the new node's start there. Return the
new node."
(defun ewoc--refresh-node (pp node dll)
"Redisplay the element represented by NODE using the pretty-printer PP."
- (let ((inhibit-read-only t)
- (m (ewoc--node-start-marker node))
- (R (ewoc--node-right node)))
- ;; First, remove the string from the buffer:
- (delete-region m (ewoc--node-start-marker R))
- ;; Calculate and insert the string.
- (goto-char m)
- (funcall pp (ewoc--node-data node))
- (ewoc--adjust m (point) R dll)))
+ (let* ((m (ewoc--node-start-marker node))
+ (R (ewoc--node-right node))
+ (end (ewoc--node-start-marker R))
+ (inhibit-read-only t)
+ (offset (if (= (point) end)
+ 'end
+ (when (< m (point) end)
+ (- (point) m)))))
+ (save-excursion
+ ;; First, remove the string from the buffer:
+ (delete-region m end)
+ ;; Calculate and insert the string.
+ (goto-char m)
+ (funcall pp (ewoc--node-data node))
+ (setq end (point))
+ (ewoc--adjust m (point) R dll))
+ (when offset
+ (goto-char (if (eq offset 'end)
+ end
+ (min (+ m offset) (1- end)))))))
(defun ewoc--wrap (func)
(lambda (data)
@@ -342,11 +353,10 @@ arguments will be passed to MAP-FUNCTION."
((footer (ewoc--footer ewoc))
(pp (ewoc--pretty-printer ewoc))
(node (ewoc--node-nth dll 1)))
- (save-excursion
- (while (not (eq node footer))
- (if (apply map-function (ewoc--node-data node) args)
- (ewoc--refresh-node pp node dll))
- (setq node (ewoc--node-next dll node))))))
+ (while (not (eq node footer))
+ (if (apply map-function (ewoc--node-data node) args)
+ (ewoc--refresh-node pp node dll))
+ (setq node (ewoc--node-next dll node)))))
(defun ewoc-delete (ewoc &rest nodes)
"Delete NODES from EWOC."
@@ -461,9 +471,8 @@ If the EWOC is empty, nil is returned."
Delete current text first, thus effecting a \"refresh\"."
(ewoc--set-buffer-bind-dll-let* ewoc
((pp (ewoc--pretty-printer ewoc)))
- (save-excursion
- (dolist (node nodes)
- (ewoc--refresh-node pp node dll)))))
+ (dolist (node nodes)
+ (ewoc--refresh-node pp node dll))))
(defun ewoc-goto-prev (ewoc arg)
"Move point to the ARGth previous element in EWOC.
@@ -566,9 +575,8 @@ Return nil if the buffer has been deleted."
(hf-pp (ewoc--hf-pp ewoc)))
(setf (ewoc--node-data head) header
(ewoc--node-data foot) footer)
- (save-excursion
- (ewoc--refresh-node hf-pp head dll)
- (ewoc--refresh-node hf-pp foot dll))))
+ (ewoc--refresh-node hf-pp head dll)
+ (ewoc--refresh-node hf-pp foot dll)))
(provide 'ewoc)
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9802bd4..f5f8c82 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -61,7 +61,7 @@
"^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
-menu-bar-make-toggle\\)"
+menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)"
find-function-space-re
"\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
"The regexp used by `find-function' to search for a function definition.
@@ -290,20 +290,10 @@ Interactively, prompt for LIBRARY using the one at or
near point."
A library name is the filename of an Emacs Lisp library located
in a directory under `load-path' (or `find-function-source-path',
if non-nil)."
- (let* ((suffix-regexp (mapconcat
- (lambda (suffix)
- (concat (regexp-quote suffix) "\\'"))
- (find-library-suffixes)
- "\\|"))
- (table (cl-loop for dir in (or find-function-source-path load-path)
- for dir-or-default = (or dir default-directory)
- when (file-readable-p dir-or-default)
- append (mapcar
- (lambda (file)
- (replace-regexp-in-string suffix-regexp
- "" file))
- (directory-files dir-or-default nil
- suffix-regexp))))
+ (let* ((dirs (or find-function-source-path load-path))
+ (suffixes (find-library-suffixes))
+ (table (apply-partially 'locate-file-completion-table
+ dirs suffixes))
(def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index a8ce232..09c48d0 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -594,7 +594,7 @@ MATCH is the pattern that needs to be matched, of the form:
((null (cdr else-alts)) (car else-alts))
(t (cons (car match) (nreverse else-alts)))))))
((memq match '(:pcase--succeed :pcase--fail)) (cons match match))
- (t (error "Uknown MATCH %s" match))))
+ (t (error "Unknown MATCH %s" match))))
(defun pcase--split-rest (sym splitter rest)
(let ((then-rest '())
@@ -725,7 +725,7 @@ MATCH is the pattern that needs to be matched, of the form:
(pcase--app-subst-match match sym fun nsym))
(cdr match))))
((memq match '(:pcase--succeed :pcase--fail)) match)
- (t (error "Uknown MATCH %s" match))))
+ (t (error "Unknown MATCH %s" match))))
(defun pcase--app-subst-rest (rest sym fun nsym)
(mapcar (lambda (branch)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 0672f60..fbcd7b8 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -96,7 +96,7 @@
;; out.
;; Q: But how can I then make out the sub-expressions?
-;; A: Thats where the `sub-expression mode' comes in. In it only the
+;; A: That's where the `sub-expression mode' comes in. In it only the
;; digit keys are assigned to perform an update that will flash the
;; corresponding subexp only.
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index ce495af..62f1b16 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -65,8 +65,13 @@ cannot be handled just by the buffer's syntax-table.
The specified function may call `syntax-ppss' on any position
before END, but if it calls `syntax-ppss' on some
position and later modifies the buffer on some earlier position,
-then it is its responsability to call `syntax-ppss-flush-cache' to flush
-the now obsolete ppss info from the cache.")
+then it is its responsibility to call `syntax-ppss-flush-cache' to flush
+the now obsolete ppss info from the cache.
+
+Note: When this variable is a function, it must apply _all_ the
+`syntax-table' properties needed in the given text interval.
+Using both this function and other means to apply these
+properties won't work properly.")
(defvar syntax-propertize-chunk-size 500)
diff --git a/lisp/epa.el b/lisp/epa.el
index b065887..609ac5d 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -400,7 +400,7 @@ DOC is documentation text to insert at the start."
e expired key. n never trust. m trust marginally. u trust ultimately.
f trust fully (keys you have signed, usually).
q trust status questionable. - trust status unspecified.
- See GPG documentaion for more explanation.
+ See GPG documentation for more explanation.
\n"))
;;;###autoload
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 8551cdd..309a788 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -152,7 +152,7 @@
("EFnet: EU, PL, Warszawa" EFnet "irc.efnet.pl" 6667)
("EFnet: EU, RU, Moscow" EFnet "irc.rt.ru" ((6661 6669)))
("EFnet: EU, SE, Dalarna" EFnet "irc.du.se" ((6666 6669)))
- ("EFnet: EU, SE, Gothenberg" EFnet "irc.hemmet.chalmers.se" ((6666 7000)))
+ ("EFnet: EU, SE, Gothenburg" EFnet "irc.hemmet.chalmers.se" ((6666 7000)))
("EFnet: EU, SE, Sweden" EFnet "irc.light.se" 6667)
("EFnet: EU, UK, London (carrier)" EFnet "irc.carrier1.net.uk" ((6666 6669)))
("EFnet: EU, UK, London (demon)" EFnet "efnet.demon.co.uk" ((6665 6669)))
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index fbd3cfb..fd4cd67 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -787,9 +787,9 @@ external command."
;; completions rules for some common UNIX commands
-(defsubst eshell-complete-hostname ()
- "Complete a command that wants a hostname for an argument."
- (pcomplete-here (eshell-read-host-names)))
+(autoload 'pcmpl-unix-complete-hostname "pcmpl-unix")
+(define-obsolete-function-alias 'eshell-complete-hostname
+ #'pcmpl-unix-complete-hostname "28.1")
(defun eshell-complete-host-reference ()
"If there is a host reference, complete it."
@@ -798,26 +798,7 @@ external command."
(when (setq index (string-match "@[a-z.]*\\'" arg))
(setq pcomplete-stub (substring arg (1+ index))
pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions (eshell-read-host-names)))))
-
-(defalias 'pcomplete/ftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ncftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ping 'eshell-complete-hostname)
-(defalias 'pcomplete/rlogin 'eshell-complete-hostname)
-
-(defun pcomplete/telnet ()
- (require 'pcmpl-unix)
- (pcomplete-opt "xl(pcmpl-unix-user-names)")
- (eshell-complete-hostname))
-
-(defun pcomplete/rsh ()
- "Complete `rsh', which, after the user and hostname, is like xargs."
- (require 'pcmpl-unix)
- (pcomplete-opt "l(pcmpl-unix-user-names)")
- (eshell-complete-hostname)
- (pcomplete-here (funcall pcomplete-command-completion-function))
- (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
- pcomplete-default-completion-function)))
+ (throw 'pcomplete-completions (pcomplete-read-host-names)))))
(defvar block-size)
(defvar by-bytes)
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index d55986c..3c038ed 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -94,36 +94,6 @@ naturally accessible within Emacs."
(defalias 'eshell/ff 'find-name-dired)
(defalias 'eshell/gf 'find-grep-dired)
-(defun pcomplete/bcc32 ()
- "Completion function for Borland's C++ compiler."
- (let ((cur (pcomplete-arg 0)))
- (cond
- ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here
- '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
- "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
- "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
- "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
- "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
- "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
- "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
- "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
- "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
- ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
- ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
- (match-string 1 cur)))
- ((string-match "\\`-o\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
- (match-string 1 cur)))
- (t
- (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
- (while (pcomplete-here
- (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
-
-(defalias 'pcomplete/bcc 'pcomplete/bcc32)
-
(provide 'em-xtra)
;; Local Variables:
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index ab030ed..0122f9b 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -51,9 +51,15 @@ similarly to external commands, as far as successful result
output."
:group 'eshell-util)
(defcustom eshell-hosts-file "/etc/hosts"
- "The name of the /etc/hosts file."
+ "The name of the /etc/hosts file.
+Use `pcomplete-hosts-file' instead; this variable is obsolete and
+has no effect."
:type '(choice (const :tag "No hosts file" nil) file)
:group 'eshell-util)
+;; Don't make it into an alias, because it doesn't really work with
+;; custom and risks creating duplicate entries. Just point users to
+;; the other variable, which is less frustrating.
+(make-obsolete-variable 'eshell-hosts-file nil "28.1")
(defcustom eshell-handle-errors t
"If non-nil, Eshell will handle errors itself.
@@ -127,11 +133,14 @@ function `string-to-number'."
(defvar eshell-user-timestamp nil
"A timestamp of when the user file was read.")
-(defvar eshell-host-names nil
- "A cache the names of frequently accessed hosts.")
+;;; Obsolete variables:
-(defvar eshell-host-timestamp nil
- "A timestamp of when the hosts file was read.")
+(define-obsolete-variable-alias 'eshell-host-names
+ 'pcomplete--host-name-cache "28.1")
+(define-obsolete-variable-alias 'eshell-host-timestamp
+ 'pcomplete--host-name-cache-timestamp "28.1")
+(defvar pcomplete--host-name-cache)
+(defvar pcomplete--host-name-cache-timestamp)
;;; Functions:
@@ -479,37 +488,15 @@ list."
(defalias 'eshell-user-name 'user-login-name)
-(defun eshell-read-hosts-file (filename)
- "Read in the hosts from FILENAME, default `eshell-hosts-file'."
- (let (hosts)
- (with-temp-buffer
- (insert-file-contents (or filename eshell-hosts-file))
- (goto-char (point-min))
- (while (re-search-forward
- ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^
\t\n]+\\)\\)?"
- "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t)
- (push (cons (match-string 1)
- (split-string (match-string 2)))
- hosts)))
- (nreverse hosts)))
-
-(defun eshell-read-hosts (file result-var timestamp-var)
- "Read the contents of /etc/hosts for host names."
- (if (or (not (symbol-value result-var))
- (not (symbol-value timestamp-var))
- (time-less-p
- (symbol-value timestamp-var)
- (file-attribute-modification-time (file-attributes file))))
- (progn
- (set result-var (apply #'nconc (eshell-read-hosts-file file)))
- (set timestamp-var (current-time))))
- (symbol-value result-var))
-
-(defun eshell-read-host-names ()
- "Read the contents of /etc/hosts for host names."
- (if eshell-hosts-file
- (eshell-read-hosts eshell-hosts-file 'eshell-host-names
- 'eshell-host-timestamp)))
+(autoload 'pcomplete-read-hosts-file "pcomplete")
+(autoload 'pcomplete-read-hosts "pcomplete")
+(autoload 'pcomplete-read-host-names "pcomplete")
+(define-obsolete-function-alias 'eshell-read-hosts-file
+ #'pcomplete-read-hosts-file "28.1")
+(define-obsolete-function-alias 'eshell-read-hosts
+ #'pcomplete-read-hosts "28.1")
+(define-obsolete-function-alias 'eshell-read-host-names
+ #'pcomplete-read-host-names "28.1")
(defsubst eshell-copy-environment ()
"Return an unrelated copy of `process-environment'."
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 3e65c68..a1d80f5 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1926,6 +1926,14 @@ Only intended for interactive use."
(ffap--toggle-read-only value)
value))
+(defun ffap-read-only-other-tab (filename)
+ "Like `ffap', but put buffer in another tab and mark as read-only.
+Only intended for interactive use."
+ (interactive (list (ffap-prompter nil " read only other tab")))
+ (let ((value (window-buffer (ffap-other-tab filename))))
+ (ffap--toggle-read-only value)
+ value))
+
(defun ffap-alternate-file (filename)
"Like `ffap' and `find-alternate-file'.
Only intended for interactive use."
diff --git a/lisp/files.el b/lisp/files.el
index 92ae072..dc9633f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3070,7 +3070,7 @@ If FUNCTION is nil, then it is not called. (That is a
way of saying
"\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re
"*\\)?"
"[Hh][Tt][Mm][Ll]"))
. mhtml-mode)
- ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
+ ("<![Dd][Oo][Cc][Tt][Yy][Pp][Ee][ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
;; These two must come after html, because they are more general:
("<\\?xml " . xml-mode)
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
@@ -6257,6 +6257,82 @@ an auto-save file."
(insert-file-contents file-name (not auto-save-p)
nil nil t))))))
+(defvar revert-buffer-with-fine-grain-max-seconds 2.0
+ "Maximum time that `revert-buffer-with-fine-grain' should use.
+The command tries to preserve markers, properties and overlays.
+If the operation takes more than this time, a single
+delete+insert is performed. Actually, this value is passed as
+the MAX-SECS argument to the function `replace-buffer-contents',
+so it is not ensured that the whole execution won't take longer.
+See `replace-buffer-contents' for more details.")
+
+(defun revert-buffer-insert-file-contents-delicately (file-name _auto-save-p)
+ "Optional function for `revert-buffer-insert-file-contents-function'.
+The function `revert-buffer-with-fine-grain' uses this function by binding
+`revert-buffer-insert-file-contents-function' to it.
+
+As with `revert-buffer-insert-file-contents--default-function', FILE-NAME is
+the name of the file and AUTO-SAVE-P is non-nil if this is an auto-save file.
+Since calling `replace-buffer-contents' can take a long time, depending of
+the number of changes made to the buffer, it uses the value of the variable
+`revert-buffer-with-fine-grain-max-seconds' as a maximum time to try delicately
+reverting the buffer. If it fails, it does a delete+insert. For more details,
+see `replace-buffer-contents'."
+ (cond
+ ((not (file-exists-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists"
+ "Cannot revert nonexistent file %s")
+ file-name))
+ ((not (file-readable-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer readable"
+ "Cannot revert unreadable file %s")
+ file-name))
+ (t
+ (let* ((buf (current-buffer)) ; current-buffer is the buffer to revert.
+ (success
+ (save-excursion
+ (save-restriction
+ (widen)
+ (with-temp-buffer
+ (insert-file-contents file-name)
+ (let ((temp-buf (current-buffer)))
+ (set-buffer buf)
+ (let ((buffer-file-name nil))
+ (replace-buffer-contents
+ temp-buf
+ revert-buffer-with-fine-grain-max-seconds))))))))
+ ;; See comments in revert-buffer-with-fine-grain for an explanation.
+ (defun revert-buffer-with-fine-grain-success-p ()
+ success))
+ (set-buffer-modified-p nil))))
+
+(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
+ "Revert buffer preserving markers, overlays, etc.
+This command is an alternative to `revert-buffer' because it tries to be as
+non-destructive as possible, preserving markers, properties and overlays.
+Binds `revert-buffer-insert-file-contents-function' to the function
+`revert-buffer-insert-file-contents-delicately'.
+
+With a prefix argument, offer to revert from latest auto-save file. For more
+details on the arguments, see `revert-buffer'."
+ ;; See revert-buffer for an explanation of this.
+ (interactive (list (not current-prefix-arg)))
+ ;; Simply bind revert-buffer-insert-file-contents-function to the specialized
+ ;; function, and call revert-buffer.
+ (let ((revert-buffer-insert-file-contents-function
+ #'revert-buffer-insert-file-contents-delicately))
+ (revert-buffer ignore-auto noconfirm t)
+ ;; This closure is defined in revert-buffer-insert-file-contents-function.
+ ;; It is needed because revert-buffer--default always returns t after
+ ;; reverting, and it might be needed to report the success/failure of
+ ;; reverting delicately.
+ (when (fboundp 'revert-buffer-with-fine-grain-success-p)
+ (prog1
+ (revert-buffer-with-fine-grain-success-p)
+ (fmakunbound 'revert-buffer-with-fine-grain-success-p)))))
+
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(interactive)
@@ -6817,9 +6893,7 @@ We assume the output has the format of `df'.
The value of this variable must be just a command name or file name;
if you want to specify options, use `directory-free-space-args'.
-A value of nil disables this feature.
-
-This variable is obsolete; Emacs no longer uses it."
+A value of nil disables this feature."
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
(make-obsolete-variable 'directory-free-space-program
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index d7388d4..f748996 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1304,7 +1304,7 @@ downloaded into the agent."
;; gnus doesn't waste resources trying to fetch them.
;; NOTE: I don't do this for smaller gaps (< 100) as I don't
- ;; want to modify the local file everytime someone restarts
+ ;; want to modify the local file every time someone restarts
;; gnus. The small gap will cause a tiny performance hit
;; when gnus tries, and fails, to retrieve the articles.
;; Still that should be smaller than opening a buffer,
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 13a8537..4484b95 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -534,6 +534,13 @@ that the symbol of the saver function, which is specified
by
:group 'gnus-article-saving
:type 'regexp)
+(defcustom gnus-global-groups nil
+ "Groups that should be considered like \"news\" groups.
+This means that images will be automatically loaded, for instance."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-article)
+
;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
"A function to save articles in your favorite format.
@@ -7138,7 +7145,8 @@ If given a prefix, show the hidden text instead."
"Allows images in newsgroups to be shown, blocks images in all
other groups."
(if (or (gnus-news-group-p group)
- (gnus-member-of-valid 'global group))
+ (gnus-member-of-valid 'global group)
+ (member group gnus-global-groups))
;; Block nothing in news groups.
nil
;; Block everything anywhere else.
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 7bc7fb5..465871e 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1352,8 +1352,10 @@ For the \"inline\" alternatives, also see the variable
gcc)))
(insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
-(defun gnus-summary-resend-message (address n)
- "Resend the current article to ADDRESS."
+(defun gnus-summary-resend-message (address n &optional no-select)
+ "Resend the current article to ADDRESS.
+Uses the process/prefix convention. If NO-SELECT, don't display
+the message before resending."
(interactive
(list (message-read-from-minibuffer
"Resend message(s) to: "
@@ -1372,6 +1374,7 @@ For the \"inline\" alternatives, also see the variable
'posting-style t))
(user-full-name user-full-name)
(user-mail-address user-mail-address)
+ (group gnus-newsgroup-name)
tem)
(dolist (style styles)
(when (stringp (cadr style))
@@ -1395,11 +1398,18 @@ For the \"inline\" alternatives, also see the variable
'(gnus-agent-possibly-do-gcc)
'(gnus-inews-do-gcc)))))
(dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil nil article)
- (with-current-buffer gnus-original-article-buffer
- (let ((gnus-gcc-externalize-attachments nil)
- (message-inhibit-body-encoding t))
- (message-resend address)))
+ (if no-select
+ (with-current-buffer " *nntpd*"
+ (erase-buffer)
+ (gnus-request-article article group)
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address)))
+ (gnus-summary-select-article nil nil nil article)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address))))
(gnus-summary-mark-article-as-forwarded article))))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index ffc6b8c..2e3abe7 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -25,8 +25,6 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-art)
@@ -35,6 +33,7 @@
(require 'message)
(require 'score-mode)
(require 'gmm-utils)
+(require 'cl-lib)
(defcustom gnus-global-score-files nil
"List of global score files and directories.
@@ -497,6 +496,7 @@ of the last successful match.")
("head" -1 gnus-score-body)
("body" -1 gnus-score-body)
("all" -1 gnus-score-body)
+ (score-fn -1 nil)
("followup" 2 gnus-score-followup)
("thread" 5 gnus-score-thread)))
@@ -1175,14 +1175,19 @@ If FORMAT, also format the current score file."
(when format
(gnus-score-pretty-print))
(when (consp rule) ;; the rule exists
- (setq rule (mapconcat #'(lambda (obj)
- (regexp-quote (format "%S" obj)))
- rule
- sep))
+ (setq rule (if (symbolp (car rule))
+ (format "(%S)" (car rule))
+ (mapconcat #'(lambda (obj)
+ (regexp-quote (format "%S" obj)))
+ rule
+ sep)))
(goto-char (point-min))
- (re-search-forward rule nil t)
- ;; make it easy to use `kill-sexp':
- (goto-char (1- (match-beginning 0)))))))
+ (let ((move (if (string-match "(.*)" rule)
+ 0
+ -1)))
+ (re-search-forward rule nil t)
+ ;; make it easy to use `kill-sexp':
+ (goto-char (+ move (match-beginning 0))))))))
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
@@ -1232,6 +1237,7 @@ If FORMAT, also format the current score file."
(let ((mark (car (gnus-score-get 'mark alist)))
(expunge (car (gnus-score-get 'expunge alist)))
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
+ (score-fn (car (gnus-score-get 'score-fn alist)))
(files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist))
(orphan (car (gnus-score-get 'orphan alist)))
@@ -1567,10 +1573,14 @@ If FORMAT, also format the current score file."
(gnus-message
7 "Scoring on headers or body skipped.")
nil)
+ ;; Run score-fn
+ (if (eq header 'score-fn)
+ (setq new (gnus-score-func scores trace))
;; Call the scoring function for this type of "header".
(setq new (funcall (nth 2 entry) scores header
- now expire trace)))
+ now expire trace))))
(push new news))))
+
(when (gnus-buffer-live-p gnus-summary-buffer)
(let ((scored gnus-newsgroup-scored))
(with-current-buffer gnus-summary-buffer
@@ -1636,6 +1646,30 @@ score in `gnus-newsgroup-scored' by SCORE."
(not (string= id "")))
(gnus-score-lower-thread thread score)))))
+(defun gnus-score-func (scores &optional trace)
+ (dolist (alist scores)
+ (let ((articles gnus-scores-articles)
+ (entries (assoc 'score-fn alist)))
+ (dolist (score-fn (cdr entries))
+ (let ((score-fn (car score-fn))
+ article-alist score fn-score)
+ (dolist (art articles)
+ (setq article-alist
+ (cl-pairlis
+ '(number subject from date id
+ refs chars lines xref extra)
+ (car art))
+ score (cdr art))
+ (when (integerp (setq fn-score (funcall score-fn
+ article-alist score)))
+ (setcdr art (+ score fn-score)))
+ (setq score (cdr art))
+ (when (and trace
+ (integerp fn-score))
+ (push (cons (car-safe (rassq alist gnus-score-cache))
+ (list score-fn fn-score))
+ gnus-score-trace))))))))
+
(defun gnus-score-integer (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
entries alist)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 2f0ea0c..b3ed5cb 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -11537,7 +11537,7 @@ If ALL is non-nil, also mark ticked and dormant
articles as read."
(gnus-save-hidden-threads
(let ((beg (point)))
;; We check that there are unread articles.
- (when (or all (gnus-summary-find-next))
+ (when (or all (gnus-summary-last-article-p) (gnus-summary-find-next))
(gnus-summary-catchup all t beg nil t)))))
(gnus-summary-position-point))
@@ -11806,8 +11806,6 @@ will not be hidden."
(defun gnus-summary-hide-thread ()
"Hide thread subtrees.
-If PREDICATE is supplied, threads that satisfy this predicate
-will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
(beginning-of-line)
@@ -11828,9 +11826,9 @@ Returns nil if no threads were there to be hidden."
(overlay-put ol 'invisible 'gnus-sum)
(overlay-put ol 'evaporate t)))
(gnus-summary-goto-subject article)
+ ;; We moved backward past the start point (invisible thread?)
(when (> start (point))
- (message "Hiding the thread moved us backwards, aborting!")
- (goto-char (point-max))))
+ (goto-char starteol)))
(goto-char start)
nil))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 3e7e189..16f47c8 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4843,10 +4843,10 @@ If you always want Gnus to send messages in one piece,
set
Each line should be no more than 79 characters long."
(goto-char (point-min))
(while (not (eobp))
- (when (and (looking-at "[^:]+:")
- (> (- (line-end-position) (point)) 79))
- (mail-header-fold-field))
- (forward-line 1)))
+ (if (and (looking-at "[^:]+:")
+ (> (- (line-end-position) (point)) 79))
+ (goto-char (mail-header-fold-field))
+ (forward-line 1))))
(defvar sendmail-program)
(defvar smtpmail-smtp-server)
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index cb39ffe..ca61001 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -546,7 +546,7 @@ If MODE is not set, try to find mode automatically."
(mm-display-inline-fontify handle 'shell-script-mode))
(defun mm-display-javascript-inline (handle)
- "Show JavsScript code from HANDLE inline."
+ "Show JavaScript code from HANDLE inline."
(mm-display-inline-fontify handle 'javascript-mode))
;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 7894285..a43eee4 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1425,7 +1425,7 @@ all. This may very well take some time.")
(pop years)))
(if years
;; Because we might not be limited in years, we must guard against
- ;; infinite loops. Appart from cases like Feb 31, there are probably
+ ;; infinite loops. Apart from cases like Feb 31, there are probably
;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to
;; decide this, so I assume that if we reach 10 years later, the
;; schedule is undecidable.
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 168c994..20f82e5 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -211,7 +211,7 @@ By default this is the name of an email header field.")
"Search groups in Gnus with assorted search engines."
:group 'gnus)
-(make-obsolete-variable 'nnir-summary-line-format "The formating
+(make-obsolete-variable 'nnir-summary-line-format "The formatting
specs previously unique to this variable may now be set in
'gnus-summary-line-format." "28.1")
diff --git a/lisp/help.el b/lisp/help.el
index 928a376..4d0c4d5 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -458,6 +458,7 @@ the variable `message-log-max'."
"Display last few input keystrokes and the commands run.
For convenience this uses the same format as
`edit-last-kbd-macro'.
+See `lossage-size' to update the number of recorded keystrokes.
To record all your input, use `open-dribble-file'."
(interactive)
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 4d65397..ed2cd26 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1034,7 +1034,7 @@ then the specification is returned unchanged."
((facep fn)
(hfy-face-attr-for-class fn hfy-display-class))
;; FIXME: is this necessary? Faces can be symbols, but
- ;; not symbols refering to other symbols?
+ ;; not symbols referring to other symbols?
((and (symbolp fn)
(facep (symbol-value fn)))
(hfy-face-attr-for-class
diff --git a/lisp/info.el b/lisp/info.el
index dc1102a..e4f75b4 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -956,6 +956,7 @@ This function first looks for a case-sensitive match for
NODENAME;
if none is found it then tries a case-insensitive match (unless
STRICT-CASE is non-nil)."
(info-initialize)
+ (setq nodename (info--node-canonicalize-whitespace nodename))
(setq filename (Info-find-file filename))
;; Go into Info buffer.
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -2684,14 +2685,16 @@ Because of ambiguities, this should be concatenated
with something like
;;; (setq Info-point-loc
;;; (buffer-substring (match-beginning 0) (1- (match-beginning
1))))
)
- (replace-regexp-in-string
- "[ \n]+" " "
+ (info--node-canonicalize-whitespace
(or (and (not (equal (match-string-no-properties 2) ""))
(match-string-no-properties 2))
;; If the node name is the menu entry name (using `entry::').
(buffer-substring-no-properties
(match-beginning 0) (1- (match-beginning 1)))))))
+(defun info--node-canonicalize-whitespace (string)
+ (replace-regexp-in-string "[ \t\n]+" " " string))
+
;; No one calls this.
;;(defun Info-menu-item-sequence (list)
;; (while list
diff --git a/lisp/international/ucs-normalize.el
b/lisp/international/ucs-normalize.el
index b703d3d..6b7419f 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -98,7 +98,7 @@
;;
;; D. Sorting and Composition of Smaller Blocks
(`ucs-normalize-block-compose-chars')
;;
-;; The block will be split to multiple samller blocks by starter
+;; The block will be split to multiple smaller blocks by starter
;; characters. Each block is sorted, and composed if necessary.
;;
;; E. Composition of Entire Block (`ucs-normalize-compose-chars')
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 7fb1d8a..0053c4d 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -269,6 +269,14 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'),
`isearch-symbol-regexp'
"Non-nil means incremental search highlights the current match."
:type 'boolean)
+(defcustom search-highlight-submatches t
+ "Whether to highlight regexp subexpressions of the current regexp match.
+
+The faces used to do the highlights are named `isearch-group-1',
+`isearch-group-2', and so on."
+ :type 'boolean
+ :version "28.1")
+
(defface isearch
'((((class color) (min-colors 88) (background light))
;; The background must not be too dark, for that means
@@ -3654,6 +3662,98 @@ since they have special meaning in a regexp."
;; Highlighting
(defvar isearch-overlay nil)
+(defvar isearch-submatches-overlays nil)
+
+(defface isearch-group-1
+ '((((class color) (background light))
+ (:background "#ff00ff" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "palevioletred3" :foreground "brown4"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (first sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-2
+ '((((class color) (background light))
+ (:background "#d000d0" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#be698f" :foreground "black"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (second sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-3
+ '((((class color) (background light))
+ (:background "#a000a0" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#a06080" :foreground "brown4"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (third sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-4
+ '((((class color) (background light))
+ (:background "#800080" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#905070" :foreground "brown4"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (fourth sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-5
+ '((((class color) (background light))
+ (:background "#600060" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#804060" :foreground "black"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (fifth sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-6
+ '((((class color) (background light))
+ (:background "#500050" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#703050" :foreground "white"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (sixth sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-7
+ '((((class color) (background light))
+ (:background "#400040" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#602050" :foreground "white"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (seventh sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-8
+ '((((class color) (background light))
+ (:background "#300030" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#501050" :foreground "white"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (eighth sub-group)."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-9
+ '((((class color) (background light))
+ (:background "#200020" :foreground "lightskyblue1"))
+ (((class color) (background dark))
+ (:background "#400040" :foreground "white"))
+ (t (:inverse-video t)))
+ "Face for highlighting Isearch sub-group matches (ninth sub-group)."
+ :group 'isearch
+ :version "28.1")
+
(defun isearch-highlight (beg end)
(if search-highlight
@@ -3664,11 +3764,27 @@ since they have special meaning in a regexp."
(setq isearch-overlay (make-overlay beg end))
;; 1001 is higher than lazy's 1000 and ediff's 100+
(overlay-put isearch-overlay 'priority 1001)
- (overlay-put isearch-overlay 'face isearch-face))))
+ (overlay-put isearch-overlay 'face isearch-face)))
+ (when (and search-highlight-submatches
+ isearch-regexp)
+ (mapc 'delete-overlay isearch-submatches-overlays)
+ (setq isearch-submatches-overlays nil)
+ (let ((i 0) ov)
+ (while (<= i 9)
+ (when (match-beginning i)
+ (setq ov (make-overlay (match-beginning i) (match-end i)))
+ (overlay-put ov 'face (intern-soft (format "isearch-group-%d" i)))
+ (overlay-put ov 'priority 1002)
+ (push ov isearch-submatches-overlays))
+ (setq i (1+ i))))))
(defun isearch-dehighlight ()
(when isearch-overlay
- (delete-overlay isearch-overlay)))
+ (delete-overlay isearch-overlay))
+ (when search-highlight-submatches
+ (mapc 'delete-overlay isearch-submatches-overlays)
+ (setq isearch-submatches-overlays nil)))
+
;; isearch-lazy-highlight feature
;; by Bob Glickstein <http://www.zanshin.com/~bobg/>
diff --git a/lisp/json.el b/lisp/json.el
index 9002e86..c2fc157 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -432,14 +432,14 @@ Initialized lazily by `json-encode-string'.")
;; string length as our heuristic. See also bug#20154.
(if (and (< (length string) json--long-string-threshold)
(not (string-match-p (rx json--escape) string)))
- (concat "\"" string "\"")
+ (concat "\"" (substring-no-properties string) "\"")
(with-current-buffer
(or json--string-buffer
(with-current-buffer (generate-new-buffer " *json-string*")
;; This seems to afford decent performance gains.
(setq-local inhibit-modification-hooks t)
(setq json--string-buffer (current-buffer))))
- (insert ?\" string)
+ (insert ?\" (substring-no-properties string)) ; see bug#43549
(goto-char (1+ (point-min)))
(while (re-search-forward (rx json--escape) nil 'move)
(let ((char (preceding-char)))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 2d50df7..b319bf6 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -274,7 +274,7 @@ error of type `jsonrpc-error'.
DEFERRED is passed to `jsonrpc-async-request', which see.
If CANCEL-ON-INPUT is non-nil and the user inputs something while
-the functino is waiting, then it exits immediately, returning
+the function is waiting, then it exits immediately, returning
CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are
ignored."
(let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer
@@ -336,7 +336,7 @@ ignored."
"Time in seconds before timing out a JSONRPC request.")
-;;; Specfic to `jsonrpc-process-connection'
+;;; Specific to `jsonrpc-process-connection'
;;;
(defclass jsonrpc-process-connection (jsonrpc-connection)
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 3a59708..3437dba 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -924,7 +924,7 @@ The ARG parameter is unused."
nil
(if kmacro-view-last-item
(concat (cond ((= kmacro-view-item-no 2) "2nd")
- ((= kmacro-view-item-no 3) "3nd")
+ ((= kmacro-view-item-no 3) "3rd")
(t (format "%dth" kmacro-view-item-no)))
" previous macro")
"Last macro")))
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index 296dbd7..3821785 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -46,7 +46,7 @@
(concat "korean-hangul" default-korean-keyboard))))
(defun quail-hangul-switch-symbol-ksc (&rest ignore)
- "Swith to/from Korean symbol package."
+ "Switch to/from Korean symbol package."
(interactive "i")
(and current-input-method
(if (string-equal current-input-method "korean-symbol")
@@ -55,7 +55,7 @@
(activate-input-method "korean-symbol"))))
(defun quail-hangul-switch-hanja (&rest ignore)
- "Swith to/from Korean hanja package."
+ "Switch to/from Korean hanja package."
(interactive "i")
(and current-input-method
(if (string-match "korean-hanja" current-input-method)
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index db85b64..36d1dc7 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -416,67 +416,73 @@ usually do not have translators for other
languages.\n\n")))
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (and (= (- (point) (point-min))
- (length report-emacs-bug-orig-text))
- (string-equal (buffer-substring-no-properties (point-min) (point))
- report-emacs-bug-orig-text)
- (error "No text entered in bug report"))
- ;; Warning for novice users.
- (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to"))
- (not report-emacs-bug-no-confirmation)
- (not (yes-or-no-p
- "Send this bug report to the Emacs maintainers? ")))
- (with-output-to-temp-buffer "*Bug Help*"
- (princ (substitute-command-keys
- (format "\
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (and (= (- (point) (point-min))
+ (length report-emacs-bug-orig-text))
+ (string-equal (buffer-substring-no-properties (point-min) (point))
+ report-emacs-bug-orig-text)
+ (error "No text entered in bug report"))
+ ;; Warning for novice users.
+ (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to"))
+ (not report-emacs-bug-no-confirmation)
+ (not (yes-or-no-p
+ "Send this bug report to the Emacs maintainers? ")))
+ (with-output-to-temp-buffer "*Bug Help*"
+ (princ (substitute-command-keys
+ (format "\
You invoked the command M-x report-emacs-bug,
but you decided not to mail the bug report to the Emacs maintainers.
If you want to mail it to someone else instead,
please insert the proper e-mail address after \"To: \",
and send the mail again%s."
- (if report-emacs-bug-send-command
- (format " using \\[%s]"
- report-emacs-bug-send-command)
- "")))))
- (error "M-x report-emacs-bug was canceled, please read *Bug Help*
buffer"))
- ;; Query the user for the SMTP method, so that we can skip
- ;; questions about From header validity if the user is going to
- ;; use mailclient, anyway.
- (when (or (and (derived-mode-p 'message-mode)
- (eq message-send-mail-function 'sendmail-query-once))
- (and (not (derived-mode-p 'message-mode))
- (eq send-mail-function 'sendmail-query-once)))
- (sendmail-query-user-about-smtp)
- (when (derived-mode-p 'message-mode)
- (setq message-send-mail-function (message-default-send-mail-function))))
- (or report-emacs-bug-no-confirmation
- ;; mailclient.el does not need a valid From
- (if (derived-mode-p 'message-mode)
- (eq message-send-mail-function 'message-send-mail-with-mailclient)
- (eq send-mail-function 'mailclient-send-it))
- ;; Not narrowing to the headers, but that's OK.
- (let ((from (mail-fetch-field "From")))
- (and (or (not from)
- (message-bogus-recipient-p from)
- ;; This is the default user-mail-address. On today's
- ;; systems, it seems more likely to be wrong than right,
- ;; since most people don't run their own mail server.
- (string-match (format "\\<%s@%s\\>"
- (regexp-quote (user-login-name))
- (regexp-quote (system-name)))
- from))
- (not (yes-or-no-p
- (format-message "Is `%s' really your email address? "
- from)))
- (error "Please edit the From address and try again"))))
- ;; Bury the help buffer (if it's shown).
- (when-let ((help (get-buffer "*Bug Help*")))
- (when (get-buffer-window help)
- (quit-window nil (get-buffer-window help))))))
+ (if report-emacs-bug-send-command
+ (format " using \\[%s]"
+ report-emacs-bug-send-command)
+ "")))))
+ (error "M-x report-emacs-bug was canceled, please read *Bug Help* buffer"))
+ ;; Query the user for the SMTP method, so that we can skip
+ ;; questions about From header validity if the user is going to
+ ;; use mailclient, anyway.
+ (when (or (and (derived-mode-p 'message-mode)
+ (eq (message-default-send-mail-function) 'sendmail-query-once))
+ (and (not (derived-mode-p 'message-mode))
+ (eq send-mail-function 'sendmail-query-once)))
+ (setq send-mail-function (sendmail-query-user-about-smtp))
+ (when (derived-mode-p 'message-mode)
+ (setq message-send-mail-function (message-default-send-mail-function))
+ (add-hook 'message-sent-hook
+ (lambda ()
+ (when (y-or-n-p "Save this mail sending choice?")
+ (customize-save-variable 'send-mail-function
+ send-mail-function)))
+ nil t)))
+ (or report-emacs-bug-no-confirmation
+ ;; mailclient.el does not need a valid From
+ (eq send-mail-function 'mailclient-send-it)
+ ;; Not narrowing to the headers, but that's OK.
+ (let ((from (mail-fetch-field "From")))
+ (when (and (or (not from)
+ (message-bogus-recipient-p from)
+ ;; This is the default user-mail-address. On
+ ;; today's systems, it seems more likely to
+ ;; be wrong than right, since most people
+ ;; don't run their own mail server.
+ (string-match (format "\\<%s@%s\\>"
+ (regexp-quote (user-login-name))
+ (regexp-quote (system-name)))
+ from))
+ (not (yes-or-no-p
+ (format-message "Is `%s' really your email address? "
+ from))))
+ (goto-char (point-min))
+ (re-search-forward "^From: " nil t)
+ (error "Please edit the From address and try again"))))
+ ;; Bury the help buffer (if it's shown).
+ (when-let ((help (get-buffer "*Bug Help*")))
+ (when (get-buffer-window help)
+ (quit-window nil (get-buffer-window help)))))
;;;###autoload
(defun submit-emacs-patch (subject file)
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 0832548..405ae17 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -134,7 +134,7 @@ The mail client is taken to be the handler of mailto URLs."
character-coding
;; Use the external browser function to send the
;; message.
- (browse-url-mailto-function nil))
+ (browse-url-default-handlers nil))
;; initialize limiter
(setq mailclient-delim-static "?")
;; construct and call up mailto URL
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 234f319..4aa0c28 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -716,11 +716,13 @@ Point moves to the end of the region."
(goto-char e)))))
(defun rfc2047-fold-field ()
- "Fold the current header field."
+ "Fold the current header field.
+Return the new end point."
(save-excursion
(save-restriction
(rfc2047-narrow-to-field)
- (rfc2047-fold-region (point-min) (point-max)))))
+ (rfc2047-fold-region (point-min) (point-max))
+ (point-max))))
(defun rfc2047-fold-region (b e)
"Fold long lines in region B to E."
diff --git a/lisp/man.el b/lisp/man.el
index 1a82b12..5ee60ca 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1508,8 +1508,11 @@ manpage command."
(when delete-buff
(if (window-live-p (get-buffer-window Man-buffer t))
- (quit-restore-window
- (get-buffer-window Man-buffer t) 'kill)
+ (progn
+ (quit-restore-window
+ (get-buffer-window Man-buffer t) 'kill)
+ ;; Ensure that we end up in the correct window.
+ (select-window (old-selected-window)))
(kill-buffer Man-buffer)))
(when message
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 9a93fa6..1556ee2 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -663,31 +663,63 @@ PROPS are additional properties."
:button (:toggle . (and (default-boundp ',fname)
(default-value ',fname)))))
-(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
+(defmacro menu-bar-make-toggle (command variable item-name message help
+ &rest body)
+ "Define a menu-bar toggle command.
+See `menu-bar-make-toggle-command', for which this is a
+compatability wrapper. BODY is passed in as SETTING-SEXP in that macro."
+ (declare (obsolete menu-bar-make-toggle-command "28.1"))
+ `(menu-bar-make-toggle-command ,command ,variable ,item-name ,message ,help
+ ,(and body
+ `(progn
+ ,@body))))
+
+(defmacro menu-bar-make-toggle-command (command variable item-name message
+ help
+ &optional setting-sexp
+ &rest keywords)
+ "Define a menu-bar toggle command.
+COMMAND (a symbol) is the toggle command to define.
+
+VARIABLE (a symbol) is the variable to set.
+
+ITEM-NAME (a string) is the menu-item name.
+
+MESSAGE is a format string for the toggle message, with %s for the new
+status.
+
+HELP (a string) is the `:help' tooltip text and the doc string first
+line (minus final period) for the command.
+
+SETTING-SEXP is a Lisp sexp that sets VARIABLE, or it is nil meaning
+set it according to its `defcustom' or using `set-default'.
+
+KEYWORDS is a plist for `menu-item' for keywords other than `:help'."
`(progn
- (defun ,name (&optional interactively)
+ (defun ,command (&optional interactively)
,(concat "Toggle whether to " (downcase (substring help 0 1))
- (substring help 1) ".
+ (substring help 1) ".
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
(interactive "p")
- (if ,(if body `(progn . ,body)
- `(progn
+ (if ,(if setting-sexp
+ `,setting-sexp
+ `(progn
(custom-load-symbol ',variable)
(let ((set (or (get ',variable 'custom-set) 'set-default))
(get (or (get ',variable 'custom-get) 'default-value)))
(funcall set ',variable (not (funcall get ',variable))))))
- (message ,message "enabled globally")
- (message ,message "disabled globally"))
- ;; The function `customize-mark-as-set' must only be called when
- ;; a variable is set interactively, as the purpose is to mark it as
- ;; a candidate for "Save Options", and we do not want to save options
- ;; the user have already set explicitly in his init file.
- (if interactively (customize-mark-as-set ',variable)))
- '(menu-item ,doc ,name
- :help ,help
- :button (:toggle . (and (default-boundp ',variable)
- (default-value ',variable))))))
+ (message ,message "enabled globally")
+ (message ,message "disabled globally"))
+ ;; `customize-mark-as-set' must only be called when a variable is set
+ ;; interactively, because the purpose is to mark the variable as a
+ ;; candidate for `Save Options', and we do not want to save options that
+ ;; the user has already set explicitly in the init file.
+ (when interactively (customize-mark-as-set ',variable)))
+ '(menu-item ,item-name ,command :help ,help
+ :button (:toggle . (and (default-boundp ',variable)
+ (default-value ',variable)))
+ ,@keywords)))
;; Function for setting/saving default font.
@@ -959,10 +991,11 @@ The selected font will be the default on both the
existing and future frames."
:help "Indicate buffer boundaries in fringe"))
(bindings--define-key menu [indicate-empty-lines]
- (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
- "Empty Line Indicators"
- "Indicating of empty lines %s"
- "Indicate trailing empty lines in fringe,
globally"))
+ (menu-bar-make-toggle-command
+ toggle-indicate-empty-lines indicate-empty-lines
+ "Empty Line Indicators"
+ "Indicating of empty lines %s"
+ "Indicate trailing empty lines in fringe, globally"))
(bindings--define-key menu [customize]
'(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
@@ -1407,7 +1440,7 @@ mail status in mode line"))
(bindings--define-key menu [custom-separator]
menu-bar-separator)
(bindings--define-key menu [case-fold-search]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-case-fold-search case-fold-search
"Ignore Case"
"Case-Insensitive Search %s"
@@ -1438,7 +1471,7 @@ mail status in mode line"))
(if (featurep 'system-font-setting)
(bindings--define-key menu [menu-system-font]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-use-system-font font-use-system-font
"Use System Font"
"Use system font: %s"
@@ -1464,13 +1497,15 @@ mail status in mode line"))
menu-bar-separator)
(bindings--define-key menu [debug-on-quit]
- (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
- "Enter Debugger on Quit/C-g" "Debug on Quit %s"
- "Enter Lisp debugger when C-g is pressed"))
+ (menu-bar-make-toggle-command
+ toggle-debug-on-quit debug-on-quit
+ "Enter Debugger on Quit/C-g" "Debug on Quit %s"
+ "Enter Lisp debugger when C-g is pressed"))
(bindings--define-key menu [debug-on-error]
- (menu-bar-make-toggle toggle-debug-on-error debug-on-error
- "Enter Debugger on Error" "Debug on Error %s"
- "Enter Lisp debugger when an error is signaled"))
+ (menu-bar-make-toggle-command
+ toggle-debug-on-error debug-on-error
+ "Enter Debugger on Error" "Debug on Error %s"
+ "Enter Lisp debugger when an error is signaled"))
(bindings--define-key menu [debugger-separator]
menu-bar-separator)
@@ -1483,31 +1518,33 @@ mail status in mode line"))
menu-bar-separator)
(bindings--define-key menu [save-desktop]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-save-desktop-globally desktop-save-mode
"Save State between Sessions"
"Saving desktop state %s"
"Visit desktop of previous session when restarting Emacs"
- (require 'desktop)
- ;; Do it by name, to avoid a free-variable
- ;; warning during byte compilation.
- (set-default
- 'desktop-save-mode (not (symbol-value 'desktop-save-mode)))))
+ (progn
+ (require 'desktop)
+ ;; Do it by name, to avoid a free-variable
+ ;; warning during byte compilation.
+ (set-default
+ 'desktop-save-mode (not (symbol-value 'desktop-save-mode))))))
(bindings--define-key menu [save-place]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-save-place-globally save-place-mode
"Save Place in Files between Sessions"
"Saving place in files %s"
"Visit files of previous session when restarting Emacs"
- (require 'saveplace)
- ;; Do it by name, to avoid a free-variable
- ;; warning during byte compilation.
- (set-default
- 'save-place-mode (not (symbol-value 'save-place-mode)))))
+ (progn
+ (require 'saveplace)
+ ;; Do it by name, to avoid a free-variable
+ ;; warning during byte compilation.
+ (set-default
+ 'save-place-mode (not (symbol-value 'save-place-mode))))))
(bindings--define-key menu [uniquify]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
"Directory name in buffer names (uniquify) %s"
@@ -1521,7 +1558,7 @@ mail status in mode line"))
(bindings--define-key menu [cua-mode]
(menu-bar-make-mm-toggle
cua-mode
- "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
+ "Cut/Paste with C-x/C-c/C-v (CUA Mode)"
"Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
(:visible (or (not (boundp 'cua-enable-cua-keys))
cua-enable-cua-keys))))
@@ -2448,7 +2485,7 @@ created in the future."
(put 'menu-bar-mode 'standard-value '(t))
(defun toggle-menu-bar-mode-from-frame (&optional arg)
- "Toggle menu bar on or off, based on the status of the current frame.
+ "Toggle display of the menu bar of the current frame.
See `menu-bar-mode' for more information."
(interactive (list (or current-prefix-arg 'toggle)))
(if (eq arg 'toggle)
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index a3fbb89b..d457780 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -148,7 +148,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this
command."
"Put all following messages with same subject in sequence 'subject.
If arg ALL is t, move to beginning of folder buffer to collect all
messages.
-If arg ALL is nil, collect only messages fron current one on forward.
+If arg ALL is nil, collect only messages from current one on forward.
Return number of messages put in the sequence:
@@ -198,7 +198,7 @@ It would be desirable to avoid hard-coding this.")
This function only works with an unthreaded folder. If arg ALL is
t, move to beginning of folder buffer to collect all messages. If
-arg ALL is nil, collect only messages fron current one on
+arg ALL is nil, collect only messages from current one on
forward.
Return number of messages put in the sequence:
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 7e0981b..0732a16 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -307,7 +307,7 @@ The function will expand out parent folders of FOLDER if
needed."
(mh-speed-toggle))
(goto-char (gethash prefix mh-speed-folder-map))))
(while suffix-list
- ;; We always need atleast one toggle. We need two if the directory list
+ ;; We always need at least one toggle. We need two if the directory list
;; is stale since a folder was added.
(when (equal prefix (get-text-property (mh-line-beginning-position)
'mh-folder))
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 6cd8580..363899d 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -44,12 +44,12 @@
(concat
(regexp-quote (substring minibuffer-default-prompt-format
0 (match-beginning 0)))
- ".*"
+ "\\(.*?\\)"
(regexp-quote (substring minibuffer-default-prompt-format
(match-end 0))))
(regexp-quote minibuffer-default-prompt-format))
"\\): ")
- 1)
+ 1 (and minibuffer-eldef-shorten-default " [\\2]"))
`(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
("([^(]+?\\(, default\\(?: is\\)? \\(.*\\)\\)):? \\'" 1)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 62a33f3..3e23c05 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1065,10 +1065,16 @@ in the last `cdr'."
(defun completion--replace (beg end newtext)
"Replace the buffer text between BEG and END with NEWTEXT.
Moves point to the end of the new text."
- ;; The properties on `newtext' include things like
- ;; completions-first-difference, which we don't want to include
- ;; upon insertion.
- (set-text-properties 0 (length newtext) nil newtext)
+ ;; The properties on `newtext' include things like the
+ ;; `completions-first-difference' face, which we don't want to
+ ;; include upon insertion.
+ (if minibuffer-allow-text-properties
+ ;; If we're preserving properties, then just remove the faces
+ ;; and other properties added by the completion machinery.
+ (remove-text-properties 0 (length newtext) '(face completion-score)
+ newtext)
+ ;; Remove all text properties.
+ (set-text-properties 0 (length newtext) nil newtext))
;; Maybe this should be in subr.el.
;; You'd think this is trivial to do, but details matter if you want
;; to keep markers "at the right place" and be robust in the face of
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 3b93bd1..32fde0d 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -203,13 +203,13 @@ Also see `mouse-wheel-tilt-scroll'."
(defvar mouse-wheel-left-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
'wheel-left
- (intern "mouse-6"))
+ 'mouse-6)
"Event used for scrolling left.")
(defvar mouse-wheel-right-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
'wheel-right
- (intern "mouse-7"))
+ 'mouse-7)
"Event used for scrolling right.")
(defun mouse-wheel--get-scroll-window (event)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index d4e6cb9..86db7cb 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -51,6 +51,8 @@
(unless (boundp 'dbus-debug)
(defvar dbus-debug nil))
+(require 'seq)
+(require 'subr-x)
(require 'xml)
;;; D-Bus constants.
@@ -160,21 +162,19 @@ See URL
`https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
:link '(custom-manual "(dbus)Top")
:version "28.1")
-(defcustom dbus-show-dbus-errors nil
- "Propagate incoming D-Bus error messages."
- :version "28.1"
- :type 'boolean)
-
(defconst dbus-error-dbus "org.freedesktop.DBus.Error"
"The namespace for default error names.
See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
-(defconst dbus-error-failed (concat dbus-error-dbus ".Failed")
- "A generic error; \"something went wrong\" - see the error message for
more.")
-
(defconst dbus-error-access-denied (concat dbus-error-dbus ".AccessDenied")
"Security restrictions don't allow doing what you're trying to do.")
+(defconst dbus-error-disconnected (concat dbus-error-dbus ".Disconnected")
+ "The connection is disconnected and you're trying to use it.")
+
+(defconst dbus-error-failed (concat dbus-error-dbus ".Failed")
+ "A generic error; \"something went wrong\" - see the error message for
more.")
+
(defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs")
"Invalid arguments passed to a method call.")
@@ -185,6 +185,9 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
(concat dbus-error-dbus ".PropertyReadOnly")
"Property you tried to set is read-only.")
+(defconst dbus-error-service-unknown (concat dbus-error-dbus ".ServiceUnknown")
+ "The bus doesn't know how to launch a service to supply the bus name you
wanted.")
+
(defconst dbus-error-unknown-interface
(concat dbus-error-dbus ".UnknownInterface")
"Interface you invoked a method on isn't known by the object.")
@@ -217,17 +220,11 @@ shall be subdirectories of this path.")
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
-Signals also D-Bus error when `dbus-show-dbus-errors' is non-nil
-and a D-Bus error message has arrived. Otherwise, return result
-of last form in BODY, or all other errors."
+Otherwise, return result of last form in BODY, or all other errors."
(declare (indent 0) (debug t))
`(condition-case err
(progn ,@body)
- (dbus-error
- (when (or dbus-debug
- (and dbus-show-dbus-errors
- (= dbus-message-type-error (nth 2 last-input-event))))
- (signal (car err) (cdr err))))))
+ (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
"Functions to be called when a D-Bus error happens in the event handler.
@@ -540,6 +537,21 @@ This is an internal function, it shall not be used outside
dbus.el."
(apply #'dbus-message-internal dbus-message-type-error
bus service serial error-name args))
+(defun dbus-check-arguments (bus service &rest args)
+ "Check arguments ARGS by side effect.
+BUS, SERVICE and ARGS have the same format as in `dbus-call-method'.
+Any wrong argument triggers a D-Bus error. Otherwise, return t.
+This is an internal function, it shall not be used outside dbus.el."
+
+ (or (featurep 'dbusbind)
+ (signal 'dbus-error (list "Emacs not compiled with dbus support")))
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+
+ (apply #'dbus-message-internal dbus-message-type-invalid bus service args))
+
;;; Hash table of registered functions.
@@ -1016,8 +1028,9 @@ D-Bus message. SERVICE and PATH are the unique name and
the
object path of the D-Bus object emitting the message. INTERFACE
and MEMBER denote the message which has been sent. HANDLER is
the function which has been registered for this message. ARGS
-are the arguments passed to HANDLER, when it is called during
-event handling in `dbus-handle-event'.
+are the typed arguments as returned from the message. They are
+passed to HANDLER without type information, when it is called
+during event handling in `dbus-handle-event'.
This function signals a `dbus-error' if the event is not well
formed."
@@ -1053,22 +1066,53 @@ formed."
(functionp (nth 8 event)))
(signal 'dbus-error (list "Not a valid D-Bus event" event))))
+(defun dbus-delete-types (&rest args)
+ "Delete type information from arguments retrieved via `dbus-handle-event'.
+Basic type arguments (TYPE VALUE) will be transformed into VALUE, and
+compound type arguments (TYPE VALUE) will be transformed into (VALUE)."
+ (car
+ (mapcar
+ (lambda (elt)
+ (cond
+ ((atom elt) elt)
+ ((memq (car elt) dbus-compound-types)
+ (mapcar #'dbus-delete-types (cdr elt)))
+ (t (cadr elt))))
+ args)))
+
+(defun dbus-flatten-types (arg)
+ "Flatten type information from argument retrieved via `dbus-handle-event'.
+Basic type arguments (TYPE VALUE) will be transformed into TYPE VALUE, and
+compound type arguments (TYPE VALUE) will be kept as is."
+ (let (result)
+ (dolist (elt arg)
+ (cond
+ ((atom elt) (push elt result))
+ ((and (not (memq (car elt) dbus-compound-types)))
+ (push (car elt) result)
+ (push (cadr elt) result))
+ (t
+ (push (cons (car elt) (dbus-flatten-types (cdr elt))) result))))
+ (nreverse result)))
+
;;;###autoload
(defun dbus-handle-event (event)
"Handle events from the D-Bus.
EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
-part of the event, is called with arguments ARGS.
+part of the event, is called with arguments ARGS (without type information).
If the HANDLER returns a `dbus-error', it is propagated as return message."
(interactive "e")
(condition-case err
- (let (result)
+ (let (args result)
;; We ignore not well-formed events.
(dbus-check-event event)
+ ;; Remove type information.
+ (setq args (mapcar #'dbus-delete-types (nthcdr 9 event)))
;; Error messages must be propagated.
(when (= dbus-message-type-error (nth 2 event))
- (signal 'dbus-error (nthcdr 9 event)))
+ (signal 'dbus-error args))
;; Apply the handler.
- (setq result (apply (nth 8 event) (nthcdr 9 event)))
+ (setq result (apply (nth 8 event) args))
;; Return an (error) message when it is a message call.
(when (= dbus-message-type-method-call (nth 2 event))
(dbus-ignore-errors
@@ -1160,10 +1204,11 @@ function signals a `dbus-error' if the event is not
well formed."
BUS defaults to `:system' when nil or omitted. The result is a
list of strings, which is nil when there are no activatable
service names at all."
- (dbus-ignore-errors
- (dbus-call-method
- (or bus :system) dbus-service-dbus
- dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ (or bus :system) dbus-service-dbus
+ dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))))
(defun dbus-list-names (bus)
"Return the service names registered at D-Bus BUS.
@@ -1171,9 +1216,10 @@ The result is a list of strings, which is nil when there
are no
registered service names at all. Well known names are strings
like \"org.freedesktop.DBus\". Names starting with \":\" are
unique names for services."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))))
(defun dbus-list-known-names (bus)
"Retrieve all services which correspond to a known name in BUS.
@@ -1186,18 +1232,20 @@ A service has a known name if it doesn't start with
\":\"."
"Return the unique names registered at D-Bus BUS and queued for SERVICE.
The result is a list of strings, or nil when there are no queued
name owner service names at all."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "ListQueuedOwners" service)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "ListQueuedOwners" service))))
(defun dbus-get-name-owner (bus service)
"Return the name owner of SERVICE registered at D-Bus BUS.
The result is either a string, or nil if there is no name owner."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "GetNameOwner" service)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "GetNameOwner" service))))
(defun dbus-ping (bus service &optional timeout)
"Check whether SERVICE is registered for D-Bus BUS.
@@ -1267,10 +1315,11 @@ and PATH must be a valid object path. The last two
parameters
are strings. The result, the introspection data, is a string in
XML format."
;; We don't want to raise errors.
- (dbus-ignore-errors
- (dbus-call-method
- bus service path dbus-interface-introspectable "Introspect"
- :timeout 1000)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-introspectable "Introspect"
+ :timeout 1000))))
(defalias 'dbus--parse-xml-buffer
(if (libxml-available-p)
@@ -1472,12 +1521,11 @@ If NAME is a `signal' or a `property', DIRECTION is
ignored."
"Return the value of PROPERTY of INTERFACE.
It will be checked at BUS, SERVICE, PATH. The result can be any
valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read."
- (dbus-ignore-errors
- ;; "Get" returns a variant, so we must use the `car'.
- (car
- (dbus-call-method
- bus service path dbus-interface-properties
- "Get" :timeout 500 interface property))))
+ ;; "Get" returns a variant, so we must use the `car'.
+ (car
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Get" :timeout 500 interface property)))
(defun dbus-set-property (bus service path interface property &rest args)
"Set value of PROPERTY of INTERFACE to VALUE.
@@ -1487,26 +1535,30 @@ property's access type is not `:write', return VALUE.
Otherwise,
return nil.
\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)"
- (dbus-ignore-errors
- ;; "Set" requires a variant.
- (dbus-call-method
- bus service path dbus-interface-properties
- "Set" :timeout 500 interface property (list :variant args))
- ;; Return VALUE.
- (or (dbus-get-property bus service path interface property)
- (if (symbolp (car args)) (cadr args) (car args)))))
+ ;; "Set" requires a variant.
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Set" :timeout 500 interface property (cons :variant args))
+ ;; Return VALUE.
+ (condition-case err
+ (dbus-get-property bus service path interface property)
+ (dbus-error
+ (if (string-equal dbus-error-access-denied (cadr err))
+ (car args)
+ (signal (car err) (cdr err))))))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
The result is a list of entries. Every entry is a cons of the
name of the property, and its value. If there are no properties,
nil is returned."
- (dbus-ignore-errors
- ;; "GetAll" returns "a{sv}".
- (mapcar (lambda (dict)
- (cons (car dict) (caadr dict)))
- (dbus-call-method bus service path dbus-interface-properties
- "GetAll" :timeout 500 interface))))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ ;; "GetAll" returns "a{sv}".
+ (mapcar (lambda (dict)
+ (cons (car dict) (caadr dict)))
+ (dbus-call-method bus service path dbus-interface-properties
+ "GetAll" :timeout 500 interface)))))
(defun dbus-get-this-registered-property (bus _service path interface property)
"Return PROPERTY entry of `dbus-registered-objects-table'.
@@ -1570,9 +1622,8 @@ clients from discovering the still incomplete interface.
\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
- (let ((signature "s") ;; FIXME: For the time being.
- ;; Read basic type symbol.
- (type (when (symbolp (car args)) (pop args)))
+ (let (;; Read basic type symbol.
+ (type (when (keywordp (car args)) (pop args)))
(value (pop args))
(emits-signal (pop args))
(dont-register-service (pop args)))
@@ -1590,6 +1641,9 @@ clients from discovering the still incomplete interface.
(signal 'wrong-type-argument (list "Value type invalid"
value))))))
(unless (consp value)
(setq value (list type value)))
+ (setq value (if (member (car value) dbus-compound-types)
+ (list :variant value) (cons :variant value)))
+ (dbus-check-arguments bus service value)
;; Add handlers for the three property-related methods.
(dbus-register-method
@@ -1613,10 +1667,7 @@ clients from discovering the still incomplete interface.
;; changed_properties.
(if (eq access :write)
'(:array: :signature "{sv}")
- `(:array
- (:dict-entry
- ,property
- ,(if type (list :variant type value) (list :variant value)))))
+ `(:array (:dict-entry ,property ,value)))
;; invalidated_properties.
(if (eq access :write)
`(:array ,property)
@@ -1627,8 +1678,7 @@ clients from discovering the still incomplete interface.
(let ((key (list :property bus interface property))
(val
(cons
- (list
- nil service path (list access emits-signal signature value))
+ (list nil service path (list access emits-signal value))
(dbus-get-other-registered-properties
bus service path interface property))))
(puthash key val dbus-registered-objects-table)
@@ -1639,12 +1689,13 @@ clients from discovering the still incomplete interface.
(defun dbus-property-handler (&rest args)
"Default handler for the \"org.freedesktop.DBus.Properties\" interface.
It will be registered for all objects created by `dbus-register-property'."
- (let ((bus (dbus-event-bus-name last-input-event))
- (service (dbus-event-service-name last-input-event))
- (path (dbus-event-path-name last-input-event))
- (method (dbus-event-member-name last-input-event))
- (interface (car args))
- (property (cadr args)))
+ (let* ((last-input-event last-input-event)
+ (bus (dbus-event-bus-name last-input-event))
+ (service (dbus-event-service-name last-input-event))
+ (path (dbus-event-path-name last-input-event))
+ (method (dbus-event-member-name last-input-event))
+ (interface (car args))
+ (property (cadr args)))
(cond
;; "Get" returns a variant.
((string-equal method "Get")
@@ -1662,13 +1713,11 @@ It will be registered for all objects created by
`dbus-register-property'."
"Property \"%s\" at path \"%s\" is not readable" property path)))
;; Return the result. Since variant is a list, we must embed
;; it into another list.
- (t (list (if (memq (car (nth 3 object)) dbus-compound-types)
- (list :variant (nth 3 object))
- (cons :variant (nth 3 object))))))))
+ (t (list (nth 2 object))))))
- ;; "Set" expects the same type as registered. FIXME: Implement!
+ ;; "Set" needs the third typed argument from `last-input-event'.
((string-equal method "Set")
- (let* ((value (caar (nth 2 args)))
+ (let* ((value (dbus-flatten-types (nth 11 last-input-event)))
(entry (dbus-get-this-registered-property
bus service path interface property))
(object (car (last (car entry)))))
@@ -1681,12 +1730,10 @@ It will be registered for all objects created by
`dbus-register-property'."
`(:error ,dbus-error-property-read-only
,(format-message
"Property \"%s\" at path \"%s\" is not writable" property path)))
- (t (unless (consp value)
- (setq value (list (car (nth 3 object)) value)))
- (puthash (list :property bus interface property)
+ (t (puthash (list :property bus interface property)
(cons (append
(butlast (car entry))
- ;; Reuse ACCESS, EMITS-SIGNAL and TYPE.
+ ;; Reuse ACCESS and EMITS-SIGNAL.
(list (append (butlast object) (list value))))
(dbus-get-other-registered-properties
bus service path interface property))
@@ -1698,7 +1745,7 @@ It will be registered for all objects created by
`dbus-register-property'."
;; changed_properties.
(if (eq :write (car object))
'(:array: :signature "{sv}")
- `(:array (:dict-entry ,property (:variant ,value))))
+ `(:array (:dict-entry ,property ,value)))
;; invalidated_properties.
(if (eq :write (car object))
`(:array ,property)
@@ -1719,11 +1766,7 @@ It will be registered for all objects created by
`dbus-register-property'."
(consp object)
(not (eq :write (car object))))
(push
- (list :dict-entry
- (car (last key))
- (if (memq (car (nth 3 object)) dbus-compound-types)
- (list :variant (nth 3 object))
- (cons :variant (nth 3 object))))
+ (list :dict-entry (car (last key)) (nth 2 object))
result))))))
dbus-registered-objects-table)
;; Return the result, or an empty array. An array must be
@@ -1773,10 +1816,11 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which
is slow."
(let ((result
;; Direct call. Fails, if the target does not support the
;; object manager interface.
- (dbus-ignore-errors
- (dbus-call-method
- bus service path dbus-interface-objectmanager
- "GetManagedObjects" :timeout 1000))))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-objectmanager
+ "GetManagedObjects" :timeout 1000)))))
(if result
;; Massage the returned structure.
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 69dc2d4..1ed87c6 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -141,7 +141,7 @@ this should be a list where the first item is the program,
and
the rest are the arguments."
:version "28.1"
:type '(choice (const :tag "Use `url-retrieve'" nil)
- (list string)))
+ (repeat string)))
(defcustom eww-use-external-browser-for-content-type
"\\`\\(video/\\|audio/\\|application/ogg\\)"
@@ -730,8 +730,7 @@ Currently this means either text/html or
application/xhtml+xml."
(setq header-line-format
(and eww-header-line-format
(let ((peer (plist-get eww-data :peer))
- (url (propertize (plist-get eww-data :url)
- 'face 'variable-pitch))
+ (url (plist-get eww-data :url))
(title (propertize
(if (zerop (length (plist-get eww-data :title)))
"[untitled]"
@@ -747,10 +746,13 @@ Currently this means either text/html or
application/xhtml+xml."
;; Limit the length of the title so that the host name
;; of the URL is always visible.
(when url
+ (setq url (propertize url 'face 'variable-pitch))
(let* ((parsed (url-generic-parse-url url))
(host-length (shr-string-pixel-width
- (format "%s://%s" (url-type parsed)
- (url-host parsed))))
+ (propertize
+ (format "%s://%s" (url-type parsed)
+ (url-host parsed))
+ 'face 'variable-pitch)))
(width (window-width nil t)))
(cond
;; The host bit is wider than the window, so nix
@@ -1632,7 +1634,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(cond
((member (plist-get input :type) '("checkbox" "radio"))
(when (plist-get input :checked)
- (push (cons name (plist-get input :value))
+ (push (cons name (or (plist-get input :value) "on"))
values)))
((equal (plist-get input :type) "file")
(when-let ((file (plist-get input :filename)))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 6517596..dcb6415 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -555,7 +555,7 @@ size, and full-buffer size."
;; If the element was empty, we don't have anything to put the
;; anchor on. So just insert a dummy character.
(when (= start (point))
- (insert ?*)
+ (insert ? )
(put-text-property (1- (point)) (point) 'display ""))
(put-text-property start (1+ start) 'shr-target-id id))
;; If style is set, then this node has set the color.
@@ -714,7 +714,8 @@ size, and full-buffer size."
(forward-char 1))))
(defun shr-fill-line ()
- (let ((shr-indentation (get-text-property (point) 'shr-indentation))
+ (let ((shr-indentation (or (get-text-property (point) 'shr-indentation)
+ shr-indentation))
(continuation (get-text-property
(point) 'shr-continuation-indentation))
start)
@@ -932,6 +933,22 @@ size, and full-buffer size."
(looking-at " *$")))
;; We're already at a new paragraph; do nothing.
)
+ ((and (not (bolp))
+ (save-excursion
+ (beginning-of-line)
+ (looking-at " *$"))
+ (save-excursion
+ (forward-line -1)
+ (looking-at " *$"))
+ ;; Check all chars on the current line and see whether
+ ;; they're all placeholders.
+ (cl-loop for pos from (line-beginning-position) upto (1- (point))
+ unless (get-text-property pos 'shr-target-id)
+ return nil
+ finally return t))
+ ;; We have some invisible markers from <div id="foo"></div>;
+ ;; do nothing.
+ )
((and prefix
(= prefix (- (point) (line-beginning-position))))
;; Do nothing; we're at the start of a <li>.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7fd48b2..6d44ad2 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1297,7 +1297,7 @@ If nil, return `tramp-default-port'."
(or (tramp-file-name-port vec)
(tramp-get-method-parameter vec 'tramp-default-port)))
-;; Comparision of file names is performed by `tramp-equal-remote'.
+;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
"Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
@@ -4639,7 +4639,7 @@ If it doesn't exist, generate a new one."
(with-tramp-connection-property (tramp-get-connection-process vec) "device"
(cons -1 (setq tramp-devices (1+ tramp-devices)))))
-;; Comparision of vectors is performed by `tramp-file-name-equal-p'.
+;; Comparison of vectors is performed by `tramp-file-name-equal-p'.
(defun tramp-equal-remote (file1 file2)
"Check, whether the remote parts of FILE1 and FILE2 are identical.
The check depends on method, user and host name of the files. If
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 822f6f3..74f45b9 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -217,6 +217,29 @@ Includes files as well as host names followed by a colon."
(pcmpl-ssh-hosts)))))))
(complete-with-action action table string pred))))))
+(defsubst pcmpl-unix-complete-hostname ()
+ "Complete a command that wants a hostname for an argument."
+ (pcomplete-here (pcomplete-read-host-names)))
+
+(defalias 'pcomplete/ftp 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/ncftp 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/ping 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/rlogin 'pcmpl-unix-complete-hostname)
+
+;;;###autoload
+(defun pcomplete/telnet ()
+ (pcomplete-opt "xl(pcmpl-unix-user-names)")
+ (pcmpl-unix-complete-hostname))
+
+;;;###autoload
+(defun pcomplete/rsh ()
+ "Complete `rsh', which, after the user and hostname, is like xargs."
+ (pcomplete-opt "l(pcmpl-unix-user-names)")
+ (pcmpl-unix-complete-hostname)
+ (pcomplete-here (funcall pcomplete-command-completion-function))
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
(provide 'pcmpl-unix)
;;; pcmpl-unix.el ends here
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 5244ada..6e96a67 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -286,5 +286,37 @@ long options."
(pcmpl-x-ag-options))))
(pcomplete-here* (pcomplete-dirs-or-entries)))))
+;;;###autoload
+(defun pcomplete/bcc32 ()
+ "Completion function for Borland's C++ compiler."
+ (let ((cur (pcomplete-arg 0)))
+ (cond
+ ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
+ (pcomplete-here
+ '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
+ "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
+ "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
+ "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
+ "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
+ "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
+ "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
+ "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
+ "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
+ ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
+ ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
+ (match-string 1 cur)))
+ ((string-match "\\`-o\\(.*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
+ (match-string 1 cur)))
+ (t
+ (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
+ (while (pcomplete-here
+ (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
+
+;;;###autoload
+(defalias 'pcomplete/bcc 'pcomplete/bcc32)
+
(provide 'pcmpl-x)
;;; pcmpl-x.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 32e61e8..014f962 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -325,6 +325,10 @@ already terminated by a character, this variable should be
locally
modified to be an empty string, or the desired separation string."
:type 'string)
+(defcustom pcomplete-hosts-file "/etc/hosts"
+ "The name of the /etc/hosts file."
+ :type '(choice (const :tag "No hosts file" nil) file))
+
;;; Internal Variables:
;; for cycling completion support
@@ -1289,6 +1293,46 @@ If specific documentation can't be given, be generic."
(skip-chars-backward "\n")
(buffer-substring (point-min) (point))))
+;; hostname completion
+
+(defvar pcomplete--host-name-cache nil
+ "A cache the names of frequently accessed hosts.")
+
+(defvar pcomplete--host-name-cache-timestamp nil
+ "A timestamp of when the hosts file was read.")
+
+(defun pcomplete-read-hosts-file (filename)
+ "Read in the hosts from FILENAME, default `pcomplete-hosts-file'."
+ (let (hosts)
+ (with-temp-buffer
+ (insert-file-contents (or filename pcomplete-hosts-file))
+ (goto-char (point-min))
+ (while (re-search-forward
+ ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^
\t\n]+\\)\\)?"
+ "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t)
+ (push (cons (match-string 1)
+ (split-string (match-string 2)))
+ hosts)))
+ (nreverse hosts)))
+
+(defun pcomplete-read-hosts (file result-var timestamp-var)
+ "Read the contents of /etc/hosts for host names."
+ (if (or (not (symbol-value result-var))
+ (not (symbol-value timestamp-var))
+ (time-less-p
+ (symbol-value timestamp-var)
+ (file-attribute-modification-time (file-attributes file))))
+ (progn
+ (set result-var (apply #'nconc (pcomplete-read-hosts-file file)))
+ (set timestamp-var (current-time))))
+ (symbol-value result-var))
+
+(defun pcomplete-read-host-names ()
+ "Read the contents of /etc/hosts for host names."
+ (if pcomplete-hosts-file
+ (pcomplete-read-hosts pcomplete-hosts-file 'pcomplete--host-name-cache
+ 'pcomplete--host-name-cache-timestamp)))
+
;; create a set of aliases which allow completion functions to be not
;; quite so verbose
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 7c4941e..3d4843a 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -582,7 +582,7 @@ Solutions are sorted from least to greatest Hamming weight."
(math-sub dest org))))
;; transferm is the transfer matrix, ie it is the 25x25
- ;; matrix applied everytime a flip is carried out where a
+ ;; matrix applied every time a flip is carried out where a
;; flip is defined by a 25x1 Dirac vector --- ie all zeros
;; but 1 in the position that is flipped.
(transferm
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 0a5ddc1..bf8aacc 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -305,7 +305,7 @@ Optional argument MODE means only check for the specified
mode (cpu or mem)."
(let ((fun-map (make-hash-table :test 'profiler-function-equal))
(parent-map (make-hash-table :test 'eq))
(leftover-tree (profiler-make-calltree
- :entry (intern "...") :parent tree)))
+ :entry '... :parent tree)))
(push leftover-tree (profiler-calltree-children tree))
(maphash
(lambda (backtrace _count)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 7d10027..4e336c0 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -2697,7 +2697,7 @@ comment at the start of cc-engine.el for more info."
;; or the car of the list is the "position element" of ELT, the position
;; where ELT is valid.
;;
- ;; POINT is left at the postition for which the returned state is valid. It
+ ;; POINT is left at the position for which the returned state is valid. It
;; will be either the position element of ELT, or one character before
;; that. (The latter happens in Emacs <= 25 and XEmacs, when ELT indicates
;; its position element directly follows a potential first character of a
@@ -2767,7 +2767,7 @@ comment at the start of cc-engine.el for more info."
((nth 3 state) ; A string
(list (point) (nth 3 state) (nth 8 state)))
((and (nth 4 state) ; A comment
- (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo
comment.
+ (not (eq (nth 7 state) 'syntax-table))) ; but not a pseudo
comment.
(list (point)
(if (eq (nth 7 state) 1) 'c++ 'c)
(nth 8 state)))
@@ -2894,7 +2894,7 @@ comment at the start of cc-engine.el for more info."
(setq nc-list (cdr nc-list))))))
(defun c-semi-get-near-cache-entry (here)
- ;; Return the near cache entry at the highest postion before HERE, if any,
+ ;; Return the near cache entry at the highest position before HERE, if any,
;; or nil. The near cache entry is of the form (POSITION . STATE), where
;; STATE has the form of a result of `parse-partial-sexp'.
(let ((nc-pos-state
@@ -7170,7 +7170,7 @@ comment at the start of cc-engine.el for more info."
;; characters.) If the raw string is not terminated, E\) and E\" are set to
;; nil.
;;
- ;; Note: this function is dependant upon the correct syntax-table text
+ ;; Note: this function is dependent upon the correct syntax-table text
;; properties being set.
(let ((state (c-semi-pp-to-literal (point)))
open-quote-pos open-paren-pos close-paren-pos close-quote-pos id)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 386cc2f..bb7e5be 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1073,17 +1073,18 @@ casts and declarations are fontified. Used on level 2
and higher."
(defun c-font-lock-declarators (limit list types not-top
&optional template-class)
;; Assuming the point is at the start of a declarator in a declaration,
- ;; fontify the identifier it declares. (If TYPES is set, it does this via
- ;; the macro `c-fontify-types-and-refs'.)
+ ;; fontify the identifier it declares. (If TYPES is t, it does this via the
+ ;; macro `c-fontify-types-and-refs'.)
;;
;; If LIST is non-nil, also fontify the ids in any following declarators in
;; a comma separated list (e.g. "foo" and "*bar" in "int foo = 17, *bar;");
;; additionally, mark the commas with c-type property 'c-decl-id-start or
;; 'c-decl-type-start (according to TYPES). Stop at LIMIT.
;;
- ;; If TYPES is non-nil, fontify all identifiers as types. If NOT-TOP is
- ;; non-nil, we are not at the top-level ("top-level" includes being directly
- ;; inside a class or namespace, etc.).
+ ;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as
+ ;; either variables or functions, otherwise TYPES is a face to use. If
+ ;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes
+ ;; being directly inside a class or namespace, etc.).
;;
;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters
;; and was introduced by, e.g. "typename" or "class", such that if there is
@@ -1100,9 +1101,10 @@ casts and declarations are fontified. Used on level 2
and higher."
()
(c-do-declarators
limit list not-top
- (if types 'c-decl-type-start 'c-decl-id-start)
+ (cond ((eq types t) 'c-decl-type-start)
+ ((null types) 'c-decl-id-start))
(lambda (id-start _id-end end-pos _not-top is-function init-char)
- (if types
+ (if (eq types t)
;; Register and fontify the identifier as a type.
(let ((c-promote-possible-types t))
(goto-char id-start)
@@ -1121,9 +1123,10 @@ casts and declarations are fontified. Used on level 2
and higher."
;; `c-forward-declarator'.
(c-put-font-lock-face (car c-last-identifier-range)
(cdr c-last-identifier-range)
- (if is-function
- 'font-lock-function-name-face
- 'font-lock-variable-name-face))))
+ (cond
+ ((not (memq types '(nil t))) types)
+ (is-function 'font-lock-function-name-face)
+ (t 'font-lock-variable-name-face)))))
(and template-class
(eq init-char ?=) ; C++ "<class X = Y>"?
(progn
@@ -1357,7 +1360,8 @@ casts and declarations are fontified. Used on level 2
and higher."
'c-decl-id-start)))))
(c-font-lock-declarators
(min limit (point-max)) decl-list
- (cadr decl-or-cast) (not toplev) template-class))
+ (not (null (cadr decl-or-cast)))
+ (not toplev) template-class))
;; A declaration has been successfully identified, so do all the
;; fontification of types and refs that've been recorded.
@@ -2004,6 +2008,9 @@ on level 2 only and so aren't combined with
`c-complex-decl-matchers'."
,@(when (c-major-mode-is 'c++-mode)
'(c-font-lock-c++-lambda-captures))
+ ,@(when (c-lang-const c-using-key)
+ `(c-font-lock-c++-using))
+
;; The first two rules here mostly find occurrences that
;; `c-font-lock-declarations' has found already, but not
;; declarations containing blocks in the type (see note below).
@@ -2263,6 +2270,40 @@ need for `c-font-lock-extra-types'.")
;;; C++.
+(defun c-font-lock-c++-using (limit)
+ ;; Fontify any clauses starting with the keyword `using'.
+ ;;
+ ;; This function will be called from font-lock- for a region bounded by
+ ;; POINT and LIMIT, as though it were to identify a keyword for
+ ;; font-lock-keyword-face. It always returns NIL to inhibit this and
+ ;; prevent a repeat invocation. See elisp/lispref page "Search-based
+ ;; fontification".
+ (let (pos after-name)
+ (while (c-syntactic-re-search-forward c-using-key limit 'end)
+ (while ; Do one declarator of a comma separated list, each time around.
+ (progn
+ (c-forward-syntactic-ws)
+ (setq pos (point)) ; token after "using".
+ (when (and (c-on-identifier)
+ (c-forward-name))
+ (setq after-name (point))
+ (cond
+ ((eq (char-after) ?=) ; using foo = <type-id>;
+ (goto-char pos)
+ (c-font-lock-declarators limit nil t nil))
+ ((save-excursion
+ (and c-colon-type-list-re
+ (c-go-up-list-backward)
+ (eq (char-after) ?{)
+ (eq (car (c-beginning-of-decl-1)) 'same)
+ (looking-at c-colon-type-list-re)))
+ ;; Inherited protected member: leave unfontified
+ )
+ (t (goto-char pos)
+ (c-font-lock-declarators limit nil c-label-face-name nil)))
+ (eq (char-after) ?,)))
+ (forward-char))) ; over the comma.
+ nil))
(defun c-font-lock-c++-new (limit)
;; FIXME!!! Put in a comment about the context of this function's
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index c4c6ad2..eee8e30 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -2339,6 +2339,16 @@ will be handled."
t (c-make-keywords-re t (c-lang-const c-typedef-decl-kwds)))
(c-lang-defvar c-typedef-decl-key (c-lang-const c-typedef-decl-key))
+(c-lang-defconst c-using-kwds
+ "Keywords which behave like `using' in C++"
+ t nil
+ c++ '("using"))
+
+(c-lang-defconst c-using-key
+ ;; Regexp matching C++'s `using'.
+ t (c-make-keywords-re t (c-lang-const c-using-kwds)))
+(c-lang-defvar c-using-key (c-lang-const c-using-key))
+
(c-lang-defconst c-typeless-decl-kwds
"Keywords introducing declarations where the (first) identifier
\(declarator) follows directly after the keyword, without any type.
@@ -2389,7 +2399,8 @@ will be handled."
t nil
(c c++) '("auto" "extern" "inline" "register" "static")
c++ (append '("constexpr" "explicit" "friend" "mutable" "template"
- "thread_local" "using" "virtual")
+ "thread_local" "virtual")
+ ;; "using" is now handled specially (2020-09-14).
(c-lang-const c-modifier-kwds))
objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static")
;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 13b672b..7ac5405 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2090,8 +2090,7 @@ Returns the compilation buffer created."
'(menu-item "Compile..." compile
:help "Compile the program including the current buffer.
Default: run `make'"))
map)
- "Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a parent of this.")
+ "Keymap for compilation log buffers.")
(defvar compilation-mode-tool-bar-map
;; When bootstrapping, tool-bar-map is not properly initialized yet,
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index af179e2..468ffc9 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -814,7 +814,7 @@ capable syntax engines).
(defvar cperl-speed 'please-ignore-this-line
"This is an incomplete compendium of what is available in other parts
-of CPerl documentation. (Please inform me if I skept anything.)
+of CPerl documentation. (Please inform me if I skipped anything.)
There is a perception that CPerl is slower than alternatives. This part
of documentation is designed to overcome this misconception.
@@ -1234,6 +1234,7 @@ versions of Emacs."
["Auto fill" auto-fill-mode t])
("Indent styles..."
["CPerl" (cperl-set-style "CPerl") t]
+ ["PBP" (cperl-set-style "PBP") t]
["PerlStyle" (cperl-set-style "PerlStyle") t]
["GNU" (cperl-set-style "GNU") t]
["C++" (cperl-set-style "C++") t]
@@ -1553,12 +1554,12 @@ Variables controlling indentation style:
`cperl-min-label-indent'
Minimal indentation for line that is a label.
-Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
- `cperl-indent-level' 5 4 2 4
- `cperl-brace-offset' 0 0 0 0
- `cperl-continued-brace-offset' -5 -4 0 0
- `cperl-label-offset' -5 -4 -2 -4
- `cperl-continued-statement-offset' 5 4 2 4
+Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith
+ `cperl-indent-level' 5 4 2 4 4
+ `cperl-brace-offset' 0 0 0 0 0
+ `cperl-continued-brace-offset' -5 -4 0 0 0
+ `cperl-label-offset' -5 -4 -2 -2 -4
+ `cperl-continued-statement-offset' 5 4 2 4 4
CPerl knows several indentation styles, and may bulk set the
corresponding variables. Use \\[cperl-set-style] to do this. Use
@@ -4485,7 +4486,7 @@ the sections using `cperl-pod-head-face',
`cperl-pod-face',
'syntax-table cperl-st-cfence))))
(setq was-subgr nil))
(t ; (?#)-comment
- ;; Inside "(" and "\" arn't special in any way
+ ;; Inside "(" and "\" aren't special in any way
;; Works also if the outside delimiters are ().
(or;;(if (eq (char-after b) ?\) )
;;(re-search-forward
@@ -6046,7 +6047,19 @@ if (foo) {
stop;
}
-### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil
+### PBP (=Perl Best Practices) 4/0/0/-4/4/nil/nil
+if (foo) {
+ bar
+ baz;
+ label:
+ {
+ boon;
+ }
+}
+else {
+ stop;
+}
+### PerlStyle (=CPerl with 4 as indent) 4/0/0/-2/4/t/nil
if (foo) {
bar
baz;
@@ -6149,6 +6162,18 @@ else
(cperl-extra-newline-before-brace-multiline . nil)
(cperl-merge-trailing-else . t))
+ ("PBP" ;; Perl Best Practices by Damian Conway
+ (cperl-indent-level . 4)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . 0)
+ (cperl-label-offset . -2)
+ (cperl-continued-statement-offset . 4)
+ (cperl-extra-newline-before-brace . nil)
+ (cperl-extra-newline-before-brace-multiline . nil)
+ (cperl-merge-trailing-else . nil)
+ (cperl-indent-parens-as-block . t)
+ (cperl-tab-always-indent . t))
+
("PerlStyle" ; CPerl with 4 as indent
(cperl-indent-level . 4)
(cperl-brace-offset . 0)
@@ -6220,7 +6245,8 @@ See examples in `cperl-style-examples'.")
"Set CPerl mode variables to use one of several different indentation styles.
The arguments are a string representing the desired style.
The list of styles is in `cperl-style-alist', available styles
-are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith.
+are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\"
+and \"Whitesmith\".
The current value of style is memorized (unless there is a memorized
data already), may be restored by `cperl-set-style-back'.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 72b94a5..b480368 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -683,7 +683,7 @@ otherwise build the summary from TYPE and SYMBOL."
"List of functions to be run from `elisp--xref-find-definitions' to add
additional xrefs.
Called with one arg; the symbol whose definition is desired.
Each function should return a list of xrefs, or nil; the first
-non-nil result supercedes the xrefs produced by
+non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 2c5c365..f6af1f2 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1845,7 +1845,7 @@ Also see the documentation of the `tags-file-name'
variable."
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue].
-For non-interactive use, superceded by `fileloop-initialize-replace'."
+For non-interactive use, superseded by `fileloop-initialize-replace'."
(declare (advertised-calling-convention (from to &optional delimited)
"27.1"))
(interactive (query-replace-read-args "Tags query replace (regexp)" t t))
(fileloop-initialize-replace
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index bdb7757..b286208 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -226,10 +226,10 @@ Specifically, start it when the saved buffer is actually
displayed."
(defcustom flymake-suppress-zero-counters :warning
"Control appearance of zero-valued diagnostic counters in mode line.
-If set to t, supress all zero counters. If set to a severity
+If set to t, suppress all zero counters. If set to a severity
symbol like `:warning' (the default) suppress zero counters less
severe than that severity, according to `warning-numeric-level'.
-If set to nil, don't supress any zero counters."
+If set to nil, don't suppress any zero counters."
:type 'symbol)
(when (fboundp 'define-fringe-bitmap)
@@ -632,7 +632,7 @@ associated `flymake-category' return DEFAULT."
for (ov-prop . value) in
(append (reverse
(flymake--diag-overlay-properties diagnostic))
- (reverse ; ensure ealier props override later ones
+ (reverse ; ensure earlier props override later ones
(flymake--lookup-type-property type 'flymake-overlay-control))
(alist-get type flymake-diagnostic-types-alist))
do (overlay-put ov ov-prop value))
@@ -1004,7 +1004,7 @@ special *Flymake log* buffer." :group 'flymake :lighter
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
(add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t)
- ;; If Flymake happened to be alrady already ON, we must cleanup
+ ;; If Flymake happened to be already already ON, we must cleanup
;; existing diagnostic overlays, lest we forget them by blindly
;; reinitializing `flymake--backend-state' in the next line.
;; See https://github.com/joaotavora/eglot/issues/223.
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index c118421..8d6f8af 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -2547,7 +2547,7 @@ file names include non-ASCII characters."
(defun gdb-gdb (_output-field)
;; This is needed because the "explore" command is not ended by the
- ;; likes of "end" or "quit", but instead by a RET at the approriate
+ ;; likes of "end" or "quit", but instead by a RET at the appropriate
;; place, and we know we have exited "explore" when we get the
;; "(gdb)" prompt.
(and (> gdb-control-level 0)
@@ -4665,11 +4665,11 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(interactive)
(customize-option 'gdb-switch-reasons))))
(define-key menu [gdb-switch-when-another-stopped]
- (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped
- gdb-switch-when-another-stopped
- "Automatically switch to stopped thread"
- "GDB thread switching %s"
- "Switch to stopped thread"))
+ (menu-bar-make-toggle-command
+ gdb-toggle-switch-when-another-stopped
+ gdb-switch-when-another-stopped
+ "Automatically switch to stopped thread"
+ "GDB thread switching %s" "Switch to stopped thread"))
(define-key gud-menu-map [mi]
`(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi))))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 092d159..84c473d 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -2358,17 +2358,17 @@ during jdb initialization depending on the value of
(if (< n gud-jdb-lowest-stack-level)
(progn (setq gud-jdb-lowest-stack-level n) t)))
t)
- (if (setq file-found
- (gud-jdb-find-source (match-string 2 gud-marker-acc)))
- (setq gud-last-frame
- (cons file-found
- (string-to-number
- (let
- ((numstr (match-string 4 gud-marker-acc)))
- (if (string-match "[.,]" numstr)
- (replace-match "" nil nil numstr)
- numstr)))))
- (message "Could not find source file.")))
+ (let ((class (match-string 2 gud-marker-acc)))
+ (if (setq file-found (gud-jdb-find-source class))
+ (setq gud-last-frame
+ (cons file-found
+ (string-to-number
+ (let
+ ((numstr (match-string 4 gud-marker-acc)))
+ (if (string-match "[.,]" numstr)
+ (replace-match "" nil nil numstr)
+ numstr)))))
+ (message "Could not find source file for %s" class))))
;; Set the accumulator to the remaining text.
(setq gud-marker-acc (substring gud-marker-acc (match-end 0))))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 0b1ba80..9177b13 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -301,7 +301,7 @@ Several variables affect how the hiding is done:
;; `hide-ifdef-env' is now a global variable.
;; We can still simulate the behavior of older hideif versions (i.e.
;; `hide-ifdef-env' being buffer local) by clearing this variable
- ;; (C-c @ C) everytime before hiding current buffer.
+ ;; (C-c @ C) every time before hiding current buffer.
;; (set (make-local-variable 'hide-ifdef-env)
;; (default-value 'hide-ifdef-env))
(set 'hide-ifdef-env (default-value 'hide-ifdef-env))
@@ -1490,7 +1490,7 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for
more details."
(test (hif-canonicalize hif-ifx-regexp))
(range (hif-find-range))
(elifs (hif-range-elif range))
- (if-part t) ; Everytime we start from if-part
+ (if-part t) ; Every time we start from if-part
(complete nil))
;; (message "test = %s" test) (sit-for 1)
@@ -1650,7 +1650,7 @@ first arg will be `hif-etc'."
;; postponed the evaluation process one stage and store the "parsed tree"
;; into symbol database. The evaluation process was then "strings -> tokens
;; -> [parsed tree] -> value". Hideif therefore run slower since it need to
-;; evaluate the parsed tree everytime when trying to expand the symbol. These
+;; evaluate the parsed tree every time when trying to expand the symbol. These
;; temporarily code changes are obsolete and not in Emacs source repository.
;;
;; Furthermore, CPP did allow partial expression to be defined in several
@@ -1659,7 +1659,7 @@ first arg will be `hif-etc'."
;; further, otherwise those partial expression will be fail on parsing and
;; we'll miss all macros that reference it. The evaluation process thus
;; became "strings -> [tokens] -> parsed tree -> value." This degraded the
-;; performance since we need to parse tokens and evaluate them everytime
+;; performance since we need to parse tokens and evaluate them every time
;; when that symbol is referenced.
;;
;; In real cases I found a lot portion of macros are "simple macros" that
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 235279e..01cc330 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1413,7 +1413,7 @@ Fill comments, backslashed lines, and variable
definitions specially."
"Leave the browser and return to the makefile buffer."
(interactive)
(let ((my-client makefile-browser-client))
- (setq makefile-browser-client nil) ; we quitted, so NO client!
+ (setq makefile-browser-client nil) ; we quit, so NO client!
(set-buffer-modified-p nil)
(quit-window t)
(pop-to-buffer my-client)))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 7180ba3..8c550b5 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1021,7 +1021,7 @@ Each condition is either:
The car can be one of the following:
* `major-mode': the buffer is killed if the buffer's major
mode is eq to the cons-cell's cdr
- * `defived-mode': the buffer is killed if the buffer's major
+ * `derived-mode': the buffer is killed if the buffer's major
mode is derived from the major mode denoted by the cons-cell's
cdr
* `not': the cdr is interpreted as a negation of a condition.
@@ -1030,7 +1030,7 @@ Each condition is either:
* `or': the cdr is a list of recursive conditions, of which at
least one has to be met.
-If any of these conditions are satified for a buffer in the
+If any of these conditions are satisfied for a buffer in the
current project, it will be killed."
:type '(repeat (choice regexp function symbol
(cons :tag "Major mode"
@@ -1105,7 +1105,7 @@ identical. Only the buffers that match a condition in
`project-kill-buffer-conditions' will be killed. If NO-CONFIRM
is non-nil, the command will not ask the user for confirmation.
NO-CONFIRM is always nil when the command is invoked
-interactivly."
+interactively."
(interactive)
(let* ((pr (project-current t))
(bufs (project--buffers-to-kill pr)))
@@ -1225,7 +1225,7 @@ command to run when KEY is pressed. LABEL is used to
distinguish
the menu entries in the dispatch menu.")
(defun project--keymap-prompt ()
- "Return a prompt for the project swithing dispatch menu."
+ "Return a prompt for the project switching dispatch menu."
(mapconcat
(pcase-lambda (`(,key ,label))
(format "[%s] %s"
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index ccbcb08..7c3b611 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -2059,7 +2059,7 @@ that they are prioritized when looking for executables."
When this variable is non-nil, values are exported into remote
hosts PATH before starting processes. Values defined in
`python-shell-exec-path' will take precedence to paths defined
-here. Normally you wont use this variable directly unless you
+here. Normally you won't use this variable directly unless you
plan to ensure a particular set of paths to all Python shell
executed through tramp connections."
:version "25.1"
@@ -4130,7 +4130,7 @@ JUSTIFY should be used (if applicable) as in
`fill-paragraph'."
(goto-char (point-max)))
(point-marker)))
(multi-line-p
- ;; Docstring styles may vary for oneliners and multi-liners.
+ ;; Docstring styles may vary for one-liners and multi-liners.
(> (count-matches "\n" str-start-pos str-end-pos) 0))
(delimiters-style
(pcase python-fill-docstring-style
@@ -5129,21 +5129,22 @@ point's current `syntax-ppss'."
(>=
2
(let (last-backward-sexp-point)
- (while (save-excursion
- (python-nav-backward-sexp)
- (setq backward-sexp-point (point))
- (and (= indentation (current-indentation))
- ;; Make sure we're always moving point.
- ;; If we get stuck in the same position
- ;; on consecutive loop iterations,
- ;; bail out.
- (prog1 (not (eql last-backward-sexp-point
- backward-sexp-point))
- (setq last-backward-sexp-point
- backward-sexp-point))
- (looking-at-p
- (concat "[uU]?[rR]?"
- (python-rx string-delimiter)))))
+ (while (and (<= counter 2)
+ (save-excursion
+ (python-nav-backward-sexp)
+ (setq backward-sexp-point (point))
+ (and (= indentation (current-indentation))
+ ;; Make sure we're always moving point.
+ ;; If we get stuck in the same position
+ ;; on consecutive loop iterations,
+ ;; bail out.
+ (prog1 (not (eql last-backward-sexp-point
+ backward-sexp-point))
+ (setq last-backward-sexp-point
+ backward-sexp-point))
+ (looking-at-p
+ (concat "[uU]?[rR]?"
+ (python-rx string-delimiter))))))
;; Previous sexp was a string, restore point.
(goto-char backward-sexp-point)
(cl-incf counter))
@@ -5335,7 +5336,7 @@ To use `flake8' you would set this to (\"flake8\" \"-\")."
:group 'python-flymake
:type '(repeat string))
-;; The default regexp accomodates for older pyflakes, which did not
+;; The default regexp accommodates for older pyflakes, which did not
;; report the column number, and at the same time it's compatible with
;; flake8 output, although it may be redefined to explicitly match the
;; TYPE
@@ -5535,7 +5536,7 @@ REPORT-FN is Flymake's callback function."
(^ '(- (1+ (current-indentation))))))
(with-no-warnings
- ;; supress warnings about eldoc-documentation-function being obsolete
+ ;; suppress warnings about eldoc-documentation-function being obsolete
(if (null eldoc-documentation-function)
;; Emacs<25
(set (make-local-variable 'eldoc-documentation-function)
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 5a469bb..b1abefe 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -1284,7 +1284,7 @@ won't merge conflict."
(defcustom verilog-auto-inst-template-required nil
"If non-nil, when creating a port with AUTOINST, require a template.
-Any port which does not have a template will be ommitted from the
+Any port which does not have a template will be omitted from the
instantiation.
If nil, if a port is not templated it will be inserted to connect
diff --git a/lisp/replace.el b/lisp/replace.el
index a751822..035031a 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1674,7 +1674,7 @@ See also `multi-occur'."
(with-current-buffer occur-buf
;; Make the default-directory of the *Occur* buffer match that of
- ;; the buffer where the occurences come from
+ ;; the buffer where the occurrences come from
(setq default-directory source-buffer-default-directory)
(if (stringp nlines)
(fundamental-mode) ;; This is for collect operation.
@@ -2953,6 +2953,8 @@ characters."
(replace-dehighlight)
(save-excursion (recursive-edit))
(setq replaced t))
+ ((commandp def t)
+ (call-interactively def))
;; Note: we do not need to treat `exit-prefix'
;; specially here, since we reread
;; any unrecognized character.
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 92b80071..f9e3864 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -60,6 +60,13 @@
:type 'boolean
:group 'reveal)
+(defcustom reveal-auto-hide t
+ "Automatically hide revealed text when leaving it.
+If nil, the `reveal-hide-revealed' command can be useful to hide
+revealed text manually."
+ :type 'boolean
+ :version "28.1")
+
(defvar reveal-open-spots nil
"List of spots in the buffer which are open.
Each element has the form (WINDOW . OVERLAY).")
@@ -97,7 +104,8 @@ Each element has the form (WINDOW . OVERLAY).")
(cdr x))))
reveal-open-spots))))
(setq old-ols (reveal-open-new-overlays old-ols))
- (reveal-close-old-overlays old-ols)))))
+ (when reveal-auto-hide
+ (reveal-close-old-overlays old-ols))))))
(defun reveal-open-new-overlays (old-ols)
(let ((repeat t))
@@ -196,6 +204,14 @@ Each element has the form (WINDOW . OVERLAY).")
(delq (rassoc ol reveal-open-spots)
reveal-open-spots)))))))
+(defun reveal-hide-revealed ()
+ "Hide all revealed text.
+If there is revealed text under point, this command does not hide
+that text."
+ (interactive)
+ (let ((reveal-auto-hide t))
+ (reveal-post-command)))
+
(defvar reveal-mode-map
(let ((map (make-sparse-keymap)))
;; Override the default move-beginning-of-line and move-end-of-line
@@ -209,7 +225,9 @@ Each element has the form (WINDOW . OVERLAY).")
"Toggle uncloaking of invisible text near point (Reveal mode).
Reveal mode is a buffer-local minor mode. When enabled, it
-reveals invisible text around point."
+reveals invisible text around point.
+
+Also see the `reveal-auto-hide' variable."
:group 'reveal
:lighter (global-reveal-mode nil " Reveal")
:keymap reveal-mode-map
diff --git a/lisp/ses.el b/lisp/ses.el
index a2e6033..64d03a7 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -3672,7 +3672,7 @@ highlighted range in the spreadsheet."
;; 'rowcol' corresponding to 'ses-cell' property of symbol
;; 'sym'. Both must be the same.
(unless (eq sym old-name)
- (error "Spreadsheet is broken, both symbols %S and %S refering to cell
(%d,%d)" sym old-name row col))
+ (error "Spreadsheet is broken, both symbols %S and %S referring to cell
(%d,%d)" sym old-name row col))
(if new-rowcol
;; the new name is of A1 type, so we test that the coordinate
;; inferred from new name
@@ -3685,7 +3685,7 @@ highlighted range in the spreadsheet."
(puthash new-name rowcol ses--named-cell-hashmap))
(push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
(cl-pushnew rowcol ses--deferred-write :test #'equal)
- ;; Replace name by new name in formula of cells refering to renamed cell.
+ ;; Replace name by new name in formula of cells referring to renamed cell.
(dolist (ref (ses-cell-references cell))
(let* ((x (ses-sym-rowcol ref))
(xcell (ses-get-cell (car x) (cdr x))))
diff --git a/lisp/simple.el b/lisp/simple.el
index b00f6bb..d7486e5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -516,7 +516,7 @@ This hook is run by `delete-selection-uses-region-p', which
see.")
"Propertized string representing a hard newline character.")
(defun newline (&optional arg interactive)
- "Insert a newline, and move to left margin of the new line if it's blank.
+ "Insert a newline, and move to left margin of the new line.
With prefix argument ARG, insert that many newlines.
If `electric-indent-mode' is enabled, this indents the final new line
@@ -553,7 +553,7 @@ A non-nil INTERACTIVE argument means to run the
`post-self-insert-hook'."
(save-excursion
(goto-char beforepos)
(beginning-of-line)
- (and (looking-at "[ \t]$")
+ (and (looking-at "[ \t]+$")
(> (current-left-margin) 0)
(delete-region (point)
(line-end-position))))
@@ -2755,7 +2755,7 @@ Interactively, ARG is the prefix numeric argument and
defaults to 1."
(interactive "*p")
(cond
((not (undo--last-change-was-undo-p buffer-undo-list))
- (user-error "No undo to undo"))
+ (user-error "No undone changes to redo"))
(t
(let* ((ul buffer-undo-list)
(new-ul
@@ -7805,11 +7805,17 @@ a specialization of overwrite mode, entered by setting
the
Line numbers do not appear for very large buffers and buffers
with very long lines; see variables `line-number-display-limit'
-and `line-number-display-limit-width'."
+and `line-number-display-limit-width'.
+
+See `mode-line-position-line-format' for how this number is
+presented."
:init-value t :global t :group 'mode-line)
(define-minor-mode column-number-mode
- "Toggle column number display in the mode line (Column Number mode)."
+ "Toggle column number display in the mode line (Column Number mode).
+
+See `mode-line-position-column-format' for how this number is
+presented."
:global t :group 'mode-line)
(define-minor-mode size-indication-mode
diff --git a/lisp/so-long.el b/lisp/so-long.el
index f8a5cc9..6ae8d0a 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -833,7 +833,7 @@ available in Emacs versions < 27). For more information
refer to info node
`(emacs) Bidirectional Editing' and info node `(elisp) Bidirectional Display'.
Buffers are made read-only by default to prevent potentially-slow editing from
-occurring inadvertantly, as buffers with excessively long lines are likely not
+occurring inadvertently, as buffers with excessively long lines are likely not
intended to be edited manually."
:type '(alist :key-type (variable :tag "Variable")
:value-type (sexp :tag "Value"))
diff --git a/lisp/subr.el b/lisp/subr.el
index 3529771..795cf3e 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2349,13 +2349,19 @@ use `start-file-process'."
(if program
(list :command (cons program program-args))))))
-(defun process-lines (program &rest args)
+(defun process-lines-handling-status (program status-handler &rest args)
"Execute PROGRAM with ARGS, returning its output as a list of lines.
-Signal an error if the program returns with a non-zero exit status."
+If STATUS-HANDLER is non-NIL, it must be a function with one
+argument, which will be called with the exit status of the
+program before the output is collected. If STATUS-HANDLER is
+NIL, an error is signalled if the program returns with a non-zero
+exit status."
(with-temp-buffer
(let ((status (apply 'call-process program nil (current-buffer) nil args)))
- (unless (eq status 0)
- (error "%s exited with status %s" program status))
+ (if status-handler
+ (funcall status-handler status)
+ (unless (eq status 0)
+ (error "%s exited with status %s" program status)))
(goto-char (point-min))
(let (lines)
(while (not (eobp))
@@ -2366,6 +2372,18 @@ Signal an error if the program returns with a non-zero
exit status."
(forward-line 1))
(nreverse lines)))))
+(defun process-lines (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+Signal an error if the program returns with a non-zero exit status.
+Also see `process-lines-ignore-status'."
+ (apply #'process-lines-handling-status program nil args))
+
+(defun process-lines-ignore-status (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+The exit status of the program is ignored.
+Also see `process-lines'."
+ (apply #'process-lines-handling-status program #'identity args))
+
(defun process-live-p (process)
"Return non-nil if PROCESS is alive.
A process is considered alive if its status is `run', `open',
@@ -4416,6 +4434,40 @@ Unless optional argument INPLACE is non-nil, return a
new string."
(aset newstr i tochar)))
newstr))
+(defun replace-in-string (fromstring tostring instring)
+ "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs.
+This function returns a freshly created string."
+ (declare (side-effect-free t))
+ (let ((i 0)
+ (start 0)
+ (result nil))
+ (while (< i (length instring))
+ (if (eq (aref instring i)
+ (aref fromstring 0))
+ ;; See if we're in a match.
+ (let ((ii i)
+ (if 0))
+ (while (and (< ii (length instring))
+ (< if (length fromstring))
+ (eq (aref instring ii)
+ (aref fromstring if)))
+ (setq ii (1+ ii)
+ if (1+ if)))
+ (if (not (= if (length fromstring)))
+ ;; We didn't have a match after all.
+ (setq i (1+ i))
+ ;; We had one, so gather the previous part and the
+ ;; substitution.
+ (when (not (= start i))
+ (push (substring instring start i) result))
+ (push tostring result)
+ (setq i ii
+ start ii)))
+ (setq i (1+ i))))
+ (when (not (= start i))
+ (push (substring instring start i) result))
+ (apply #'concat (nreverse result))))
+
(defun replace-regexp-in-string (regexp rep string &optional
fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index d8f932e..9c6b9cb 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -801,7 +801,6 @@ After the tab is created, the hooks in
(nth to-index tabs)))
(cond
- (tab-bar-mode)
((eq tab-bar-show t)
(tab-bar-mode 1))
((and (natnump tab-bar-show)
@@ -1567,6 +1566,20 @@ Like \\[find-file-other-frame] (which see), but creates
a new tab."
value)
(switch-to-buffer-other-tab value))))
+(defun find-file-read-only-other-tab (filename &optional wildcards)
+ "Edit file FILENAME, in another tab, but don't allow changes.
+Like \\[find-file-other-frame] (which see), but creates a new tab.
+
+Like \\[find-file-other-tab], but marks buffer as read-only.
+Use \\[read-only-mode] to permit editing."
+ (interactive
+ (find-file-read-args "Find file read-only in other tab: "
+ (confirm-nonexistent-file-or-buffer)))
+ (find-file--read-only (lambda (filename wildcards)
+ (window-buffer
+ (find-file-other-tab filename wildcards)))
+ filename wildcards))
+
(defun other-tab-prefix ()
"Display the buffer of the next command in a new tab.
The next buffer is the buffer displayed by the next command invoked
@@ -1596,6 +1609,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(define-key tab-prefix-map "b" 'switch-to-buffer-other-tab)
(define-key tab-prefix-map "f" 'find-file-other-tab)
(define-key tab-prefix-map "\C-f" 'find-file-other-tab)
+(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab)
(define-key tab-prefix-map "t" 'other-tab-prefix)
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 51ed3a2..e862e35 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -529,7 +529,21 @@ in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer."
- :lighter flyspell-mode-line-string
+ :lighter (flyspell-mode-line-string
+ ;; If `flyspell-mode-line-string' is nil, then nothing of
+ ;; the following is displayed in the mode line.
+ ((:propertize flyspell-mode-line-string)
+ (:propertize
+ (:eval
+ (concat "/" (substring (or ispell-local-dictionary
+ ispell-dictionary
+ "--")
+ 0 2)))
+ face bold
+ help-echo "mouse-1: Change dictionary"
+ local-map (keymap
+ (mode-line keymap
+ (mouse-1 . ispell-change-dictionary))))))
:keymap flyspell-mode-map
:group 'flyspell
(if flyspell-mode
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index e0ef786..f3d8695 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1188,10 +1188,9 @@ and move to the line in the SGML document that caused
it."
(or sgml-saved-validate-command
(concat sgml-validate-command
" "
- (shell-quote-argument
- (let ((name (buffer-file-name)))
- (and name
- (file-name-nondirectory name)))))))))
+ (when-let ((name (buffer-file-name)))
+ (shell-quote-argument
+ (file-name-nondirectory name))))))))
(setq sgml-saved-validate-command command)
(save-some-buffers (not compilation-ask-about-save) nil)
(compilation-start command))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index cfe6ce5..c7bf687 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -3279,7 +3279,7 @@ Currently this method is for LaTeX only."
(with-temp-buffer
(insert line)
(goto-char (point-min))
- (while (re-search-forward
"\\([#$~_^%{}]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
+ (while (re-search-forward
"\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
(if (match-beginning 1)
(save-excursion
(goto-char (match-beginning 1))
diff --git a/lisp/time.el b/lisp/time.el
index e2fab4a..cb3a847 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -588,19 +588,23 @@ To turn off the world time display, go to the window and
type `\\[quit-window]'.
(world-clock-cancel-timer)))
;;;###autoload
-(defun emacs-uptime (&optional format)
+(defun emacs-uptime (&optional format here)
"Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
-For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"."
- (interactive)
+For example, the Unix uptime command format is \"%D, %z%2h:%.2m\".
+If the optional argument HERE is non-nil, insert string at
+point."
+ (interactive "i\nP")
(let ((str
(format-seconds (or format "%Y, %D, %H, %M, %z%S")
(time-convert
(time-since before-init-time)
'integer))))
- (if (called-interactively-p 'interactive)
- (message "%s" str)
- str)))
+ (if here
+ (insert str)
+ (if (called-interactively-p 'interactive)
+ (message "%s" str)
+ str))))
;;;###autoload
(defun emacs-init-time ()
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 70e8ece..e6a1b35 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -104,6 +104,14 @@ would have the following buffer names in the various
styles:
post-forward-angle-brackets name<bar/mumble> name<quux/mumble>
nil name name<2>
+The value can be set to a customized function with two arguments
+BASE and EXTRA-STRINGS where BASE is a string and EXTRA-STRINGS
+is a list of strings. For example the current implementation for
+post-forward-angle-brackets could be:
+
+(defun my-post-forward-angle-brackets (base extra-string)
+ (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\"))
+
The \"mumble\" part may be stripped as well, depending on the
setting of `uniquify-strip-common-suffix'. For more options that
you can set, browse the `uniquify' custom group."
@@ -111,6 +119,7 @@ you can set, browse the `uniquify' custom group."
(const reverse)
(const post-forward)
(const post-forward-angle-brackets)
+ (function :tag "Other")
(const :tag "numeric suffixes" nil))
:version "24.4"
:require 'uniquify)
@@ -364,20 +373,22 @@ in `uniquify-list-buffers-directory-modes', otherwise
returns nil."
(cond
((null extra-string) base)
((string-equal base "") ;Happens for dired buffers on the root directory.
- (mapconcat 'identity extra-string "/"))
+ (mapconcat #'identity extra-string "/"))
((eq uniquify-buffer-name-style 'reverse)
- (mapconcat 'identity
+ (mapconcat #'identity
(cons base (nreverse extra-string))
(or uniquify-separator "\\")))
((eq uniquify-buffer-name-style 'forward)
- (mapconcat 'identity (nconc extra-string (list base))
+ (mapconcat #'identity (nconc extra-string (list base))
"/"))
((eq uniquify-buffer-name-style 'post-forward)
(concat base (or uniquify-separator "|")
- (mapconcat 'identity extra-string "/")))
+ (mapconcat #'identity extra-string "/")))
((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
- (concat base "<" (mapconcat 'identity extra-string "/")
+ (concat base "<" (mapconcat #'identity extra-string "/")
">"))
+ ((functionp uniquify-buffer-name-style)
+ (funcall uniquify-buffer-name-style base extra-string))
(t (error "Bad value for uniquify-buffer-name-style: %s"
uniquify-buffer-name-style)))))
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 4698880..b7f17bf 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -258,6 +258,8 @@ This requires the external program `diff' to be in your
`exec-path'."
(interactive "bBuffer: ")
(let ((buf (get-buffer (or buffer (current-buffer)))))
(with-current-buffer (or (buffer-base-buffer buf) buf)
+ (unless buffer-file-name
+ (error "Buffer is not visiting a file"))
(diff buffer-file-name (current-buffer) nil 'noasync))))
;;;###autoload
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 52878ba..e28d857 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -4129,10 +4129,10 @@ Mail anyway? (y or n) ")
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ (format "\nCtl buffer: %S\n" ediff-control-buffer))
- (ediff-print-diff-vector (intern "ediff-difference-vector-A"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-B"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-C"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor"))
+ (ediff-print-diff-vector 'ediff-difference-vector-A)
+ (ediff-print-diff-vector 'ediff-difference-vector-B)
+ (ediff-print-diff-vector 'ediff-difference-vector-C)
+ (ediff-print-diff-vector 'ediff-difference-vector-Ancestor)
))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 6c21900..cdf8ab9 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -451,11 +451,7 @@ If NOINSERT, ignore elements on ENTRIES which are not in
the ewoc."
(setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1
entry))
(setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2
entry))
(setf (vc-dir-fileinfo->needs-update (ewoc-data node))
nil)
- ;; `ewoc-invalidate' will kill line and insert new text,
- ;; let's keep point column.
- (let ((p (point)))
- (ewoc-invalidate vc-ewoc node)
- (goto-char p)))
+ (ewoc-invalidate vc-ewoc node))
;; If the state is nil, the file does not exist
;; anymore, so remember the entry so we can remove
;; it after we are done inserting all ENTRIES.
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 84aeb0a..6ff6951 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1707,12 +1707,13 @@ This command shares argument histories with \\[rgrep]
and \\[grep]."
(vc-resynch-buffer (vc-git-root default-directory) t t))
(defun vc-git-stash-list ()
- (delete
- ""
- (split-string
- (replace-regexp-in-string
- "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
- "\n")))
+ (when-let ((out (vc-git--run-command-string nil "stash" "list")))
+ (delete
+ ""
+ (split-string
+ (replace-regexp-in-string
+ "^stash@" " " out)
+ "\n"))))
(defun vc-git-stash-get-at-point (point)
(save-excursion
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 4cbd265..3852a64 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1895,9 +1895,16 @@ saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-diff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
- (vc-diff-internal t (vc-deduce-fileset t) nil nil
- (called-interactively-p 'interactive))))
+ (let ((fileset (vc-deduce-fileset t)))
+ (vc-buffer-sync-fileset fileset not-urgent)
+ (vc-diff-internal t fileset nil nil
+ (called-interactively-p 'interactive)))))
+
+(defun vc-buffer-sync-fileset (fileset not-urgent)
+ (dolist (filename (cadr fileset))
+ (when-let ((buffer (find-buffer-visiting filename)))
+ (with-current-buffer buffer
+ (vc-buffer-sync not-urgent)))))
;;;###autoload
(defun vc-diff-mergebase (_files rev1 rev2)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 097e769..53f918c 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -187,7 +187,7 @@ if that value is non-nil."
(define-widget 'widget-browse 'push-button
"Button for creating a widget browser.
-The :value of the widget shuld be the widget to be browsed."
+The :value of the widget should be the widget to be browsed."
:format "%[[%v]%]"
:value-create 'widget-browse-value-create
:action 'widget-browse-action)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index bc2afc6..13d850a 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -973,86 +973,92 @@ Note that such modes will need to require wid-edit.")
"If non-nil, `widget-button-click' moves point to a button after invoking it.
If nil, point returns to its original position after invoking a button.")
+(defun widget-button--check-and-call-button (event button)
+ "Call BUTTON if BUTTON is a widget and EVENT is correct for it.
+If nothing was called, return non-nil."
+ (let* ((oevent event)
+ (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ (pos (widget-event-point event))
+ newpoint)
+ (catch 'button-press-cancelled
+ ;; Mouse click on a widget button. Do the following
+ ;; in a save-excursion so that the click on the button
+ ;; doesn't change point.
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let* ((overlay (widget-get button :button-overlay))
+ (pressed-face (or (widget-get button :pressed-face)
+ widget-button-pressed-face))
+ (face (overlay-get overlay 'face))
+ (mouse-face (overlay-get overlay 'mouse-face)))
+ (unwind-protect
+ ;; Read events, including mouse-movement
+ ;; events, waiting for a release event. If we
+ ;; began with a mouse-1 event and receive a
+ ;; movement event, that means the user wants
+ ;; to perform drag-selection, so cancel the
+ ;; button press and do the default mouse-1
+ ;; action. For mouse-2, just highlight/
+ ;; unhighlight the button the mouse was
+ ;; initially on when we move over it.
+ (save-excursion
+ (when face ; avoid changing around image
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (unless (widget-apply button :mouse-down-action event)
+ (let ((track-mouse t))
+ (while (not (widget-button-release-event-p event))
+ (setq event (read-event))
+ (when (and mouse-1 (mouse-movement-p event))
+ (push event unread-command-events)
+ (setq event oevent)
+ (throw 'button-press-cancelled t))
+ (unless (or (integerp event)
+ (memq (car event)
+ '(switch-frame select-window))
+ (eq (car event) 'scroll-bar-movement))
+ (setq pos (widget-event-point event))
+ (if (and pos
+ (eq (get-char-property pos 'button)
+ button))
+ (when face
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))))
+
+ ;; When mouse is released over the button, run
+ ;; its action function.
+ (when (and pos (eq (get-char-property pos 'button) button))
+ (goto-char pos)
+ (widget-apply-action button event)
+ (if widget-button-click-moves-point
+ (setq newpoint (point)))))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))
+
+ (when newpoint
+ (goto-char newpoint)))
+ nil)))
+
(defun widget-button-click (event)
"Invoke the button that the mouse is pointing at."
(interactive "e")
(if (widget-event-point event)
- (let* ((oevent event)
- (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ (let* ((mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
(pos (widget-event-point event))
(start (event-start event))
- (button (get-char-property
+ (button (get-char-property
pos 'button (and (windowp (posn-window start))
- (window-buffer (posn-window start)))))
- newpoint)
- (when (or (null button)
- (catch 'button-press-cancelled
- ;; Mouse click on a widget button. Do the following
- ;; in a save-excursion so that the click on the button
- ;; doesn't change point.
- (save-selected-window
- (select-window (posn-window (event-start event)))
- (save-excursion
- (goto-char (posn-point (event-start event)))
- (let* ((overlay (widget-get button :button-overlay))
- (pressed-face (or (widget-get button :pressed-face)
- widget-button-pressed-face))
- (face (overlay-get overlay 'face))
- (mouse-face (overlay-get overlay 'mouse-face)))
- (unwind-protect
- ;; Read events, including mouse-movement
- ;; events, waiting for a release event. If we
- ;; began with a mouse-1 event and receive a
- ;; movement event, that means the user wants
- ;; to perform drag-selection, so cancel the
- ;; button press and do the default mouse-1
- ;; action. For mouse-2, just highlight/
- ;; unhighlight the button the mouse was
- ;; initially on when we move over it.
- (save-excursion
- (when face ; avoid changing around image
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face pressed-face))
- (unless (widget-apply button :mouse-down-action event)
- (let ((track-mouse t))
- (while (not (widget-button-release-event-p event))
- (setq event (read-event))
- (when (and mouse-1 (mouse-movement-p event))
- (push event unread-command-events)
- (setq event oevent)
- (throw 'button-press-cancelled t))
- (unless (or (integerp event)
- (memq (car event) '(switch-frame
select-window))
- (eq (car event)
'scroll-bar-movement))
- (setq pos (widget-event-point event))
- (if (and pos
- (eq (get-char-property pos 'button)
- button))
- (when face
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face
pressed-face))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face
mouse-face))))))
-
- ;; When mouse is released over the button, run
- ;; its action function.
- (when (and pos (eq (get-char-property pos 'button)
button))
- (goto-char pos)
- (widget-apply-action button event)
- (if widget-button-click-moves-point
- (setq newpoint (point)))))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face))))
-
- (if newpoint (goto-char newpoint))
- ;; This loses if the widget action switches windows. -- cyd
- ;; (unless (pos-visible-in-window-p (widget-event-point event))
- ;; (mouse-set-point event)
- ;; (beginning-of-line)
- ;; (recenter))
- )
- nil))
- (let ((up t) command)
+ (window-buffer (posn-window start))))))
+
+ (when (and (widget-get button :button-overlay)
+ (or (null button)
+ (widget-button--check-and-call-button event button)))
+ (let ((up t)
+ command)
;; Mouse click not on a widget button. Find the global
;; command to run, and check whether it is bound to an
;; up event.
@@ -1911,6 +1917,16 @@ If END is omitted, it defaults to the length of LIST."
"Show the variable specified by WIDGET."
(describe-variable (widget-value widget)))
+;;; The `face-link' Widget.
+
+(define-widget 'face-link 'link
+ "A link to an Emacs face."
+ :action 'widget-face-link-action)
+
+(defun widget-face-link-action (widget &optional _event)
+ "Show the variable specified by WIDGET."
+ (describe-face (widget-value widget)))
+
;;; The `file-link' Widget.
(define-widget 'file-link 'link
diff --git a/lisp/window.el b/lisp/window.el
index bb34a6d..9aca94d 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2172,7 +2172,8 @@ the font."
(with-selected-window (window-normalize-window window t)
(let* ((window-width (window-body-width window t))
(font-width (window-font-width window face))
- (ncols (/ window-width font-width)))
+ (ncols (- (/ window-width font-width)
+ (ceiling (line-number-display-width 'columns)))))
(if (and (display-graphic-p)
overflow-newline-into-fringe
(not
@@ -10184,4 +10185,6 @@ displaying that processes's buffer."
(define-key ctl-x-4-map "1" 'same-window-prefix)
(define-key ctl-x-4-map "4" 'other-window-prefix)
+(provide 'window)
+
;;; window.el ends here
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 2b9fab5..362d29b 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -237,7 +237,10 @@ which is the \"1006\" extension implemented in Xterm >=
277."
(xterm-mouse--read-event-sequence extension))
(t
(error "Unsupported XTerm mouse protocol")))))
- (when click
+ (when (and click
+ ;; In very obscure circumstances, the click may become
+ ;; invalid (see bug#17378).
+ (>= (nth 1 click) 0))
(let* ((type (nth 0 click))
(x (nth 1 click))
(y (nth 2 click))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 0743208..caf57ae 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -217,7 +217,7 @@ If N is omitted or nil, scroll down by one line."
(defun xwidget-webkit-scroll-forward (&optional n)
"Scroll webkit horizontally by N chars.
The width of char is calculated with `window-font-width'.
-If N is ommited or nil, scroll forwards by one char."
+If N is omitted or nil, scroll forwards by one char."
(interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
@@ -227,7 +227,7 @@ If N is ommited or nil, scroll forwards by one char."
(defun xwidget-webkit-scroll-backward (&optional n)
"Scroll webkit back by N chars.
The width of char is calculated with `window-font-width'.
-If N is ommited or nil, scroll backwards by one char."
+If N is omitted or nil, scroll backwards by one char."
(interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
@@ -318,7 +318,7 @@ If non-nil, plugins are enabled. Otherwise, disabled."))
(defcustom xwidget-webkit-download-dir "~/Downloads/"
"Directory where download file saved."
- :version "27.1"
+ :version "28.1"
:type 'file)
(defun xwidget-webkit-save-as-file (url mime-type file-name)
@@ -348,7 +348,7 @@ If non-nil, use a new xwidget webkit session after bookmark
jump.
Otherwise, it will use `xwidget-webkit-last-session'.
When you set this variable to nil, consider further customization with
`xwidget-webkit-last-session-buffer'."
- :version "27.1"
+ :version "28.1"
:type 'boolean)
(defun xwidget-webkit-bookmark-make-record ()
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index 4cbae16..2c754f9 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -39,6 +39,32 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# undef __POSIX_2008_DEPRECATED
# define __POSIX_2008_DEPRECATED
# endif
+/* Old versions of MinGW don't have these in the w32api headers, and
+ Gnulib uses them in some files. */
+# ifndef _WIN32_WINNT_WIN2K
+# define _WIN32_WINNT_WIN2K 0x0500
+# endif
+# ifndef _WIN32_WINNT_WINXP
+# define _WIN32_WINNT_WINXP 0x0501
+# endif
+# ifndef _WIN32_WINNT_WS03
+# define _WIN32_WINNT_WS03 0x0502
+# endif
+# ifndef _WIN32_WINNT_VISTA
+# define _WIN32_WINNT_VISTA 0x0600
+# endif
+# ifndef _WIN32_WINNT_WIN7
+# define _WIN32_WINNT_WIN7 0x0601
+# endif
+# ifndef _WIN32_WINNT_WIN8
+# define _WIN32_WINNT_WIN8 0x0602
+# endif
+# ifndef _WIN32_WINNT_WINBLUE
+# define _WIN32_WINNT_WINBLUE 0x0603
+# endif
+# ifndef _WIN32_WINNT_WIN10
+# define _WIN32_WINNT_WIN10 0x0A00
+# endif
#endif
/* #undef const */
diff --git a/src/data.c b/src/data.c
index 85c73b4..3f03526 100644
--- a/src/data.c
+++ b/src/data.c
@@ -966,6 +966,15 @@ Value, if non-nil, is a list (interactive SPEC). */)
if (PVSIZE (fun) > COMPILED_INTERACTIVE)
return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
}
+#ifdef HAVE_MODULES
+ else if (MODULE_FUNCTIONP (fun))
+ {
+ Lisp_Object form
+ = module_function_interactive_form (XMODULE_FUNCTION (fun));
+ if (! NILP (form))
+ return form;
+ }
+#endif
else if (AUTOLOADP (fun))
return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
else if (CONSP (fun))
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 02af244..4c5ab48 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -129,36 +129,23 @@ static bool xd_in_read_queued_messages = 0;
#define XD_BASIC_DBUS_TYPE(type) \
(dbus_type_is_valid (type) && dbus_type_is_basic (type))
#else
-#ifdef DBUS_TYPE_UNIX_FD
-#define XD_BASIC_DBUS_TYPE(type) \
- ((type == DBUS_TYPE_BYTE) \
- || (type == DBUS_TYPE_BOOLEAN) \
- || (type == DBUS_TYPE_INT16) \
- || (type == DBUS_TYPE_UINT16) \
- || (type == DBUS_TYPE_INT32) \
- || (type == DBUS_TYPE_UINT32) \
- || (type == DBUS_TYPE_INT64) \
- || (type == DBUS_TYPE_UINT64) \
- || (type == DBUS_TYPE_DOUBLE) \
- || (type == DBUS_TYPE_STRING) \
- || (type == DBUS_TYPE_OBJECT_PATH) \
- || (type == DBUS_TYPE_SIGNATURE) \
- || (type == DBUS_TYPE_UNIX_FD))
-#else
#define XD_BASIC_DBUS_TYPE(type) \
- ((type == DBUS_TYPE_BYTE) \
- || (type == DBUS_TYPE_BOOLEAN) \
- || (type == DBUS_TYPE_INT16) \
- || (type == DBUS_TYPE_UINT16) \
- || (type == DBUS_TYPE_INT32) \
- || (type == DBUS_TYPE_UINT32) \
- || (type == DBUS_TYPE_INT64) \
- || (type == DBUS_TYPE_UINT64) \
- || (type == DBUS_TYPE_DOUBLE) \
- || (type == DBUS_TYPE_STRING) \
- || (type == DBUS_TYPE_OBJECT_PATH) \
- || (type == DBUS_TYPE_SIGNATURE))
+ ((type == DBUS_TYPE_BYTE) \
+ || (type == DBUS_TYPE_BOOLEAN) \
+ || (type == DBUS_TYPE_INT16)
\
+ || (type == DBUS_TYPE_UINT16) \
+ || (type == DBUS_TYPE_INT32)
\
+ || (type == DBUS_TYPE_UINT32) \
+ || (type == DBUS_TYPE_INT64)
\
+ || (type == DBUS_TYPE_UINT64) \
+ || (type == DBUS_TYPE_DOUBLE) \
+ || (type == DBUS_TYPE_STRING) \
+ || (type == DBUS_TYPE_OBJECT_PATH) \
+ || (type == DBUS_TYPE_SIGNATURE) \
+#ifdef DBUS_TYPE_UNIX_FD
+ || (type == DBUS_TYPE_UNIX_FD) \
#endif
+ )
#endif
/* This was a macro. On Solaris 2.11 it was said to compile for
@@ -192,6 +179,33 @@ xd_symbol_to_dbus_type (Lisp_Object object)
: DBUS_TYPE_INVALID);
}
+/* Determine the Lisp symbol of DBusType. */
+static Lisp_Object
+xd_dbus_type_to_symbol (int type)
+{
+ return
+ (type == DBUS_TYPE_BYTE) ? QCbyte
+ : (type == DBUS_TYPE_BOOLEAN) ? QCboolean
+ : (type == DBUS_TYPE_INT16) ? QCint16
+ : (type == DBUS_TYPE_UINT16) ? QCuint16
+ : (type == DBUS_TYPE_INT32) ? QCint32
+ : (type == DBUS_TYPE_UINT32) ? QCuint32
+ : (type == DBUS_TYPE_INT64) ? QCint64
+ : (type == DBUS_TYPE_UINT64) ? QCuint64
+ : (type == DBUS_TYPE_DOUBLE) ? QCdouble
+ : (type == DBUS_TYPE_STRING) ? QCstring
+ : (type == DBUS_TYPE_OBJECT_PATH) ? QCobject_path
+ : (type == DBUS_TYPE_SIGNATURE) ? QCsignature
+#ifdef DBUS_TYPE_UNIX_FD
+ : (type == DBUS_TYPE_UNIX_FD) ? QCunix_fd
+#endif
+ : (type == DBUS_TYPE_ARRAY) ? QCarray
+ : (type == DBUS_TYPE_VARIANT) ? QCvariant
+ : (type == DBUS_TYPE_STRUCT) ? QCstruct
+ : (type == DBUS_TYPE_DICT_ENTRY) ? QCdict_entry
+ : Qnil;
+}
+
/* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
#define XD_DBUS_TYPE_P(object) \
(SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) !=
DBUS_TYPE_INVALID)))
@@ -360,8 +374,8 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
break;
case DBUS_TYPE_BOOLEAN:
- if (!EQ (object, Qt) && !NILP (object))
- wrong_type_argument (intern ("booleanp"), object);
+ /* Any non-nil object will be regarded as `t', so we don't apply
+ further type check. */
sprintf (signature, "%c", dtype);
break;
@@ -816,7 +830,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
val = val & 0xFF;
XD_DEBUG_MESSAGE ("%c %u", dtype, val);
- return make_fixnum (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
}
case DBUS_TYPE_BOOLEAN:
@@ -824,7 +838,8 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_bool_t val;
dbus_message_iter_get_basic (iter, &val);
XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
- return (val == FALSE) ? Qnil : Qt;
+ return list2 (xd_dbus_type_to_symbol (dtype),
+ (val == FALSE) ? Qnil : Qt);
}
case DBUS_TYPE_INT16:
@@ -834,7 +849,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
- return make_fixnum (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
}
case DBUS_TYPE_UINT16:
@@ -844,7 +859,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
- return make_fixnum (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
}
case DBUS_TYPE_INT32:
@@ -854,7 +869,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_UINT32:
@@ -867,7 +882,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_INT64:
@@ -876,7 +891,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
intmax_t pval = val;
XD_DEBUG_MESSAGE ("%c %"PRIdMAX, dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_UINT64:
@@ -885,7 +900,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
uintmax_t pval = val;
XD_DEBUG_MESSAGE ("%c %"PRIuMAX, dtype, pval);
- return INT_TO_INTEGER (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
}
case DBUS_TYPE_DOUBLE:
@@ -893,7 +908,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
double val;
dbus_message_iter_get_basic (iter, &val);
XD_DEBUG_MESSAGE ("%c %f", dtype, val);
- return make_float (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), make_float (val));
}
case DBUS_TYPE_STRING:
@@ -903,7 +918,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
char *val;
dbus_message_iter_get_basic (iter, &val);
XD_DEBUG_MESSAGE ("%c %s", dtype, val);
- return build_string (val);
+ return list2 (xd_dbus_type_to_symbol (dtype), build_string (val));
}
case DBUS_TYPE_ARRAY:
@@ -923,7 +938,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_next (&subiter);
}
XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
- return Fnreverse (result);
+ return Fcons (xd_dbus_type_to_symbol (dtype), Fnreverse (result));
}
default:
@@ -1254,6 +1269,10 @@ The following usages are expected:
(dbus-message-internal
dbus-message-type-error BUS SERVICE SERIAL ERROR-NAME &rest ARGS)
+`dbus-check-arguments': (does not send a message)
+ (dbus-message-internal
+ dbus-message-type-invalid BUS SERVICE &rest ARGS)
+
usage: (dbus-message-internal &rest REST) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
@@ -1271,7 +1290,7 @@ usage: (dbus-message-internal &rest REST) */)
dbus_uint32_t serial = 0;
unsigned int ui_serial;
int timeout = -1;
- ptrdiff_t count;
+ ptrdiff_t count, count0;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Initialize parameters. */
@@ -1281,7 +1300,7 @@ usage: (dbus-message-internal &rest REST) */)
handler = Qnil;
CHECK_FIXNAT (message_type);
- if (! (DBUS_MESSAGE_TYPE_INVALID < XFIXNAT (message_type)
+ if (! (DBUS_MESSAGE_TYPE_INVALID <= XFIXNAT (message_type)
&& XFIXNAT (message_type) < DBUS_NUM_MESSAGE_TYPES))
XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
mtype = XFIXNAT (message_type);
@@ -1296,13 +1315,16 @@ usage: (dbus-message-internal &rest REST) */)
handler = args[6];
count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
}
- else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
+ || (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t));
if (mtype == DBUS_MESSAGE_TYPE_ERROR)
error_name = args[4];
count = (mtype == DBUS_MESSAGE_TYPE_ERROR) ? 5 : 4;
}
+ else /* DBUS_MESSAGE_TYPE_INVALID */
+ count = 3;
/* Check parameters. */
XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
@@ -1352,7 +1374,7 @@ usage: (dbus-message-internal &rest REST) */)
XD_OBJECT_TO_STRING (service),
ui_serial);
break;
- default: /* DBUS_MESSAGE_TYPE_ERROR */
+ case DBUS_MESSAGE_TYPE_ERROR:
ui_serial = serial;
XD_DEBUG_MESSAGE ("%s %s %s %u %s",
XD_MESSAGE_TYPE_TO_STRING (mtype),
@@ -1360,17 +1382,25 @@ usage: (dbus-message-internal &rest REST) */)
XD_OBJECT_TO_STRING (service),
ui_serial,
XD_OBJECT_TO_STRING (error_name));
+ break;
+ default: /* DBUS_MESSAGE_TYPE_INVALID */
+ XD_DEBUG_MESSAGE ("%s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service));
}
/* Retrieve bus address. */
connection = xd_get_connection_address (bus);
- /* Create the D-Bus message. */
- dmessage = dbus_message_new (mtype);
+ /* Create the D-Bus message. Since DBUS_MESSAGE_TYPE_INVALID is not
+ a valid message type, we mockup it with DBUS_MESSAGE_TYPE_SIGNAL. */
+ dmessage = dbus_message_new
+ ((mtype == DBUS_MESSAGE_TYPE_INVALID) ? DBUS_MESSAGE_TYPE_SIGNAL : mtype);
if (dmessage == NULL)
XD_SIGNAL1 (build_string ("Unable to create a new message"));
- if (STRINGP (service))
+ if ((STRINGP (service)) && (mtype != DBUS_MESSAGE_TYPE_INVALID))
{
if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
/* Set destination. */
@@ -1412,7 +1442,8 @@ usage: (dbus-message-internal &rest REST) */)
XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
}
- else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
+ || (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
if (!dbus_message_set_reply_serial (dmessage, serial))
XD_SIGNAL1 (build_string ("Unable to create a return message"));
@@ -1434,6 +1465,7 @@ usage: (dbus-message-internal &rest REST) */)
dbus_message_iter_init_append (dmessage, &iter);
/* Append parameters to the message. */
+ count0 = count - 1;
for (; count < nargs; ++count)
{
dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
@@ -1441,15 +1473,17 @@ usage: (dbus-message-internal &rest REST) */)
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s Parameter%"pD"d: %s",
+ count - count0,
XD_OBJECT_TO_STRING (args[count]),
+ count + 1 - count0,
XD_OBJECT_TO_STRING (args[count+1]));
++count;
}
else
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s", count - count0,
XD_OBJECT_TO_STRING (args[count]));
}
@@ -1460,7 +1494,10 @@ usage: (dbus-message-internal &rest REST) */)
xd_append_arg (dtype, args[count], &iter);
}
- if (!NILP (handler))
+ if (mtype == DBUS_MESSAGE_TYPE_INVALID)
+ result = Qt;
+
+ else if (!NILP (handler))
{
/* Send the message. The message is just added to the outgoing
message queue. */
@@ -1485,7 +1522,8 @@ usage: (dbus-message-internal &rest REST) */)
result = Qnil;
}
- XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
+ if (mtype != DBUS_MESSAGE_TYPE_INVALID)
+ XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
/* Cleanup. */
dbus_message_unref (dmessage);
@@ -1533,7 +1571,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
}
/* Read message type, message serial, unique name, object path,
- interface and member from the message. */
+ interface, member and error name from the message. */
mtype = dbus_message_get_type (dmessage);
ui_serial = serial =
((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
@@ -1544,7 +1582,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
path = dbus_message_get_path (dmessage);
interface = dbus_message_get_interface (dmessage);
member = dbus_message_get_member (dmessage);
- error_name =dbus_message_get_error_name (dmessage);
+ error_name = dbus_message_get_error_name (dmessage);
XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s",
XD_MESSAGE_TYPE_TO_STRING (mtype),
@@ -1572,9 +1610,11 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
- event.arg = Fcons (value,
- (mtype == DBUS_MESSAGE_TYPE_ERROR)
- ? (Fcons (build_string (error_name), args)) : args);
+ event.arg =
+ Fcons (value,
+ (mtype == DBUS_MESSAGE_TYPE_ERROR)
+ ? Fcons (list2 (QCstring, build_string (error_name)), args)
+ : args);
}
else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
@@ -1828,7 +1868,7 @@ wildcard then.
OBJECT is either the handler to be called when a D-Bus message, which
matches the key criteria, arrives (TYPE `:method' and `:signal'), or a
-list (ACCESS EMITS-SIGNAL SIGNATURE VALUE) for TYPE `:property'.
+list (ACCESS EMITS-SIGNAL VALUE) for TYPE `:property'.
For entries of type `:signal', there is also a fifth element RULE,
which keeps the match string the signal is registered with.
diff --git a/src/dispextern.h b/src/dispextern.h
index 956ca96..0d982f7 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -102,7 +102,7 @@ typedef XImage *Emacs_Pix_Context;
#endif
#ifdef USE_CAIRO
-/* Mininal version of XImage. */
+/* Minimal version of XImage. */
typedef struct
{
int width, height; /* size of image */
@@ -1744,6 +1744,7 @@ struct face
bool_bf tty_italic_p : 1;
bool_bf tty_underline_p : 1;
bool_bf tty_reverse_p : 1;
+ bool_bf tty_strike_through_p : 1;
/* True means that colors of this face may not be freed because they
have been copied bitwise from a base face (see
@@ -3290,6 +3291,7 @@ enum tool_bar_item_image
#define TTY_CAP_BOLD 0x04
#define TTY_CAP_DIM 0x08
#define TTY_CAP_ITALIC 0x10
+#define TTY_CAP_STRIKE_THROUGH 0x20
/***********************************************************************
diff --git a/src/emacs-module.c b/src/emacs-module.c
index a0bab11..3581daa 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -551,7 +551,7 @@ struct Lisp_Module_Function
union vectorlike_header header;
/* Fields traced by GC; these must come first. */
- Lisp_Object documentation;
+ Lisp_Object documentation, interactive_form;
/* Fields ignored by GC. */
ptrdiff_t min_arity, max_arity;
@@ -564,7 +564,7 @@ static struct Lisp_Module_Function *
allocate_module_function (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
- documentation, PVEC_MODULE_FUNCTION);
+ interactive_form, PVEC_MODULE_FUNCTION);
}
#define XSET_MODULE_FUNCTION(var, ptr) \
@@ -630,6 +630,24 @@ module_finalize_function (const struct
Lisp_Module_Function *func)
func->finalizer (func->data);
}
+static void
+module_make_interactive (emacs_env *env, emacs_value function, emacs_value
spec)
+{
+ MODULE_FUNCTION_BEGIN ();
+ Lisp_Object lisp_fun = value_to_lisp (function);
+ CHECK_MODULE_FUNCTION (lisp_fun);
+ Lisp_Object lisp_spec = value_to_lisp (spec);
+ /* Normalize (interactive nil) to (interactive). */
+ XMODULE_FUNCTION (lisp_fun)->interactive_form
+ = NILP (lisp_spec) ? list1 (Qinteractive) : list2 (Qinteractive,
lisp_spec);
+}
+
+Lisp_Object
+module_function_interactive_form (const struct Lisp_Module_Function *fun)
+{
+ return fun->interactive_form;
+}
+
static emacs_value
module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
emacs_value *args)
@@ -1463,6 +1481,7 @@ initialize_environment (emacs_env *env, struct
emacs_env_private *priv)
env->get_function_finalizer = module_get_function_finalizer;
env->set_function_finalizer = module_set_function_finalizer;
env->open_channel = module_open_channel;
+ env->make_interactive = module_make_interactive;
Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
return env;
}
diff --git a/src/eval.c b/src/eval.c
index 71b7ac8..9e0cec6 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2012,6 +2012,15 @@ then strings and vectors are not accepted. */)
else if (COMPILEDP (fun))
return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop);
+#ifdef HAVE_MODULES
+ /* Module functions are interactive if their `interactive_form'
+ field is non-nil. */
+ else if (MODULE_FUNCTIONP (fun))
+ return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))
+ ? if_prop
+ : Qt;
+#endif
+
/* Strings and vectors are keyboard macros. */
if (STRINGP (fun) || VECTORP (fun))
return (NILP (for_call_interactively) ? Qt : Qnil);
diff --git a/src/font.c b/src/font.c
index 2786a77..beaa7be 100644
--- a/src/font.c
+++ b/src/font.c
@@ -2810,7 +2810,13 @@ font_list_entities (struct frame *f, Lisp_Object spec)
|| ! NILP (Vface_ignored_fonts)))
val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);
if (ASIZE (val) > 0)
- list = Fcons (val, list);
+ {
+ list = Fcons (val, list);
+ /* Querying further backends can be very slow, so we only do
+ it if the user has explicitly requested it (Bug#43177). */
+ if (query_all_font_backends == false)
+ break;
+ }
}
list = Fnreverse (list);
@@ -5527,6 +5533,13 @@ Non-nil means don't query fontconfig for color fonts,
since they often
cause Xft crashes. Only has an effect in Xft builds. */);
xft_ignore_color_fonts = true;
+ DEFVAR_BOOL ("query-all-font-backends", query_all_font_backends,
+ doc: /*
+If non-nil, attempt to query all available font backends.
+By default Emacs will stop searching for a matching font at the first
+match. */);
+ query_all_font_backends = false;
+
#ifdef HAVE_WINDOW_SYSTEM
#ifdef HAVE_FREETYPE
syms_of_ftfont ();
diff --git a/src/frame.c b/src/frame.c
index c4dfc35..3f93450 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -6106,7 +6106,7 @@ when the mouse is over clickable text. */);
Vmouse_highlight = Qt;
DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible,
- doc: /* If non-nil, make pointer invisible while typing.
+ doc: /* If non-nil, make mouse pointer invisible while typing.
The pointer becomes visible again when the mouse is moved. */);
Vmake_pointer_invisible = Qt;
diff --git a/src/keyboard.c b/src/keyboard.c
index 590d183..af075a4 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -103,7 +103,8 @@ static KBOARD *all_kboards;
/* True in the single-kboard state, false in the any-kboard state. */
static bool single_kboard;
-#define NUM_RECENT_KEYS (300)
+/* Minimum allowed size of the recent_keys vector. */
+#define MIN_NUM_RECENT_KEYS (100)
/* Index for storing next element into recent_keys. */
static int recent_keys_index;
@@ -111,7 +112,10 @@ static int recent_keys_index;
/* Total number of elements stored into recent_keys. */
static int total_keys;
-/* This vector holds the last NUM_RECENT_KEYS keystrokes. */
+/* Size of the recent_keys vector. */
+static int lossage_limit = 3 * MIN_NUM_RECENT_KEYS;
+
+/* This vector holds the last lossage_limit keystrokes. */
static Lisp_Object recent_keys;
/* Vector holding the key sequence that invoked the current command.
@@ -1421,10 +1425,10 @@ command_loop_1 (void)
/* Execute the command. */
{
- total_keys += total_keys < NUM_RECENT_KEYS;
+ total_keys += total_keys < lossage_limit;
ASET (recent_keys, recent_keys_index,
Fcons (Qnil, cmd));
- if (++recent_keys_index >= NUM_RECENT_KEYS)
+ if (++recent_keys_index >= lossage_limit)
recent_keys_index = 0;
}
Vthis_command = cmd;
@@ -3248,15 +3252,15 @@ record_char (Lisp_Object c)
int ix1, ix2, ix3;
if ((ix1 = recent_keys_index - 1) < 0)
- ix1 = NUM_RECENT_KEYS - 1;
+ ix1 = lossage_limit - 1;
ev1 = AREF (recent_keys, ix1);
if ((ix2 = ix1 - 1) < 0)
- ix2 = NUM_RECENT_KEYS - 1;
+ ix2 = lossage_limit - 1;
ev2 = AREF (recent_keys, ix2);
if ((ix3 = ix2 - 1) < 0)
- ix3 = NUM_RECENT_KEYS - 1;
+ ix3 = lossage_limit - 1;
ev3 = AREF (recent_keys, ix3);
if (EQ (XCAR (c), Qhelp_echo))
@@ -3307,12 +3311,12 @@ record_char (Lisp_Object c)
{
if (!recorded)
{
- total_keys += total_keys < NUM_RECENT_KEYS;
+ total_keys += total_keys < lossage_limit;
ASET (recent_keys, recent_keys_index,
/* Copy the event, in case it gets modified by side-effect
by some remapping function (bug#30955). */
CONSP (c) ? Fcopy_sequence (c) : c);
- if (++recent_keys_index >= NUM_RECENT_KEYS)
+ if (++recent_keys_index >= lossage_limit)
recent_keys_index = 0;
}
else if (recorded < 0)
@@ -3326,10 +3330,10 @@ record_char (Lisp_Object c)
while (recorded++ < 0 && total_keys > 0)
{
- if (total_keys < NUM_RECENT_KEYS)
+ if (total_keys < lossage_limit)
total_keys--;
if (--recent_keys_index < 0)
- recent_keys_index = NUM_RECENT_KEYS - 1;
+ recent_keys_index = lossage_limit - 1;
ASET (recent_keys, recent_keys_index, Qnil);
}
}
@@ -5692,7 +5696,7 @@ make_lispy_event (struct input_event *event)
ignore_mouse_drag_p = false;
}
- /* Now we're releasing a button - check the co-ordinates to
+ /* Now we're releasing a button - check the coordinates to
see if this was a click or a drag. */
else if (event->modifiers & up_modifier)
{
@@ -6640,7 +6644,7 @@ has the same base event type and all the specified
modifiers. */)
DEFUN ("internal-handle-focus-in", Finternal_handle_focus_in,
Sinternal_handle_focus_in, 1, 1, 0,
doc: /* Internally handle focus-in events.
-This function potentially generates an artifical switch-frame event. */)
+This function potentially generates an artificial switch-frame event. */)
(Lisp_Object event)
{
Lisp_Object frame;
@@ -10410,6 +10414,64 @@ If CHECK-TIMERS is non-nil, timers that are ready to
run will do so. */)
? Qt : Qnil);
}
+/* Reallocate recent_keys copying the recorded keystrokes
+ in the right order. */
+static void
+update_recent_keys (int new_size, int kept_keys)
+{
+ int osize = ASIZE (recent_keys);
+ eassert (recent_keys_index < osize);
+ eassert (kept_keys <= min (osize, new_size));
+ Lisp_Object v = make_nil_vector (new_size);
+ int i, idx;
+ for (i = 0; i < kept_keys; ++i)
+ {
+ idx = recent_keys_index - kept_keys + i;
+ while (idx < 0)
+ idx += osize;
+ ASET (v, i, AREF (recent_keys, idx));
+ }
+ recent_keys = v;
+ total_keys = kept_keys;
+ recent_keys_index = total_keys % new_size;
+ lossage_limit = new_size;
+
+}
+
+DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1,
+ "(list (read-number \"new-size: \" (lossage-size)))",
+ doc: /* Return or set the maximum number of keystrokes to save.
+If called with a non-nil ARG, set the limit to ARG and return it.
+Otherwise, return the current limit.
+
+The saved keystrokes are shown by `view-lossage'. */)
+ (Lisp_Object arg)
+{
+ if (NILP(arg))
+ return make_fixnum (lossage_limit);
+
+ if (!FIXNATP (arg))
+ user_error ("Value must be a positive integer");
+ int osize = ASIZE (recent_keys);
+ eassert (lossage_limit == osize);
+ int min_size = MIN_NUM_RECENT_KEYS;
+ int new_size = XFIXNAT (arg);
+
+ if (new_size == osize)
+ return make_fixnum (lossage_limit);
+
+ if (new_size < min_size)
+ {
+ AUTO_STRING (fmt, "Value must be >= %d");
+ Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum
(min_size))));
+ }
+
+ int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys);
+ update_recent_keys (new_size, kept_keys);
+
+ return make_fixnum (lossage_limit);
+}
+
DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0,
doc: /* Return vector of last few events, not counting those from
keyboard macros.
If INCLUDE-CMDS is non-nil, include the commands that were run,
@@ -10419,21 +10481,21 @@ represented as pseudo-events of the form (nil .
COMMAND). */)
bool cmds = !NILP (include_cmds);
if (!total_keys
- || (cmds && total_keys < NUM_RECENT_KEYS))
+ || (cmds && total_keys < lossage_limit))
return Fvector (total_keys,
XVECTOR (recent_keys)->contents);
else
{
Lisp_Object es = Qnil;
- int i = (total_keys < NUM_RECENT_KEYS
+ int i = (total_keys < lossage_limit
? 0 : recent_keys_index);
- eassert (recent_keys_index < NUM_RECENT_KEYS);
+ eassert (recent_keys_index < lossage_limit);
do
{
Lisp_Object e = AREF (recent_keys, i);
if (cmds || !CONSP (e) || !NILP (XCAR (e)))
es = Fcons (e, es);
- if (++i >= NUM_RECENT_KEYS)
+ if (++i >= lossage_limit)
i = 0;
} while (i != recent_keys_index);
es = Fnreverse (es);
@@ -11686,7 +11748,7 @@ syms_of_keyboard (void)
staticpro (&modifier_symbols);
}
- recent_keys = make_nil_vector (NUM_RECENT_KEYS);
+ recent_keys = make_nil_vector (lossage_limit);
staticpro (&recent_keys);
this_command_keys = make_nil_vector (40);
@@ -11736,6 +11798,7 @@ syms_of_keyboard (void)
defsubr (&Srecursive_edit);
defsubr (&Sinternal_track_mouse);
defsubr (&Sinput_pending_p);
+ defsubr (&Slossage_size);
defsubr (&Srecent_keys);
defsubr (&Sthis_command_keys);
defsubr (&Sthis_command_keys_vector);
diff --git a/src/lisp.h b/src/lisp.h
index bb68684..cbc6a66 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4224,6 +4224,8 @@ extern Lisp_Object funcall_module (Lisp_Object,
ptrdiff_t, Lisp_Object *);
extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
extern Lisp_Object module_function_documentation
(struct Lisp_Module_Function const *);
+extern Lisp_Object module_function_interactive_form
+ (const struct Lisp_Module_Function *);
extern module_funcptr module_function_address
(struct Lisp_Module_Function const *);
extern void *module_function_data (const struct Lisp_Module_Function *);
diff --git a/src/lread.c b/src/lread.c
index 3c226e0..d32f575 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4221,6 +4221,9 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray,
Lisp_Object index)
{
make_symbol_constant (sym);
XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
+ /* Mark keywords as special. This makes (let ((:key 'foo)) ...)
+ in lexically bound elisp signal an error, as documented. */
+ XSYMBOL (sym)->u.s.declared_special = true;
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
diff --git a/src/module-env-28.h b/src/module-env-28.h
index 5d884c1..40b03b9 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -12,3 +12,7 @@
int (*open_channel) (emacs_env *env, emacs_value pipe_process)
EMACS_ATTRIBUTE_NONNULL (1);
+
+ void (*make_interactive) (emacs_env *env, emacs_value function,
+ emacs_value spec)
+ EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/src/nsterm.m b/src/nsterm.m
index 26059ab..5e5d09f 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -6449,7 +6449,7 @@ not_in_argv (NSString *arg)
if (nsEvArray == nil)
nsEvArray = [[NSMutableArray alloc] initWithCapacity: 1];
- [NSCursor setHiddenUntilMouseMoves: YES];
+ [NSCursor setHiddenUntilMouseMoves:! NILP (Vmake_pointer_invisible)];
if (hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight))
{
@@ -8610,7 +8610,7 @@ not_in_argv (NSString *arg)
while ( (file = [fenum nextObject]) )
strings = Fcons ([file lispString], strings);
}
- else if ([type isEqualToString: NSURLPboardType])
+ else if ([type isEqualToString: NSPasteboardTypeURL])
{
NSURL *url = [NSURL URLFromPasteboard: pb];
if (url == nil) return NO;
@@ -8619,8 +8619,8 @@ not_in_argv (NSString *arg)
strings = list1 ([[url absoluteString] lispString]);
}
- else if ([type isEqualToString: NSStringPboardType]
- || [type isEqualToString: NSTabularTextPboardType])
+ else if ([type isEqualToString: NSPasteboardTypeString]
+ || [type isEqualToString: NSPasteboardTypeTabularText])
{
NSString *data;
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
index e81ca7f..3c6402c 100644
--- a/src/nsxwidget.m
+++ b/src/nsxwidget.m
@@ -33,14 +33,14 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
/* Thoughts on NS Cocoa xwidget and webkit2:
Webkit2 process architecture seems to be very hostile for offscreen
- rendering techniques, which is used by GTK xwiget implementation;
+ rendering techniques, which is used by GTK xwidget implementation;
Specifically NSView level view sharing / copying is not working.
- *** So only one view can be associcated with a model. ***
+ *** So only one view can be associated with a model. ***
With this decision, implementation is plain and can expect best out
of webkit2's rationale. But process and session structures will
- diverge from GTK xwiget. Though, cosmetically similar usages can
+ diverge from GTK xwidget. Though, cosmetically similar usages can
be presented and will be preferred, if agreeable.
For other widget types, OSR seems possible, but will not care for a
diff --git a/src/pdumper.c b/src/pdumper.c
index da5e7a1..0a7e038 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1834,7 +1834,7 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
/* Now value is the Lisp_Object to which we want to point whether or
not the field is a raw pointer (in which case we just synthesized
- the Lisp_Object outselves) or a Lisp_Object (in which case we
+ the Lisp_Object ourselves) or a Lisp_Object (in which case we
just copied the thing). Add a fixup or relocation. */
intptr_t out_value;
@@ -1925,7 +1925,7 @@ dump_field_fixup_later (struct dump_context *ctx,
(void) field_relpos (in_start, in_field);
}
-/* Mark an output object field, which is as wide as a poiner, as being
+/* Mark an output object field, which is as wide as a pointer, as being
fixed up to point to a specific offset in the dump. */
static void
dump_field_ptr_to_dump_offset (struct dump_context *ctx,
diff --git a/src/print.c b/src/print.c
index c5f4bbe..1b083f7 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1590,27 +1590,34 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
/* Print the data here as a plist. */
ptrdiff_t real_size = HASH_TABLE_SIZE (h);
- ptrdiff_t size = real_size;
+ ptrdiff_t size = h->count;
/* Don't print more elements than the specified maximum. */
if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
size = XFIXNAT (Vprint_length);
printchar ('(', printcharfun);
- for (ptrdiff_t i = 0; i < size; i++)
+ ptrdiff_t j = 0;
+ for (ptrdiff_t i = 0; i < real_size; i++)
{
Lisp_Object key = HASH_KEY (h, i);
if (!EQ (key, Qunbound))
{
- if (i) printchar (' ', printcharfun);
+ if (j++) printchar (' ', printcharfun);
print_object (key, printcharfun, escapeflag);
printchar (' ', printcharfun);
print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
+ if (j == size)
+ break;
}
}
- if (size < real_size)
- print_c_string (" ...", printcharfun);
+ if (j < h->count)
+ {
+ if (j)
+ printchar (' ', printcharfun);
+ print_c_string ("...", printcharfun);
+ }
print_c_string ("))", printcharfun);
}
diff --git a/src/process.c b/src/process.c
index 3aa105a..53f4a1d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -5413,14 +5413,16 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
/* If data can be read from the process, do so until exhausted. */
if (wait_proc->infd >= 0)
{
+ unsigned int count = 0;
XSETPROCESS (proc, wait_proc);
while (true)
{
int nread = read_process_output (proc, wait_proc->infd);
+ rarely_quit (++count);
if (nread < 0)
{
- if (errno == EIO || would_block (errno))
+ if (errno != EINTR)
break;
}
else
diff --git a/src/syntax.c b/src/syntax.c
index 7f0fc34..e6af8a3 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -2542,20 +2542,23 @@ between them, return t; otherwise return nil. */)
bool fence_found = 0;
ptrdiff_t ini = from, ini_byte = from_byte;
- while (1)
+ if (from > stop)
{
- dec_both (&from, &from_byte);
- UPDATE_SYNTAX_TABLE_BACKWARD (from);
- c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
- if (SYNTAX (c) == Scomment_fence
- && !char_quoted (from, from_byte))
+ while (1)
{
- fence_found = 1;
- break;
+ dec_both (&from, &from_byte);
+ UPDATE_SYNTAX_TABLE_BACKWARD (from);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
+ if (SYNTAX (c) == Scomment_fence
+ && !char_quoted (from, from_byte))
+ {
+ fence_found = 1;
+ break;
+ }
+ else if (from == stop)
+ break;
+ rarely_quit (++quit_count);
}
- else if (from == stop)
- break;
- rarely_quit (++quit_count);
}
if (fence_found == 0)
{
diff --git a/src/term.c b/src/term.c
index 5cbb092..3677644 100644
--- a/src/term.c
+++ b/src/term.c
@@ -105,14 +105,14 @@ struct tty_display_info *tty_list;
enum no_color_bit
{
- NC_STANDOUT = 1 << 0,
- NC_UNDERLINE = 1 << 1,
- NC_REVERSE = 1 << 2,
- NC_ITALIC = 1 << 3,
- NC_DIM = 1 << 4,
- NC_BOLD = 1 << 5,
- NC_INVIS = 1 << 6,
- NC_PROTECT = 1 << 7
+ NC_STANDOUT = 1 << 0,
+ NC_UNDERLINE = 1 << 1,
+ NC_REVERSE = 1 << 2,
+ NC_ITALIC = 1 << 3,
+ NC_DIM = 1 << 4,
+ NC_BOLD = 1 << 5,
+ NC_STRIKE_THROUGH = 1 << 6,
+ NC_PROTECT = 1 << 7
};
/* internal state */
@@ -1931,6 +1931,10 @@ turn_on_face (struct frame *f, int face_id)
if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
+ if (face->tty_strike_through_p
+ && MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH))
+ OUTPUT1_IF (tty, tty->TS_enter_strike_through_mode);
+
if (tty->TN_max_colors > 0)
{
const char *ts;
@@ -1971,7 +1975,8 @@ turn_off_face (struct frame *f, int face_id)
if (face->tty_bold_p
|| face->tty_italic_p
|| face->tty_reverse_p
- || face->tty_underline_p)
+ || face->tty_underline_p
+ || face->tty_strike_through_p)
{
OUTPUT1_IF (tty, tty->TS_exit_attribute_mode);
if (strcmp (tty->TS_exit_attribute_mode, tty->TS_end_standout_mode)
== 0)
@@ -2006,11 +2011,20 @@ tty_capable_p (struct tty_display_info *tty, unsigned
int caps)
if ((caps & (cap)) && (!(TS) || !MAY_USE_WITH_COLORS_P(tty, NC_bit)))
\
return 0;
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_INVERSE, tty->TS_standout_mode,
NC_REVERSE);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode,
NC_UNDERLINE);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_BOLD, tty->TS_enter_bold_mode,
NC_BOLD);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_DIM, tty->TS_enter_dim_mode,
NC_DIM);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_ITALIC, tty->TS_enter_italic_mode,
NC_ITALIC);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_INVERSE, tty->TS_standout_mode, NC_REVERSE);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode,
+ NC_UNDERLINE);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC);
+ TTY_CAPABLE_P_TRY (tty,
+ TTY_CAP_STRIKE_THROUGH, tty->TS_enter_strike_through_mode,
+ NC_STRIKE_THROUGH);
/* We can do it! */
return 1;
@@ -2402,7 +2416,7 @@ tty_draw_row_with_mouse_face (struct window *w, struct
glyph_row *row,
pos_y = row->y + WINDOW_TOP_EDGE_Y (w);
pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w);
- /* Save current cursor co-ordinates. */
+ /* Save current cursor coordinates. */
save_y = curY (tty);
save_x = curX (tty);
cursor_to (f, pos_y, pos_x);
@@ -4124,6 +4138,7 @@ use the Bourne shell command 'TERM=...; export TERM'
(C-shell:\n\
tty->TS_enter_alt_charset_mode = tgetstr ("as", address);
tty->TS_exit_alt_charset_mode = tgetstr ("ae", address);
tty->TS_exit_attribute_mode = tgetstr ("me", address);
+ tty->TS_enter_strike_through_mode = tgetstr ("smxx", address);
MultiUp (tty) = tgetstr ("UP", address);
MultiDown (tty) = tgetstr ("DO", address);
diff --git a/src/termchar.h b/src/termchar.h
index c96b819..c967e7d 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -136,6 +136,8 @@ struct tty_display_info
const char *TS_enter_reverse_mode; /* "mr" -- enter reverse video mode. */
const char *TS_exit_underline_mode; /* "us" -- start underlining. */
const char *TS_enter_underline_mode; /* "ue" -- end underlining. */
+ const char *TS_enter_strike_through_mode; /* "smxx" -- turn on strike-through
+ mode. */
/* "as"/"ae" -- start/end alternate character set. Not really
supported, yet. */
diff --git a/src/terminfo.c b/src/terminfo.c
index 51fd32e..0765996 100644
--- a/src/terminfo.c
+++ b/src/terminfo.c
@@ -23,9 +23,12 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
/* Define these variables that serve as global parameters to termcap,
so that we do not need to conditionalize the places in Emacs
- that set them. */
+ that set them. But don't do that for terminfo, as that could
+ cause link errors when using -fno-common. */
+#if !TERMINFO
char *UP, *BC, PC;
+#endif
/* Interface to curses/terminfo library.
Turns out that all of the terminfo-level routines look
diff --git a/src/w32fns.c b/src/w32fns.c
index ab86433..3134f67 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -3640,7 +3640,7 @@ get_wm_chars (HWND aWnd, int *buf, int buflen, int
ignore_ctrl, int ctrl,
non-Emacs window with the same language environment, and using (dead)keys
there would change the value stored in the kernel, but not this value. */
/* A layout may emit deadkey=0. It looks like this would reset the state
- of the kernel's finite automaton (equivalent to emiting 0-length string,
+ of the kernel's finite automaton (equivalent to emitting 0-length string,
which is otherwise impossible in the dead-key map of a layout).
Be ready to treat the case when this delivers WM_(SYS)DEADCHAR. */
static int after_deadkey = -1;
@@ -3701,7 +3701,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg,
UINT wParam,
of w32_get_key_modifiers (). */
wmsg.dwModifiers = w32_kbd_mods_to_emacs (console_modifiers, wParam);
- /* What follows is just heuristics; the correct treatement requires
+ /* What follows is just heuristics; the correct treatment requires
non-destructive ToUnicode():
http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Can_an_application_on_Windows_accept_keyboard_events?_Part_IV:_application-specific_modifiers
@@ -7001,7 +7001,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo,
Lisp_Object parms)
Frame parameters may be changed if .Xdefaults contains
specifications for the default font. For example, if there is an
`Emacs.default.attributeBackground: pink', the `background-color'
- attribute of the frame get's set, which let's the internal border
+ attribute of the frame gets set, which let's the internal border
of the tooltip frame appear in pink. Prevent this. */
{
Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
@@ -7085,7 +7085,7 @@ compute_tip_xy (struct frame *f,
/* If multiple monitor support is available, constrain the tip onto
the current monitor. This improves the above by allowing negative
- co-ordinates if monitor positions are such that they are valid, and
+ coordinates if monitor positions are such that they are valid, and
snaps a tooltip onto a single monitor if we are close to the edge
where it would otherwise flow onto the other monitor (or into
nothingness if there is a gap in the overlap). */
@@ -8079,7 +8079,7 @@ operations:
\"pastelink\"
- create a shortcut in DOCUMENT (which must be a directory)
the file or directory whose name is in the clipboard.
- \"runas\" - run DOCUMENT, which must be an excutable file, with
+ \"runas\" - run DOCUMENT, which must be an executable file, with
elevated privileges (a.k.a. \"as Administrator\").
\"properties\"
- open the property sheet dialog for DOCUMENT.
diff --git a/src/w32heap.c b/src/w32heap.c
index ececc73..ba3550b 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -884,7 +884,7 @@ setrlimit (rlimit_resource_t rltype, const struct rlimit
*rlp)
{
case RLIMIT_STACK:
case RLIMIT_NOFILE:
- /* We cannot modfy these limits, so we always fail. */
+ /* We cannot modify these limits, so we always fail. */
errno = EPERM;
break;
default:
diff --git a/src/w32menu.c b/src/w32menu.c
index e076043..da2db78 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1485,7 +1485,7 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item,
UINT flags)
crash Emacs when we try to display those "strings". It
is unclear why we get these dwItemData, or what they are:
sometimes they point to a wchar_t string that is the menu
- title, sometimes to someting that doesn't look like text
+ title, sometimes to something that doesn't look like text
at all. (The problematic data also comes with the 0x0800
bit set, but this bit is not documented, so we don't want
to depend on it.) */
diff --git a/src/w32term.c b/src/w32term.c
index 2669f29..e0618e4 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -6877,7 +6877,7 @@ w32_make_frame_visible (struct frame *f)
/* According to a report in emacs-devel 2008-06-03, SW_SHOWNORMAL
causes unexpected behavior when unminimizing frames that were
previously maximized. But only SW_SHOWNORMAL works properly for
- frames that were truely hidden (using make-frame-invisible), so
+ frames that were truly hidden (using make-frame-invisible), so
we need it to avoid Bug#5482. It seems that iconified is only
set for minimized windows that are still visible, so use that to
determine the appropriate flag to pass ShowWindow. */
diff --git a/src/w32term.h b/src/w32term.h
index 8ba2480..694493c 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -476,7 +476,7 @@ struct scroll_bar {
editing large files, we establish a minimum height by always
drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below
where they would be normally; the bottom and top are in a
- different co-ordinate system. */
+ different coordinate system. */
int start, end;
/* If the scroll bar handle is currently being dragged by the user,
diff --git a/src/xdisp.c b/src/xdisp.c
index 69e5a9e..ac5307f 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -510,7 +510,7 @@ static Lisp_Object list_of_error;
|| *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t'))))
/* These are the category sets we use. They are defined by
- kinsoku.el and chracters.el. */
+ kinsoku.el and characters.el. */
#define NOT_AT_EOL '<'
#define NOT_AT_BOL '>'
#define LINE_BREAKABLE '|'
@@ -2230,7 +2230,7 @@ estimate_mode_line_height (struct frame *f, enum face_id
face_id)
}
/* Given a pixel position (PIX_X, PIX_Y) on frame F, return glyph
- co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
+ coordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP, do
not force the value into range. */
@@ -3744,7 +3744,7 @@ init_to_row_end (struct it *it, struct window *w, struct
glyph_row *row)
it->continuation_lines_width
= row->continuation_lines_width + row->pixel_width;
CHECK_IT (it);
- /* Initializing IT in the presense of compositions in reordered
+ /* Initializing IT in the presence of compositions in reordered
rows is tricky: row->end above will generally cause us to
start at position that is not the first one in the logical
order, and we might therefore miss the composition earlier in
@@ -25641,8 +25641,10 @@ display_mode_element (struct it *it, int depth, int
field_width, int precision,
/* Non-ASCII characters in SPEC should cause mode-line
element be displayed as a multibyte string. */
ptrdiff_t nbytes = strlen (spec);
- if (multibyte_chars_in_text ((const unsigned char *)spec,
- nbytes) != nbytes)
+ ptrdiff_t nchars, mb_nbytes;
+ parse_str_as_multibyte ((const unsigned char *)spec, nbytes,
+ &nchars, &mb_nbytes);
+ if (!(nbytes == nchars || nbytes != mb_nbytes))
multibyte = true;
switch (mode_line_target)
@@ -34831,8 +34833,7 @@ and is used only on frames for which no explicit name
has been set
Oracle Developer Studio 12.6. */
Lisp_Object icon_title_name_format
= pure_list (empty_unibyte_string,
- intern_c_string ("invocation-name"),
- build_pure_c_string ("@"),
+ build_pure_c_string ("%b - GNU Emacs at "),
intern_c_string ("system-name"));
Vicon_title_format
= Vframe_title_format
@@ -35008,8 +35009,10 @@ but does not change the fact they are interpreted as
raw bytes. */);
DEFVAR_LISP ("max-mini-window-height", Vmax_mini_window_height,
doc: /* Maximum height for resizing mini-windows (the minibuffer and the
echo area).
-If a float, it specifies a fraction of the mini-window frame's height.
-If an integer, it specifies a number of lines. */);
+If a float, it specifies the maximum height in units of the
+mini-window frame's height.
+If an integer, it specifies the maximum height in units of the
+mini-window frame's default font's height. */);
Vmax_mini_window_height = make_float (0.25);
DEFVAR_LISP ("resize-mini-windows", Vresize_mini_windows,
diff --git a/src/xfaces.c b/src/xfaces.c
index 06d2f99..73a536b 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -5217,7 +5217,6 @@ tty_supports_face_attributes_p (struct frame *f,
|| !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]))
return false;
@@ -5282,6 +5281,15 @@ tty_supports_face_attributes_p (struct frame *f,
test_caps |= TTY_CAP_INVERSE;
}
+ /* strike through */
+ val = attrs[LFACE_STRIKE_THROUGH_INDEX];
+ if (!UNSPECIFIEDP (val))
+ {
+ if (face_attr_equal_p (val, def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
+ return false; /* same as default */
+ else
+ test_caps |= TTY_CAP_STRIKE_THROUGH;
+ }
/* Color testing. */
@@ -6244,6 +6252,8 @@ realize_tty_face (struct face_cache *cache,
face->tty_underline_p = true;
if (!NILP (attrs[LFACE_INVERSE_INDEX]))
face->tty_reverse_p = true;
+ if (!NILP (attrs[LFACE_STRIKE_THROUGH_INDEX]))
+ face->tty_strike_through_p = true;
/* Map color names to color indices. */
map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
diff --git a/src/xfns.c b/src/xfns.c
index 78f977b..46e4bd7 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6535,7 +6535,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
Lisp_Object parms)
Frame parameters may be changed if .Xdefaults contains
specifications for the default font. For example, if there is an
`Emacs.default.attributeBackground: pink', the `background-color'
- attribute of the frame get's set, which let's the internal border
+ attribute of the frame gets set, which let's the internal border
of the tooltip frame appear in pink. Prevent this. */
{
Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
diff --git a/src/xterm.h b/src/xterm.h
index db8d584..0f8ba5e 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -890,7 +890,7 @@ struct scroll_bar
editing large files, we establish a minimum height by always
drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below
where they would be normally; the bottom and top are in a
- different co-ordinate system. */
+ different coordinate system. */
int start, end;
/* If the scroll bar handle is currently being dragged by the user,
diff --git a/test/ChangeLog.1 b/test/ChangeLog.1
index c364219..2bf014d 100644
--- a/test/ChangeLog.1
+++ b/test/ChangeLog.1
@@ -1754,7 +1754,7 @@
* indent/prolog.prolog: Test alignment of ->; with operator at bol.
- * indent/css-mode.css (.x2): Test alignement inside braces.
+ * indent/css-mode.css (.x2): Test alignment inside braces.
2013-10-26 Dmitry Gutov <dgutov@yandex.ru>
diff --git a/test/data/emacs-module/mod-test.c
b/test/data/emacs-module/mod-test.c
index 37186fc..da298d4 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -673,6 +673,14 @@ Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs,
emacs_value *args,
return env->intern (env, "nil");
}
+static emacs_value
+Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ assert (nargs == 1);
+ return args[0];
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
/* Provide FEATURE to Emacs. */
@@ -764,6 +772,19 @@ emacs_module_init (struct emacs_runtime *ert)
#undef DEFUN
+ emacs_value constant_fn
+ = env->make_function (env, 0, 0, Fmod_test_return_t, NULL, NULL);
+ env->make_interactive (env, constant_fn, env->intern (env, "nil"));
+ bind_function (env, "mod-test-return-t-int", constant_fn);
+
+ emacs_value identity_fn
+ = env->make_function (env, 1, 1, Fmod_test_identity, NULL, NULL);
+ const char *interactive_spec = "i";
+ env->make_interactive (env, identity_fn,
+ env->make_string (env, interactive_spec,
+ strlen (interactive_spec)));
+ bind_function (env, "mod-test-identity", identity_fn);
+
provide (env, "mod-test");
return 0;
}
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 0909756..dce82b6 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -391,6 +391,73 @@ An existing calc stack is reused, otherwise a new one is
created."
(var n var-n) -1 1))
8)))
+(defun calc-tests--fac (n)
+ (apply #'* (number-sequence 1 n)))
+
+(defun calc-tests--choose (n k)
+ "N choose K, reference implementation."
+ (cond
+ ((and (integerp n) (integerp k))
+ (if (<= 0 n)
+ (if (<= 0 k n)
+ (/ (calc-tests--fac n)
+ (* (calc-tests--fac k) (calc-tests--fac (- n k))))
+ 0) ; 0≤n<k
+ ;; n<0, n and k integers: use extension from M. J. Kronenburg
+ (cond
+ ((<= 0 k)
+ (* (expt -1 k)
+ (calc-tests--choose (+ (- n) k -1) k)))
+ ((<= k n)
+ (* (expt -1 (- n k))
+ (calc-tests--choose (+ (- k) -1) (- n k))))
+ (t ; n<k<0
+ 0))))
+ ((natnump k)
+ ;; Generalisation for any n, integral k≥0: use falling product
+ (/ (apply '* (number-sequence n (- n (1- k)) -1))
+ (calc-tests--fac k)))
+ (t (error "case not covered"))))
+
+(defun calc-tests--check-choose (n k)
+ (equal (calcFunc-choose n k)
+ (calc-tests--choose n k)))
+
+(defun calc-tests--explain-choose (n k)
+ (let ((got (calcFunc-choose n k))
+ (expected (calc-tests--choose n k)))
+ (format "(calcFunc-choose %d %d) => %S, expected %S" n k got expected)))
+
+(put 'calc-tests--check-choose 'ert-explainer 'calc-tests--explain-choose)
+
+(defun calc-tests--calc-to-number (x)
+ "Convert a Calc object to a Lisp number."
+ (pcase x
+ ((pred numberp) x)
+ (`(frac ,p ,q) (/ (float p) q))
+ (`(float ,m ,e) (* m (expt 10 e)))
+ (_ (error "calc object not converted: %S" x))))
+
+(ert-deftest calc-choose ()
+ "Test computation of binomial coefficients (bug#16999)."
+ ;; Integral arguments
+ (dolist (n (number-sequence -6 6))
+ (dolist (k (number-sequence -6 6))
+ (should (calc-tests--check-choose n k))))
+
+ ;; Fractional n, natural k
+ (should (equal (calc-tests--calc-to-number
+ (calcFunc-choose '(frac 15 2) 3))
+ (calc-tests--choose 7.5 3)))
+
+ (should (equal (calc-tests--calc-to-number
+ (calcFunc-choose '(frac 1 2) 2))
+ (calc-tests--choose 0.5 2)))
+
+ (should (equal (calc-tests--calc-to-number
+ (calcFunc-choose '(frac -15 2) 3))
+ (calc-tests--choose -7.5 3))))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index 132fe87..5b59340 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -52,73 +52,41 @@
(dolist (str comint-testsuite-password-strings)
(should (string-match comint-password-prompt-regexp str))))
-(ert-deftest comint-test-no-password-function ()
- "Test that `comint-password-function' not being set does not
-alter normal password flow."
- (cl-letf
- (((symbol-function 'read-passwd)
- (lambda (_prompt &optional _confirm _default)
- "PaSsWoRd123")))
- (let ((cat (executable-find "cat")))
- (when cat
+(defun comint-tests/test-password-function (password-function)
+ "PASSWORD-FUNCTION can return nil or a string."
+ (when-let ((cat (executable-find "cat")))
+ (let ((comint-password-function password-function))
+ (cl-letf (((symbol-function 'read-passwd)
+ (lambda (&rest _args) "non-nil")))
(with-temp-buffer
(make-comint-in-buffer "test-comint-password" (current-buffer) cat)
(let ((proc (get-buffer-process (current-buffer))))
(set-process-query-on-exit-flag proc nil)
- (comint-send-string proc "Password: ")
- (comint-send-eof)
- (while (accept-process-output proc 0.1 nil t))
- (should (string-equal (buffer-substring-no-properties (point-min)
(point-max))
- "Password: PaSsWoRd123\n"))
- (when (process-live-p proc)
- (kill-process proc))
- (accept-process-output proc 0 1 t)))))))
+ (set-process-query-on-exit-flag proc nil)
+ (comint-send-invisible "Password: ")
+ (accept-process-output proc 0.1)
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ (concat (or (and password-function
+ (funcall password-function))
+ "non-nil")
+ "\n")))))))))
+
+(ert-deftest comint-test-no-password-function ()
+ "Test that `comint-password-function' not being set does not
+alter normal password flow."
+ (comint-tests/test-password-function nil))
(ert-deftest comint-test-password-function-with-value ()
"Test that `comint-password-function' alters normal password
flow. Hook function returns alternative password."
- (cl-letf
- (((symbol-function 'read-passwd)
- (lambda (_prompt &optional _confirm _default)
- "PaSsWoRd123")))
- (let ((cat (executable-find "cat"))
- (comint-password-function (lambda (_prompt) "MaGiC-PaSsWoRd789")))
- (when cat
- (with-temp-buffer
- (make-comint-in-buffer "test-comint-password" (current-buffer) cat)
- (let ((proc (get-buffer-process (current-buffer))))
- (set-process-query-on-exit-flag proc nil)
- (comint-send-string proc "Password: ")
- (comint-send-eof)
- (while (accept-process-output proc 0.1 nil t))
- (should (string-equal (buffer-substring-no-properties (point-min)
(point-max))
- "Password: MaGiC-PaSsWoRd789\n"))
- (when (process-live-p proc)
- (kill-process proc))
- (accept-process-output proc 0 1 t)))))))
+ (comint-tests/test-password-function
+ (lambda (&rest _args) "MaGiC-PaSsWoRd789")))
(ert-deftest comint-test-password-function-with-nil ()
"Test that `comint-password-function' does not alter the normal
password flow if it returns a nil value."
- (cl-letf
- (((symbol-function 'read-passwd)
- (lambda (_prompt &optional _confirm _default)
- "PaSsWoRd456")))
- (let ((cat (executable-find "cat"))
- (comint-password-function (lambda (_prompt) nil)))
- (when cat
- (with-temp-buffer
- (make-comint-in-buffer "test-comint-password" (current-buffer) cat)
- (let ((proc (get-buffer-process (current-buffer))))
- (set-process-query-on-exit-flag proc nil)
- (comint-send-string proc "Password: ")
- (comint-send-eof)
- (while (accept-process-output proc 0.1 nil t))
- (should (string-equal (buffer-substring-no-properties (point-min)
(point-max))
- "Password: PaSsWoRd456\n"))
- (when (process-live-p proc)
- (kill-process proc))
- (accept-process-output proc 0 1 t)))))))
+ (comint-tests/test-password-function #'ignore))
;; Local Variables:
;; no-byte-compile: t
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index 1fe1557..6bb8ced 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -28,7 +28,7 @@
(let* ((foo (make-temp-file "foo"))
(files (list foo)))
(unwind-protect
- (cl-letf (((symbol-function 'y-or-n-p) 'error))
+ (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error))
(dired temporary-file-directory)
(dired-goto-file foo)
;; `dired-do-shell-command' returns nil on success.
@@ -40,7 +40,7 @@
(should-not (dired-do-shell-command "ls ? ./`?`" nil files)))
(delete-file foo))))
-;; Auxiliar macro for `dired-test-bug28834': it binds
+;; Auxiliary macro for `dired-test-bug28834': it binds
;; `dired-create-destination-dirs' to CREATE-DIRS and execute BODY.
;; If YES-OR-NO is non-nil, it binds `yes-or-no-p' to
;; to avoid the prompt.
@@ -114,6 +114,49 @@
(mapc #'delete-file `(,file1 ,file2))
(kill-buffer buf)))))
+(defun dired-test--check-highlighting (command positions)
+ (let ((start 1))
+ (dolist (pos positions)
+ (should-not (text-property-not-all start (1- pos) 'face nil command))
+ (should (equal 'warning (get-text-property pos 'face command)))
+ (setq start (1+ pos)))
+ (should-not (text-property-not-all
+ start (length command) 'face nil command))))
+
+(ert-deftest dired-test-highlight-metachar ()
+ "Check that non-isolated meta-characters are highlighted."
+ (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`")
+ (markers " ^ ^")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "?")
+ command
+ t))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 2))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (should (string-match (regexp-quote markers) (nth 1 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(15 29)))
+ ;; Note that `?` is considered isolated, but `*` is not.
+ (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'")
+ (markers " ^ ^")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "*")
+ command
+ t))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 2))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (should (string-match (regexp-quote markers) (nth 1 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(11 25)))
+ (let* ((command "sed 's/\\?/!/'")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "?")
+ command
+ nil))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 1))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(8))))
(provide 'dired-aux-tests)
;; dired-aux-tests.el ends here
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
index 4bad360..c77f2dc 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
@@ -44,7 +44,7 @@
(0 (progn
(add-text-properties (match-beginning 0)
(match-end 0)
- '(help-echo "Baloon tip: Fly smoothly!"))
+ '(help-echo "Balloon tip: Fly smoothly!"))
font-lock-warning-face))))
"Highlight rules for `faceup-test-mode'.")
diff --git a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
index 7d4938a..ec9e821 100644
--- a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
+++ b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
@@ -1,7 +1,7 @@
This is a test of `faceup', a regression test system for font-lock
keywords. It should use major mode `faceup-test-mode'.
-«(help-echo):"Baloon tip: Fly smoothly!":«w:WARNING»»: The first word on this
line should use
+«(help-echo):"Balloon tip: Fly smoothly!":«w:WARNING»»: The first word on this
line should use
`font-lock-warning-face', and a tooltip should be displayed if the
mouse pointer is moved over it.
diff --git a/test/lisp/emacs-lisp/find-func-tests.el
b/test/lisp/emacs-lisp/find-func-tests.el
new file mode 100644
index 0000000..f505e78
--- /dev/null
+++ b/test/lisp/emacs-lisp/find-func-tests.el
@@ -0,0 +1,45 @@
+;;; find-func-tests.el --- Unit tests for find-func.el -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert-x) ;For `ert-run-keys'.
+
+(ert-deftest find-func-tests--library-completion () ;bug#43393
+ ;; FIXME: How can we make this work in batch (see also
+ ;; `mule-cmds--test-universal-coding-system-argument')?
+ ;; (skip-unless (not noninteractive))
+ ;; Check that `partial-completion' works when completing library names.
+ (should (equal "org/org"
+ (ert-simulate-keys
+ (kbd "o / o r g TAB RET")
+ (read-library-name))))
+ ;; Check that absolute file names also work.
+ (should (equal (expand-file-name "nxml/" data-directory)
+ (ert-simulate-keys
+ (concat data-directory (kbd "n x / TAB RET"))
+ (read-library-name)))))
+
+(provide 'find-func-tests)
+;;; find-func-tests.el ends here
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el
b/test/lisp/emacs-lisp/lisp-mode-tests.el
index febac8f..d1183d8 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -153,7 +153,7 @@ noindent\" 3
(should (equal (buffer-string) str)))))
(ert-deftest indent-sexp-stop-before-eol-non-lisp ()
- "`indent-sexp' shouldn't be too agressive in non-Lisp modes."
+ "`indent-sexp' shouldn't be too aggressive in non-Lisp modes."
;; See https://debbugs.gnu.org/35286#13.
(with-temp-buffer
(prolog-mode)
@@ -294,6 +294,18 @@ Expected initialization file: `%s'\"
(insert "\"\n")
(lisp-indent-region (point-min) (point-max))))
+(ert-deftest lisp-indent-defun ()
+ (with-temp-buffer
+ (lisp-mode)
+ (let ((orig "(defun x ()
+ (print (quote ( thingy great
+ stuff)))
+ (print (quote (thingy great
+ stuff))))"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
;;; Fontification
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 5b2f5fd..54801ad 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1365,5 +1365,71 @@ See <https://debbugs.gnu.org/36401>."
(should (equal (parse-colon-path "/foo//bar/baz")
'("/foo/bar/baz/"))))
+(ert-deftest files-test-magic-mode-alist-doctype ()
+ "Test that DOCTYPE and variants put files in mhtml-mode."
+ (with-temp-buffer
+ (goto-char (point-min))
+ (insert "<!DOCTYPE html>")
+ (normal-mode)
+ (should (eq major-mode 'mhtml-mode))
+ (erase-buffer)
+ (insert "<!doctype html>")
+ (normal-mode)
+ (should (eq major-mode 'mhtml-mode))))
+
+(defvar files-tests-lao "The Way that can be told of is not the eternal Way;
+The name that can be named is not the eternal name.
+The Nameless is the origin of Heaven and Earth;
+The Named is the mother of all things.
+Therefore let there always be non-being,
+ so we may see their subtlety,
+And let there always be being,
+ so we may see their outcome.
+The two are the same,
+But after they are produced,
+ they have different names.
+")
+
+(defvar files-tests-tzu "The Nameless is the origin of Heaven and Earth;
+The named is the mother of all things.
+
+Therefore let there always be non-being,
+ so we may see their subtlety,
+And let there always be being,
+ so we may see their outcome.
+The two are the same,
+But after they are produced,
+ they have different names.
+They both may be called deep and profound.
+Deeper and more profound,
+The door of all subtleties!
+")
+
+(ert-deftest files-tests-revert-buffer ()
+ "Test that revert-buffer is successful."
+ (files-tests--with-temp-file temp-file-name
+ (with-temp-buffer
+ (insert files-tests-lao)
+ (write-file temp-file-name)
+ (erase-buffer)
+ (insert files-tests-tzu)
+ (revert-buffer t t t)
+ (should (compare-strings files-tests-lao nil nil
+ (buffer-substring (point-min) (point-max))
+ nil nil)))))
+
+(ert-deftest files-tests-revert-buffer-with-fine-grain ()
+ "Test that revert-buffer-with-fine-grain is successful."
+ (files-tests--with-temp-file temp-file-name
+ (with-temp-buffer
+ (insert files-tests-lao)
+ (write-file temp-file-name)
+ (erase-buffer)
+ (insert files-tests-tzu)
+ (should (revert-buffer-with-fine-grain t t))
+ (should (compare-strings files-tests-lao nil nil
+ (buffer-substring (point-min) (point-max))
+ nil nil)))))
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index ba0783b..4c745ea 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -828,7 +828,7 @@ In the first decryption this passphrase is hardcoded, in
the second one it
method "uid1@example.org" "sub@example.org" nil
;; Beware! For passphrases copy-sequence is necessary, as they may
;; be erased, which actually changes the function's code and causes
- ;; multiple invokations to fail. I was surprised...
+ ;; multiple invocations to fail. I was surprised...
(copy-sequence "Passphrase") t)
(mml-secure-test-en-decrypt-with-passphrase
method "uid1@example.org" "sub@example.org" nil
diff --git a/test/lisp/international/mule-tests.el
b/test/lisp/international/mule-tests.el
index 5f8e653..9520d9d 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -23,6 +23,8 @@
;;; Code:
+(require 'ert-x) ;For `ert-run-keys'.
+
(ert-deftest find-auto-coding--bug27391 ()
"Check that Bug#27391 is fixed."
(with-temp-buffer
@@ -41,12 +43,11 @@
(should (not (multibyte-string-p (encode-coding-char ?a 'utf-8)))))
(ert-deftest mule-cmds--test-universal-coding-system-argument ()
- (skip-unless (not noninteractive))
(should (equal "ccccccccccccccccab"
- (let ((enable-recursive-minibuffers t)
- (unread-command-events
- (append (kbd "C-x RET c u t f - 8 RET C-u C-u c a b
RET") nil)))
- (read-string "prompt:")))))
+ (let ((enable-recursive-minibuffers t))
+ (ert-simulate-keys
+ (kbd "C-x RET c u t f - 8 RET C-u C-u c a b RET")
+ (read-string "prompt:"))))))
(ert-deftest mule-utf-7 ()
;; utf-7 and utf-7-imap are not ASCII-compatible.
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index 168a2c9..1ef83da 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -167,7 +167,7 @@
(ert-deftest deferred-action-toolate ()
:tags '(:expensive-test)
- "Deferred request fails because noone clears the flag."
+ "Deferred request fails because no one clears the flag."
(jsonrpc--with-emacsrpc-fixture (conn)
(should-error
(jsonrpc-request conn '+ [1 2]
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index d470bca..62ed3f2 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -25,8 +25,6 @@
(defvar dbus-debug nil)
(declare-function dbus-get-unique-name "dbusbind.c" (bus))
-(setq dbus-show-dbus-errors nil)
-
(defconst dbus--test-enabled-session-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :session)))
@@ -93,6 +91,275 @@
(string-equal
(dbus-unescape-from-identifier (dbus-escape-as-identifier mstr)) mstr))))
+(ert-deftest dbus-test01-basic-types ()
+ "Check basic D-Bus type arguments."
+ ;; Unknown keyword.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :keyword)
+ :type 'wrong-type-argument)
+
+ ;; `:string'.
+ (should (dbus-check-arguments :session dbus--test-service "string"))
+ (should (dbus-check-arguments :session dbus--test-service :string "string"))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :string 0.5)
+ :type 'wrong-type-argument)
+
+ ;; `:object-path'.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service :object-path "/object/path"))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :object-path "string")
+ :type 'dbus-error)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :object-path 0.5)
+ :type 'wrong-type-argument)
+
+ ;; `:signature'.
+ (should (dbus-check-arguments :session dbus--test-service :signature "as"))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :signature "string")
+ :type 'dbus-error)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :signature 0.5)
+ :type 'wrong-type-argument)
+
+ ;; `:boolean'.
+ (should (dbus-check-arguments :session dbus--test-service nil))
+ (should (dbus-check-arguments :session dbus--test-service t))
+ (should (dbus-check-arguments :session dbus--test-service :boolean nil))
+ (should (dbus-check-arguments :session dbus--test-service :boolean t))
+ ;; Will be handled as `nil'.
+ (should (dbus-check-arguments :session dbus--test-service :boolean))
+ ;; Will be handled as `t'.
+ (should (dbus-check-arguments :session dbus--test-service :boolean
'whatever))
+
+ ;; `:byte'.
+ (should (dbus-check-arguments :session dbus--test-service :byte 0))
+ ;; Only the least significant byte is taken into account.
+ (should
+ (dbus-check-arguments :session dbus--test-service :byte
most-positive-fixnum))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :byte -1)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :byte 0.5)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :byte "string")
+ :type 'wrong-type-argument)
+
+ ;; `:int16'.
+ (should (dbus-check-arguments :session dbus--test-service :int16 0))
+ (should (dbus-check-arguments :session dbus--test-service :int16 #x7fff))
+ (should (dbus-check-arguments :session dbus--test-service :int16 #x-8000))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 #x8000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 #x-8001)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 0.5)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int16 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:uint16'.
+ (should (dbus-check-arguments :session dbus--test-service :uint16 0))
+ (should (dbus-check-arguments :session dbus--test-service :uint16 #xffff))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 #x10000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 -1)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 0.5)
+ :type 'wrong-type-argument)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint16 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:int32'.
+ (should (dbus-check-arguments :session dbus--test-service :int32 0))
+ (should (dbus-check-arguments :session dbus--test-service :int32 #x7fffffff))
+ (should (dbus-check-arguments :session dbus--test-service :int32
#x-80000000))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 #x80000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 #x-80000001)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int32 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:uint32'.
+ (should (dbus-check-arguments :session dbus--test-service 0))
+ (should (dbus-check-arguments :session dbus--test-service :uint32 0))
+ (should (dbus-check-arguments :session dbus--test-service :uint32
#xffffffff))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 #x100000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 -1)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint32 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:int64'.
+ (should (dbus-check-arguments :session dbus--test-service :int64 0))
+ (should
+ (dbus-check-arguments :session dbus--test-service :int64
#x7fffffffffffffff))
+ (should
+ (dbus-check-arguments :session dbus--test-service :int64
#x-8000000000000000))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64
#x-8000000000000001)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :int64 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:uint64'.
+ (should (dbus-check-arguments :session dbus--test-service :uint64 0))
+ (should
+ (dbus-check-arguments :session dbus--test-service :uint64
#xffffffffffffffff))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64
#x10000000000000000)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64 -1)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :uint64 "string")
+ :type 'wrong-type-argument)
+
+ ;; `:double'.
+ (should (dbus-check-arguments :session dbus--test-service :double 0))
+ (should (dbus-check-arguments :session dbus--test-service :double 0.5))
+ (should (dbus-check-arguments :session dbus--test-service :double -0.5))
+ (should (dbus-check-arguments :session dbus--test-service :double -1))
+ ;; Shall both be supported?
+ (should (dbus-check-arguments :session dbus--test-service :double 1.0e+INF))
+ (should (dbus-check-arguments :session dbus--test-service :double 0.0e+NaN))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :double "string")
+ :type 'wrong-type-argument)
+
+ ;; `:unix-fd'. Value range 0 .. 9.
+ (should (dbus-check-arguments :session dbus--test-service :unix-fd 0))
+ (should (dbus-check-arguments :session dbus--test-service :unix-fd 9))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd 10)
+ :type 'dbus-error)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd -1)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd 0.5)
+ :type 'args-out-of-range)
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd "string")
+ :type 'wrong-type-argument))
+
+(ert-deftest dbus-test01-compound-types ()
+ "Check basic D-Bus type arguments."
+ ;; `:array'. It contains several elements of the same type.
+ (should (dbus-check-arguments :session dbus--test-service '("string")))
+ (should (dbus-check-arguments :session dbus--test-service '(:array
"string")))
+ (should
+ (dbus-check-arguments :session dbus--test-service '(:array :string
"string")))
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service '(:array :string "string1" "string2")))
+ ;; Empty array.
+ (should (dbus-check-arguments :session dbus--test-service '(:array)))
+ (should
+ (dbus-check-arguments :session dbus--test-service '(:array :signature "o")))
+ ;; Different element types.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array :string "string" :object-path "/object/path"))
+ :type 'wrong-type-argument)
+
+ ;; `:variant'. It contains exactly one element.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service '(:variant :string "string")))
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service '(:variant (:array "string"))))
+ ;; More than one element.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:variant :string "string" :object-path "/object/path"))
+ :type 'wrong-type-argument)
+
+ ;; `:dict-entry'. It must contain two elements; the first one must
+ ;; be of a basic type. It must be an element of an array.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array (:dict-entry :string "string" :boolean t))))
+ ;; The second element is `nil' (implicitly). FIXME: Is this right?
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service '(:array (:dict-entry :string "string"))))
+ ;; Not two elements.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array (:dict-entry :string "string" :boolean t :boolean t)))
+ :type 'wrong-type-argument)
+ ;; The first element ist not of a basic type.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array (:dict-entry (:array :string "string") :boolean t)))
+ :type 'wrong-type-argument)
+ ;; It is not an element of an array.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service '(:dict-entry :string "string" :boolean t))
+ :type 'wrong-type-argument)
+ ;; Different dict entry types can be part of an array.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:array
+ (:dict-entry :string "string1" :boolean t)
+ (:dict-entry :string "string2" :object-path "/object/path"))))
+
+ ;; `:struct'. There is no restriction what could be an element of a struct.
+ (should
+ (dbus-check-arguments
+ :session dbus--test-service
+ '(:struct
+ :string "string"
+ :object-path "/object/path"
+ (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4))))))
+
(defun dbus--test-register-service (bus)
"Check service registration at BUS."
;; Cleanup.
@@ -219,6 +486,17 @@ This includes initialization and closing the bus."
(handler #'dbus--test-method-handler)
registered)
+ ;; The service is not registered yet.
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 :timeout 10 "foo")))
+ `(dbus-error ,dbus-error-service-unknown)))
+
+ ;; Register.
(should
(equal
(setq
@@ -272,7 +550,6 @@ This includes initialization and closing the bus."
(should-not (dbus-unregister-object registered))
(should
(equal
- ;; We don't care the error message text.
(butlast
(should-error
(dbus-call-method
@@ -283,8 +560,67 @@ This includes initialization and closing the bus."
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
-;; TODO: Test emits-signal.
-(ert-deftest dbus-test05-register-property ()
+(defvar dbus--test-signal-received nil
+ "Received signal value in `dbus--test-signal-handler'.")
+
+(defun dbus--test-signal-handler (&rest args)
+ "Signal handler for `dbus-test*-signal'."
+ (setq dbus--test-signal-received args))
+
+(defun dbus--test-timeout-handler (&rest _ignore)
+ "Timeout handler, reporting a failed test."
+ (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
+
+(ert-deftest dbus-test05-register-signal ()
+ "Check signal registration for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((member "Member")
+ (handler #'dbus--test-signal-handler)
+ registered)
+
+ ;; Register signal handler.
+ (should
+ (equal
+ (setq
+ registered
+ (dbus-register-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member handler))
+ `((:signal :session ,dbus--test-interface ,member)
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; Send one argument, basic type.
+ (setq dbus--test-signal-received nil)
+ (dbus-send-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member "foo")
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ (should (equal dbus--test-signal-received '("foo")))
+
+ ;; Send two arguments, compound types.
+ (setq dbus--test-signal-received nil)
+ (dbus-send-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member
+ '(:array :byte 1 :byte 2 :byte 3) '(:variant :string "bar"))
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ (should (equal dbus--test-signal-received '((1 2 3) ("bar"))))
+
+ ;; Unregister signal.
+ (should (dbus-unregister-object registered))
+ (should-not (dbus-unregister-object registered)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test06-register-property ()
"Check property registration for an own service."
(skip-unless dbus--test-enabled-session-bus)
(dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
@@ -314,20 +650,14 @@ This includes initialization and closing the bus."
"foo"))
;; Due to `:read' access type, we don't get a proper reply
;; from `dbus-set-property'.
- (should-not
- (dbus-set-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property1 "foofoo"))
- (let ((dbus-show-dbus-errors t))
- (should
- (equal
- ;; We don't care the error message text.
- (butlast
- (should-error
- (dbus-set-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property1 "foofoo")))
- `(dbus-error ,dbus-error-property-read-only))))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo")))
+ `(dbus-error ,dbus-error-property-read-only)))
(should
(string-equal
(dbus-get-property
@@ -345,30 +675,29 @@ This includes initialization and closing the bus."
(,dbus--test-service ,dbus--test-path))))
;; Due to `:write' access type, we don't get a proper reply
;; from `dbus-get-property'.
- (should-not
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property2))
- (let ((dbus-show-dbus-errors t))
- (should
- (equal
- ;; We don't care the error message text.
- (butlast
- (should-error
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property2)))
- `(dbus-error ,dbus-error-access-denied))))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)))
+ `(dbus-error ,dbus-error-access-denied)))
(should
(string-equal
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2 "barbar")
"barbar"))
- (should-not ;; Due to `:write' access type.
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property2))
+ ;; Still `:write' access type.
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)))
+ `(dbus-error ,dbus-error-access-denied)))
;; `:readwrite' property, typed value (Bug#43252).
(should
@@ -398,34 +727,22 @@ This includes initialization and closing the bus."
"/baz/baz"))
;; Not registered property.
- (should-not
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property4))
- (let ((dbus-show-dbus-errors t))
- (should
- (equal
- ;; We don't care the error message text.
- (butlast
- (should-error
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property4)))
- `(dbus-error ,dbus-error-unknown-property))))
- (should-not
- (dbus-set-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property4 "foobarbaz"))
- (let ((dbus-show-dbus-errors t))
- (should
- (equal
- ;; We don't care the error message text.
- (butlast
- (should-error
- (dbus-set-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property4 "foobarbaz")))
- `(dbus-error ,dbus-error-unknown-property))))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4)))
+ `(dbus-error ,dbus-error-unknown-property)))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4 "foobarbaz")))
+ `(dbus-error ,dbus-error-unknown-property)))
;; `dbus-get-all-properties'. We cannot retrieve a value for
;; the property with `:write' access type.
@@ -451,26 +768,20 @@ This includes initialization and closing the bus."
;; Unregister property.
(should (dbus-unregister-object registered))
(should-not (dbus-unregister-object registered))
- (should-not
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property1))
- (let ((dbus-show-dbus-errors t))
- (should
- (equal
- ;; We don't care the error message text.
- (butlast
- (should-error
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property1)))
- `(dbus-error ,dbus-error-unknown-property)))))
+ (should
+ (equal
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)))
+ `(dbus-error ,dbus-error-unknown-property))))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
;; The following test is inspired by Bug#43146.
-(ert-deftest dbus-test05-register-property-several-paths ()
+(ert-deftest dbus-test06-register-property-several-paths ()
"Check property registration for an own service at several paths."
(skip-unless dbus--test-enabled-session-bus)
(dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
@@ -625,6 +936,74 @@ This includes initialization and closing the bus."
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
+(ert-deftest dbus-test06-register-property-emits-signal ()
+ "Check property registration for an own service, including signalling."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property "Property")
+ (handler #'dbus--test-signal-handler))
+
+ ;; Register signal handler.
+ (should
+ (equal
+ (dbus-register-signal
+ :session dbus--test-service dbus--test-path
+ dbus-interface-properties "PropertiesChanged" handler)
+ `((:signal :session ,dbus-interface-properties "PropertiesChanged")
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; Register property.
+ (setq dbus--test-signal-received nil)
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property :readwrite "foo" 'emits-signal)
+ `((:property :session ,dbus--test-interface ,property)
+ (,dbus--test-service ,dbus--test-path))))
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ ;; It returns two arguments, "changed_properties" (an array of
+ ;; dict entries) and "invalidated_properties" (an array of
+ ;; strings).
+ (should (equal dbus--test-signal-received `(((,property ("foo"))) ())))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property)
+ "foo"))
+
+ ;; Set property. The new value shall be signalled.
+ (setq dbus--test-signal-received nil)
+ (should
+ (equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property
+ '(:array :byte 1 :byte 2 :byte 3))
+ '(1 2 3)))
+ (with-timeout (1 (dbus--test-timeout-handler))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1)))
+ (should
+ (equal
+ dbus--test-signal-received `(((,property ((1 2 3)))) ())))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property)
+ '(1 2 3))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
(interactive "p")
diff --git a/test/lisp/nxml/nxml-mode-tests.el
b/test/lisp/nxml/nxml-mode-tests.el
index 624e5c8..54d3bd8 100644
--- a/test/lisp/nxml/nxml-mode-tests.el
+++ b/test/lisp/nxml/nxml-mode-tests.el
@@ -132,5 +132,26 @@
<sub/>
</t>"))))
+(ert-deftest nxml-mode-test-comment-bug-17264 ()
+ "Test for Bug#17264."
+ (with-temp-buffer
+ (nxml-mode)
+ (let ((data "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+<spocosy version=\"1.0\" responsetime=\"2011-03-15 13:53:12\" exec=\"0.171\">
+ <!--
+ <query-response requestid=\"\" service=\"objectquery\">
+ <sport name=\"Soccer\" enetSportCode=\"s\" del=\"no\" n=\"1\"
ut=\"2009-12-29
+ 15:36:24\" id=\"1\">
+ </sport>
+ </query-response>
+ -->
+</spocosy>
+"))
+ (insert data)
+ (goto-char (point-min))
+ (search-forward "<query-response")
+ ;; Inside comment
+ (should (eq (nth 4 (syntax-ppss)) t)))))
+
(provide 'nxml-mode-tests)
;;; nxml-mode-tests.el ends here
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
new file mode 100644
index 0000000..0832f86
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.020;
+
+# This file contains test input and expected output for the tests in
+# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is
+# syntactically valid, but doesn't make much sense.
+
+# -------- PBP indent: input --------
+for my $foo (@ARGV)
+{
+...;
+}
+# -------- PBP indent: expected output --------
+for my $foo (@ARGV) {
+ ...;
+}
+# -------- PBP indent: end --------
+
+# -------- PBP uncuddle else: input --------
+{
+if (1 < 2)
+{
+say "Seems ok";
+} elsif (1 == 2) {
+say "Strange things are happening";
+} else {
+die "This world is backwards";
+}
+}
+# -------- PBP uncuddle else: expected output --------
+{
+ if (1 < 2) {
+ say "Seems ok";
+ }
+ elsif (1 == 2) {
+ say "Strange things are happening";
+ }
+ else {
+ die "This world is backwards";
+ }
+}
+# -------- PBP uncuddle else: end --------
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 2eaf633..f0ff8e9 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -172,4 +172,35 @@ end of the statement."
(setq got (concat "test case " name ":\n" (buffer-string)))
(should (equal got expected))))))))
+(ert-deftest cperl-mode-test-indent-styles ()
+ "Verify correct indentation by style \"PBP\".
+Perl Best Practices sets some indentation values different from
+ the defaults, and also wants an \"else\" or \"elsif\" keyword
+ to align with the \"if\"."
+ (let ((file (expand-file-name "cperl-indent-styles.pl"
+ cperl-mode-tests-data-directory)))
+ (with-temp-buffer
+ (cperl-set-style "PBP")
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
+ "\\(?2:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: expected output ?-+\n"
+ "\\(?3:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: end ?-+")
+ nil t)
+ (let ((name (match-string 1))
+ (code (match-string 2))
+ (expected (match-string 3))
+ got)
+ (with-temp-buffer
+ (insert code)
+ (cperl-mode)
+ (indent-region (point-min) (point-max)) ; here we go!
+ (setq expected (concat "test case " name ":\n" expected))
+ (setq got (concat "test case " name ":\n" (buffer-string)))
+ (should (equal got expected)))))
+ (cperl-set-style "CPerl"))))
+
;;; cperl-mode-tests.el ends here
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index 2de533e..6c30e4f 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -810,5 +810,17 @@ to (xref-elisp-test-descr-to-target xref)."
(insert "?\\N{HEAVY CHECK MARK}")
(should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK}))))
+(ert-deftest elisp-indent-basic ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (let ((orig "(defun x ()
+ (print (quote ( thingy great
+ stuff)))
+ (print (quote (thingy great
+ stuff))))"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here
diff --git a/test/src/keyboard-tests.el b/test/lisp/progmodes/opascal-tests.el
similarity index 52%
copy from test/src/keyboard-tests.el
copy to test/lisp/progmodes/opascal-tests.el
index 1988ba5..70a4ebf 100644
--- a/test/src/keyboard-tests.el
+++ b/test/lisp/progmodes/opascal-tests.el
@@ -1,6 +1,6 @@
-;;; keyboard-tests.el --- Tests for keyboard.c -*- lexical-binding: t -*-
+;;; opascal-tests.el --- tests for opascal.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -17,20 +17,29 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;; Code:
-
(require 'ert)
+(require 'opascal)
+
+(ert-deftest opascal-indent-bug-36348 ()
+ (with-temp-buffer
+ (opascal-mode)
+ (let ((orig "{ -*- opascal -*- }
+
+procedure Toto ();
+begin
+ for i := 0 to 1 do
+ Write (str.Chars[i]);
+
+ // bug#36348
+ for var i := 0 to 1 do
+ Write (str.Chars[i]);
+
+end;
+"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
+(provide 'opascal-tests)
-(ert-deftest keyboard-unread-command-events ()
- "Test `unread-command-events'."
- (should (equal (progn (push ?\C-a unread-command-events)
- (read-event nil nil 1))
- ?\C-a))
- (should (equal (progn (run-with-timer
- 1 nil
- (lambda () (push '(t . ?\C-b) unread-command-events)))
- (read-event nil nil 2))
- ?\C-b)))
-
-(provide 'keyboard-tests)
-;;; keyboard-tests.el ends here
+;;; opascal-tests.el ends here
diff --git a/test/lisp/progmodes/ps-mode-tests.el
b/test/lisp/progmodes/ps-mode-tests.el
index d565b32..eedf3f7 100644
--- a/test/lisp/progmodes/ps-mode-tests.el
+++ b/test/lisp/progmodes/ps-mode-tests.el
@@ -43,6 +43,30 @@
(should (equal (buffer-string)
"foo\\220\\221\\222bar"))))
+(ert-deftest ps-mode-test-indent ()
+ ;; Converted from manual test.
+ (with-temp-buffer
+ (ps-mode)
+ ;; TODO: Should some of these be fontification tests as well?
+ (let ((orig "%!PS-2.0
+
+<< 23 45 >> %dictionary
+< 23 > %hex string
+<~a>a%a~> %base85 string
+(%)s
+(sf\(g>a)sdg)
+
+/foo {
+ <<
+ hello 2
+ 3
+ >>
+} def
+"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
(provide 'ps-mode-tests)
;;; ps-mode-tests.el ends here
diff --git a/test/manual/indent/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
similarity index 99%
rename from test/manual/indent/ruby.rb
rename to test/lisp/progmodes/ruby-mode-resources/ruby.rb
index b038512..6b7d10d 100644
--- a/test/manual/indent/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -34,7 +34,7 @@ x = # "tot %q/to"; =
# Regexp after whitelisted method.
"abc".sub /b/, 'd'
-# Don't mis-match "sub" at the end of words.
+# Don't mismatch "sub" at the end of words.
a = asub / aslb + bsub / bslb;
# Highlight the regexp after "if".
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index 9d677a2..fb3b42b 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -24,6 +24,12 @@
(require 'ert)
(require 'ruby-mode)
+(defvar ruby-mode-tests-data-dir
+ (file-truename
+ (expand-file-name "ruby-mode-resources/"
+ (file-name-directory (or load-file-name
+ buffer-file-name)))))
+
(defmacro ruby-with-temp-buffer (contents &rest body)
(declare (indent 1) (debug t))
`(with-temp-buffer
@@ -842,6 +848,19 @@ VALUES-PLIST is a list with alternating index and value
elements."
(ruby--insert-coding-comment "utf-8")
(should (string= "# encoding: utf-8\n\n" (buffer-string))))))
+;; TODO: Convert these into unit proper tests instead of using an
+;; external file.
+(ert-deftest ruby--indent/converted-from-manual-test ()
+ :tags '(:expensive-test)
+ ;; Converted from manual test.
+ (let ((buf (find-file-noselect (expand-file-name "ruby.rb"
+ ruby-mode-tests-data-dir))))
+ (unwind-protect
+ (with-current-buffer buf
+ (let ((orig (buffer-string)))
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig))))
+ (kill-buffer buf))))
(provide 'ruby-mode-tests)
diff --git a/test/lisp/progmodes/scheme-tests.el
b/test/lisp/progmodes/scheme-tests.el
new file mode 100644
index 0000000..e3736bd
--- /dev/null
+++ b/test/lisp/progmodes/scheme-tests.el
@@ -0,0 +1,50 @@
+;;; scheme-tests.el --- Test suite for scheme.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'scheme)
+
+(ert-deftest scheme-test-indent ()
+ ;; FIXME: Look into what is the expected indent here and fix it.
+ :expected-result :failed
+ ;; Converted from manual test.
+ (with-temp-buffer
+ (scheme-mode)
+ ;; TODO: Should some of these be fontification tests as well?
+ (let ((orig "#!/usr/bin/scheme is this a comment?
+
+;; This one is a comment
+(a)
+#| and this one as #|well|# as this! |#
+(b)
+(cons #;(this is a
+ comment)
+ head tail)
+"))
+ (insert orig)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
+(provide 'scheme-tests)
+
+;;; scheme-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 2df5537..2adb4a6 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -440,5 +440,23 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(should-error (ignore-error foo
(read ""))))
+(ert-deftest replace-in-string ()
+ (should (equal (replace-in-string "foo" "bar" "zot")
+ "zot"))
+ (should (equal (replace-in-string "foo" "bar" "foozot")
+ "barzot"))
+ (should (equal (replace-in-string "foo" "bar" "barfoozot")
+ "barbarzot"))
+ (should (equal (replace-in-string "zot" "bar" "barfoozot")
+ "barfoobar"))
+ (should (equal (replace-in-string "z" "bar" "barfoozot")
+ "barfoobarot"))
+ (should (equal (replace-in-string "zot" "bar" "zat")
+ "zat"))
+ (should (equal (replace-in-string "azot" "bar" "zat")
+ "zat"))
+ (should (equal (replace-in-string "azot" "bar" "azot")
+ "bar")))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/textmodes/css-mode-tests.el
b/test/lisp/textmodes/css-mode-tests.el
index f627d1c..02bd2ac 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -417,6 +417,8 @@
(point))
"black")))))
+;; TODO: Convert these into unit proper tests instead of using an
+;; external file.
(ert-deftest css-mode-test-indent ()
(with-current-buffer
(find-file-noselect (expand-file-name "test-indent.css"
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index f738da7..b68a694 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -38,13 +38,26 @@
;; abort if they cannot. I could not figure out how to stop bzr
;; doing that, so just give it a temporary homedir for the duration.
;; http://bugs.launchpad.net/bzr/+bug/137407 ?
+ ;;
+ ;; Note that with bzr 2.x, this works:
+ ;; mkdir /tmp/bzr
+ ;; HOME=/nonexistent BZR_HOME=/tmp/bzr bzr status
+ ;; but with brz 3.1, it complains:
+ ;; "failed to open trace file: [Errno 13] Permission denied: '/nonexistent'"
+ ;; which confuses vc-dir.
+ ;; We can quieten brz by adding either BRZ_LOG=/dev/null, or
+ ;; XDG_CACHE_HOME=/tmp/bzr (log defaults to XDG_CACHE_HOME/breezy/brz.log),
+ ;; but it seems simpler to just set HOME to a newly created
+ ;; temporary directory.
+ ;; TODO does this means tests should be setting XDG_ variables (not
+ ;; just HOME) to temporary values too?
(let* ((homedir (make-temp-file "vc-bzr-test" t))
(bzrdir (expand-file-name "bzr" homedir))
(ignored-dir (progn
(make-directory bzrdir)
(expand-file-name "ignored-dir" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
- (process-environment (cons (format "BZR_HOME=%s" homedir)
+ (process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
(progn
@@ -81,7 +94,7 @@
(expand-file-name "subdir" bzrdir)))
(file (expand-file-name "file" bzrdir))
(default-directory (file-name-as-directory bzrdir))
- (process-environment (cons (format "BZR_HOME=%s" homedir)
+ (process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
(progn
@@ -119,7 +132,7 @@
(expand-file-name "foo.el" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
(generated-autoload-file (expand-file-name "loaddefs.el" bzrdir))
- (process-environment (cons (format "BZR_HOME=%s" homedir)
+ (process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
(progn
diff --git a/test/manual/etags/c-src/emacs/src/keyboard.c
b/test/manual/etags/c-src/emacs/src/keyboard.c
index d4e3848..e869363 100644
--- a/test/manual/etags/c-src/emacs/src/keyboard.c
+++ b/test/manual/etags/c-src/emacs/src/keyboard.c
@@ -5754,7 +5754,7 @@ make_lispy_event (struct input_event *event)
ignore_mouse_drag_p = 0;
}
- /* Now we're releasing a button - check the co-ordinates to
+ /* Now we're releasing a button - check the coordinates to
see if this was a click or a drag. */
else if (event->modifiers & up_modifier)
{
diff --git a/test/manual/etags/y-src/parse.c b/test/manual/etags/y-src/parse.c
index e35d862..0415c4a 100644
--- a/test/manual/etags/y-src/parse.c
+++ b/test/manual/etags/y-src/parse.c
@@ -1917,7 +1917,7 @@ yylex FUN0()
}
#ifdef TEST
if(nn==n_usr_funs) {
- io_error_msg("Couln't turn fp into a ##");
+ io_error_msg("Couldn't turn fp into a ##");
parse_error=BAD_FUNC;
return ERROR;
}
diff --git a/test/manual/etags/y-src/parse.y b/test/manual/etags/y-src/parse.y
index 075add2..eeef44c 100644
--- a/test/manual/etags/y-src/parse.y
+++ b/test/manual/etags/y-src/parse.y
@@ -556,7 +556,7 @@ yylex FUN0()
}
#ifdef TEST
if(nn==n_usr_funs) {
- io_error_msg("Couln't turn fp into a ##");
+ io_error_msg("Couldn't turn fp into a ##");
parse_error=BAD_FUNC;
return ERROR;
}
diff --git a/test/manual/indent/elisp.el b/test/manual/indent/elisp.el
deleted file mode 100644
index 7d634ae..0000000
--- a/test/manual/indent/elisp.el
+++ /dev/null
@@ -1,6 +0,0 @@
-;; -*- lexical-binding:t -*-
-(defun x ()
- (print (quote ( thingy great
- stuff)))
- (print (quote (thingy great
- stuff))))
diff --git a/test/manual/indent/lisp.lisp b/test/manual/indent/lisp.lisp
deleted file mode 100644
index f3874b5..0000000
--- a/test/manual/indent/lisp.lisp
+++ /dev/null
@@ -1,5 +0,0 @@
-(defun x ()
- (print (quote ( thingy great
- stuff)))
- (print (quote (thingy great
- stuff))))
diff --git a/test/manual/indent/nxml.xml b/test/manual/indent/nxml.xml
deleted file mode 100644
index 61b84f2..0000000
--- a/test/manual/indent/nxml.xml
+++ /dev/null
@@ -1,10 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<spocosy version="1.0" responsetime="2011-03-15 13:53:12" exec="0.171">
- <!--
- <query-response requestid="" service="objectquery">
- <sport name="Soccer" enetSportCode="s" del="no" n="1" ut="2009-12-29
- 15:36:24" id="1">
- </sport>
- </query-response>
- -->
-</spocosy>
diff --git a/test/manual/indent/opascal.pas b/test/manual/indent/opascal.pas
deleted file mode 100644
index ac4beb3..0000000
--- a/test/manual/indent/opascal.pas
+++ /dev/null
@@ -1,12 +0,0 @@
-{ -*- opascal -*- }
-
-procedure Toto ();
-begin
- for i := 0 to 1 do
- Write (str.Chars[i]);
-
- // bug#36348
- for var i := 0 to 1 do
- Write (str.Chars[i]);
-
-end;
diff --git a/test/manual/indent/ps-mode.ps b/test/manual/indent/ps-mode.ps
deleted file mode 100644
index 4b4ee0f..0000000
--- a/test/manual/indent/ps-mode.ps
+++ /dev/null
@@ -1,14 +0,0 @@
-%!PS-2.0
-
-<< 23 45 >> %dictionary
-< 23 > %hex string
-<~a>a%a~> %base85 string
-(%)s
-(sf\(g>a)sdg)
-
-/foo {
- <<
- hello 2
- 3
- >>
-} def
diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm
deleted file mode 100644
index 84d0f6d..0000000
--- a/test/manual/indent/scheme.scm
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/usr/bin/scheme is this a comment?
-
-;; This one is a comment
-(a)
-#| and this one as #|well|# as this! |#
-(b)
-(cons #;(this is a
- comment)
- head tail)
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 096c6b3..1eebb41 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -468,4 +468,36 @@ See Bug#36226."
(should (equal (buffer-string) "data from thread")))
(delete-process process)))))
+(ert-deftest module/interactive/return-t ()
+ (should (functionp (symbol-function #'mod-test-return-t)))
+ (should (module-function-p (symbol-function #'mod-test-return-t)))
+ (should-not (commandp #'mod-test-return-t))
+ (should-not (commandp (symbol-function #'mod-test-return-t)))
+ (should-not (interactive-form #'mod-test-return-t))
+ (should-not (interactive-form (symbol-function #'mod-test-return-t)))
+ (should-error (call-interactively #'mod-test-return-t)
+ :type 'wrong-type-argument))
+
+(ert-deftest module/interactive/return-t-int ()
+ (should (functionp (symbol-function #'mod-test-return-t-int)))
+ (should (module-function-p (symbol-function #'mod-test-return-t-int)))
+ (should (commandp #'mod-test-return-t-int))
+ (should (commandp (symbol-function #'mod-test-return-t-int)))
+ (should (equal (interactive-form #'mod-test-return-t-int) '(interactive)))
+ (should (equal (interactive-form (symbol-function #'mod-test-return-t-int))
+ '(interactive)))
+ (should (eq (mod-test-return-t-int) t))
+ (should (eq (call-interactively #'mod-test-return-t-int) t)))
+
+(ert-deftest module/interactive/identity ()
+ (should (functionp (symbol-function #'mod-test-identity)))
+ (should (module-function-p (symbol-function #'mod-test-identity)))
+ (should (commandp #'mod-test-identity))
+ (should (commandp (symbol-function #'mod-test-identity)))
+ (should (equal (interactive-form #'mod-test-identity) '(interactive "i")))
+ (should (equal (interactive-form (symbol-function #'mod-test-identity))
+ '(interactive "i")))
+ (should (eq (mod-test-identity 123) 123))
+ (should-not (call-interactively #'mod-test-identity)))
+
;;; emacs-module-tests.el ends here
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
index 1988ba5..970a535 100644
--- a/test/src/keyboard-tests.el
+++ b/test/src/keyboard-tests.el
@@ -32,5 +32,20 @@
(read-event nil nil 2))
?\C-b)))
+(ert-deftest keyboard-lossage-size ()
+ "Test `lossage-size'."
+ (let ((min-value 100)
+ (lossage-orig (lossage-size)))
+ (dolist (factor (list 1 3 4 5 10 7 3))
+ (let ((new-lossage (* factor min-value)))
+ (should (= new-lossage (lossage-size new-lossage)))))
+ ;; Wrong type
+ (should-error (lossage-size -5))
+ (should-error (lossage-size "200"))
+ ;; Less that minimum value
+ (should-error (lossage-size (1- min-value)))
+ (should (= lossage-orig (lossage-size lossage-orig)))))
+
+
(provide 'keyboard-tests)
;;; keyboard-tests.el ends here
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 42e5962..eb9572d 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -355,5 +355,33 @@ otherwise, use a different charset."
(setcdr err err)
(should-error (error-message-string err) :type 'circular-list)))
+(print-tests--deftest print-hash-table-test ()
+ (should
+ (string-match
+ "data (2 3)"
+ (let ((h (make-hash-table)))
+ (puthash 1 2 h)
+ (puthash 2 3 h)
+ (remhash 1 h)
+ (format "%S" h))))
+
+ (should
+ (string-match
+ "data ()"
+ (let ((h (make-hash-table)))
+ (let ((print-length 0))
+ (format "%S" h)))))
+
+ (should
+ (string-match
+ "data (99 99)"
+ (let ((h (make-hash-table)))
+ (dotimes (i 100)
+ (puthash i i h))
+ (dotimes (i 99)
+ (remhash i h))
+ (let ((print-length 1))
+ (format "%S" h))))))
+
(provide 'print-tests)
;;; print-tests.el ends here