[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 6eb5a8c 1/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 6eb5a8c 1/2: Merge remote-tracking branch 'savannah/master' into clean-up |
|
Date: |
Wed, 30 Sep 2020 10:06:09 -0400 (EDT) |
branch: feature/native-comp
commit 6eb5a8c49295a132d341c04fad6998b293930eb6
Merge: 89f0641 6c0f1c2
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into clean-up
---
admin/cus-test.el | 2 +-
doc/emacs/ChangeLog.1 | 4 +-
doc/emacs/abbrevs.texi | 33 ++++
doc/emacs/building.texi | 5 +
doc/emacs/custom.texi | 2 +-
doc/emacs/emacs.texi | 8 +-
doc/emacs/maintaining.texi | 2 +-
doc/lispref/display.texi | 2 +-
doc/lispref/functions.texi | 10 ++
doc/lispref/internals.texi | 2 +-
doc/lispref/modes.texi | 2 +-
doc/lispref/searching.texi | 8 +-
doc/misc/ChangeLog.1 | 10 +-
doc/misc/dbus.texi | 165 +++++++++++++-----
doc/misc/ede.texi | 2 +-
doc/misc/flymake.texi | 2 +-
doc/misc/gnus-faq.texi | 2 +-
doc/misc/tramp.texi | 2 +-
etc/NEWS | 33 +++-
etc/NEWS.1-17 | 2 +-
etc/NEWS.27 | 2 +-
lisp/abbrev.el | 143 +++++++++++++++-
lisp/arc-mode.el | 17 +-
lisp/bindings.el | 4 +-
lisp/comint.el | 16 +-
lisp/cus-start.el | 14 +-
lisp/dired-aux.el | 8 +-
lisp/dired.el | 5 +-
lisp/emacs-lisp/byte-opt.el | 29 ++--
lisp/emacs-lisp/cl-macs.el | 1 +
lisp/emacs-lisp/generic.el | 4 +
lisp/emacs-lisp/subr-x.el | 1 +
lisp/epa-file.el | 21 ++-
lisp/fileloop.el | 3 +
lisp/gnus/gnus-fun.el | 11 +-
lisp/gnus/gnus-icalendar.el | 8 +-
lisp/gnus/gnus-util.el | 47 ++++++
lisp/gnus/message.el | 3 +-
lisp/gnus/smime.el | 5 +-
lisp/hi-lock.el | 14 +-
lisp/isearch.el | 54 +++---
lisp/mail/emacsbug.el | 6 +-
lisp/menu-bar.el | 4 +
lisp/net/dbus.el | 296 +++++++++++++++++++++------------
lisp/net/soap-client.el | 149 ++++++++++++-----
lisp/pcmpl-unix.el | 6 +-
lisp/progmodes/compile.el | 13 +-
lisp/progmodes/cperl-mode.el | 245 ++++-----------------------
lisp/progmodes/grep.el | 9 +-
lisp/server.el | 17 +-
lisp/shell.el | 9 +-
lisp/simple.el | 6 +-
lisp/subr.el | 17 +-
lisp/wid-edit.el | 71 +++++++-
make-dist | 2 +-
src/cmds.c | 2 +-
src/dbusbind.c | 22 ++-
src/eval.c | 4 +-
src/fns.c | 46 ++++-
src/print.c | 50 +++---
src/xdisp.c | 11 +-
test/lisp/gnus/gnus-icalendar-tests.el | 125 ++++++++------
test/lisp/gnus/gnus-util-tests.el | 95 +++++++++++
test/lisp/net/dbus-tests.el | 78 ++++++++-
test/lisp/subr-tests.el | 42 +++--
test/src/fns-tests.el | 28 +++-
66 files changed, 1388 insertions(+), 673 deletions(-)
diff --git a/admin/cus-test.el b/admin/cus-test.el
index cee8c19..b4e4b42 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -347,7 +347,7 @@ Optional argument ALL non-nil means list all (non-obsolete)
Lisp files."
;; Hack to remove leading "./".
(mapcar (lambda (e) (substring e 2))
(apply 'process-lines find-program
- "-name" "obsolete" "-prune" "-o"
+ "." "-name" "obsolete" "-prune" "-o"
"-name" "[^.]*.el" ; ignore .dir-locals.el
(if all
'("-print")
diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1
index 3513c66..cf641be 100644
--- a/doc/emacs/ChangeLog.1
+++ b/doc/emacs/ChangeLog.1
@@ -2206,7 +2206,7 @@
Describe group levels more clearly.
(Gnus Group Buffer, Gnus Summary Buffer): New nodes, split from
Summary of Gnus.
- (Document View): Copyedits. Move zoom commads to DocView
+ (Document View): Copyedits. Move zoom commands to DocView
Navigation node.
(DocView Navigation, DocView Searching, DocView Slicing)
(DocView Conversion): Nodes renamed from Navigation, etc.
@@ -10290,7 +10290,7 @@
* buffers.texi (Misc Buffer): Explain use of M-x rename-uniquely
for multiple compile and grep buffers.
- (Indirect Buffers): Don't recommand clone-indirect-buffer
+ (Indirect Buffers): Don't recommend clone-indirect-buffer
for multiple compile and grep buffers.
2004-02-29 Juanma Barranquero <lektu@terra.es>
diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi
index 21bf8c5..e3766aa 100644
--- a/doc/emacs/abbrevs.texi
+++ b/doc/emacs/abbrevs.texi
@@ -28,6 +28,7 @@ Automatic Typing}.
* Abbrev Concepts:: Fundamentals of defined abbrevs.
* Defining Abbrevs:: Defining an abbrev, so it will expand when typed.
* Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion.
+* Abbrevs Suggestions:: Get automatic suggestions about defined abbrevs.
* Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs.
* Saving Abbrevs:: Saving the entire list of abbrevs for another session.
* Dynamic Abbrevs:: Abbreviations for words already in the buffer.
@@ -223,6 +224,38 @@ changing this function you can make arbitrary changes to
the abbrev expansion. @xref{Abbrev Expansion,,, elisp, The Emacs Lisp
Reference Manual}.
+@node Abbrevs Suggestions
+@section Abbrevs Suggestions
+
+ You can get abbrev suggestions when you manually type text for which
+there is currently an active defined abbrev. For example, if there is
+an abbrev @samp{foo} with the expansion @samp{find outer otter}, and
+you manually type @samp{find outer otter}, Emacs can notice this and
+show a hint in the echo area when you have stopped typing.
+
+@vindex abbrev-suggest
+ To enable the abbrev suggestion feature, customize the option
+@code{abbrev-suggest} to a non-@code{nil} value.
+
+@vindex abbrev-suggest-hint-threshold
+ The variable @code{abbrev-suggest-hint-threshold} controls when to
+suggest an abbrev to the user. This variable defines the minimum
+savings (in terms of the number of characters the user will not have
+to type) required for Emacs to suggest using an abbrev. For example,
+if the user types @samp{foo bar} (seven characters) and there is an
+abbrev @samp{fubar} defined (five characters), the user will not get
+any suggestion unless the threshold is set to the number 2 or lower.
+With the default value 3, the user would not get any suggestion in
+this example, because the savings in using the abbrev are below
+the threshold. If you always want to get abbrev suggestions, set this
+variable's value to zero.
+
+@findex abbrev-suggest-show-report
+ The command @code{abbrev-suggest-show-report} displays a buffer with
+all the abbrev suggestions shown during the current editing session.
+This can be useful if you get several abbrev suggestions and don't
+remember them all.
+
@node Editing Abbrevs
@section Examining and Editing Abbrevs
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 7074bd4..5f7d9b7 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -427,11 +427,16 @@ M-n}}, @key{RET}, and so forth, just like compilation
errors.
@xref{Compilation Mode}, for detailed description of commands and key
bindings available in the @file{*grep*} buffer.
+@vindex grep-match-regexp
Some grep programs accept a @samp{--color} option to output special
markers around matches for the purpose of highlighting. You can make
use of this feature by setting @code{grep-highlight-matches} to
@code{t}. When displaying a match in the source buffer, the exact
match will be highlighted, instead of the entire source line.
+Highlighting is provided via matching the @acronym{ANSI} escape
+sequences emitted by @command{grep}. The matching of the sequences is
+controlled by @code{grep-match-regexp}, which can be customized to
+accommodate different @command{grep} programs.
As with compilation commands (@pxref{Compilation}), while the grep
command runs, the mode line shows the running number of matches found
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index a512fd1..81874a0 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2679,7 +2679,7 @@ basename.)
Emacs can also look in an XDG-compatible location for @file{init.el},
the default is the directory @file{~/.config/emacs}. This can be
-overriden by setting @env{XDG_CONFIG_HOME} in your environment, its
+overridden by setting @env{XDG_CONFIG_HOME} in your environment, its
value replaces @file{~/.config} in the name of the default XDG init
file. However @file{~/.emacs.d}, @file{~/.emacs}, and
@file{~/.emacs.el} are always preferred if they exist, which means
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 6aed7bd..bd40e10 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -108,10 +108,9 @@ Cover art by Etienne Suvasa; cover design by Matt Lee.
@node Top
@top The Emacs Editor
-Emacs is the extensible, customizable, self-documenting real-time
-display editor. This manual describes how to edit with Emacs and
-some of the ways to customize it; it corresponds to GNU Emacs version
-@value{EMACSVER}.
+Emacs is the advanced, extensible, customizable, self-documenting
+editor. This manual describes how to edit with Emacs and some of the
+ways to customize it; it corresponds to GNU Emacs version @value{EMACSVER}.
@c See 'manual-html-mono' and 'manual-html-node' in admin/admin.el.
@ifset WWW_GNU_ORG
@@ -908,6 +907,7 @@ Abbrevs
* Abbrev Concepts:: Fundamentals of defined abbrevs.
* Defining Abbrevs:: Defining an abbrev, so it will expand when typed.
* Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion.
+* Abbrevs Suggestions:: Get automatic suggestions about defined abbrevs.
* Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs.
* Saving Abbrevs:: Saving the entire list of abbrevs for another session.
* Dynamic Abbrevs:: Abbreviations for words already in the buffer.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index a9b0da5..1f10b68 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1458,7 +1458,7 @@ working tree to match the branch you switch to. Bazaar
also supports
co-located branches, in which case the @kbd{bzr switch} command
will switch branches in the current directory. With Subversion, you
switch to another branch using the @kbd{svn switch} command. With
-Mercurial, command @kbd{hg update} is used to swith to another
+Mercurial, command @kbd{hg update} is used to switch to another
branch.
The VC command to switch to another branch in the current directory
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 40978b4..7d1c14c 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -8265,7 +8265,7 @@ different.
Emacs provides a primitive that applications can use to detect
instances of text whose bidirectional properties were overridden so as
to make a left-to-right character display as if it were a
-right-to-left character, or vise versa.
+right-to-left character, or vice versa.
@defun bidi-find-overridden-directionality from to &optional object
This function looks at the text of the specified @var{object} between
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 26b212d..e8e2207 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -762,6 +762,11 @@ arguments, rather than a single list. We say that
@code{apply}
@dfn{spreads} this list so that each individual element becomes an
argument.
+@code{apply} with a single argument is special: the first element of
+the argument, which must be a non-empty list, is called as a function
+with the remaining elements as individual arguments. Passing two or
+more arguments will be faster.
+
@code{apply} returns the result of calling @var{function}. As with
@code{funcall}, @var{function} must either be a Lisp function or a
primitive function; special forms and macros do not make sense in
@@ -789,6 +794,11 @@ primitive function; special forms and macros do not make
sense in
(apply 'append '((a b c) nil (x y z) nil))
@result{} (a b c x y z)
@end group
+
+@group
+(apply '(+ 3 4))
+ @result{} 7
+@end group
@end example
For an interesting example of using @code{apply}, see @ref{Definition
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index cc18b85..fed9612 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -2059,7 +2059,7 @@ I/O,,,libc}.
@cindex nonlocal exits, in modules
Emacs Lisp supports nonlocal exits, whereby program control is
-transfered from one point in a program to another remote point.
+transferred from one point in a program to another remote point.
@xref{Nonlocal Exits}. Thus, Lisp functions called by your module
might exit nonlocally by calling @code{signal} or @code{throw}, and
your module functions must handle such nonlocal exits properly. Such
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 1652cb6..be2ee57 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -3293,7 +3293,7 @@ is disabled, @code{font-lock-face} has no effect on the
display.
also use the normal Font Lock machinery. But if the mode does not use
the normal Font Lock machinery, it should not set the variable
@code{font-lock-defaults}. In this case the @code{face} property will
-not be overriden, so using the @code{face} property could work too.
+not be overridden, so using the @code{face} property could work too.
However, using @code{font-lock-face} is generally preferable as it
allows the user to control the fontification by toggling
@code{font-lock-mode}, and lets the code work regardless of whether
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index a217c6e..592b876 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -2566,9 +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}.
+@defun string-replace fromstring tostring instring
+This function replaces all occurrences of @var{fromstring} with
+@var{tostring} in @var{instring} and returns the result. It may
+return one of its arguments unchanged, a constant string or a new
+string. Case is significant, and text properties are ignored.
@end defun
If you want to write a command along the lines of @code{query-replace},
diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1
index a85971b..f74e51f 100644
--- a/doc/misc/ChangeLog.1
+++ b/doc/misc/ChangeLog.1
@@ -502,7 +502,7 @@
* org.texi (@LaTeX{} specific attributes): Update manual.
* org.texi (Top, Exporting): Org has its own documentation and
- should therefore be removed from "Other build-in back-ends".
+ should therefore be removed from "Other built-in back-ends".
2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -1161,7 +1161,7 @@
(Special agenda views): Mention the "agenda*" agenda view.
* org.texi (Repeated tasks): Document how to ignore a repeater
- when using both a scheduled and a deadline timetamp.
+ when using both a scheduled and a deadline timestamp.
* org.texi (Global and local cycling): Wrap in a new subsection.
(Initial visibility, Catching invisible edits): New subsections.
@@ -3515,7 +3515,7 @@
2012-01-03 Rafael Laboissiere <rafael@laboissiere.net> (tiny change)
* org.texi (External links): Add footnote on how the behavior
- of the text search in Org files are controled by the variable
+ of the text search in Org files are controlled by the variable
`org-link-search-must-match-exact-headline'.
2012-01-03 Eric Schulte <schulte.eric@gmail.com>
@@ -6262,7 +6262,7 @@
information - it's hard to keep up-to-date, and adds nothing.
Similarly with direct links to mailing lists.
(Spell-checkers): Rename node from Ispell. Mention Aspell and Hunspell.
- (Mailcrypt): Remove section - mailcrypt has not been updated in mnay
+ (Mailcrypt): Remove section - mailcrypt has not been updated in many
years, and Emacs comes with tools for this now.
(Patch): Remove section - this is a standard tool.
(Using function keys under X): Remove section.
@@ -6493,7 +6493,7 @@
specified in a property.
(Text areas in HTML export): New section.
(External links): Add examples for text search and ID links.
- (Built-in table editor): Remove the descriptio of `C-c
+ (Built-in table editor): Remove the description of `C-c
C-q', it not longer works.
(Literal examples): Document that a space must follow
the colon in short examples.
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 95d6523..4b2eab4 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -63,6 +63,7 @@ another. An overview of D-Bus can be found at
* Signals:: Sending and receiving signals.
* Alternative Buses:: Alternative buses and environments.
* Errors and Events:: Errors and events.
+* Monitoring Events:: Monitoring events.
* Index:: Index including concepts, functions, variables.
* GNU Free Documentation License:: The license for this documentation.
@@ -162,12 +163,13 @@ registered names. Internally they use the basic interface
@defun dbus-list-activatable-names &optional bus
This function returns the D-Bus service names, which can be activated
-for @var{bus}. It must be either the symbol @code{:system} (the
-default) or the symbol @code{:session}. An activatable service is
+for @var{bus}. It must be either the keyword @code{:system} (the
+default) or the keyword @code{:session}. An activatable service is
described in a service registration file. Under GNU/Linux, such files
are located at @file{/usr/share/dbus-1/system-services/} (for the
@code{:system} bus) or @file{/usr/share/dbus-1/services/}. An
-activatable service is not necessarily registered at @var{bus} already.
+activatable service is not necessarily registered at @var{bus}
+already.
The result is a list of strings, which is @code{nil} when there are no
activatable service names at all. Example:
@@ -186,7 +188,7 @@ there are no registered service names at all. Well known
names are
strings like @samp{org.freedesktop.DBus}. Names starting with
@samp{:} are unique names for services.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -196,7 +198,7 @@ known name in @var{bus}. A service has a known name if it
doesn't
start with @samp{:}. The result is a list of strings, which is
@code{nil} when there are no known names at all.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -206,7 +208,7 @@ For a given service, registered at D-Bus @var{bus} under
the name
result is a list of strings, or @code{nil} when there are no queued
names for @var{service} at all.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a known service name as
string.
@end defun
@@ -217,7 +219,7 @@ For a given service, registered at D-Bus @var{bus} under
the name
owner. The result is a string, or @code{nil} when there is no name
owner of @var{service}.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a known service name as
string.
@end defun
@@ -228,7 +230,7 @@ registered at D-Bus @var{bus}. If @var{service} has not
yet started,
it is autostarted if possible. The result is either @code{t} or
@code{nil}.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a string. @var{timeout}, a
nonnegative integer, specifies the maximum number of milliseconds
before @code{dbus-ping} must return. The default value is 25,000.
@@ -256,7 +258,7 @@ it, you can instead write:
This function returns the unique name, under which Emacs is registered
at D-Bus @var{bus}, as a string.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -375,7 +377,7 @@ must be strings.
This function returns all interfaces and sub-nodes of @var{service},
registered at object path @var{path} at bus @var{bus}.
-@var{bus} must be either the symbol @code{:system} or the symbol
+@var{bus} must be either the keyword @code{:system} or the keyword
@code{:session}. @var{service} must be a known service name, and
@var{path} must be a valid object path. The last two parameters are
strings. The result, the introspection data, is a string in XML
@@ -747,8 +749,8 @@ or @var{property} cannot be read, an error is raised.
Example:
@defun dbus-set-property bus service path interface property [type] value
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}.
+@var{path}. @var{value} can be preceded by a @var{type} keyword.
+When the value is successfully set, this function returns @var{value}.
Example:
@lisp
@@ -999,8 +1001,8 @@ Other Lisp objects, like symbols or hash tables, are not
accepted as
input parameters.
If it is necessary to use another D-Bus type, a corresponding type
-symbol can be prepended to the corresponding Lisp object. Basic D-Bus
-types are represented by the type symbols @code{:byte},
+keyword can be prepended to the corresponding Lisp object. Basic
+D-Bus types are represented by the type keywords @code{:byte},
@code{:boolean}, @code{:int16}, @code{:uint16}, @code{:int32},
@code{:uint32}, @code{:int64}, @code{:uint64}, @code{:double},
@code{:string}, @code{:object-path}, @code{:signature} and
@@ -1040,7 +1042,7 @@ 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},
+of this list can be the type keyword @code{:array}, @code{:variant},
@code{:struct} or @code{:dict-entry}, which would result in a
corresponding D-Bus container. @code{:array} is optional, because
this is the default compound D-Bus type for a list.
@@ -1215,7 +1217,7 @@ parameters from the object.
@defun dbus-call-method bus service path interface method &optional :timeout
timeout &rest args
@anchor{dbus-call-method}
This function calls @var{method} on the D-Bus @var{bus}. @var{bus} is
-either the symbol @code{:system} or the symbol @code{:session}.
+either the keyword @code{:system} or the keyword @code{:session}.
@var{service} is the D-Bus service name to be used. @var{path} is the
D-Bus object path, @var{service} is registered at. @var{interface} is
@@ -1308,8 +1310,8 @@ emulate the @code{lshal} command on GNU/Linux systems:
@defun dbus-call-method-asynchronously bus service path interface method
handler &optional :timeout timeout &rest args
This function calls @var{method} on the D-Bus @var{bus}
-asynchronously. @var{bus} is either the symbol @code{:system} or the
-symbol @code{:session}.
+asynchronously. @var{bus} is either the keyword @code{:system} or the
+keyword @code{:session}.
@var{service} is the D-Bus service name to be used. @var{path} is the
D-Bus object path, @var{service} is registered at. @var{interface} is
@@ -1369,7 +1371,7 @@ the following functions:
This function registers the known name @var{service} on D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the service name to be registered on the D-Bus. It
@@ -1405,7 +1407,7 @@ We already are the primary owner.
This function unregisters all objects from D-Bus @var{bus}, that were
registered by Emacs for @var{service}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus. It must be a
@@ -1452,7 +1454,7 @@ The interface namespace @code{org.gnu.Emacs} used by
Emacs.
With this function, an application registers @var{method} on the D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus object
@@ -1477,8 +1479,8 @@ cons cell, @var{handler} can return this object directly,
instead of
returning a list containing the object.
If @var{handler} returns a reply message with an empty argument list,
-@var{handler} must return the symbol @code{:ignore} in order
-to distinguish it from @code{nil} (the boolean false).
+@var{handler} must return the keyword @code{:ignore} in order to
+distinguish it from @code{nil} (the boolean false).
If @var{handler} detects an error, it shall return the list
@code{(:error @var{error-name} @var{error-message})}.
@@ -1580,7 +1582,7 @@ The test then runs
With this function, an application declares a @var{property} on the D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus. It must be a
@@ -1593,12 +1595,12 @@ discussion of @var{dont-register-service} below).
@var{property} is the name of the property of @var{interface}.
@var{access} indicates, whether the property can be changed by other
-services via D-Bus. It must be either the symbol @code{:read},
+services via D-Bus. It must be either the keyword @code{:read},
@code{:write} or @code{:readwrite}.
@var{value} is the initial value of the property, it can be of any
valid type (@xref{dbus-call-method}, for details). @var{value} can be
-preceded by a @var{type} symbol.
+preceded by a @var{type} keyword.
If @var{property} already exists on @var{path}, it will be
overwritten. For properties with access type @code{:read} this is the
@@ -1707,7 +1709,7 @@ This function is similar to @code{dbus-call-method}. The
difference
is, that there are no returning output parameters.
The function emits @var{signal} on the D-Bus @var{bus}. @var{bus} is
-either the symbol @code{:system} or the symbol @code{:session}. It
+either the keyword @code{:system} or the keyword @code{:session}. It
doesn't matter whether another object has registered for @var{signal}.
Signals can be unicast or broadcast messages. For broadcast messages,
@@ -1735,7 +1737,7 @@ arguments. They are converted into D-Bus types as
described in
With this function, an application registers for a signal on the D-Bus
@var{bus}.
-@var{bus} is either the symbol @code{:system} or the symbol
+@var{bus} is either the keyword @code{:system} or the keyword
@code{:session}.
@var{service} is the D-Bus service name used by the sending D-Bus
@@ -1837,18 +1839,17 @@ Until now, we have spoken about the system and the
session buses,
which are the default buses to be connected to. However, it is
possible to connect to any bus with a known address. This is a UNIX
domain or TCP/IP socket. Everywhere, where a @var{bus} is mentioned
-as argument of a function (the symbol @code{:system} or the symbol
+as argument of a function (the keyword @code{:system} or the keyword
@code{:session}), this address can be used instead. The connection to
this bus must be initialized first.
@defun dbus-init-bus bus &optional private
This function establishes the connection to D-Bus @var{bus}.
-@var{bus} can be either the symbol @code{:system} or the symbol
+@var{bus} can be either the keyword @code{:system} or the keyword
@code{:session}, or it can be a string denoting the address of the
-corresponding bus. For the system and session buses, this function
-is called when loading @file{dbus.el}, there is no need to call it
-again.
+corresponding bus. For the system and session buses, this function is
+called when loading @file{dbus.el}, there is no need to call it again.
The function returns the number of connections this Emacs session has
established to the @var{bus} under the same unique name
@@ -1860,11 +1861,12 @@ established.
When @var{private} is non-@code{nil}, a new connection is established
instead of reusing an existing one. It results in a new unique name
-at the bus. This can be used, if it is necessary to distinguish from
-another connection used in the same Emacs process, like the one
-established by GTK+. It should be used with care for at least the
-@code{:system} and @code{:session} buses, because other Emacs Lisp
-packages might already use this connection to those buses.
+at the @var{bus}. This can be used, if it is necessary to distinguish
+from another connection used in the same Emacs process, like the one
+established by GTK+. If @var{bus} is the keyword @code{:system} or
+the keyword @code{:session}, the new private connection is identified
+by the keywords @code{:system-private} or @code{:session-private},
+respectively.
Example: You initialize a connection to the AT-SPI bus on your host:
@@ -1907,7 +1909,7 @@ is supported depends on the bus daemon configuration,
however.
This function sets the value of the @var{bus} environment
@var{variable} to @var{value}.
-@var{bus} is either a Lisp symbol, @code{:system} or @code{:session},
+@var{bus} is either a Lisp keyword, @code{:system} or @code{:session},
or a string denoting the bus address. Both @var{variable} and
@var{value} should be strings.
@@ -1973,23 +1975,31 @@ Events, , , elisp}. They are retrieved only, when
Emacs runs in
interactive mode. The generated event has this form:
@lisp
-(dbus-event @var{bus} @var{type} @var{serial} @var{service} @var{path}
@var{interface} @var{member} @var{handler}
- &rest @var{args})
+(dbus-event @var{bus} @var{type} @var{serial} @var{service} @var{destination}
@var{path} @var{interface} @var{member}
+ @var{handler} &rest @var{args})
@end lisp
@var{bus} identifies the D-Bus the message is coming from. It is
-either the symbol @code{:system} or the symbol @code{:session}.
+either a Lisp keyword, @code{:system}, @code{:session},
+@code{:system-private} or @code{:session-private}, or a string
+denoting the bus address.
@var{type} is the D-Bus message type which has caused the event. It
can be @code{dbus-message-type-invalid},
@code{dbus-message-type-method-call},
@code{dbus-message-type-method-return},
@code{dbus-message-type-error}, or @code{dbus-message-type-signal}.
-@var{serial} is the serial number of the received D-Bus message.
+@var{serial} is the serial number of the received D-Bus message,
+unless @var{type} is equal @code{dbus-message-type-error}.
@var{service} and @var{path} are the unique name and the object path
-of the D-Bus object emitting the message. @var{interface} and
-@var{member} denote the message which has been sent.
+of the D-Bus object emitting the message. @var{destination} is the
+D-Bus name the message is dedicated to, or @code{nil} in case the
+message is a broadcast signal.
+
+@var{interface} and @var{member} denote the message which has been
+sent. When @var{type} is @code{dbus-message-type-error}, @var{member}
+is the error name.
@var{handler} is the callback function which has been registered for
this message (@pxref{Signals}). @var{args} are the typed arguments as
@@ -2010,7 +2020,7 @@ callback function in order to retrieve the information
from the event.
@defun dbus-event-bus-name event
This function returns the bus name @var{event} is coming from. The
-result is either the symbol @code{:system} or the symbol
+result is either the keyword @code{:system} or the keyword
@code{:session}.
@end defun
@@ -2029,6 +2039,11 @@ This function returns the unique name of the D-Bus
object @var{event}
is coming from.
@end defun
+@defun dbus-event-destination-name event
+This function returns the unique name of the D-Bus object @var{event}
+is dedicated to.
+@end defun
+
@defun dbus-event-path-name event
This function returns the object path of the D-Bus object @var{event}
is coming from.
@@ -2044,6 +2059,16 @@ 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
+@defun dbus-event-handler event
+This function returns the handler the D-Bus object @var{event} is
+applied with.
+@end defun
+
+@defun dbus-event-arguments event
+This function returns the arguments the D-Bus object @var{event} is
+carrying on.
+@end defun
+
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
@@ -2074,6 +2099,54 @@ D-Bus applications running. They should therefore check
carefully,
whether a given D-Bus error is related to them.
+@node Monitoring Events
+@chapter Monitoring events.
+@cindex monitoring
+
+@defun dbus-register-monitor bus &optional handler &key type sender
destination path interface member
+This function registers @var{handler} for monitor events on the D-Bus
+@var{bus}.
+
+@var{bus} is either a Lisp keyword, @code{:system} or @code{:session},
+or a string denoting the bus address.
+
+@findex dbus-monitor-handler
+@var{handler} is the function to be called when a monitor event
+arrives. It is called with the `args' slot of the monitor event,
+which are stripped off the type keywords. If @var{handler} is
+@code{nil}, the default handler @code{dbus-monitor-handler} is
+applied. This default handler behaves similar to the
+@command{dbus-monitor} program.
+
+The other arguments are keyword-value pairs. @code{:type @var{type}}
+defines the message type to be monitored. If given, it must be equal
+one of the strings @samp{method_call}, @samp{method_return},
+@samp{error} or @samp{signal}.
+
+@code{:sender @var{sender}} and @code{:destination @var{destination}}
+are D-Bus names. They can be unique names, or well-known service
+names.
+
+@code{:path @var{path}} is the D-Bus object to be monitored.
+@code{:interface @var{interface}} is the name of an interface, and
+@code{:member @var{member}} is either a method name, a signal name, or
+an error name.
+
+The following form shows all D-Bus events on the session bus in buffer
+@samp{*D-Bus Monitor*}:
+
+@lisp
+(dbus-register-monitor :session)
+@end lisp
+
+And this form restricts the monitoring on D-Bus errors:
+
+@lisp
+(dbus-register-monitor :session nil :type "error")
+@end lisp
+@end defun
+
+
@node Index
@unnumbered Index
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index 4121769..63e3595 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -2436,7 +2436,7 @@ Argument @var{THIS} is the project to convert @var{PATH}
to.
@end deffn
@deffn Method ede-name :AFTER this
-Return the name of @var{THIS} targt.
+Return the name of @var{THIS} target.
@end deffn
@deffn Method ede-target-buffer-in-sourcelist :AFTER this buffer source
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 19dcb19..c7bf99c 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -465,7 +465,7 @@ string containing the text contained between those
positions (if any),
after the change was performed.
@item @code{:changes-start} and @code{:changes-end}
-The value is, repectively, the minimum and maximum buffer positions
+The value is, respectively, the minimum and maximum buffer positions
touched by the recent changes. These are provided for convenience and
only if @code{:recent-changes} is also provided.
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 9c1d2d0..6e2aeda 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -1757,7 +1757,7 @@ more then one article."
(let ((archive-name
(format
"nnml:1.%s"
- (replace-in-string gnus-newsgroup-name "^.*:" ""))))
+ (replace-regexp-in-string "^.*:" "" gnus-newsgroup-name))))
(gnus-summary-copy-article n archive-name)))
@end example
@noindent
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 806a1dd..5e84a36 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3150,7 +3150,7 @@ to user @code{root} on host @code{remotehost}, starting
with an
@option{ssh} session on host @code{remotehost}:
@samp{@value{prefix}ssh@value{postfixhop}%h|su@value{postfixhop}remotehost@value{postfix}}.
-On the other hand, if a trailing hop does not specifiy a host name,
+On the other hand, if a trailing hop does not specify a host name,
the host name of the previous hop is reused. Therefore, the following
file name is equivalent to the previous example:
@samp{@value{prefix}ssh@value{postfixhop}remotehost|su@value{postfixhop}@value{postfix}}.
diff --git a/etc/NEWS b/etc/NEWS
index d3a9748..10b99f4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -518,6 +518,15 @@ take the actual screenshot, and defaults to "ImageMagick
import".
A server entry retrieved by auth-source can request a desired smtp
authentication mechanism by setting a value for the key 'smtp-auth'.
+** Grep
+
++++
+*** New variable 'grep-match-regexp' matches grep markers to highlight.
+grep emits SGR ANSI escape sequences to color its output. The new variable
+'grep-match-regexp' holds the regular expression to match the appropriate
+markers in order to provide highlighting in the source buffer. The variable
+can be customized to accommodate other grep-like tools.
+
** Help
+++
@@ -1271,6 +1280,16 @@ This value customizes Emacs to use the style recommended
in Damian
Conway's book "Perl Best Practices" for indentation and formatting
of conditionals.
+** Abbrev mode
+
++++
+*** Emacs can now suggest to use an abbrev based on text you type.
+A new user option, 'abbrev-suggest', enables the new abbrev suggestion
+feature. When enabled, if a user manually types a piece of text that
+could have saved enough typing by using an abbrev, a hint will be
+displayed in the echo area, mentioning the abbrev that could have been
+used instead.
+
* New Modes and Packages in Emacs 28.1
@@ -1436,7 +1455,13 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
+++
*** New function 'string-search'.
This function takes two string parameters and returns the position of
-the first instance of the first string in the latter.
+the first instance of the former string in the latter.
+
++++
+*** New function 'string-replace'.
+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.
+++
*** New function 'process-lines-ignore-status'.
@@ -1444,12 +1469,6 @@ 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'.
diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17
index 8ca61a0..c4ff83b 100644
--- a/etc/NEWS.1-17
+++ b/etc/NEWS.1-17
@@ -1944,7 +1944,7 @@ It's Beat CCA Week.
described by dot and mark, at its corners;
the existing text is pushed to the right.
clear-rectangle:
- replace the rectangle described by dot ane mark
+ replace the rectangle described by dot and mark
with blanks. The previous text is deleted.
delete-rectangle:
delete the text of the specified rectangle,
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index 32ac05d..149bd32 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -1101,7 +1101,7 @@ prefer to rely upon existing Emacs facilities for
formatting code but
the 'sql-indent' package provides facilities to aid more casual SQL
developers layout queries and complex expressions.
-**** 'sql-use-indent-support' (default t) enables SQL indention support.
+**** 'sql-use-indent-support' (default t) enables SQL indentation support.
The 'sql-indent' package from ELPA must be installed to get the
indentation support in 'sql-mode' and 'sql-interactive-mode'.
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index be6f9ee..dc52a22 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -824,6 +824,145 @@ see `define-abbrev' for details."
"Function that `expand-abbrev' uses to perform abbrev expansion.
Takes no argument and should return the abbrev symbol if expansion took
place.")
+(defcustom abbrev-suggest nil
+ "Non-nil means suggest using abbrevs to save typing.
+When abbrev mode is active and this option is non-nil, Emacs will
+suggest in the echo area to use an existing abbrev if doing so
+will save enough typing. See `abbrev-suggest-hint-threshold' for
+the definition of \"enough typing\"."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom abbrev-suggest-hint-threshold 3
+ "Threshold for when to suggest to use an abbrev to save typing.
+The threshold is the amount of typing, in terms of the number of
+characters, that would be saved by using the abbrev. The
+thinking is that if the expansion is only a few characters
+longer than the abbrev, the benefit of informing the user is not
+significant. If you always want to be informed about existing
+abbrevs for the text you type, set this value to zero or less.
+This setting only applies if `abbrev-suggest' is non-nil."
+ :type 'number
+ :version "28.1")
+
+(defun abbrev--suggest-get-active-tables-including-parents ()
+ "Return a list of all active abbrev tables, including parent tables."
+ (let* ((tables (abbrev--active-tables))
+ (all tables))
+ (dolist (table tables)
+ (setq all (append (abbrev-table-get table :parents) all)))
+ all))
+
+(defun abbrev--suggest-get-active-abbrev-expansions ()
+ "Return a list of all the active abbrev expansions.
+Includes expansions from parent abbrev tables."
+ (let (expansions)
+ (dolist (table (abbrev--suggest-get-active-tables-including-parents))
+ (mapatoms (lambda (e)
+ (let ((value (symbol-value (abbrev--symbol e table))))
+ (when value
+ (push (cons value (symbol-name e)) expansions))))
+ table))
+ expansions))
+
+(defun abbrev--suggest-count-words (expansion)
+ "Return the number of words in EXPANSION.
+Expansion is a string of one or more words."
+ (length (split-string expansion " " t)))
+
+(defun abbrev--suggest-get-previous-words (n)
+ "Return the N words before point, spaces included."
+ (let ((end (point)))
+ (save-excursion
+ (backward-word n)
+ (replace-regexp-in-string
+ "\\s " " "
+ (buffer-substring-no-properties (point) end)))))
+
+(defun abbrev--suggest-above-threshold (expansion)
+ "Return non-nil if the abbrev in EXPANSION provides significant savings.
+A significant saving, here, is the difference in length between
+the abbrev and the abbrev expansion. EXPANSION is a cons cell
+where the car is the expansion and the cdr is the abbrev."
+ (>= (- (length (car expansion))
+ (length (cdr expansion)))
+ abbrev-suggest-hint-threshold))
+
+(defvar abbrev--suggest-saved-recommendations nil
+ "Keeps a list of expansions that have abbrevs defined.
+The user can show this list by calling
+`abbrev-suggest-show-report'.")
+
+(defun abbrev--suggest-inform-user (expansion)
+ "Display a message to the user about the existing abbrev.
+EXPANSION is a cons cell where the `car' is the expansion and the
+`cdr' is the abbrev."
+ (run-with-idle-timer
+ 1 nil
+ (lambda ()
+ (message "You can write `%s' using the abbrev `%s'."
+ (car expansion) (cdr expansion))))
+ (push expansion abbrev--suggest-saved-recommendations))
+
+(defun abbrev--suggest-shortest-abbrev (new current)
+ "Return the shortest abbrev of NEW and CURRENT.
+NEW and CURRENT are cons cells where the `car' is the expansion
+and the `cdr' is the abbrev."
+ (if (not current)
+ new
+ (if (< (length (cdr new))
+ (length (cdr current)))
+ new
+ current)))
+
+(defun abbrev--suggest-maybe-suggest ()
+ "Suggest an abbrev to the user based on the word(s) before point.
+Uses `abbrev-suggest-hint-threshold' to find out if the user should be
+informed about the existing abbrev."
+ (let (words abbrev-found word-count)
+ (dolist (expansion (abbrev--suggest-get-active-abbrev-expansions))
+ (setq word-count (abbrev--suggest-count-words (car expansion))
+ words (abbrev--suggest-get-previous-words word-count))
+ (let ((case-fold-search t))
+ (when (and (> word-count 0)
+ (string-match (car expansion) words)
+ (abbrev--suggest-above-threshold expansion))
+ (setq abbrev-found (abbrev--suggest-shortest-abbrev
+ expansion abbrev-found)))))
+ (when abbrev-found
+ (abbrev--suggest-inform-user abbrev-found))))
+
+(defun abbrev--suggest-get-totals ()
+ "Return a list of all expansions and how many times they were used.
+Each expansion is a cons cell where the `car' is the expansion
+and the `cdr' is the number of times the expansion has been
+typed."
+ (let (total cell)
+ (dolist (expansion abbrev--suggest-saved-recommendations)
+ (if (not (assoc (car expansion) total))
+ (push (cons (car expansion) 1) total)
+ (setq cell (assoc (car expansion) total))
+ (setcdr cell (1+ (cdr cell)))))
+ total))
+
+(defun abbrev-suggest-show-report ()
+ "Show a buffer with the list of abbrevs you could have used.
+This shows the abbrevs you've \"missed\" because you typed the
+full text instead of the abbrevs that expand into that text."
+ (interactive)
+ (let ((totals (abbrev--suggest-get-totals))
+ (buf (get-buffer-create "*abbrev-suggest*")))
+ (set-buffer buf)
+ (erase-buffer)
+ (insert "** Abbrev expansion usage **
+
+Below is a list of expansions for which abbrevs are defined, and
+the number of times the expansion was typed manually. To display
+and edit all abbrevs, type `M-x edit-abbrevs RET'\n\n")
+ (dolist (expansion totals)
+ (insert (format " %s: %d\n" (car expansion) (cdr expansion))))
+ (display-buffer buf)))
+
(defun expand-abbrev ()
"Expand the abbrev before point, if there is an abbrev there.
Effective when explicitly called even when `abbrev-mode' is nil.
@@ -831,7 +970,9 @@ Calls the value of `abbrev-expand-function' with no
argument to do
the work, and returns whatever it does. (That return value should
be the abbrev symbol if expansion occurred, else nil.)"
(interactive)
- (funcall abbrev-expand-function))
+ (or (funcall abbrev-expand-function)
+ (if abbrev-suggest
+ (abbrev--suggest-maybe-suggest))))
(defun abbrev--default-expand ()
"Default function to use for `abbrev-expand-function'.
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index ae85fc5..c998a8a 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1920,10 +1920,10 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(search-backward-regexp "[P]K\005\006")
(let ((p (archive-l-e (+ (point) 16) 4))
files)
- (when (= p -1)
- ;; If the offset of end-of-central-directory is -1, this is a
- ;; Zip64 extended ZIP file format, and we need to glean the info
- ;; from Zip64 records instead.
+ (when (or (= p #xffffffff) (= p -1))
+ ;; If the offset of end-of-central-directory is 0xFFFFFFFF, this
+ ;; is a Zip64 extended ZIP file format, and we need to glean the
+ ;; info from Zip64 records instead.
;;
;; First, find the Zip64 end-of-central-directory locator.
(search-backward "PK\006\007")
@@ -1949,6 +1949,15 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
(decode-coding-string
str archive-file-name-coding-system)))
+ (ucsize (if (and (or (= ucsize #xffffffff) (= ucsize -1))
+ (> exlen 0))
+ ;; APPNOTE.TXT, para 4.5.3: the Extra Field
+ ;; begins with 2 bytes of signature
+ ;; (\000\001), followed by 2 bytes that give
+ ;; the size of the extra block, followed by
+ ;; an 8-byte uncompressed size.
+ (archive-l-e (+ p 46 fnlen 4) 8)
+ ucsize))
(isdir (and (= ucsize 0)
(string= (file-name-nondirectory efnname) "")))
(mode (cond ((memq creator '(2 3)) ; Unix
diff --git a/lisp/bindings.el b/lisp/bindings.el
index f31c6cc..3930f5b 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -493,7 +493,7 @@ mouse-1: Display Line and Column Mode Menu")))
,@mode-line-position--column-line-properties))
(10
(:propertize
- (:eval (replace-in-string
+ (:eval (string-replace
"%c" "%C" (car mode-line-position-column-line-format)))
,@mode-line-position--column-line-properties)))
(6
@@ -508,7 +508,7 @@ mouse-1: Display Line and Column Mode Menu")))
(,@mode-line-position--column-line-properties)))
(6
(:propertize
- (:eval (replace-in-string
+ (:eval (string-replace
"%c" "%C" (car mode-line-position-column-format)))
,@mode-line-position--column-line-properties))))))
"Mode line construct for displaying the position in the buffer.
diff --git a/lisp/comint.el b/lisp/comint.el
index b4ea232..b966fae 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -820,18 +820,10 @@ series of processes in the same Comint buffer. The hook
(goto-char (point-max))
(set-marker (process-mark proc) (point))
;; Feed it the startfile.
- (cond (startfile
- ;;This is guaranteed to wait long enough
- ;;but has bad results if the comint does not prompt at all
- ;; (while (= size (buffer-size))
- ;; (sleep-for 1))
- ;;I hope 1 second is enough!
- (sleep-for 1)
- (goto-char (point-max))
- (insert-file-contents startfile)
- (setq startfile (buffer-substring (point) (point-max)))
- (delete-region (point) (point-max))
- (comint-send-string proc startfile)))
+ (when startfile
+ (comint-send-string proc (with-temp-buffer
+ (insert-file-contents startfile)
+ (buffer-string))))
(run-hooks 'comint-exec-hook)
buffer)))
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index f5b70e0..3fd6ac0 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -73,9 +73,11 @@
'(choice
(const :tag "Frame default" t)
(const :tag "Filled box" box)
+ (cons :tag "Box with specified size"
+ (const box) integer)
(const :tag "Hollow cursor" hollow)
(const :tag "Vertical bar" bar)
- (cons :tag "Vertical bar with specified width"
+ (cons :tag "Vertical bar with specified height"
(const bar) integer)
(const :tag "Horizontal bar" hbar)
(cons :tag "Horizontal bar with specified width"
@@ -627,7 +629,9 @@ since it could result in memory overflow and make Emacs
crash."
(scroll-margin windows integer)
(maximum-scroll-margin windows float "26.1")
(hscroll-margin windows integer "22.1")
- (hscroll-step windows number "22.1")
+ (hscroll-step windows
+ (choice (const :tag "Center horizontally" nil)
+ number) "22.1")
(truncate-partial-width-windows
display
(choice (integer :tag "Truncate if narrower than")
@@ -787,7 +791,11 @@ since it could result in memory overflow and make Emacs
crash."
"27.1"
:safe (lambda (value) (or (characterp value) (null value))))
;; xfaces.c
- (scalable-fonts-allowed display boolean "22.1")
+ (scalable-fonts-allowed
+ display (choice (const :tag "Don't allow scalable fonts" nil)
+ (const :tag "Allow any scalable font" t)
+ (repeat regexp))
+ "22.1")
;; xfns.c
(x-bitmap-file-path installation
(repeat (directory :format "%v")))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index df25a64..6034d12 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1802,7 +1802,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil."
(if (and buffer-file-name
(dired-in-this-tree-p buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
- (to-file (dired-replace-in-string
+ (to-file (replace-regexp-in-string
(concat "^" (regexp-quote from-dir))
to-dir
buffer-file-name)))
@@ -1866,7 +1866,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil."
;; Update buffer-local dired-subdir-alist and dired-switches-alist
(let ((cons (assoc-string (car elt) dired-switches-alist))
(cur-dir (dired-normalize-subdir
- (dired-replace-in-string regexp newtext (car elt)))))
+ (replace-regexp-in-string regexp newtext (car elt)))))
(setcar elt cur-dir)
(when cons (setcar cons cur-dir))))))
@@ -2612,7 +2612,7 @@ This function takes some pains to conform to `ls -lR'
output."
(push (cons dirname switches) dired-switches-alist)))
(when switches-have-R
(dired-build-subdir-alist switches)
- (setq switches (dired-replace-in-string "R" "" switches))
+ (setq switches (string-replace "R" "" switches))
(dolist (cur-ass dired-subdir-alist)
(let ((cur-dir (car cur-ass)))
(and (dired-in-this-tree-p cur-dir dirname)
@@ -2713,7 +2713,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME
as well."
(let ((dired-actual-switches
(or switches
dired-subdir-switches
- (dired-replace-in-string "R" "" dired-actual-switches))))
+ (string-replace "R" "" dired-actual-switches))))
(if (equal dirname (car (car (last dired-subdir-alist))))
;; If doing the top level directory of the buffer,
;; redo it as specified in dired-directory.
diff --git a/lisp/dired.el b/lisp/dired.el
index 1ed949d..b4b3368 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1504,7 +1504,7 @@ see `dired-use-ls-dired' for more details.")
;; "--dired", so we cannot add it to the `process-file'
;; call for wildcards.
(when (file-remote-p dir)
- (setq switches (dired-replace-in-string "--dired" "" switches)))
+ (setq switches (string-replace "--dired" "" switches)))
(let* ((default-directory (car dir-wildcard))
(script (format "ls %s %s" switches (cdr dir-wildcard)))
(remotep (file-remote-p dir))
@@ -4290,11 +4290,10 @@ With a prefix argument, edit the current listing
switches instead."
(dired-sort-set-mode-line)
(revert-buffer))
-;; Some user code loads dired especially for this.
-;; Don't do that--use replace-regexp-in-string instead.
(defun dired-replace-in-string (regexp newtext string)
;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
+ (declare (obsolete replace-regexp-in-string "28.1"))
(let ((result "") (start 0) mb me)
(while (string-match regexp string start)
(setq mb (match-beginning 0)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 8a6c0b9..65e4e44 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1044,19 +1044,22 @@
(defun byte-optimize-apply (form)
;; If the last arg is a literal constant, turn this into a funcall.
;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
- (let ((fn (nth 1 form))
- (last (nth (1- (length form)) form))) ; I think this really is fastest
- (or (if (or (null last)
- (eq (car-safe last) 'quote))
- (if (listp (nth 1 last))
- (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
- (nconc (list 'funcall fn) butlast
- (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
- (byte-compile-warn
- "last arg to apply can't be a literal atom: `%s'"
- (prin1-to-string last))
- nil))
- form)))
+ (if (= (length form) 2)
+ ;; single-argument `apply' is not worth optimizing (bug#40968)
+ form
+ (let ((fn (nth 1 form))
+ (last (nth (1- (length form)) form))) ; I think this really is fastest
+ (or (if (or (null last)
+ (eq (car-safe last) 'quote))
+ (if (listp (nth 1 last))
+ (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
+ (nconc (list 'funcall fn) butlast
+ (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
+ (byte-compile-warn
+ "last arg to apply can't be a literal atom: `%s'"
+ (prin1-to-string last))
+ nil))
+ form))))
(put 'funcall 'byte-optimizer #'byte-optimize-funcall)
(put 'apply 'byte-optimizer #'byte-optimize-apply)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9c41374..8571cca 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3182,6 +3182,7 @@ Of course, we really can't know that for sure, so it's
just a heuristic."
(buffer . bufferp)
(character . natnump)
(char-table . char-table-p)
+ (hash-table . hash-table-p)
(cons . consp)
(fixnum . integerp)
(float . floatp)
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 06ef580..a9328a6 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -116,6 +116,10 @@ instead (which see).")
function-list &optional docstring)
"Create a new generic mode MODE.
+A \"generic\" mode is a simple major mode with basic support for
+comment syntax and Font Lock mode, but otherwise do not have a
+any special keystrokes or functionality available.
+
MODE is the name of the command for the generic mode; don't quote it.
The optional DOCSTRING is the documentation for the mode command. If
you do not supply it, `define-generic-mode' uses a default
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 9f96ac5..e6abb39 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -156,6 +156,7 @@ are non-nil, then the result is non-nil."
,@(or body `(,res))))
`(let* () ,@(or body '(t))))))
+;;;###autoload
(defmacro if-let (spec then &rest else)
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index bb027b9..7fd4178 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -26,6 +26,7 @@
(require 'epa)
(require 'epa-hook)
+(eval-when-compile (require 'subr-x))
;;; Options
@@ -115,8 +116,17 @@ encryption is used."
(let ((error epa-file-error))
(save-window-excursion
(kill-buffer))
- (signal 'file-missing
- (cons "Opening input file" (cdr error)))))
+ (if (nth 3 error)
+ (user-error "Wrong passphrase: %s" (nth 3 error))
+ (signal 'file-missing
+ (cons "Opening input file" (cdr error))))))
+
+(defun epa--wrong-password-p (context)
+ (let ((error-string (epg-context-error-output context)))
+ (and (string-match
+ "decryption failed: \\(Bad session key\\|No secret key\\)"
+ error-string)
+ (match-string 1 error-string))))
(defvar last-coding-system-used)
(defun epa-file-insert-file-contents (file &optional visit beg end replace)
@@ -159,7 +169,12 @@ encryption is used."
(nth 3 error)))
(let ((exists (file-exists-p local-file)))
(when exists
- (epa-display-error context)
+ (if-let ((wrong-password (epa--wrong-password-p context)))
+ ;; Don't display the *error* buffer if we just
+ ;; have a wrong password; let the later error
+ ;; handler notify the user.
+ (setq error (append error (list wrong-password)))
+ (epa-display-error context))
;; When the .gpg file isn't an encrypted file (e.g.,
;; it's a keyring.gpg file instead), then gpg will
;; say "Unexpected exit" as the error message. In
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index 458c25a..b778eca 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -57,6 +57,9 @@
(defvar fileloop--iterator iter-empty)
(defvar fileloop--scan-function
(lambda () (user-error "No operation in progress")))
+;; If the default value below is changed, the :enable form of
+;; tags-continue and tags-repl-continue in menu-bar.el will have to be
+;; updated accordingly.
(defvar fileloop--operate-function #'ignore)
(defvar fileloop--freshly-initialized nil)
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index c954497..2461fd4 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -205,11 +205,12 @@ different input formats."
(defun gnus-convert-face-to-png (face)
"Convert FACE (which is base64-encoded) to a PNG.
The PNG is returned as a string."
- (mm-with-unibyte-buffer
- (insert face)
- (ignore-errors
- (base64-decode-region (point-min) (point-max)))
- (buffer-string)))
+ (let ((face (gnus-base64-repad face)))
+ (mm-with-unibyte-buffer
+ (insert face)
+ (ignore-errors
+ (base64-decode-region (point-min) (point-max)))
+ (buffer-string))))
;;;###autoload
(defun gnus-convert-png-to-face (file)
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index f624b9d..7d4fa6c 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -134,11 +134,11 @@
(cl-defmethod gnus-icalendar-event:recurring-interval ((event
gnus-icalendar-event))
"Return recurring interval of EVENT."
(let ((rrule (gnus-icalendar-event:recur event))
- (default-interval 1))
+ (default-interval "1"))
- (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule)
- (or (match-string 1 rrule)
- default-interval)))
+ (if (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule)
+ (match-string 1 rrule)
+ default-interval)))
(cl-defmethod gnus-icalendar-event:recurring-days ((event
gnus-icalendar-event))
"Return, when available, the week day numbers on which the EVENT recurs."
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index aa9f137..0e15ebc 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1343,6 +1343,53 @@ forbidden in URL encoding."
(setq tmp (concat tmp str))
tmp))
+(defun gnus-base64-repad (str &optional reject-newlines line-length)
+ "Take a base 64-encoded string and return it padded correctly.
+Existing padding is ignored.
+
+If any combination of CR and LF characters are present and
+REJECT-NEWLINES is nil, remove them; otherwise raise an error.
+If LINE-LENGTH is set and the string (or any line in the string
+if REJECT-NEWLINES is nil) is longer than that number, raise an
+error. Common line length for input characters are 76 plus CRLF
+(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including
+CRLF (RFC 5321 SMTP)."
+ ;; RFC 4648 specifies that:
+ ;; - three 8-bit inputs make up a 24-bit group
+ ;; - the 24-bit group is broken up into four 6-bit values
+ ;; - each 6-bit value is mapped to one character of the base 64 alphabet
+ ;; - if the final 24-bit quantum is filled with only 8 bits the output
+ ;; will be two base 64 characters followed by two "=" padding characters
+ ;; - if the final 24-bit quantum is filled with only 16 bits the output
+ ;; will be three base 64 character followed by one "=" padding character
+ ;;
+ ;; RFC 4648 section 3 considerations:
+ ;; - if reject-newlines is nil (default), concatenate multi-line
+ ;; input (3.1, 3.3)
+ ;; - if line-length is set, error on input exceeding the limit (3.1)
+ ;; - reject characters outside base encoding (3.3, also section 12)
+ (let ((splitstr (split-string str "[\n\r \t]+" t)))
+ (when (and reject-newlines (> (length splitstr) 1))
+ (error "Invalid Base64 string"))
+ (dolist (substr splitstr)
+ (when (and line-length (> (length substr) line-length))
+ (error "Base64 string exceeds line-length"))
+ (when (string-match "[^A-Za-z0-9+/=]" substr)
+ (error "Invalid Base64 string")))
+ (let* ((str (string-join splitstr))
+ (len (length str)))
+ (when (string-match "=" str)
+ (setq len (match-beginning 0)))
+ (concat
+ (substring str 0 len)
+ (make-string (/
+ (- 24
+ (pcase (mod (* len 6) 24)
+ (`0 24)
+ (n n)))
+ 6)
+ ?=)))))
+
(defun gnus-make-predicate (spec)
"Transform SPEC into a function that can be called.
SPEC is a predicate specifier that contains stuff like `or', `and',
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 2ad479b..ef010d6 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4568,7 +4568,8 @@ This function could be useful in `message-setup-hook'."
(custom-add-option 'message-setup-hook 'message-check-recipients)
(defun message-add-action (action &rest types)
- "Add ACTION to be performed when doing an exit of type TYPES."
+ "Add ACTION to be performed when doing an exit of type TYPES.
+Valid types are `send', `return', `exit', `kill' and `postpone'."
(while types
(add-to-list (intern (format "message-%s-actions" (pop types)))
action)))
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 5500148..eb27fee 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -174,8 +174,9 @@ and the files themselves should be in PEM format."
(eq 0 (call-process "openssl" nil nil nil "version"))
(error nil))
"openssl")
- "Name of OpenSSL binary."
- :type 'string
+ "Name of OpenSSL binary or nil if none."
+ :type '(choice string
+ (const :tag "none" nil))
:group 'smime)
;; OpenSSL option to select the encryption cipher
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 0fe651a..1c55a23 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -136,9 +136,9 @@ patterns."
(put 'hi-lock-file-patterns-policy 'risky-local-variable t)
(defcustom hi-lock-auto-select-face nil
- "Non-nil means highlighting commands do not prompt for the face to use.
-Instead, each hi-lock command will cycle through the faces in
-`hi-lock-face-defaults'."
+ "When nil, highlighting commands prompt for the face to use.
+When non-nil, highlighting command determine the faces to use
+by cycling through the faces in `hi-lock-face-defaults'."
:type 'boolean
:version "24.4")
@@ -484,7 +484,13 @@ the major mode specifies support for Font Lock."
(interactive
(list
(hi-lock-regexp-okay
- (read-regexp "Regexp to highlight" 'regexp-history-last))
+ (read-regexp "Regexp to highlight"
+ (if (use-region-p)
+ (prog1
+ (buffer-substring (region-beginning)
+ (region-end))
+ (deactivate-mark))
+ 'regexp-history-last)))
(hi-lock-read-face-name)
current-prefix-arg))
(or (facep face) (setq face 'hi-yellow))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 0053c4d..4e964b3 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -3665,91 +3665,91 @@ since they have special meaning in a regexp."
(defvar isearch-submatches-overlays nil)
(defface isearch-group-1
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#ff00ff" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "palevioletred3" :foreground "brown4"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (first sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-2
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#d000d0" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#be698f" :foreground "black"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (second sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-3
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#a000a0" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#a06080" :foreground "brown4"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (third sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-4
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#800080" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#905070" :foreground "brown4"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (fourth sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-5
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#600060" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#804060" :foreground "black"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (fifth sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-6
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#500050" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#703050" :foreground "white"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (sixth sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-7
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#400040" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#602050" :foreground "white"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (seventh sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-8
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#300030" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#501050" :foreground "white"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (eighth sub-group)."
:group 'isearch
:version "28.1")
(defface isearch-group-9
- '((((class color) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "#200020" :foreground "lightskyblue1"))
- (((class color) (background dark))
+ (((class color) (min-colors 88) (background dark))
(:background "#400040" :foreground "white"))
- (t (:inverse-video t)))
+ (t (:inherit isearch)))
"Face for highlighting Isearch sub-group matches (ninth sub-group)."
:group 'isearch
:version "28.1")
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 36d1dc7..e48c254 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -514,9 +514,13 @@ Message buffer where you can explain more about the patch."
(insert "\n\n\n")
(emacs-bug--system-description)
(mml-attach-file file "text/patch" nil "attachment")
- (message-add-header "X-Debbugs-Tags: patch")
(message-goto-body)
(message "Write a description of the patch and use `C-c C-c' to send it")
+ (add-hook 'message-send-hook
+ (lambda ()
+ (message-goto-body)
+ (insert "Tags: patch\nthanks\n\n"))
+ t)
(message-add-action
(lambda ()
;; Bury the help buffer (if it's shown).
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 1556ee2..d3e434a 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -333,6 +333,8 @@
(bindings--define-key menu [tags-continue]
'(menu-item "Continue Tags Search" fileloop-continue
+ :enable (and (featurep 'fileloop)
+ (not (eq fileloop--operate-function 'ignore)))
:help "Continue last tags search operation"))
(bindings--define-key menu [tags-srch]
'(menu-item "Search Tagged Files..." tags-search
@@ -382,6 +384,8 @@
(let ((menu (make-sparse-keymap "Replace")))
(bindings--define-key menu [tags-repl-continue]
'(menu-item "Continue Replace" fileloop-continue
+ :enable (and (featurep 'fileloop)
+ (not (eq fileloop--operate-function 'ignore)))
:help "Continue last tags replace operation"))
(bindings--define-key menu [tags-repl]
'(menu-item "Replace in Tagged Files..." tags-query-replace
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index da47e5b..23ba191 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -51,6 +51,7 @@
(unless (boundp 'dbus-debug)
(defvar dbus-debug nil))
+(require 'cl-lib)
(require 'seq)
(require 'subr-x)
(require 'xml)
@@ -245,7 +246,7 @@ caught in `condition-case' by `dbus-error'.")
(defvar dbus-return-values-table (make-hash-table :test #'equal)
"Hash table for temporarily storing arguments of reply messages.
A key in this hash table is a list (:serial BUS SERIAL), like in
-`dbus-registered-objects-table'. BUS is either a Lisp symbol,
+`dbus-registered-objects-table'. BUS is either a Lisp keyword,
`:system' or `:session', or a string denoting the bus address.
SERIAL is the serial number of the reply message.
@@ -279,8 +280,8 @@ The result will be made available in
`dbus-return-values-table'."
(defun dbus-call-method (bus service path interface method &rest args)
"Call METHOD on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@@ -301,8 +302,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
`dbus-call-method' returns the resulting values of METHOD as a list of
Lisp objects. The type conversion happens the other direction as for
@@ -405,8 +406,8 @@ object is returned instead of a list containing this single
Lisp object.
(bus service path interface method handler &rest args)
"Call METHOD on the D-Bus BUS asynchronously.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@@ -431,8 +432,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
If HANDLER is a Lisp function, the function returns a key into the
hash table `dbus-registered-objects-table'. The corresponding entry
@@ -472,9 +473,9 @@ Example:
(defun dbus-send-signal (bus service path interface signal &rest args)
"Send signal SIGNAL on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. The signal is sent from the D-Bus object
-Emacs is registered at BUS.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. The signal is sent from the
+D-Bus object Emacs is registered at BUS.
SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
name or a unique name. If SERVICE is nil, the signal is sent as
@@ -492,8 +493,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
Example:
@@ -586,8 +587,9 @@ hash table."
(defun dbus-setenv (bus variable value)
"Set the value of the BUS environment variable named VARIABLE to VALUE.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. Both VARIABLE and VALUE should be strings.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. Both VARIABLE and VALUE should
+be strings.
Normally, services inherit the environment of the BUS daemon. This
function adds to or modifies that environment when activating services.
@@ -601,8 +603,8 @@ Some bus instances, such as `:system', may disable setting
the environment."
(defun dbus-register-service (bus service &rest flags)
"Register known name SERVICE on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name that should be registered. It must
be a known name.
@@ -663,8 +665,9 @@ placed in the queue.
(defun dbus-unregister-service (bus service)
"Unregister all objects related to SERVICE from D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. SERVICE must be a known service
+name.
The function returns a keyword, indicating the result of the
operation. One of the following keywords is returned:
@@ -699,8 +702,8 @@ queue of this service."
(bus service path interface signal handler &rest args)
"Register for a signal on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name used by the sending D-Bus object.
It can be either a known name or the unique name of the D-Bus object
@@ -854,8 +857,8 @@ Example:
(bus service path interface method handler &optional dont-register-service)
"Register METHOD on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus object METHOD is
registered for. It must be a known name (see discussion of
@@ -869,7 +872,7 @@ HANDLER is a Lisp function to be called when a method call
is
received. It must accept the input arguments of METHOD. The
return value of HANDLER is used for composing the returning D-Bus
message. If HANDLER returns a reply message with an empty
-argument list, HANDLER must return the symbol `:ignore' in order
+argument list, HANDLER must return the keyword `:ignore' in order
to distinguish it from nil (the boolean false).
If HANDLER detects an error, it shall return the list `(:error
@@ -1039,7 +1042,7 @@ EVENT is a list which starts with symbol `dbus-event':
INTERFACE MEMBER HANDLER &rest ARGS)
BUS identifies the D-Bus the message is coming from. It is
-either a Lisp symbol, `:system', `:session', `:systemp-private'
+either a Lisp keyword, `:system', `:session', `:systemp-private'
or `:session-private', or a string denoting the bus address.
TYPE is the D-Bus message type which has caused the event, SERIAL
@@ -1048,7 +1051,7 @@ equal `dbus-message-type-method-return' or
`dbus-message-type-error'.
SERVICE and PATH are the unique name and the object path of the
D-Bus object emitting the message. DESTINATION is the D-Bus name
-the message is dedicated to, or nil in case thje message is a
+the message is dedicated to, or nil in case the message is a
broadcast signal.
INTERFACE and MEMBER denote the message which has been sent.
@@ -1064,7 +1067,7 @@ formed."
(when dbus-debug (message "DBus-Event %s" event))
(unless (and (listp event)
(eq (car event) 'dbus-event)
- ;; Bus symbol.
+ ;; Bus keyword.
(or (keywordp (nth 1 event))
(stringp (nth 1 event)))
;; Type.
@@ -1181,8 +1184,8 @@ If the HANDLER returns a `dbus-error', it is propagated
as return message."
(defun dbus-event-bus-name (event)
"Return the bus name the event is coming from.
-The result is either a Lisp symbol, `:system' or `:session', or a
-string denoting the bus address. EVENT is a D-Bus event, see
+The result is either a Lisp keyword, `:system' or `:session', or
+a string denoting the bus address. EVENT is a D-Bus event, see
`dbus-check-event'. This function signals a `dbus-error' if the
event is not well formed."
(dbus-check-event event)
@@ -1375,11 +1378,11 @@ It will be registered for all objects created by
`dbus-register-service'."
"Return all interfaces and sub-nodes of SERVICE,
registered at object path PATH at bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name,
-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."
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. SERVICE must be a known service
+name, 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.
(let (dbus-debug)
(dbus-ignore-errors
@@ -1596,7 +1599,7 @@ valid D-Bus value, or nil if there is no PROPERTY, or
PROPERTY cannot be read."
(defun dbus-set-property (bus service path interface property &rest args)
"Set value of PROPERTY of INTERFACE to VALUE.
It will be checked at BUS, SERVICE, PATH. VALUE can be preceded
-by a TYPE symbol. When the value is successfully set, and the
+by a TYPE keyword. When the value is successfully set, and the
property's access type is not `:write', return VALUE. Otherwise,
return nil.
@@ -1651,8 +1654,8 @@ Filter out matching PATH."
(bus service path interface property access &rest args)
"Register PROPERTY on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus. It must be a
known name (see discussion of DONT-REGISTER-SERVICE below).
@@ -1662,11 +1665,11 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE
is the
name of the interface used at PATH, PROPERTY is the name of the
property of INTERFACE. ACCESS indicates, whether the property
can be changed by other services via D-Bus. It must be either
-the symbol `:read', `:write' or `:readwrite'.
+the keyword `:read', `:write' or `:readwrite'.
VALUE is the initial value of the property, it can be of any
valid type (see `dbus-call-method' for details). VALUE can be
-preceded by a TYPE symbol.
+preceded by a TYPE keyword.
If PROPERTY already exists on PATH, it will be overwritten. For
properties with access type `:read' this is the only way to
@@ -1688,7 +1691,7 @@ 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 (;; Read basic type symbol.
+ (let (;; Read basic type keyword.
(type (when (keywordp (car args)) (pop args)))
(value (pop args))
(emits-signal (pop args))
@@ -1973,72 +1976,57 @@ It will be registered for all objects created by
`dbus-register-service'."
result)
'(:signature "{oa{sa{sv}}}"))))))
-(defun dbus-register-monitor
- (bus &optional service path interface member handler &rest args)
+(cl-defun dbus-register-monitor
+ (bus &optional handler &key type sender destination path interface member)
"Register HANDLER for monitor events on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
-SERVICE is the D-Bus service name of the D-Bus. It must be a
-known name (see discussion of DONT-REGISTER-SERVICE below).
+HANDLER is the function to be called when a monitor event
+arrives. It is called with the `args' slot of the monitor event,
+which are stripped off the type keywords. If HANDLER is nil, the
+default handler `dbus-monitor-handler' is applied.
-PATH is the D-Bus object path SERVICE is registered at (see
-discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
-name of the interface used at PATH. MEMBER is either a method
-name, a signal name, or an error name.
+The other arguments are keyword-value pairs. `:type TYPE'
+defines the message type to be monitored. If given, it must be
+equal one of the strings \"method_call\", \"method_return\",
+\"error\" or \"signal\".
-HANDLER is the function to be called when a monitor event
-arrives. If nil, the default handler `dbus-monitor-handler' is
-applied. It is called with ARGS as arguments."
+`:sender SENDER' and `:destination DESTINATION' are D-Bus names.
+They can be unique names, or well-known service names.
+`:path PATH' is the D-Bus object to be monitored. `:interface
+INTERFACE' is the name of an interface, and `:member MEMBER' is
+either a method name, a signal name, or an error name."
(let ((bus-private (if (eq bus :system) :system-private
(if (eq bus :session) :session-private bus)))
- keyword type rule1 rule2 key key1 value)
+ rule key key1 value)
(unless handler (setq handler #'dbus-monitor-handler))
- ;; Read arguments.
- (while args
- (when (keywordp (setq keyword (pop args)))
- (cond
- ((eq :type keyword)
- ;; Must be "signal", "method_call", "method_return", or "error".
- (setq type (pop args))))))
- ;; Compose rules.
- (setq rule1
- (or
- (string-join
- (delq nil
- (list (when service (format "sender='%s'" service))
- (when path (format "path='%s'" path))
- (when interface (format "interface='%s'" interface))
- (when member (format "member='%s'" member))
- (when type (format "type='%s'" type))))
- ",")
- "")
- rule2
- (when service
- (string-join
- (delq nil
- (list (format "destination='%s'" service)
- (when path (format "path='%s'" path))
- (when interface (format "interface='%s'" interface))
- (when member (format "member='%s'" member))
- (when type (format "type='%s'" type))))
- ",")))
+ ;; Compose rule.
+ (setq rule
+ (string-join
+ (delq nil (mapcar
+ (lambda (item)
+ (when (cdr item)
+ (format "%s='%s'" (car item) (cdr item))))
+ `(("type" . ,type) ("sender" . ,sender)
+ ("destination" . ,destination) ("path" . ,path)
+ ("interface" . ,interface) ("member" . ,member))))
+ ",")
+ rule (or rule ""))
(unless (ignore-errors (dbus-get-unique-name bus-private))
(dbus-init-bus bus 'private))
(dbus-call-method
bus-private dbus-service-dbus dbus-path-dbus dbus-interface-monitoring
- "BecomeMonitor"
- (append `(:array :string ,rule1) (when rule2 `(:string ,rule2)))
- :uint32 0)
+ "BecomeMonitor" `(:array :string ,rule) :uint32 0)
- (when dbus-debug (message "Matching rule \"%s\" created" rule1))
+ (when dbus-debug (message "Matching rule \"%s\" created" rule))
;; Create a hash table entry.
(setq key (list :monitor bus-private)
- key1 (list nil nil nil handler)
+ key1 (list nil nil nil handler rule)
value (gethash key dbus-registered-objects-table))
(unless (member key1 value)
(puthash key (cons key1 value) dbus-registered-objects-table))
@@ -2046,14 +2034,48 @@ applied. It is called with ARGS as arguments."
(when dbus-debug (message "%s" dbus-registered-objects-table))
;; Return the object.
- (list key (list service path handler))))
+ (list key key1)))
+
+(defconst dbus-monitor-method-call
+ (propertize "method-call" 'face 'font-lock-function-name-face)
+ "Text to be inserted for D-Bus method-call in monitor.")
+
+(defconst dbus-monitor-method-return
+ (propertize "method-return" 'face 'font-lock-function-name-face)
+ "Text to be inserted for D-Bus method-return in monitor.")
+
+(defconst dbus-monitor-error (propertize "error" 'face 'font-lock-warning-face)
+ "Text to be inserted for D-Bus error in monitor.")
+
+(defconst dbus-monitor-signal
+ (propertize "signal" 'face 'font-lock-type-face)
+ "Text to be inserted for D-Bus signal in monitor.")
+
+(defun dbus-monitor-goto-serial ()
+ "Goto D-Bus message with the same serial number."
+ (interactive)
+ (when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
+ (when-let ((point (get-text-property (point) 'dbus-serial)))
+ (goto-char point)))
(defun dbus-monitor-handler (&rest _args)
"Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\"
interface.
-It will be applied all objects created by `dbus-register-monitor'."
+It will be applied for all objects created by `dbus-register-monitor'
+which don't declare an own handler. The printed timestamps do
+not reflect the time the D-Bus message has passed the D-Bus
+daemon, it is rather the timestamp the corresponding D-Bus event
+has been handled by this function."
(with-current-buffer (get-buffer-create "*D-Bus Monitor*")
(special-mode)
+ ;; Move forward and backward between messages.
+ (local-set-key [?n] #'forward-paragraph)
+ (local-set-key [?p] #'backward-paragraph)
+ ;; Follow serial links.
+ (local-set-key (kbd "RET") #'dbus-monitor-goto-serial)
+ (local-set-key [mouse-2] #'dbus-monitor-goto-serial)
(let* ((inhibit-read-only t)
+ (text-quoting-style 'grave)
+ (point (point))
(eobp (eobp))
(event last-input-event)
(type (dbus-event-message-type event))
@@ -2063,23 +2085,76 @@ It will be applied all objects created by
`dbus-register-monitor'."
(path (dbus-event-path-name event))
(interface (dbus-event-interface-name event))
(member (dbus-event-member-name event))
- (arguments (dbus-event-arguments event)))
+ (arguments (dbus-event-arguments event))
+ (time (time-to-seconds (current-time))))
(save-excursion
+ ;; Check for matching method-call.
+ (goto-char (point-max))
+ (when (and (or (= type dbus-message-type-method-return)
+ (= type dbus-message-type-error))
+ (re-search-backward
+ (format
+ (concat
+ "^method-call time=\\(\\S-+\\) "
+ ".*sender=%s .*serial=\\(%d\\) ")
+ destination serial)
+ nil 'noerror))
+ (setq serial
+ (propertize
+ (match-string 2) 'dbus-serial (match-beginning 0)
+ 'help-echo "RET, mouse-1, mouse-2: goto method-call"
+ 'face 'link 'follow-link 'mouse-face 'mouse-face 'highlight)
+ time (format "%f (%f)" time (- time (read (match-string 1)))))
+ (set-text-properties
+ (match-beginning 2) (match-end 2)
+ `(dbus-serial ,(point-max)
+ help-echo
+ ,(format
+ "RET, mouse-1, mouse-2: goto %s"
+ (if (= type dbus-message-type-error) "error" "method-return"))
+ face link follow-link mouse-face mouse-face highlight)))
+ ;; Insert D-Bus message.
(goto-char (point-max))
(insert
(format
(concat
- "%s sender=%s -> destination=%s serial=%s "
+ "%s time=%s sender=%s -> destination=%s serial=%s "
"path=%s interface=%s member=%s\n")
(cond
- ((= type dbus-message-type-method-call) "method-call")
- ((= type dbus-message-type-method-return) "method-return")
- ((= type dbus-message-type-error) "error")
- ((= type dbus-message-type-signal) "signal"))
- sender destination serial path interface member))
+ ((= type dbus-message-type-method-call) dbus-monitor-method-call)
+ ((= type dbus-message-type-method-return)
dbus-monitor-method-return)
+ ((= type dbus-message-type-error) dbus-monitor-error)
+ ((= type dbus-message-type-signal) dbus-monitor-signal))
+ time sender destination serial path interface member))
(dolist (arg arguments)
(pp (dbus-flatten-types arg) (current-buffer)))
- (insert "\n"))
+ (insert "\n")
+ ;; Show byte arrays as string.
+ (goto-char point)
+ (while (re-search-forward
+ "(:array\\( :byte [[:digit:]]+\\)+)" nil 'noerror)
+ (put-text-property
+ (match-beginning 0) (match-end 0)
+ 'help-echo (dbus-byte-array-to-string (read (match-string 0)))))
+ ;; Show fixed numbers.
+ (goto-char point)
+ (while (re-search-forward
+ (concat
+ (regexp-opt
+ '(":int16" ":uint16" ":int32" ":uint32" ":int64" ":uint64"))
+ " \\([-+[:digit:]]+\\)")
+ nil 'noerror)
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'help-echo
+ (format
+ "#o%o, #x%X" (read (match-string 1)) (read (match-string 1)))))
+ ;; Show floating numbers.
+ (goto-char point)
+ (while (re-search-forward ":double \\([-+.[:digit:]]+\\)" nil 'noerror)
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'help-echo (format "%e" (read (match-string 1))))))
(when eobp
(goto-char (point-max))))))
@@ -2115,10 +2190,11 @@ pending at the time of disconnect to fail."
(defun dbus-init-bus (bus &optional private)
"Establish the connection to D-Bus BUS.
-BUS can be either the symbol `:system' or the symbol `:session', or it
-can be a string denoting the address of the corresponding bus. For
-the system and session buses, this function is called when loading
-`dbus.el', there is no need to call it again.
+BUS can be either the keyword `:system' or the keyword
+`:session', or it can be a string denoting the address of the
+corresponding bus. For the system and session buses, this
+function is called when loading `dbus.el', there is no need to
+call it again.
The function returns the number of connections this Emacs session
has established to the BUS under the same unique name (see
@@ -2128,13 +2204,13 @@ example, if Emacs is linked with the GTK+ toolkit, and
it runs in
a GTK+-aware environment like GNOME, another connection might
already be established.
-When PRIVATE is non-nil, a new connection is established instead of
-reusing an existing one. It results in a new unique name at the bus.
-This can be used, if it is necessary to distinguish from another
-connection used in the same Emacs process, like the one established by
-GTK+. It should be used with care for at least the `:system' and
-`:session' buses, because other Emacs Lisp packages might already use
-this connection to those buses."
+When PRIVATE is non-nil, a new connection is established instead
+of reusing an existing one. It results in a new unique name at
+the bus. This can be used, if it is necessary to distinguish
+from another connection used in the same Emacs process, like the
+one established by GTK+. If BUS is the keyword `:system' or the
+keyword `:session', the new connection is identified by the
+keywords `:system-private' or `:session-private', respectively."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(prog1
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index bb74f47..f07d214 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -5,7 +5,7 @@
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Created: December, 2009
-;; Version: 3.1.5
+;; Version: 3.2.0
;; Keywords: soap, web-services, comm, hypermedia
;; Package: soap-client
;; Homepage: https://github.com/alex-hhh/emacs-soap-client
@@ -551,30 +551,77 @@ This is a specialization of `soap-encode-value' for
(soap-validate-xs-basic-type value-string type)
(insert value-string)))))
-;; Inspired by rng-xsd-convert-date-time.
-(defun soap-decode-date-time (date-time-string datatype)
+(defun soap-decode-date-time (date-time-string &optional datatype)
"Decode DATE-TIME-STRING as DATATYPE.
DATE-TIME-STRING should be in ISO 8601 basic or extended format.
-DATATYPE is one of dateTime, time, date, gYearMonth, gYear,
-gMonthDay, gDay or gMonth.
-
-Return a list in a format (SEC MINUTE HOUR DAY MONTH YEAR
-SEC-FRACTION DATATYPE ZONE). This format is meant to be similar
-to that returned by `decode-time' (and compatible with
-`encode-time'). The differences are the SEC (seconds)
-field is always an integer, the DOW (day-of-week) field
-is replaced with SEC-FRACTION, a float representing the
-fractional seconds, and the DST (daylight savings time) field is
-replaced with DATATYPE, a symbol representing the XSD primitive
-datatype. This symbol can be used to determine which fields
-apply and which don't when it's not already clear from context.
-For example a datatype of `time' means the year, month and day
+DATATYPE can be omitted, or one of the symbols dateTime, time,
+date, gYearMonth, gYear, gMonthDay, gDay, or gMonth. If Emacs is
+a version that supports fractional seconds, DATATYPE can also be
+dateTime-subsecond, or time-subsecond. On older versions of
+Emacs (prior to 27.1), which do not support fractional seconds,
+leaving DATATYPE nil means that subseconds in DATE-TIME-STRING
+will be ignored.
+
+Return a list in a format identical or similar to that returned
+by `decode-time'. The returned format is always compatible with
+`encode-time'. If DATATYPE is omitted or nil, this function will
+return a list that has exactly the same format as that returned
+by `decode-time'.
+
+Note that on versions of Emacs that predate support for
+fractional seconds, `encode-time' will not notice the SUBSECOND
+field so it must be handled specially.
+
+The formats returned by this function are as follows, where _
+means \"should be ignored\":
+
+ DATATYPE | Return format
+------------+----------------------------------------------------------------
+ nil | (SECOND MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF)
+ dateTime | (SECOND MINUTE HOUR DAY MONTH YEAR SUBSECOND dateTime UTCOFF)
+ time | (SECOND MINUTE HOUR _ _ _ SUBSECOND time _)
+ date | (_ _ _ DAY MONTH YEAR _ date _)
+ gYearMonth | (_ _ _ _ MONTH YEAR _ gYearMonth _)
+ gYear | (_ _ _ _ _ YEAR _ gYear _)
+ gMonthDay | (_ _ _ DAY MONTH _ _ gMonthDay _)
+ gDay | (_ _ _ DAY _ _ _ gDay _)
+ gMonth | (_ _ _ _ MONTH _ _ gMonth _)
+
+When DATATYPE is dateTime or time, the DOW (day-of-week) field is
+replaced with SUBSECOND, a float representing the fractional
+seconds, and the DST (daylight savings time) field is replaced
+with DATATYPE, a symbol representing the XSD primitive datatype.
+This symbol can be used to determine which fields apply and which
+do not, when it is not already clear from context. For example a
+datatype of `time' means the year, month, day and time zone
fields should be ignored.
-This function will throw an error if DATE-TIME-STRING represents
-a leap second, since the XML Schema 1.1 standard explicitly
-disallows them."
- (let* ((datetime-regexp (cadr (get datatype 'rng-xsd-convert)))
+New code that depends on Emacs 27.1 or newer anyway, and that
+wants dateTime or time but with the first argument with subsecond
+resolution, i.e., (TICKS . HZ), can set DATATYPE to
+dateTime-subsecond or time-subsecond respectively. This function
+throws an error if dateTime-subsecond or time-subsecond is
+specified when Emacs does not support subsecond resolution.
+
+This function throws an error if DATE-TIME-STRING represents a
+leap second, since the XML Schema 1.1 standard does not support
+representing leap seconds."
+ (let* ((new-decode-time (condition-case nil
+ (not (null
+ (with-no-warnings (decode-time nil nil
t))))
+ (wrong-number-of-arguments)))
+ (new-decode-time-second nil)
+ (no-support "This Emacs version does not support %s")
+ (datetime-regexp-type
+ (cl-case datatype
+ ((dateTime-subsecond time-subsecond)
+ (if new-decode-time
+ (intern (replace-regexp-in-string
+ "-subsecond" "" (symbol-name datatype)))
+ (error (format no-support (symbol-name datatype)))))
+ ((nil) 'dateTime)
+ (otherwise datatype)))
+ (datetime-regexp (cadr (get datetime-regexp-type 'rng-xsd-convert)))
(year-sign (progn
(string-match datetime-regexp date-time-string)
(match-string 1 date-time-string)))
@@ -585,6 +632,7 @@ disallows them."
(minute (match-string 6 date-time-string))
(second (match-string 7 date-time-string))
(second-fraction (match-string 8 date-time-string))
+ (time-zone nil)
(has-time-zone (match-string 9 date-time-string))
(time-zone-sign (match-string 10 date-time-string))
(time-zone-hour (match-string 11 date-time-string))
@@ -605,11 +653,28 @@ disallows them."
(if hour (string-to-number hour) 0))
(setq minute
(if minute (string-to-number minute) 0))
+ (when new-decode-time
+ (setq new-decode-time-second
+ (if second
+ (if second-fraction
+ (let* ((second-fraction-significand
+ (replace-regexp-in-string "\\." ""
second-fraction))
+ (hertz
+ (expt 10 (length second-fraction-significand)))
+ (ticks (+ (* hertz (string-to-number second))
+ (string-to-number
+ second-fraction-significand))))
+ (cons ticks hertz))
+ (cons second 1)))))
(setq second
(if second (string-to-number second) 0))
(setq second-fraction
(if second-fraction
- (float (string-to-number second-fraction))
+ (progn
+ (when (and (not datatype) (not new-decode-time))
+ (message
+ "soap-decode-date-time: Discarding fractional seconds"))
+ (float (string-to-number second-fraction)))
0.0))
(setq has-time-zone (and has-time-zone t))
(setq time-zone-sign
@@ -618,6 +683,14 @@ disallows them."
(if time-zone-hour (string-to-number time-zone-hour) 0))
(setq time-zone-minute
(if time-zone-minute (string-to-number time-zone-minute) 0))
+ (setq time-zone (if has-time-zone
+ (* (rng-xsd-time-to-seconds
+ time-zone-hour
+ time-zone-minute
+ 0)
+ time-zone-sign)
+ ;; UTC.
+ 0))
(unless (and
;; XSD does not allow year 0.
(> year 0)
@@ -635,18 +708,22 @@ disallows them."
(>= time-zone-minute 0)
(<= time-zone-minute 59))
(error "Invalid or unsupported time: %s" date-time-string))
- ;; Return a value in a format similar to that returned by decode-time, and
- ;; suitable for (apply #'encode-time ...).
- ;; FIXME: Nobody uses this idiosyncratic value. Perhaps stop returning it?
- (list second minute hour day month year second-fraction datatype
- (if has-time-zone
- (* (rng-xsd-time-to-seconds
- time-zone-hour
- time-zone-minute
- 0)
- time-zone-sign)
- ;; UTC.
- 0))))
+ ;; Return a value in a format identical or similar to that
+ ;; returned by decode-time, and always suitable for (apply
+ ;; #'encode-time ...).
+ (if datatype
+ (list (if (memq datatype '(dateTime-subsecond time-subsecond))
+ new-decode-time-second
+ second)
+ minute hour day month year second-fraction datatype time-zone)
+ (let ((time
+ (apply
+ #'encode-time (list
+ (if new-decode-time new-decode-time-second second)
+ minute hour day month year nil nil time-zone))))
+ (if new-decode-time
+ (with-no-warnings (decode-time time nil t))
+ (decode-time time))))))
(defun soap-decode-xs-basic-type (type node)
"Use TYPE, a `soap-xs-basic-type', to decode the contents of NODE.
@@ -2919,8 +2996,6 @@ reference multiRef parts which are external to
RESPONSE-NODE."
;;;; SOAP type encoding
-;; FIXME: Use `cl-defmethod' (but this requires Emacs-25).
-
(defun soap-encode-attributes (value type)
"Encode XML attributes for VALUE according to TYPE.
This is a generic function which determines the attribute encoder
@@ -3028,7 +3103,7 @@ SERVICE-URL should be provided when WS-Addressing is
being used."
(insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<soap:Envelope\n")
(when (eq use 'encoded)
(insert " soapenc:encodingStyle=\"\
-https://schemas.xmlsoap.org/soap/encoding/\"\n";))
+http://schemas.xmlsoap.org/soap/encoding/\"\n";))
(dolist (nstag soap-encoded-namespaces)
(insert " xmlns:" nstag "=\"")
(let ((nsname (cdr (assoc nstag soap-well-known-xmlns))))
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 74f45b9..9d346cf 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -82,10 +82,14 @@ being via `pcmpl-ssh-known-hosts-file'."
;;;###autoload
(defun pcomplete/xargs ()
"Completion for `xargs'."
- (pcomplete-here (funcall pcomplete-command-completion-function))
+ ;; FIXME: Add completion of xargs-specific arguments.
+ (funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
+;; FIXME: Add completion of sudo-specific arguments.
+(defalias 'pcomplete/sudo #'pcomplete/xargs)
+
;;;###autoload
(defalias 'pcomplete/time 'pcomplete/xargs)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index a408d16..4fe1377 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -33,6 +33,7 @@
(eval-when-compile (require 'cl-lib))
(require 'tool-bar)
(require 'comint)
+(require 'text-property-search)
(defgroup compilation nil
"Run compiler as inferior of Emacs, parse error messages."
@@ -1573,7 +1574,14 @@ to `compilation-error-regexp-alist' if RULES is nil."
;; grep.el) don't need to flush-parse when they modify the buffer
;; in a way that impacts buffer positions but does not require
;; re-parsing.
- (setq compilation--parsed (point-min-marker)))
+ (setq compilation--parsed
+ (set-marker (make-marker)
+ (save-excursion
+ (goto-char (point-min))
+ (text-property-search-forward
'compilation-header-end)
+ ;; If we have no end marker, this will be
+ ;; `point-min' still.
+ (point)))))
(when (< compilation--parsed limit)
(let ((start (max compilation--parsed (point-min))))
(move-marker compilation--parsed limit)
@@ -1818,6 +1826,9 @@ Returns the compilation buffer created."
mode-name
(substring (current-time-string) 0 19))
command "\n")
+ ;; Mark the end of the header so that we don't interpret
+ ;; anything in it as an error.
+ (put-text-property (1- (point)) (point) 'compilation-header-end t)
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 468ffc9..c62fbab 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -7,6 +7,7 @@
;; Jonathan Rockway <jon@jrock.us>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, Perl
+;; Package-Requires: ((emacs "26.1"))
;; This file is part of GNU Emacs.
@@ -75,6 +76,26 @@
;;; Code:
+;;; Compatibility with older versions (for publishing on ELPA)
+;; The following helpers allow cperl-mode.el to work with older
+;; versions of Emacs.
+;;
+;; Whenever the minimum version is bumped (see "Package-Requires"
+;; above), please eliminate the corresponding compatibility-helpers.
+;; Whenever you create a new compatibility-helper, please add it here.
+
+;; Available in Emacs 27.1: time-convert
+(defalias 'cperl--time-convert
+ (if (fboundp 'time-convert) 'time-convert
+ 'encode-time))
+
+;; Available in Emacs 28: format-prompt
+(defalias 'cperl--format-prompt
+ (if (fboundp 'format-prompt) 'format-prompt
+ (lambda (msg default)
+ (if default (format "%s (default %s): " msg default)
+ (concat msg ": ")))))
+
(eval-when-compile (require 'cl-lib))
(defvar msb-menu-cond)
@@ -82,13 +103,6 @@
(defvar vc-rcs-header)
(defvar vc-sccs-header)
-(defmacro cperl-force-face (arg descr) ; Takes unquoted arg
- `(progn
- (or (facep (quote ,arg))
- (make-face ,arg))
- (or (boundp (quote ,arg)) ; We use unquoted variants too
- (defvar ,arg (quote ,arg) ,descr))))
-
(defun cperl-choose-color (&rest list)
(let (answer)
(while list
@@ -663,10 +677,6 @@ micro-docs on what I know about CPerl problems.")
(defvar cperl-problems 'please-ignore-this-line
"Description of problems in CPerl mode.
-Some faces will not be shown on some versions of Emacs unless you
-install choose-color.el, available from
- http://ilyaz.org/software/emacs
-
`fill-paragraph' on a comment may leave the point behind the
paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
to detect it and bulk out).
@@ -1715,10 +1725,9 @@ or as help on variables `cperl-tips', `cperl-problems',
(if cperl-hook-after-change
(add-hook 'after-change-functions #'cperl-after-change-function nil t))
;; After hooks since fontification will break this
- (if cperl-pod-here-scan
- (or cperl-syntaxify-by-font-lock
- (progn (or cperl-faces-init (cperl-init-faces-weak))
- (cperl-find-pods-heres))))
+ (when (and cperl-pod-here-scan
+ (not cperl-syntaxify-by-font-lock))
+ (cperl-find-pods-heres))
;; Setup Flymake
(add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
@@ -3262,9 +3271,6 @@ Works before syntax recognition is done."
result))
-(defvar font-lock-string-face)
-;;(defvar font-lock-reference-face)
-(defvar font-lock-constant-face)
(defsubst cperl-postpone-fontification (b e type val &optional now)
;; Do after syntactic fontification?
(if cperl-syntaxify-by-font-lock
@@ -3330,16 +3336,6 @@ Works before syntax recognition is done."
(setq end (point)))))
(or end pos)))))
-;; These are needed for byte-compile (at least with v19)
-(defvar cperl-nonoverridable-face)
-(defvar font-lock-variable-name-face)
-(defvar font-lock-function-name-face)
-(defvar font-lock-keyword-face)
-(defvar font-lock-builtin-face)
-(defvar font-lock-type-face)
-(defvar font-lock-comment-face)
-(defvar font-lock-warning-face)
-
(defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
"Syntactically mark (and fontify) attributes of a subroutine.
Should be called with the point before leading colon of an attribute."
@@ -5474,17 +5470,6 @@ indentation and initial hashes. Behaves usually outside
of comment."
(or cperl-faces-init (cperl-init-faces))
cperl-font-lock-keywords-2)
-(defun cperl-init-faces-weak ()
- ;; Allow `cperl-find-pods-heres' to run.
- (or (boundp 'font-lock-constant-face)
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names"))
- (or (boundp 'font-lock-warning-face)
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out"))
- ;;(setq font-lock-constant-face 'font-lock-constant-face)
- )
-
(defun cperl-init-faces ()
(condition-case errs
(progn
@@ -5612,7 +5597,7 @@ indentation and initial hashes. Behaves usually outside
of comment."
"wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added
manually
"\\|[sm]" ; Added manually
"\\)\\>")
- 2 'cperl-nonoverridable-face)
+ 2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted
;; (mapconcat #'identity
;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
;; "#include" "#define" "#undef")
@@ -5648,11 +5633,7 @@ indentation and initial hashes. Behaves usually outside
of comment."
2 font-lock-function-name-face)
'("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"
1 font-lock-function-name-face)
- (cond ((featurep 'font-lock-extra)
- '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[
\t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- (2 font-lock-string-face t)
- (0 '(restart 2 t)))) ; To highlight $a{bc}{ef}
- (font-lock-anchored
+ (cond (font-lock-anchored
'("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[
\t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
(2 font-lock-string-face t)
("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
@@ -5670,15 +5651,7 @@ indentation and initial hashes. Behaves usually outside
of comment."
;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
;;; (2 (cons font-lock-variable-name-face '(underline))))
- (cond ((featurep 'font-lock-extra)
- '("^[ \t]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([
\t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (3 font-lock-variable-name-face)
- (4 '(another 4 nil
- ("\\=[ \t]*,[
\t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (1 font-lock-variable-name-face)
- (2 '(restart 2 nil) nil t)))
- nil t))) ; local variables, multiple
- (font-lock-anchored
+ (cond (font-lock-anchored
;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var
`(,(concat "\\<\\(state\\|my\\|local\\|our\\)"
cperl-maybe-white-and-comment-rex
@@ -5780,164 +5753,6 @@ indentation and initial hashes. Behaves usually
outside of comment."
t-font-lock-keywords-1
cperl-font-lock-keywords-1)))
(if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
- (if (or (featurep 'choose-color) (featurep 'font-lock-extra))
- (eval ; Avoid a warning
- '(font-lock-require-faces
- (list
- ;; Color-light Color-dark Gray-light Gray-dark Mono
- (list 'font-lock-comment-face
- ["Firebrick" "OrangeRed" "DimGray"
"Gray80"]
- nil
- [nil nil t t
t]
- [nil nil t t
t]
- nil)
- (list 'font-lock-string-face
- ["RosyBrown" "LightSalmon" "Gray50"
"LightGray"]
- nil
- nil
- [nil nil t t
t]
- nil)
- (list 'font-lock-function-name-face
- (vector
- "Blue" "LightSkyBlue" "Gray50"
"LightGray"
- (cdr (assq 'background-color ; if mono
- (frame-parameters))))
- (vector
- nil nil nil nil
- (cdr (assq 'foreground-color ; if mono
- (frame-parameters))))
- [nil nil t t
t]
- nil
- nil)
- (list 'font-lock-variable-name-face
- ["DarkGoldenrod" "LightGoldenrod" "DimGray"
"Gray90"]
- nil
- [nil nil t t
t]
- [nil nil t t
t]
- nil)
- (list 'font-lock-type-face
- ["DarkOliveGreen" "PaleGreen" "DimGray"
"Gray80"]
- nil
- [nil nil t t
t]
- nil
- [nil nil t t
t])
- (list 'font-lock-warning-face
- ["Pink" "Red" "Gray50"
"LightGray"]
- ["gray20" "gray90"
- "gray80"
"gray20"]
- [nil nil t t
t]
- nil
- [nil nil t t
t]
- )
- (list 'font-lock-constant-face
- ["CadetBlue" "Aquamarine" "Gray50"
"LightGray"]
- nil
- [nil nil t t
t]
- nil
- [nil nil t t
t])
- (list 'cperl-nonoverridable-face
- ["chartreuse3" ("orchid1" "orange")
- nil "Gray80"]
- [nil nil "gray90"]
- [nil nil nil t
t]
- [nil nil t t]
- [nil nil t t
t])
- (list 'cperl-array-face
- ["blue" "yellow" nil
"Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- nil
- nil)
- (list 'cperl-hash-face
- ["red" "red" nil
"Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- t
- nil))))
- ;; Do it the dull way, without choose-color
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names")
- (cperl-force-face font-lock-variable-name-face
- "Face for variable names")
- (cperl-force-face font-lock-type-face
- "Face for data types")
- (cperl-force-face cperl-nonoverridable-face
- "Face for data types from another group")
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out")
- (cperl-force-face font-lock-comment-face
- "Face for comments")
- (cperl-force-face font-lock-function-name-face
- "Face for function names")
- ;;(defvar font-lock-constant-face 'font-lock-constant-face)
- ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
- ;;(or (boundp 'font-lock-type-face)
- ;; (defconst font-lock-type-face
- ;; 'font-lock-type-face
- ;; "Face to use for data types."))
- ;;(or (boundp 'cperl-nonoverridable-face)
- ;; (defconst cperl-nonoverridable-face
- ;; 'cperl-nonoverridable-face
- ;; "Face to use for data types from another group."))
- (if (and
- (not (facep 'cperl-array-face))
- (facep 'font-lock-emphasized-face))
- (copy-face 'font-lock-emphasized-face 'cperl-array-face))
- (if (and
- (not (facep 'cperl-hash-face))
- (facep 'font-lock-other-emphasized-face))
- (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face))
- (if (and
- (not (facep 'cperl-nonoverridable-face))
- (facep 'font-lock-other-type-face))
- (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face))
- ;;(or (boundp 'cperl-hash-face)
- ;; (defconst cperl-hash-face
- ;; 'cperl-hash-face
- ;; "Face to use for hashes."))
- ;;(or (boundp 'cperl-array-face)
- ;; (defconst cperl-array-face
- ;; 'cperl-array-face
- ;; "Face to use for arrays."))
- (let ((background 'light))
- (and (not (facep 'font-lock-constant-face))
- (facep 'font-lock-reference-face)
- (copy-face 'font-lock-reference-face 'font-lock-constant-face))
- (if (facep 'font-lock-type-face) nil
- (copy-face 'default 'font-lock-type-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "seagreen")
- "seagreen"
- "sea green")))
- ((eq background 'dark)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "os2pink")
- "os2pink"
- "pink")))
- (t
- (set-face-background 'font-lock-type-face "gray90"))))
- (if (facep 'cperl-nonoverridable-face)
- nil
- (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "chartreuse3")
- "chartreuse3"
- "chartreuse")))
- ((eq background 'dark)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "orchid1")
- "orchid1"
- "orange")))))
- (if (facep 'font-lock-variable-name-face) nil
- (copy-face 'italic 'font-lock-variable-name-face))
- (if (facep 'font-lock-constant-face) nil
- (copy-face 'italic 'font-lock-constant-face))))
(setq cperl-faces-init t))
(error (message "cperl-init-faces (ignored): %s" errs))))
@@ -6332,7 +6147,7 @@ Customized by setting variables
`cperl-shrink-wrap-info-frame',
(interactive
(let* ((default (cperl-word-at-point))
(read (read-string
- (format-prompt "Find doc for Perl function" default))))
+ (cperl--format-prompt "Find doc for Perl function" default))))
(list (if (equal read "")
default
read))))
@@ -8291,7 +8106,7 @@ the appropriate statement modifier."
(interactive
(list (let* ((default-entry (cperl-word-at-point))
(input (read-string
- (format-prompt "perldoc entry" default-entry))))
+ (cperl--format-prompt "perldoc entry" default-entry))))
(if (string= input "")
(if (string= default-entry "")
(error "No perldoc args given")
@@ -8518,7 +8333,7 @@ start with default arguments, then refine the slowdown
regions."
(or l (setq l 1))
(or step (setq step 500))
(or lim (setq lim 40))
- (let* ((timems (function (lambda () (car (time-convert nil 1000)))))
+ (let* ((timems (function (lambda () (car (cperl--time-convert nil 1000)))))
(tt (funcall timems)) (c 0) delta tot)
(goto-char (point-min))
(forward-line (1- l))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index c71a903..279eb4d 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -100,6 +100,13 @@ To change the default value, use \\[customize] or call the
function
:set #'grep-apply-setting
:version "22.1")
+(defcustom grep-match-regexp "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m"
+ "Regular expression matching grep markers to highlight.
+It matches SGR ANSI escape sequences which are emitted by grep to
+color its output. This variable is used in `grep-filter'."
+ :type 'regexp
+ :version "28.1")
+
(defcustom grep-scroll-output nil
"Non-nil to scroll the *grep* buffer window as output appears.
@@ -590,7 +597,7 @@ This function is called from `compilation-filter-hook'."
(when (< (point) end)
(setq end (copy-marker end))
;; Highlight grep matches and delete marking sequences.
- (while (re-search-forward "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m" end
1)
+ (while (re-search-forward grep-match-regexp end 1)
(replace-match (propertize (match-string 1)
'face nil 'font-lock-face grep-match-face)
t t)
diff --git a/lisp/server.el b/lisp/server.el
index 436a6ca..a660dea 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1338,7 +1338,13 @@ The following commands are accepted by the client:
"When done with this frame, type
\\[delete-frame]")))
((not (null buffers))
(run-hooks 'server-after-make-frame-hook)
- (server-switch-buffer (car buffers) nil (cdr (car files)))
+ (server-switch-buffer
+ (car buffers) nil (cdr (car files))
+ ;; When triggered from "emacsclient -c", we popped up a
+ ;; new frame. Ensure that we switch to the requested
+ ;; buffer in that frame, and not in some other frame
+ ;; where it may be displayed.
+ (plist-get (process-plist proc) 'frame))
(run-hooks 'server-switch-hook)
(unless nowait
(message "%s" (substitute-command-keys
@@ -1568,7 +1574,8 @@ starts server process and that is all. Invoked by
\\[server-edit]."
(server-clients (apply #'server-switch-buffer (server-done)))
(t (message "No server editing buffers exist"))))
-(defun server-switch-buffer (&optional next-buffer killed-one filepos)
+(defun server-switch-buffer (&optional next-buffer killed-one filepos
+ this-frame-only)
"Switch to another buffer, preferably one that has a client.
Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it.
@@ -1602,7 +1609,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
;; OK, we know next-buffer is live, let's display and select it.
(if (functionp server-window)
(funcall server-window next-buffer)
- (let ((win (get-buffer-window next-buffer 0)))
+ (let ((win (get-buffer-window next-buffer
+ (if this-frame-only nil 0))))
(if (and win (not server-window))
;; The buffer is already displayed: just reuse the
;; window. If FILEPOS is non-nil, use it to replace the
@@ -1620,7 +1628,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
(setq server-window (make-frame)))
(select-window (frame-selected-window server-window))))
(when (window-minibuffer-p)
- (select-window (next-window nil 'nomini 0)))
+ (select-window (next-window nil 'nomini
+ (if this-frame-only nil 0))))
;; Move to a non-dedicated window, if we have one.
(when (window-dedicated-p)
(select-window
diff --git a/lisp/shell.el b/lisp/shell.el
index 9667dab..6129e5e 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -460,9 +460,12 @@ Thus, this does not include the shell's current
directory.")
This is the value of `pcomplete-command-completion-function' for
Shell buffers. It implements `shell-completion-execonly' for
`pcomplete' completion."
- (pcomplete-here (pcomplete-entries nil
- (if shell-completion-execonly
- 'file-executable-p))))
+ (if (pcomplete-match "/")
+ (pcomplete-here (pcomplete-entries nil
+ (if shell-completion-execonly
+ 'file-executable-p)))
+ (pcomplete-here
+ (nth 2 (shell--command-completion-data)))))
(defun shell-completion-vars ()
"Setup completion vars for `shell-mode' and `read-shell-command'."
diff --git a/lisp/simple.el b/lisp/simple.el
index 6bc4196..fef22c2 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1533,7 +1533,11 @@ in *Help* buffer. See also the command `describe-char'."
encoded encoding-msg display-prop under-display)
(if (or (not coding)
(eq (coding-system-type coding) t))
- (setq coding (default-value 'buffer-file-coding-system)))
+ (setq coding (or (default-value 'buffer-file-coding-system)
+ ;; A nil value of `buffer-file-coding-system'
+ ;; means "no conversion" which means each byte
+ ;; is a char and vice versa.
+ 'binary)))
(if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
(format "(%d, #o%o, #x%x%s, raw-byte)" char char char
char-name-fmt))
diff --git a/lisp/subr.el b/lisp/subr.el
index 1035ebd..55217bd 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -193,9 +193,9 @@ except that PLACE is evaluated only once (after NEWELT)."
(list 'setq place
(list 'cons newelt place))
(require 'macroexp)
- (macroexp-let2 macroexp-copyable-p v newelt
+ (macroexp-let2 macroexp-copyable-p x newelt
(gv-letplace (getter setter) place
- (funcall setter `(cons ,v ,getter))))))
+ (funcall setter `(cons ,x ,getter))))))
(defmacro pop (place)
"Return the first element of PLACE's value, and remove it from the list.
@@ -4434,7 +4434,7 @@ Unless optional argument INPLACE is non-nil, return a new
string."
(aset newstr i tochar)))
newstr))
-(defun replace-in-string (fromstring tostring instring)
+(defun string-replace (fromstring tostring instring)
"Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
(declare (pure t))
(when (equal fromstring "")
@@ -4447,10 +4447,13 @@ Unless optional argument INPLACE is non-nil, return a
new string."
(push (substring instring start pos) result))
(push tostring result)
(setq start (+ pos (length fromstring))))
- ;; Get any remaining bit.
- (unless (= start (length instring))
- (push (substring instring start) result))
- (apply #'concat (nreverse result))))
+ (if (null result)
+ ;; No replacements were done, so just return the original string.
+ instring
+ ;; Get any remaining bit.
+ (unless (= start (length instring))
+ (push (substring instring start) result))
+ (apply #'concat (nreverse result)))))
(defun replace-regexp-in-string (regexp rep string &optional
fixedcase literal subexp start)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 8ad99f4..0a2ddb0 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1057,9 +1057,8 @@ If nothing was called, return non-nil."
pos 'button (and (windowp (posn-window start))
(window-buffer (posn-window start))))))
- (when (and (widget-get button :button-overlay)
- (or (null button)
- (widget-button--check-and-call-button event button)))
+ (when (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
@@ -1370,7 +1369,8 @@ Unlike (get-char-property POS \\='field), this works with
empty fields too."
(signal 'text-read-only
'("Attempt to change text outside editable field")))
(widget-field-use-before-change
- (widget-apply from-field :notify from-field))))))
+ (widget-apply from-field :notify
+ from-field (list 'before-change from to)))))))
(defun widget-add-change ()
(remove-hook 'post-command-hook 'widget-add-change t)
@@ -1407,7 +1407,7 @@ Unlike (get-char-property POS \\='field), this works with
empty fields too."
(> (point) begin))
(delete-char -1)))))))
(widget-specify-secret field))
- (widget-apply field :notify field))))
+ (widget-apply field :notify field (list 'after-change from to)))))
;;; Widget Functions
;;
@@ -3533,13 +3533,70 @@ To use this type, you must define :match or
:match-alternatives."
:value-to-internal (lambda (_widget value)
(if (stringp value)
value
- (char-to-string value)))
+ (let ((disp
+ (widget-character--change-character-display
+ value)))
+ (if disp
+ (propertize (char-to-string value) 'display
disp)
+ (char-to-string value)))))
:value-to-external (lambda (_widget value)
(if (stringp value)
(aref value 0)
value))
:match (lambda (_widget value)
- (characterp value)))
+ (characterp value))
+ :notify #'widget-character-notify)
+
+;; Only some escape sequences, not all of them. (Bug#15925)
+(defvar widget-character--escape-sequences-alist
+ '((?\t . ?t)
+ (?\n . ?n)
+ (?\s . ?s))
+ "Alist that associates escape sequences to a character.
+Each element has the form (ESCAPE-SEQUENCE . CHARACTER).
+
+The character widget uses this alist to display the
+non-printable character represented by ESCAPE-SEQUENCE as \\CHARACTER,
+since that makes it easier to see what's in the widget.")
+
+(defun widget-character--change-character-display (c)
+ "Return a string to represent the character C, or nil.
+
+The character widget represents some characters (e.g., the newline character
+or the tab character) specially, to make it easier for the user to see what's
+in it. For those characters, return a string to display that character in a
+more user-friendly way.
+
+For the caller, nil should mean that it is good enough to use the return value
+of `char-to-string' for the representation of C."
+ (let ((char (alist-get c widget-character--escape-sequences-alist)))
+ (and char (propertize (format "\\%c" char) 'face 'escape-glyph))))
+
+(defun widget-character-notify (widget child &optional event)
+ "Notify function for the character widget.
+
+This function allows the widget character to better display some characters,
+like the newline character or the tab character."
+ (when (eq (car-safe event) 'after-change)
+ (let* ((start (nth 1 event))
+ (end (nth 2 event))
+ str)
+ (if (eql start end)
+ (when (char-equal (widget-value widget) ?\s)
+ ;; The character widget is not really empty:
+ ;; its value is a single space character.
+ ;; We need to propertize it again, if it became empty for a while.
+ (let ((ov (widget-get widget :field-overlay)))
+ (put-text-property
+ (overlay-start ov) (overlay-end ov)
+ 'display (widget-character--change-character-display ?\s))))
+ (setq str (buffer-substring-no-properties start end))
+ ;; This assumes the user enters one character at a time,
+ ;; and does nothing crazy, like yanking a long string.
+ (let ((disp (widget-character--change-character-display (aref str 0))))
+ (when disp
+ (put-text-property start end 'display disp))))))
+ (widget-default-notify widget child event))
(define-widget 'list 'group
"A Lisp list."
diff --git a/make-dist b/make-dist
index 6901a4c..de4f343 100755
--- a/make-dist
+++ b/make-dist
@@ -110,7 +110,7 @@ while [ $# -gt 0 ]; do
;;
## Include the test/ directory.
- ## This is for backward compability to when --no-tests was the default.
+ ## This is for backward compatibility to when --no-tests was the default.
"--tests")
with_tests=yes
;;
diff --git a/src/cmds.c b/src/cmds.c
index 9052661..c29cf00 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -390,7 +390,7 @@ internal_self_insert (int c, EMACS_INT n)
by spaces so that the remaining text won't move. */
ptrdiff_t actual = PT_BYTE;
actual -= prev_char_len (actual);
- if (FETCH_CHAR (actual) == '\t')
+ if (FETCH_BYTE (actual) == '\t')
/* Rather than add spaces, let's just keep the tab. */
chars_to_delete--;
else
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 09f0317..b06077d 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -380,8 +380,9 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
break;
case DBUS_TYPE_BOOLEAN:
- /* Any non-nil object will be regarded as `t', so we don't apply
- further type check. */
+ /* There must be an argument. */
+ if (EQ (QCboolean, object))
+ wrong_type_argument (intern ("booleanp"), object);
sprintf (signature, "%c", dtype);
break;
@@ -405,6 +406,8 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
+ /* We dont check the syntax of object path and signature. This
+ will be done by libdbus. */
CHECK_STRING (object);
sprintf (signature, "%c", dtype);
break;
@@ -615,6 +618,9 @@ xd_append_arg (int dtype, Lisp_Object object,
DBusMessageIter *iter)
}
case DBUS_TYPE_BOOLEAN:
+ /* There must be an argument. */
+ if (EQ (QCboolean, object))
+ wrong_type_argument (intern ("booleanp"), object);
{
dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
@@ -713,6 +719,8 @@ xd_append_arg (int dtype, Lisp_Object object,
DBusMessageIter *iter)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
+ /* We dont check the syntax of object path and signature.
+ This will be done by libdbus. */
CHECK_STRING (object);
{
/* We need to send a valid UTF-8 string. We could encode `object'
@@ -1927,11 +1935,11 @@ and for calling handlers in case of non-blocking method
call returns.
In the first case, the key in the hash table is the list (TYPE BUS
INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
-`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
-`:session', or a string denoting the bus address. INTERFACE is a
-string which denotes a D-Bus interface, and MEMBER, also a string, is
-either a method, a signal or a property INTERFACE is offering. All
-arguments but BUS must not be nil.
+`:signal', `:property' or `:monitor'. BUS is either a Lisp symbol,
+`:system', `:session', `:system-private' or `:session-private', or a
+string denoting the bus address. INTERFACE is a string which denotes
+a D-Bus interface, and MEMBER, also a string, is either a method, a
+signal or a property INTERFACE is offering. All arguments can be nil.
The value in the hash table is a list of quadruple lists ((UNAME
SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
diff --git a/src/eval.c b/src/eval.c
index 9e0cec6..84631f4 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2437,6 +2437,8 @@ eval_sub (Lisp_Object form)
DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
doc: /* Call FUNCTION with our remaining args, using our last arg as
list of args.
Then return the value FUNCTION returns.
+With a single argument, call the argument's first element using the
+other elements as args.
Thus, (apply \\='+ 1 2 \\='(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
@@ -2450,7 +2452,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
ptrdiff_t numargs = list_length (spread_arg);
if (numargs == 0)
- return Ffuncall (nargs - 1, args);
+ return Ffuncall (max (1, nargs - 1), args);
else if (numargs == 1)
{
args [nargs - 1] = XCAR (spread_arg);
diff --git a/src/fns.c b/src/fns.c
index 2f64d95..f626fe1 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5454,6 +5454,16 @@ It should not be used for anything security-related. See
return make_digest_string (digest, SHA1_DIGEST_SIZE);
}
+static bool
+string_ascii_p (Lisp_Object string)
+{
+ ptrdiff_t nbytes = SBYTES (string);
+ for (ptrdiff_t i = 0; i < nbytes; i++)
+ if (SREF (string, i) > 127)
+ return false;
+ return true;
+}
+
DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0,
doc: /* Search for the string NEEDLE in the string HAYSTACK.
The return value is the position of the first occurrence of NEEDLE in
@@ -5468,6 +5478,7 @@ Case is always significant and text properties are
ignored. */)
{
ptrdiff_t start_byte = 0, haybytes;
char *res, *haystart;
+ EMACS_INT start = 0;
CHECK_STRING (needle);
CHECK_STRING (haystack);
@@ -5475,16 +5486,28 @@ Case is always significant and text properties are
ignored. */)
if (!NILP (start_pos))
{
CHECK_FIXNUM (start_pos);
- EMACS_INT start = XFIXNUM (start_pos);
+ start = XFIXNUM (start_pos);
if (start < 0 || start > SCHARS (haystack))
xsignal1 (Qargs_out_of_range, start_pos);
start_byte = string_char_to_byte (haystack, start);
}
+ /* If NEEDLE is longer than (the remaining length of) haystack, then
+ we can't have a match, and return early. */
+ if (SCHARS (needle) > SCHARS (haystack) - start)
+ return Qnil;
+
haystart = SSDATA (haystack) + start_byte;
haybytes = SBYTES (haystack) - start_byte;
- if (STRING_MULTIBYTE (haystack) == STRING_MULTIBYTE (needle))
+ /* We can do a direct byte-string search if both strings have the
+ same multibyteness, or if at least one of them consists of ASCII
+ characters only. */
+ if (STRING_MULTIBYTE (haystack)
+ ? (STRING_MULTIBYTE (needle)
+ || SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle))
+ : (!STRING_MULTIBYTE (needle)
+ || SCHARS (needle) == SBYTES (needle) || string_ascii_p (haystack)))
res = memmem (haystart, haybytes,
SSDATA (needle), SBYTES (needle));
else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */
@@ -5495,9 +5518,24 @@ Case is always significant and text properties are
ignored. */)
}
else /* unibyte haystack, multibyte needle */
{
- Lisp_Object uni_needle = Fstring_as_unibyte (needle);
+ /* The only possible way we can find the multibyte needle in the
+ unibyte stack (since we know that neither are pure-ASCII) is
+ if they contain "raw bytes" (and no other non-ASCII chars.) */
+ ptrdiff_t nbytes = SBYTES (needle);
+ for (ptrdiff_t i = 0; i < nbytes; i++)
+ {
+ int c = SREF (needle, i);
+ if (CHAR_BYTE8_HEAD_P (c))
+ i++; /* Skip raw byte. */
+ else if (!ASCII_CHAR_P (c))
+ return Qnil; /* Found a char that can't be in the haystack. */
+ }
+
+ /* "Raw bytes" (aka eighth-bit) are represented differently in
+ multibyte and unibyte strings. */
+ Lisp_Object uni_needle = Fstring_to_unibyte (needle);
res = memmem (haystart, haybytes,
- SSDATA (uni_needle), SBYTES (uni_needle));
+ SSDATA (uni_needle), SBYTES (uni_needle));
}
if (! res)
diff --git a/src/print.c b/src/print.c
index 1b083f7..23d0625 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1940,7 +1940,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
ptrdiff_t i, i_byte;
ptrdiff_t size_byte;
/* True means we must ensure that the next character we output
- cannot be taken as part of a hex character escape. */
+ cannot be taken as part of a hex character escape. */
bool need_nonhex = false;
bool multibyte = STRING_MULTIBYTE (obj);
@@ -1987,25 +1987,29 @@ print_object (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag)
/* If we just had a hex escape, and this character
could be taken as part of it,
output `\ ' to prevent that. */
- if (c_isxdigit (c))
- {
- if (need_nonhex)
- print_c_string ("\\ ", printcharfun);
- printchar (c, printcharfun);
- }
- else if (c == '\n' && print_escape_newlines
- ? (c = 'n', true)
- : c == '\f' && print_escape_newlines
- ? (c = 'f', true)
- : c == '\"' || c == '\\')
- {
- printchar ('\\', printcharfun);
- printchar (c, printcharfun);
- }
- else if (print_escape_control_characters && c_iscntrl (c))
+ if (c_isxdigit (c))
+ {
+ if (need_nonhex)
+ print_c_string ("\\ ", printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (c == '\n' && print_escape_newlines
+ ? (c = 'n', true)
+ : c == '\f' && print_escape_newlines
+ ? (c = 'f', true)
+ : c == '\"' || c == '\\')
+ {
+ printchar ('\\', printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (print_escape_control_characters && c_iscntrl (c))
octalout (c, SDATA (obj), i_byte, size_byte, printcharfun);
- else
- printchar (c, printcharfun);
+ else if (!multibyte
+ && SINGLE_BYTE_CHAR_P (c)
+ && !ASCII_CHAR_P (c))
+ printchar (BYTE8_TO_CHAR (c), printcharfun);
+ else
+ printchar (c, printcharfun);
need_nonhex = false;
}
}
@@ -2035,7 +2039,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
&& len == size_byte);
if (! NILP (Vprint_gensym)
- && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj))
+ && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj))
print_c_string ("#:", printcharfun);
else if (size_byte == 0)
{
@@ -2058,7 +2062,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
|| c == ',' || c == '.' || c == '`'
|| c == '[' || c == ']' || c == '?' || c <= 040
|| c == NO_BREAK_SPACE
- || confusing)
+ || confusing)
{
printchar ('\\', printcharfun);
confusing = false;
@@ -2123,7 +2127,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
if (!NILP (Vprint_circle))
{
- /* With the print-circle feature. */
+ /* With the print-circle feature. */
Lisp_Object num = Fgethash (obj, Vprint_number_table,
Qnil);
if (FIXNUMP (num))
@@ -2175,7 +2179,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
{
int len;
/* We're in trouble if this happens!
- Probably should just emacs_abort (). */
+ Probably should just emacs_abort (). */
print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun);
if (VECTORLIKEP (obj))
len = sprintf (buf, "(PVEC 0x%08zx)", (size_t) ASIZE (obj));
diff --git a/src/xdisp.c b/src/xdisp.c
index 3d40878..1529463 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -10619,7 +10619,7 @@ include the height of both, if present, in the return
value. */)
while (bpos > BEGV_BYTE)
{
dec_both (&start, &bpos);
- c = FETCH_CHAR (bpos);
+ c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t'))
break;
}
@@ -10641,7 +10641,7 @@ include the height of both, if present, in the return
value. */)
while (bpos > BEGV_BYTE)
{
dec_both (&end, &bpos);
- c = FETCH_CHAR (bpos);
+ c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
break;
}
@@ -22277,7 +22277,7 @@ trailing_whitespace_p (ptrdiff_t charpos)
int c = 0;
while (bytepos < ZV_BYTE
- && (c = FETCH_CHAR (bytepos),
+ && (c = FETCH_BYTE (bytepos),
c == ' ' || c == '\t'))
++bytepos;
@@ -22824,10 +22824,11 @@ display_count_lines_visually (struct it *it)
SET_TEXT_POS (from, PT, PT_BYTE);
to = IT_CHARPOS (*it);
}
- start_display (&tem_it, it->w, from);
/* Need to disable visual mode temporarily, since otherwise the
- call to move_it_to will cause infinite recursion. */
+ call to move_it_to below and inside start_display will cause
+ infinite recursion. */
specbind (Qdisplay_line_numbers, Qrelative);
+ start_display (&tem_it, it->w, from);
/* Some redisplay optimizations could invoke us very far from
PT, which will make the caller painfully slow. There should
be no need to go too far beyond the window's bottom, as any
diff --git a/test/lisp/gnus/gnus-icalendar-tests.el
b/test/lisp/gnus/gnus-icalendar-tests.el
index be23c90..dd265b4 100644
--- a/test/lisp/gnus/gnus-icalendar-tests.el
+++ b/test/lisp/gnus/gnus-icalendar-tests.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2020 Free Software Foundation, Inc.
-;; Author: Jan Tatarik <jtatarik@liveintent.com>
+;; Author: Jan Tatarik <jan.tatarik@gmail.com>
;; Keywords:
;; This file is part of GNU Emacs.
@@ -69,7 +69,7 @@ BEGIN:VEVENT
DTSTART;TZID=America/New_York:20201208T090000
DTEND;TZID=America/New_York:20201208T100000
DTSTAMP:20200728T182853Z
-ORGANIZER;CN=Company Events:mailto:liveintent.com_3bm6fh805bme9uoeliqcle1sa
+ORGANIZER;CN=Company Events:mailto:anoncompany.com_3bm6fh805bme9uoeliqcle1sa
g@group.calendar.google.com
UID:iipdt88slddpeu7hheuu09sfmd@google.com
X-MICROSOFT-CDO-OWNERAPPTID:-362490173
@@ -96,7 +96,7 @@ END:VCALENDAR
(should (not (gnus-icalendar-event:recurring-p event)))
(should (string= (gnus-icalendar-event:start event) "2020-12-08
15:00"))
(with-slots (organizer summary description location end-time uid
rsvp participation-type) event
- (should (string= organizer
"liveintent.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com"))
+ (should (string= organizer
"anoncompany.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com"))
(should (string= summary "Townhall | All Company
Meeting"))
(should (string= description "In this meeting, we will
cover topics from product and engineering presentations and demos to new hire
announcements to watching the late"))
(should (string= location "New York-22-Town Hall Space
(250) [Chrome Box]"))
@@ -182,55 +182,78 @@ END:VCALENDAR" (list "Mark Hershberger"))))
<2020-07-30 15:00-15:30 +1w>")))
(setenv "TZ" tz))))
+(ert-deftest gnus-icalendary-weekly-byday ()
+ ""
+ (let ((tz (getenv "TZ"))
+ (event (gnus-icalendar-tests--get-ical-event "\
+BEGIN:VCALENDAR
+PRODID:-//Google Inc//Google Calendar 70.9054//EN
+VERSION:2.0
+CALSCALE:GREGORIAN
+METHOD:REQUEST
+BEGIN:VTIMEZONE
+TZID:Europe/Berlin
+X-LIC-LOCATION:Europe/Berlin
+BEGIN:DAYLIGHT
+TZOFFSETFROM:+0100
+TZOFFSETTO:+0200
+TZNAME:CEST
+DTSTART:19700329T020000
+RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU
+END:DAYLIGHT
+BEGIN:STANDARD
+TZOFFSETFROM:+0200
+TZOFFSETTO:+0100
+TZNAME:CET
+DTSTART:19701025T030000
+RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU
+END:STANDARD
+END:VTIMEZONE
+BEGIN:VEVENT
+DTSTART;TZID=Europe/Berlin:20200915T140000
+DTEND;TZID=Europe/Berlin:20200915T143000
+RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE
+DTSTAMP:20200915T120627Z
+ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com
+UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com
+ATTENDEE;CUTYPE=INDIVIDUAL;ROLE=REQ-PARTICIPANT;PARTSTAT=ACCEPTED;RSVP=TRUE
+
;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com
+CREATED:20200325T095723Z
+DESCRIPTION:Coffee talk
+LAST-MODIFIED:20200915T120623Z
+LOCATION:
+SEQUENCE:0
+STATUS:CONFIRMED
+SUMMARY:Casual coffee talk
+TRANSP:OPAQUE
+END:VEVENT
+END:VCALENDAR" (list "participant@anoncompany.com"))))
-;; (VCALENDAR nil
-;; ((PRODID nil "Zimbra-Calendar-Provider")
-;; (VERSION nil "2.0")
-;; (METHOD nil "REQUEST"))
-;; ((VTIMEZONE nil
-;; ((TZID nil "America/New_York"))
-;; ((STANDARD nil
-;; ((DTSTART nil "16010101T020000")
-;; (TZOFFSETTO nil "-0500")
-;; (TZOFFSETFROM nil "-0400")
-;; (RRULE nil
"FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU")
-;; (TZNAME nil "EST"))
-;; nil)
-;; (DAYLIGHT nil
-;; ((DTSTART nil "16010101T020000")
-;; (TZOFFSETTO nil "-0400")
-;; (TZOFFSETFROM nil "-0500")
-;; (RRULE nil
"FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU")
-;; (TZNAME nil "EDT"))
-;; nil)))
-;; (VEVENT nil
-;; ((UID nil "903a5415-9067-4f63-b499-1b6205f49c88")
-;; (RRULE nil
"FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR")
-;; (SUMMARY nil "appointment every weekday, start jul 24,
2020, end aug 24, 2020")
-;; (ATTENDEE
-;; (CN "Mark Hershberger" ROLE "REQ-PARTICIPANT" PARTSTAT
"NEEDS-ACTION" CN "Mark A. Hershberger")
-;; "mailto:mah <at> nichework.com")
-;; (DTSTART
-;; (TZID "America/New_York")
-;; "20200724T090000")
-;; (DTEND
-;; (TZID "America/New_York")
-;; "20200724T093000")
-;; (STATUS nil "CONFIRMED")
-;; (CLASS nil "PUBLIC")
-;; (X-MICROSOFT-CDO-INTENDEDSTATUS nil "BUSY")
-;; (TRANSP nil "OPAQUE")
-;; (LAST-MODIFIED nil "20200719T150815Z")
-;; (DTSTAMP nil "20200719T150815Z")
-;; (SEQUENCE nil "0")
-;; (DESCRIPTION nil "The following is a new meeting
request:"))
-;; ((VALARM nil
-;; ((ACTION nil "DISPLAY")
-;; (TRIGGER
-;; (RELATED "START")
-;; "-PT5M")
-;; (DESCRIPTION nil "Reminder"))
-;; nil)))))
+ (unwind-protect
+ (progn
+ ;; Use this form so as not to rely on system tz database.
+ ;; Eg hydra.nixos.org.
+ (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
+ (should (eq (eieio-object-class event)
'gnus-icalendar-event-request))
+ (should (gnus-icalendar-event:recurring-p event))
+ (should (string= (gnus-icalendar-event:recurring-interval event)
"1"))
+ (should (string= (gnus-icalendar-event:start event) "2020-09-15
14:00"))
+ (with-slots (organizer summary description location end-time uid
rsvp participation-type) event
+ (should (string= organizer "anon@anoncompany.com"))
+ (should (string= summary "Casual coffee talk"))
+ (should (string= description "Coffee talk"))
+ (should (string= location ""))
+ (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time)
"2020-09-15 14:30"))
+ (should (string= uid
"7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com"))
+ (should rsvp)
+ (should (eq participation-type 'required)))
+ (should (equal (sort (gnus-icalendar-event:recurring-days event)
#'<) '(1 2 3 4 5)))
+ (should (string= (gnus-icalendar-event:org-timestamp event)
"<2020-09-15 14:00-14:30 +1w>
+<2020-09-16 14:00-14:30 +1w>
+<2020-09-17 14:00-14:30 +1w>
+<2020-09-18 14:00-14:30 +1w>
+<2020-09-21 14:00-14:30 +1w>")))
+ (setenv "TZ" tz))))
(provide 'gnus-icalendar-tests)
;;; gnus-icalendar-tests.el ends here
diff --git a/test/lisp/gnus/gnus-util-tests.el
b/test/lisp/gnus/gnus-util-tests.el
index 7eadb0d..ec58032 100644
--- a/test/lisp/gnus/gnus-util-tests.el
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -25,6 +25,65 @@
(require 'ert)
(require 'gnus-util)
+(ert-deftest gnus-string> ()
+ ;; Failure paths
+ (should-error (gnus-string> "" 1)
+ :type 'wrong-type-argument)
+ (should-error (gnus-string> "")
+ :type 'wrong-number-of-arguments)
+
+ ;; String tests
+ (should (gnus-string> "def" "abc"))
+ (should (gnus-string> 'def 'abc))
+ (should (gnus-string> "abc" "DEF"))
+ (should (gnus-string> "abc" 'DEF))
+ (should (gnus-string> "αβγ" "abc"))
+ (should (gnus-string> "אבג" "αβγ"))
+ (should (gnus-string> nil ""))
+ (should (gnus-string> "abc" ""))
+ (should (gnus-string> "abc" "ab"))
+ (should-not (gnus-string> "abc" "abc"))
+ (should-not (gnus-string> "abc" "def"))
+ (should-not (gnus-string> "DEF" "abc"))
+ (should-not (gnus-string> 'DEF "abc"))
+ (should-not (gnus-string> "123" "abc"))
+ (should-not (gnus-string> "" "")))
+
+(ert-deftest gnus-string< ()
+ ;; Failure paths
+ (should-error (gnus-string< "" 1)
+ :type 'wrong-type-argument)
+ (should-error (gnus-string< "")
+ :type 'wrong-number-of-arguments)
+
+ ;; String tests
+ (setq case-fold-search nil)
+ (should (gnus-string< "abc" "def"))
+ (should (gnus-string< 'abc 'def))
+ (should (gnus-string< "DEF" "abc"))
+ (should (gnus-string< "DEF" 'abc))
+ (should (gnus-string< "abc" "αβγ"))
+ (should (gnus-string< "αβγ" "אבג"))
+ (should (gnus-string< "" nil))
+ (should (gnus-string< "" "abc"))
+ (should (gnus-string< "ab" "abc"))
+ (should-not (gnus-string< "abc" "abc"))
+ (should-not (gnus-string< "def" "abc"))
+ (should-not (gnus-string< "abc" "DEF"))
+ (should-not (gnus-string< "abc" 'DEF))
+ (should-not (gnus-string< "abc" "123"))
+ (should-not (gnus-string< "" ""))
+
+ ;; gnus-string< checks case-fold-search
+ (setq case-fold-search t)
+ (should (gnus-string< "abc" "DEF"))
+ (should (gnus-string< "abc" 'GHI))
+ (should (gnus-string< 'abc "DEF"))
+ (should (gnus-string< 'GHI 'JKL))
+ (should (gnus-string< "abc" "ΑΒΓ"))
+ (should-not (gnus-string< "ABC" "abc"))
+ (should-not (gnus-string< "def" "ABC")))
+
(ert-deftest gnus-subsetp ()
;; False for non-lists.
(should-not (gnus-subsetp "1" "1"))
@@ -73,4 +132,40 @@
(should (equal '("1") (gnus-setdiff '(2 "1" 2) '(2))))
(should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2)))))
+(ert-deftest gnus-base64-repad ()
+ (should-error (gnus-base64-repad "" nil nil nil)
+ :type 'wrong-number-of-arguments)
+ (should-error (gnus-base64-repad 1)
+ :type 'wrong-type-argument)
+
+ ;; RFC4648 test vectors
+ (should (equal "" (gnus-base64-repad "")))
+ (should (equal "Zg==" (gnus-base64-repad "Zg==")))
+ (should (equal "Zm8=" (gnus-base64-repad "Zm8=")))
+ (should (equal "Zm9v" (gnus-base64-repad "Zm9v")))
+ (should (equal "Zm9vYg==" (gnus-base64-repad "Zm9vYg==")))
+ (should (equal "Zm9vYmE=" (gnus-base64-repad "Zm9vYmE=")))
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy")))
+
+ (should (equal "Zm8=" (gnus-base64-repad "Zm8")))
+ (should (equal "Zg==" (gnus-base64-repad "Zg")))
+ (should (equal "Zg==" (gnus-base64-repad "Zg====")))
+
+ (should (equal (gnus-base64-repad " ") ""))
+ (should (equal (gnus-base64-repad "Zg== ") "Zg=="))
+ (should-error (gnus-base64-repad "Z?\x00g==")
+ :type 'error)
+ ;; line-length
+ (should-error (gnus-base64-repad "Zg====" nil 4)
+ :type 'error)
+ ;; reject-newlines
+ (should-error (gnus-base64-repad "Zm9v\r\nYmFy" t)
+ :type 'error)
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy" t)))
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy" nil)))
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n" nil)))
+ (should (equal (gnus-base64-repad "Zm9v\r\n YmFy\r\n" nil) "Zm9vYmFy"))
+ (should-error (gnus-base64-repad "Zm9v\r\nYmFy" nil 3)
+ :type 'error))
+
;;; gnustest-gnus-util.el ends here
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 0f5582b..74c0ddd 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -66,6 +66,7 @@
(ert-deftest dbus-test01-type-conversion ()
"Check type conversion functions."
(skip-unless dbus--test-enabled-session-bus)
+
(let ((ustr "0123abc_xyz\x01\xff")
(mstr "Grüß Göttin"))
(should
@@ -97,7 +98,11 @@
(ert-deftest dbus-test01-basic-types ()
"Check basic D-Bus type arguments."
(skip-unless dbus--test-enabled-session-bus)
- ;; Unknown keyword.
+
+ ;; No argument or unknown keyword.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service)
+ :type 'wrong-number-of-arguments)
(should-error
(dbus-check-arguments :session dbus--test-service :keyword)
:type 'wrong-type-argument)
@@ -106,6 +111,9 @@
(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)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :string 0.5)
:type 'wrong-type-argument)
@@ -114,6 +122,10 @@
(dbus-check-arguments
:session dbus--test-service :object-path "/object/path"))
(should-error
+ (dbus-check-arguments :session dbus--test-service :object-path)
+ :type 'wrong-type-argument)
+ ;; Raises an error on stdin.
+ (should-error
(dbus-check-arguments :session dbus--test-service :object-path "string")
:type 'dbus-error)
(should-error
@@ -123,6 +135,10 @@
;; `:signature'.
(should (dbus-check-arguments :session dbus--test-service :signature "as"))
(should-error
+ (dbus-check-arguments :session dbus--test-service :signature)
+ :type 'wrong-type-argument)
+ ;; Raises an error on stdin.
+ (should-error
(dbus-check-arguments :session dbus--test-service :signature "string")
:type 'dbus-error)
(should-error
@@ -134,10 +150,10 @@
(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))
+ (should-error
+ (dbus-check-arguments :session dbus--test-service :boolean)
+ :type 'wrong-type-argument)
;; `:byte'.
(should (dbus-check-arguments :session dbus--test-service :byte 0))
@@ -145,6 +161,9 @@
(should
(dbus-check-arguments :session dbus--test-service :byte
most-positive-fixnum))
(should-error
+ (dbus-check-arguments :session dbus--test-service :byte)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :byte -1)
:type 'wrong-type-argument)
(should-error
@@ -159,6 +178,9 @@
(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)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :int16 #x8000)
:type 'args-out-of-range)
(should-error
@@ -175,6 +197,9 @@
(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)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :uint16 #x10000)
:type 'args-out-of-range)
(should-error
@@ -192,6 +217,9 @@
(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)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :int32 #x80000000)
:type 'args-out-of-range)
(should-error
@@ -209,6 +237,9 @@
(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)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :uint32 #x100000000)
:type 'args-out-of-range)
(should-error
@@ -228,6 +259,9 @@
(should
(dbus-check-arguments :session dbus--test-service :int64
#x-8000000000000000))
(should-error
+ (dbus-check-arguments :session dbus--test-service :int64)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000)
:type 'args-out-of-range)
(should-error
@@ -245,6 +279,9 @@
(should
(dbus-check-arguments :session dbus--test-service :uint64
#xffffffffffffffff))
(should-error
+ (dbus-check-arguments :session dbus--test-service :uint64)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :uint64
#x10000000000000000)
:type 'args-out-of-range)
(should-error
@@ -266,6 +303,9 @@
(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)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :double "string")
:type 'wrong-type-argument)
@@ -277,6 +317,9 @@
;; type range fail.
(should (dbus-check-arguments :session dbus--test-service :unix-fd 0))
(should-error
+ (dbus-check-arguments :session dbus--test-service :unix-fd)
+ :type 'wrong-type-argument)
+ (should-error
(dbus-check-arguments :session dbus--test-service :unix-fd -1)
:type 'args-out-of-range)
(should-error
@@ -288,6 +331,8 @@
(ert-deftest dbus-test01-compound-types ()
"Check basic D-Bus type arguments."
+ (skip-unless dbus--test-enabled-session-bus)
+
;; `: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")))
@@ -296,7 +341,7 @@
(should
(dbus-check-arguments
:session dbus--test-service '(:array :string "string1" "string2")))
- ;; Empty array.
+ ;; Empty array (of strings).
(should (dbus-check-arguments :session dbus--test-service '(:array)))
(should
(dbus-check-arguments :session dbus--test-service '(:array :signature "o")))
@@ -314,7 +359,11 @@
(should
(dbus-check-arguments
:session dbus--test-service '(:variant (:array "string"))))
- ;; More than one element.
+ ;; No or more than one element.
+ ;; FIXME.
+ ;; (should-error
+ ;; (dbus-check-arguments :session dbus--test-service '(:variant))
+ ;; :type 'wrong-type-argument)
(should-error
(dbus-check-arguments
:session dbus--test-service
@@ -327,10 +376,18 @@
(dbus-check-arguments
:session dbus--test-service
'(:array (:dict-entry :string "string" :boolean t))))
- ;; The second element is `nil' (implicitly). FIXME: Is this right?
+ ;; This is an alternative syntax. FIXME: Shall this be supported?
(should
(dbus-check-arguments
- :session dbus--test-service '(:array (:dict-entry :string "string"))))
+ :session dbus--test-service
+ '(:array :dict-entry (:string "string" :boolean t))))
+ ;; FIXME: Must be errors.
+ ;; (should
+ ;; (dbus-check-arguments
+ ;; :session dbus--test-service '(:array (:dict-entry))))
+ ;; (should
+ ;; (dbus-check-arguments
+ ;; :session dbus--test-service '(:array (:dict-entry :string "string"))))
;; Not two elements.
(should-error
(dbus-check-arguments
@@ -348,7 +405,8 @@
(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.
+ ;; FIXME:! This doesn't look right.
+ ;; Different dict entry types can be part of an array ???
(should
(dbus-check-arguments
:session dbus--test-service
@@ -357,6 +415,8 @@
(:dict-entry :string "string2" :object-path "/object/path"))))
;; `:struct'. There is no restriction what could be an element of a struct.
+ ;; Empty struct. FIXME: Is this right?
+ ;; (should (dbus-check-arguments :session dbus--test-service '(:struct)))
(should
(dbus-check-arguments
:session dbus--test-service
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 505408f..035c064 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -440,33 +440,49 @@ 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")
+(ert-deftest string-replace ()
+ (should (equal (string-replace "foo" "bar" "zot")
"zot"))
- (should (equal (replace-in-string "foo" "bar" "foozot")
+ (should (equal (string-replace "foo" "bar" "foozot")
"barzot"))
- (should (equal (replace-in-string "foo" "bar" "barfoozot")
+ (should (equal (string-replace "foo" "bar" "barfoozot")
"barbarzot"))
- (should (equal (replace-in-string "zot" "bar" "barfoozot")
+ (should (equal (string-replace "zot" "bar" "barfoozot")
"barfoobar"))
- (should (equal (replace-in-string "z" "bar" "barfoozot")
+ (should (equal (string-replace "z" "bar" "barfoozot")
"barfoobarot"))
- (should (equal (replace-in-string "zot" "bar" "zat")
+ (should (equal (string-replace "zot" "bar" "zat")
"zat"))
- (should (equal (replace-in-string "azot" "bar" "zat")
+ (should (equal (string-replace "azot" "bar" "zat")
"zat"))
- (should (equal (replace-in-string "azot" "bar" "azot")
+ (should (equal (string-replace "azot" "bar" "azot")
"bar"))
- (should (equal (replace-in-string "azot" "bar" "foozotbar")
+ (should (equal (string-replace "azot" "bar" "foozotbar")
"foozotbar"))
- (should (equal (replace-in-string "\377" "x" "a\377b")
+ (should (equal (string-replace "fo" "bar" "lafofofozot")
+ "labarbarbarzot"))
+
+ (should (equal (string-replace "\377" "x" "a\377b")
+ "axb"))
+ (should (equal (string-replace "\377" "x" "a\377ø")
+ "axø"))
+ (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377b")
"axb"))
- (should (equal (replace-in-string "\377" "x" "a\377ø")
+ (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377ø")
"axø"))
- (should-error (replace-in-string "" "x" "abc")))
+ (should (equal (string-replace "ana" "ANA" "ananas") "ANAnas"))
+
+ (should (equal (string-replace "a" "" "") ""))
+ (should (equal (string-replace "a" "" "aaaaa") ""))
+ (should (equal (string-replace "ab" "" "ababab") ""))
+ (should (equal (string-replace "ab" "" "abcabcabc") "ccc"))
+ (should (equal (string-replace "a" "aa" "aaa") "aaaaaa"))
+ (should (equal (string-replace "abc" "defg" "abc") "defg"))
+
+ (should-error (string-replace "" "x" "abc")))
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index f2e1a26..d3c22f9 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -913,6 +913,7 @@
(should (equal (string-search "ab\0" "ab") nil))
(should (equal (string-search "ab" "abababab" 3) 4))
(should (equal (string-search "ab" "ababac" 3) nil))
+ (should (equal (string-search "aaa" "aa") nil))
(let ((case-fold-search t))
(should (equal (string-search "ab" "AB") nil)))
@@ -936,14 +937,16 @@
(should (equal (string-search (string-to-multibyte "\377") "ab\377c") 2))
(should (equal (string-search "\303" "aøb") nil))
(should (equal (string-search "\270" "aøb") nil))
- ;; This test currently fails, but it shouldn't!
- ;;(should (equal (string-search "ø" "\303\270") nil))
+ (should (equal (string-search "ø" "\303\270") nil))
+
+ (should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2))
(should-error (string-search "a" "abc" -1))
(should-error (string-search "a" "abc" 4))
(should-error (string-search "a" "abc" 100000000000))
(should (equal (string-search "a" "aaa" 3) nil))
+ (should (equal (string-search "aa" "aa" 1) nil))
(should (equal (string-search "\0" "") nil))
(should (equal (string-search "" "") 0))
@@ -953,4 +956,23 @@
(should (equal (string-search "" "abc" 3) 3))
(should-error (string-search "" "abc" 4))
(should-error (string-search "" "abc" -1))
- )
+
+ (should-not (string-search "ø" "foo\303\270"))
+ (should-not (string-search "\303\270" "ø"))
+ (should-not (string-search "\370" "ø"))
+ (should-not (string-search (string-to-multibyte "\370") "ø"))
+ (should-not (string-search "ø" "\370"))
+ (should-not (string-search "ø" (string-to-multibyte "\370")))
+ (should-not (string-search "\303\270" "\370"))
+ (should-not (string-search (string-to-multibyte "\303\270") "\370"))
+ (should-not (string-search "\303\270" (string-to-multibyte "\370")))
+ (should-not (string-search (string-to-multibyte "\303\270")
+ (string-to-multibyte "\370")))
+ (should-not (string-search "\370" "\303\270"))
+ (should-not (string-search (string-to-multibyte "\370") "\303\270"))
+ (should-not (string-search "\370" (string-to-multibyte "\303\270")))
+ (should-not (string-search (string-to-multibyte "\370")
+ (string-to-multibyte "\303\270")))
+ (should (equal (string-search (string-to-multibyte "o\303\270")
"foo\303\270")
+ 2))
+ (should (equal (string-search "\303\270" "foo\303\270") 3)))