[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 0173962 2/2: Merge commit '9b480db6732c6d2e886838f1
|
From: |
Stephen Leake |
|
Subject: |
[Emacs-diffs] master 0173962 2/2: Merge commit '9b480db6732c6d2e886838f112d9bd46fc8989bf' |
|
Date: |
Tue, 30 Jul 2019 14:03:43 -0400 (EDT) |
branch: master
commit 01739625704aaaea6831cef459a4a53171689513
Merge: 056cbcb 9b480db
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
Merge commit '9b480db6732c6d2e886838f112d9bd46fc8989bf'
---
admin/merge-gnulib | 2 +-
admin/notes/git-workflow | 11 +-
build-aux/config.guess | 6 +-
build-aux/update-copyright | 2 +-
doc/emacs/custom.texi | 3 +-
doc/emacs/display.texi | 18 +-
doc/emacs/package.texi | 8 +-
doc/emacs/search.texi | 19 +-
doc/lispref/control.texi | 12 +
doc/lispref/display.texi | 14 +-
doc/lispref/files.texi | 15 +-
doc/lispref/hash.texi | 16 +-
doc/lispref/internals.texi | 34 +-
doc/lispref/keymaps.texi | 5 +-
doc/lispref/os.texi | 77 ++
doc/lispref/processes.texi | 4 +-
doc/lispref/strings.texi | 10 +-
doc/lispref/tips.texi | 9 +-
doc/misc/cl.texi | 26 +-
doc/misc/edt.texi | 2 +-
doc/misc/efaq.texi | 2 +-
doc/misc/eww.texi | 10 +-
doc/misc/gnus.texi | 6 +-
doc/misc/smtpmail.texi | 14 +-
doc/misc/viper.texi | 2 +-
etc/NEWS | 233 +++--
etc/TODO | 6 +-
etc/themes/tango-dark-theme.el | 1 +
lib/fingerprint.h | 3 +-
lib/gnulib.mk.in | 1 +
lisp/autorevert.el | 11 +-
lisp/bindings.el | 4 +-
lisp/buff-menu.el | 3 +-
lisp/button.el | 32 +-
lisp/calc/calc-forms.el | 14 +-
lisp/calculator.el | 2 +-
lisp/calendar/appt.el | 5 +-
lisp/calendar/cal-dst.el | 5 +-
lisp/calendar/cal-persia.el | 8 +-
lisp/calendar/calendar.el | 4 +-
lisp/calendar/icalendar.el | 18 +-
lisp/calendar/iso8601.el | 370 +++++++
lisp/calendar/time-date.el | 151 ++-
lisp/calendar/timeclock.el | 6 +-
lisp/char-fold.el | 163 +++-
lisp/descr-text.el | 2 -
lisp/dired-aux.el | 11 +-
lisp/dired.el | 14 +-
lisp/emacs-lisp/autoload.el | 5 +-
lisp/emacs-lisp/bytecomp.el | 17 +-
lisp/emacs-lisp/cl-lib.el | 14 +-
lisp/emacs-lisp/cl-macs.el | 24 +-
lisp/emacs-lisp/derived.el | 44 +-
lisp/emacs-lisp/edebug.el | 12 +-
lisp/emacs-lisp/ert.el | 13 +-
lisp/emacs-lisp/let-alist.el | 2 +
lisp/emacs-lisp/package-x.el | 1 +
lisp/emacs-lisp/package.el | 120 ++-
lisp/emacs-lisp/testcover.el | 16 +-
lisp/emacs-lisp/timer.el | 7 +-
lisp/epg-config.el | 15 +-
lisp/eshell/em-ls.el | 14 +-
lisp/eshell/em-script.el | 1 -
lisp/eshell/esh-util.el | 2 +-
lisp/ffap.el | 4 +-
lisp/filenotify.el | 382 ++++----
lisp/files.el | 27 +-
lisp/gnus/gnus-agent.el | 15 +-
lisp/gnus/gnus-art.el | 129 +--
lisp/gnus/gnus-cus.el | 5 +-
lisp/gnus/gnus-demon.el | 35 +-
lisp/gnus/gnus-html.el | 36 +-
lisp/gnus/gnus-icalendar.el | 5 +-
lisp/gnus/gnus-int.el | 2 +
lisp/gnus/gnus-mlspl.el | 13 +-
lisp/gnus/gnus-sum.el | 84 +-
lisp/gnus/gnus-util.el | 14 +-
lisp/gnus/message.el | 4 +-
lisp/gnus/mm-decode.el | 39 +-
lisp/gnus/nndiary.el | 32 +-
lisp/gnus/nnimap.el | 31 +-
lisp/gnus/nnmaildir.el | 6 +-
lisp/ibuffer.el | 208 ++--
lisp/iimage.el | 14 +-
lisp/image.el | 2 +-
lisp/info.el | 11 +-
lisp/leim/quail/latin-ltx.el | 8 +-
lisp/ls-lisp.el | 9 +-
lisp/mail/emacsbug.el | 12 +-
lisp/mail/footnote.el | 36 +-
lisp/mail/mail-utils.el | 13 +-
lisp/mail/smtpmail.el | 56 +-
lisp/mh-e/mh-search.el | 2 +-
lisp/mh-e/mh-speed.el | 2 +-
lisp/net/browse-url.el | 319 ++++---
lisp/net/eww.el | 12 +-
lisp/net/pop3.el | 4 +-
lisp/net/rcirc.el | 3 +
lisp/net/shr.el | 44 +-
lisp/net/soap-client.el | 142 +--
lisp/nxml/nxml-mode.el | 9 +-
lisp/org/org-gnus.el | 4 +-
lisp/proced.el | 8 +-
lisp/profiler.el | 6 +-
lisp/progmodes/cc-awk.el | 6 +-
lisp/progmodes/cc-cmds.el | 26 +-
lisp/progmodes/cc-engine.el | 83 +-
lisp/progmodes/cc-fonts.el | 2 +-
lisp/progmodes/cc-langs.el | 66 +-
lisp/progmodes/cc-mode.el | 4 +-
lisp/progmodes/compile.el | 42 +-
lisp/progmodes/elisp-mode.el | 25 +-
lisp/progmodes/etags.el | 17 +-
lisp/progmodes/opascal.el | 1006 ++++++++++----------
lisp/progmodes/prog-mode.el | 6 +-
lisp/progmodes/ruby-mode.el | 3 +-
lisp/progmodes/vhdl-mode.el | 48 +-
lisp/progmodes/xref.el | 6 +-
lisp/scroll-bar.el | 4 +-
lisp/ses.el | 5 +-
lisp/simple.el | 56 +-
lisp/startup.el | 4 +-
lisp/subr.el | 17 +-
lisp/term.el | 15 +-
lisp/term/tty-colors.el | 74 +-
lisp/textmodes/conf-mode.el | 4 +-
lisp/thingatpt.el | 4 +-
lisp/time-stamp.el | 15 +-
lisp/url/url-http.el | 10 +-
lisp/vc/ediff-mult.el | 13 +-
lisp/vc/vc-git.el | 10 +
lisp/vc/vc.el | 9 +-
lisp/wid-edit.el | 9 +-
m4/gnulib-comp.m4 | 2 +
src/alloc.c | 15 +-
src/bytecode.c | 14 +-
src/editfns.c | 17 +-
src/emacs.c | 6 +-
src/fileio.c | 136 ++-
src/fns.c | 105 +-
src/gtkutil.c | 10 +-
src/image.c | 8 +-
src/json.c | 41 +-
src/keyboard.c | 3 +-
src/lisp.h | 22 +-
src/minibuf.c | 8 +-
src/nsterm.m | 12 +-
src/pdumper.c | 88 +-
src/pdumper.h | 4 +-
src/print.c | 26 +-
src/profiler.c | 6 +-
src/timefns.c | 6 +
src/unexaix.c | 2 +-
src/w32uniscribe.c | 11 +-
src/xterm.c | 33 +-
test/lisp/calendar/iso8601-tests.el | 291 ++++++
test/lisp/calendar/time-date-tests.el | 109 +++
test/lisp/char-fold-tests.el | 87 ++
test/lisp/emacs-lisp/let-alist-tests.el | 5 +
.../emacs-lisp/testcover-resources/testcases.el | 1 -
test/lisp/filenotify-tests.el | 59 +-
test/lisp/progmodes/flymake-tests.el | 6 +-
test/lisp/progmodes/ruby-mode-tests.el | 6 +-
test/lisp/subr-tests.el | 10 +
test/lisp/term/tty-colors-tests.el | 38 +
test/manual/indent/opascal.pas | 12 +
test/src/editfns-tests.el | 23 +-
test/src/fileio-tests.el | 11 +
168 files changed, 4099 insertions(+), 2211 deletions(-)
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 42e9c0c..50b0c76 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -31,7 +31,7 @@ GNULIB_MODULES='
careadlinkat close-stream copy-file-range
count-leading-zeros count-one-bits count-trailing-zeros
crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer
crypto/sha512-buffer
- d-type diffseq dosname dtoastr dtotimespec dup2
+ d-type diffseq dosname double-slash-root dtoastr dtotimespec dup2
environ execinfo explicit_bzero faccessat
fcntl fcntl-h fdopendir
filemode filevercmp flexmember fpieee fstatat fsusage fsync
diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow
index 5465786..28b6f91 100644
--- a/admin/notes/git-workflow
+++ b/admin/notes/git-workflow
@@ -1,7 +1,3 @@
-(This is a draft. The method here won't actually work yet, because
-neither git-new-workdir nor merge-changelog are in the Emacs
-distribution yet.)
-
Setting up and using git for normal, simple bugfixing
=====================================================
@@ -24,10 +20,9 @@ the current master and the emacs-26 branch.
mkdir ~/emacs
cd ~/emacs
git clone <membername>@git.sv.gnu.org:/srv/git/emacs.git master
-(cd master; git config push.default current)
-./master/admin/git-new-workdir master emacs-26
-cd emacs-26
-git checkout emacs-26
+cd master
+git config push.default current
+git worktree add ../emacs-26 emacs-26
You now have both branches conveniently accessible, and you can do
"git pull" in them once in a while to keep updated.
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 41b8b85..97ad073 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -2,7 +2,7 @@
# Attempt to guess a canonical system name.
# Copyright 1992-2019 Free Software Foundation, Inc.
-timestamp='2019-06-10'
+timestamp='2019-07-24'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -278,8 +278,8 @@ case
"$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
echo "$UNAME_MACHINE"-unknown-redox
exit ;;
mips:OSF1:*.*)
- echo mips-dec-osf1
- exit ;;
+ echo mips-dec-osf1
+ exit ;;
alpha:OSF1:*:*)
case $UNAME_RELEASE in
*4.0)
diff --git a/build-aux/update-copyright b/build-aux/update-copyright
index 4a9ea7c..b3f6b29 100755
--- a/build-aux/update-copyright
+++ b/build-aux/update-copyright
@@ -134,7 +134,7 @@
# the script through the perl program found in $PATH. The '-x' option
# is essential as well; without it, perl would re-execute the script
# through /bin/sh. When executed by perl, the next two lines are a no-op.
-eval 'exec perl -wSx "$0" "$@"'
+eval 'exec perl -wSx -0777 -pi "$0" "$@"'
if 0;
my $VERSION = '2018-03-07.03:47'; # UTC
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index fae5433..adea935 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2616,8 +2616,7 @@ kept.
The usual purpose of the terminal-specific library is to map the
escape sequences used by the terminal's function keys onto more
-meaningful names, using @code{input-decode-map} (or
-@code{function-key-map} before it). See the file
+meaningful names, using @code{input-decode-map}. See the file
@file{term/lk201.el} for an example of how this is done. Many function
keys are mapped automatically according to the information in the
Termcap data base; the terminal-specific library needs to map only the
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 0ce2913..8e842be 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -556,14 +556,14 @@ Font Lock mode.
@node Colors
@section Colors for Faces
-@cindex color name
-@cindex RGB triplet
Faces can have various foreground and background colors. When you
specify a color for a face---for instance, when customizing the face
(@pxref{Face Customization})---you can use either a @dfn{color name}
or an @dfn{RGB triplet}.
+@subsection Color Names
+@cindex color name
@findex list-colors-display
@vindex list-colors-sort
A color name is a pre-defined name, such as @samp{dark orange} or
@@ -578,12 +578,16 @@ such terminals. However, Emacs understands X11 color
names even on
text terminals; if a face is given a color specified by an X11 color
name, it is displayed using the closest-matching terminal color.
+@subsection RGB Triplets
+@cindex RGB triplet
An RGB triplet is a string of the form @samp{#RRGGBB}. Each of the
-R, G, and B components is a hexadecimal number specifying the
-component's relative intensity, one to four digits long (usually two
-digits are used). The components must have the same number of digits.
-For hexadecimal values A to F, either upper or lower case are
-acceptable.
+primary color components is represented by a hexadecimal number
+between @samp{00} (intensity 0) and @samp{FF} (the maximum intensity).
+It is also possible to use one, three, or four hex digits for each
+component, so @samp{red} can be represented as @samp{#F00},
+@samp{#fff000000}, or @samp{#ffff00000000}. The components must have
+the same number of digits. For hexadecimal values A to F, either
+upper or lower case are acceptable.
The @kbd{M-x list-colors-display} command also shows the equivalent
RGB triplet for each named color. For instance, @samp{medium sea
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 26e6424..4b33f25 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -214,9 +214,11 @@ in the @file{etc/package-keyring.gpg}. Emacs uses it
automatically.
@vindex package-unsigned-archives
If the user option @code{package-check-signature} is non-@code{nil},
Emacs attempts to verify signatures when you install packages. If the
-option has the value @code{allow-unsigned}, you can still install a
-package that is not signed. If you use some archives that do not sign
-their packages, you can add them to the list @code{package-unsigned-archives}.
+option has the value @code{allow-unsigned}, and a usable OpenPGP
+configuration is found, signed packages will be checked, but you can
+still install a package that is not signed. If you use some archives
+that do not sign their packages, you can add them to the list
+@code{package-unsigned-archives}.
For more information on cryptographic keys and signing,
@pxref{Top,, GnuPG, gnupg, The GNU Privacy Guard Manual}.
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index b47d51a..66af5d4 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1354,10 +1354,21 @@ folding, but only for that search. (Replace commands
have a different
default, controlled by a separate option; see @ref{Replacement and Lax
Matches}.)
- Like with case folding, typing an explicit variant of a character,
-such as @code{@"a}, as part of the search string disables character
-folding for that search. If you delete such a character from the
-search string, this effect ceases.
+@vindex char-fold-symmetric
+ By default, typing an explicit variant of a character, such as
+@code{@"a}, as part of the search string doesn't match its base
+character, such as @code{a}. But if you customize the variable
+@code{char-fold-symmetric} to @code{t}, then search commands treat
+equivalent characters the same and use of any of a set of equivalent
+characters in a search string finds any of them in the text being
+searched, so typing an accented character @code{@"a} matches the
+letter @code{a} as well as all the other variants like @code{@'a}.
+
+@vindex char-fold-include
+@vindex char-fold-exclude
+ You can add new foldings using the customizable variable
+@code{char-fold-include}, or remove the existing ones using the
+customizable variable @code{char-fold-exclude}.
@node Replace
@section Replacement Commands
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index de6cd93..e98daf6 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -2154,6 +2154,18 @@ Here's the example at the beginning of this subsection
rewritten using
@end example
@end defmac
+@defmac ignore-error condition body@dots{}
+This macro is like @code{ignore-errors}, but will only ignore the
+specific error condition specified.
+
+@example
+ (ignore-error end-of-file
+ (read ""))
+@end example
+
+@var{condition} can also be a list of error conditions.
+@end defmac
+
@defmac with-demoted-errors format body@dots{}
This macro is like a milder version of @code{ignore-errors}. Rather
than suppressing errors altogether, it converts them into messages.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 3c91092..cf0008d 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6473,7 +6473,9 @@ that is the value of that property, passing it the single
argument
@var{button}). If @var{use-mouse-action} is non-@code{nil}, try to
invoke the button's @code{mouse-action} property instead of
@code{action}; if the button has no @code{mouse-action} property, use
-@code{action} as normal.
+@code{action} as normal. If the @code{button-data} property is
+present in @var{button}, use that as the argument for the
+@code{action} function instead of @var{button}.
@end defun
@defun button-label button
@@ -6541,14 +6543,16 @@ event's position is used. If there's no button at
@var{pos}, do
nothing and return @code{nil}, otherwise return @code{t}.
@end deffn
-@deffn Command forward-button n &optional wrap display-message
+@deffn Command forward-button n &optional wrap display-message no-error
Move to the @var{n}th next button, or @var{n}th previous button if
@var{n} is negative. If @var{n} is zero, move to the start of any
button at point. If @var{wrap} is non-@code{nil}, moving past either
end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
-is skipped over. Returns the button found.
+is skipped over. Returns the button found, and signals an error if no
+buttons can be found. If @var{no-error} in non-@code{nil}, return nil
+instead of signalling the error.
@end deffn
@deffn Command backward-button n &optional wrap display-message
@@ -6558,7 +6562,9 @@ button at point. If @var{wrap} is non-@code{nil}, moving
past either
end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
-is skipped over. Returns the button found.
+is skipped over. Returns the button found, and signals an error if no
+buttons can be found. If @var{no-error} in non-@code{nil}, return nil
+instead of signalling the error.
@end deffn
@defun next-button pos &optional count-current
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 0519f78..6be5a52 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2154,7 +2154,11 @@ backslash, or with a drive specification
@samp{@var{x}:/}, where
@defun file-name-absolute-p filename
This function returns @code{t} if file @var{filename} is an absolute
-file name or begins with @samp{~}, @code{nil} otherwise.
+file name, @code{nil} otherwise. A file name is considered to be
+absolute if its first component is @samp{~}, or is @samp{~@var{user}}
+where @var{user} is a valid login name. In the following examples,
+assume that there is a user named @samp{rms} but no user named
+@samp{nosuchuser}.
@example
@group
@@ -2162,6 +2166,10 @@ file name or begins with @samp{~}, @code{nil} otherwise.
@result{} t
@end group
@group
+(file-name-absolute-p "~nosuchuser/foo")
+ @result{} nil
+@end group
+@group
(file-name-absolute-p "rms/foo")
@result{} nil
@end group
@@ -2911,7 +2919,7 @@ An error is signaled if @var{directory} is not the name
of a directory
that can be read.
@end defun
-@defun directory-files-recursively directory regexp &optional
include-directories predicate
+@defun directory-files-recursively directory regexp &optional
include-directories predicate follow-symlinks
Return all files under @var{directory} whose names match @var{regexp}.
This function searches the specified @var{directory} and its
sub-directories, recursively, for files whose basenames (i.e., without
@@ -2932,6 +2940,9 @@ instance, if it's not readable by this user) are ignored.
If it's
neither @code{nil} nor @code{t}, it should be a function that takes
one parameter (the subdirectory name) and should return non-@code{nil}
if the directory is to be descended into.
+
+Symbolic links to subdirectories are not followed by default, but if
+@var{follow-symlinks} is non-@code{nil}, they are followed.
@end defun
@defun directory-files-and-attributes directory &optional full-name
match-regexp nosort id-format
diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index 0515314..50d4c57 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -132,7 +132,7 @@ When you add an association to a hash table and the table
is full,
it grows automatically. This value specifies how to make the hash table
larger, at that time.
-If @var{rehash-size} is a fixnum, it should be positive and the hash
+If @var{rehash-size} is an integer, it should be positive, and the hash
table grows by adding approximately that much to the nominal size. If
@var{rehash-size} is floating point, it had better be greater
than 1, and the hash table grows by multiplying the old size by
@@ -239,8 +239,8 @@ to understand how hash tables work, and what a @dfn{hash
code} means.
You can think of a hash table conceptually as a large array of many
slots, each capable of holding one association. To look up a key,
-@code{gethash} first computes a fixnum, the hash code, from the key.
-It reduces this fixnum modulo the length of the array, to produce an
+@code{gethash} first computes an integer, the hash code, from the key.
+It can reduce this integer modulo the length of the array, to produce an
index in the array. Then it looks in that slot, and if necessary in
other nearby slots, to see if it has found the key being sought.
@@ -265,7 +265,7 @@ The function @var{test-fn} should accept two arguments, two
keys, and
return non-@code{nil} if they are considered the same.
The function @var{hash-fn} should accept one argument, a key, and return
-a fixnum that is the hash code of that key. For good results, the
+an integer that is the hash code of that key. For good results, the
function should use the whole range of fixnums for hash codes,
including negative fixnums.
@@ -276,12 +276,12 @@ under the property @code{hash-table-test}; the property
value's form is
@defun sxhash-equal obj
This function returns a hash code for Lisp object @var{obj}.
-This is a fixnum that reflects the contents of @var{obj}
+This is an integer that reflects the contents of @var{obj}
and the other Lisp objects it points to.
If two objects @var{obj1} and @var{obj2} are @code{equal}, then
@code{(sxhash-equal @var{obj1})} and @code{(sxhash-equal @var{obj2})}
-are the same fixnum.
+are the same integer.
If the two objects are not @code{equal}, the values returned by
@code{sxhash-equal} are usually different, but not always; once in a
@@ -299,7 +299,7 @@ result reflects identity of @var{obj}, but not its contents.
If two objects @var{obj1} and @var{obj2} are @code{eq}, then
@code{(sxhash-eq @var{obj1})} and @code{(sxhash-eq @var{obj2})} are
-the same fixnum.
+the same integer.
@end defun
@defun sxhash-eql obj
@@ -310,7 +310,7 @@ in which case a hash code is generated for the value.
If two objects @var{obj1} and @var{obj2} are @code{eql}, then
@code{(sxhash-eql @var{obj1})} and @code{(sxhash-eql @var{obj2})} are
-the same fixnum.
+the same integer.
@end defun
This example creates a hash table whose keys are strings that are
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 72066d3..f85c266 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -61,10 +61,10 @@ can be one of the following:
@table @samp
@item pdump
-@cindex portable dump file
-Record the preloaded Lisp data in a @dfn{portable dump} file. This
+@cindex dump file
+Record the preloaded Lisp data in a @dfn{dump file}. This
method produces an additional data file which Emacs will load at
-startup. The portable dump file is usually called @file{emacs.pdmp},
+startup. The produced dump file is usually called @file{emacs.pdmp},
and is installed in the Emacs @code{exec-directory} (@pxref{Help
Functions}). This method is the most preferred one, as it does not
require Emacs to employ any special techniques of memory allocation,
@@ -75,7 +75,7 @@ modern systems to enhance security and privacy.
@cindex bootstrapping Emacs
Like @samp{pdump}, but used while @dfn{bootstrapping} Emacs, when no
previous Emacs binary and no @file{*.elc} byte-compiled Lisp files are
-available. The produced portable dump file is usually named
+available. The produced dump file is usually named
@file{bootstrap-emacs.pdmp} in this case.
@item dump
@@ -88,6 +88,8 @@ terminal, so that the tables of terminal information are
empty in the
dumped Emacs.) This method is also known as @dfn{unexec}, because it
produces a program file from a running process, and thus is in some
sense the opposite of executing a program to start a process.
+Although this method was the way that Emacs traditionally saved its
+state, it is now deprecated.
@item bootstrap
Like @samp{dump}, but used when bootstrapping Emacs with the
@@ -97,11 +99,11 @@ Like @samp{dump}, but used when bootstrapping Emacs with the
@cindex preloaded Lisp files
@vindex preloaded-file-list
The dumped @file{emacs} executable (also called a @dfn{pure} Emacs)
-is the one which is installed. If the portable dumping was used to
+is the one which is installed. If the portable dumper was used to
build Emacs, the @file{emacs} executable is actually an exact copy of
@file{temacs}, and the corresponding @file{emacs.pdmp} file is
installed as well. The variable @code{preloaded-file-list} stores a
-list of the preloaded Lisp files recorded in the portable dump file or
+list of the preloaded Lisp files recorded in the dump file or
in the dumped Emacs executable. If you port Emacs to a new operating
system, and are not able to implement dumping of any kind, then Emacs
must load @file{loadup.el} each time it starts.
@@ -201,15 +203,19 @@ In the unlikely event that you need a more general
functionality than
@code{before-init-hook} (@pxref{Startup Summary}).
@defun dump-emacs-portable to-file &optional track-referrers
-This function dumps the current state of Emacs into a portable dump
+This function dumps the current state of Emacs into a dump
file @var{to-file}, using the @code{pdump} method. Normally, the
-portable dump file is called @file{@var{emacs-name}.dmp}, where
+dump file is called @file{@var{emacs-name}.dmp}, where
@var{emacs-name} is the name of the Emacs executable file. The
optional argument @var{track-referrers}, if non-@code{nil}, causes the
-portable dumping process keep additional information to help track
+portable dumper to keep additional information to help track
down the provenance of object types that are not yet supported by the
@code{pdump} method.
+Although the portable dumper code can run on many platforms, the dump
+files that it produces are not portable---they can be loaded only by
+the Emacs executable that dumped them.
+
If you want to use this function in an Emacs that was already dumped,
you must run Emacs with the @samp{-batch} option.
@end defun
@@ -220,20 +226,20 @@ This function dumps the current state of Emacs into an
executable file
@var{to-file}, using the @code{unexec} method. It takes symbols from
@var{from-file} (this is normally the executable file @file{temacs}).
-This function cannot be used in an Emacs that was already dumped. If
-Emacs was built without @code{unexec} support, this function will not
-be available.
+This function cannot be used in an Emacs that was already dumped.
+This function is deprecated, and by default Emacs is built without
+@code{unexec} support so this function is not available.
@end defun
@defun pdumper-stats
-If the current Emacs session restored its state from a portable dump
+If the current Emacs session restored its state from a dump
file, this function returns information about the dump file and the
time it took to restore the Emacs state. The value is an alist
@w{@code{((dumped-with-pdumper . t) (load-time . @var{time})
(dump-file-name . @var{file}))}},
where @var{file} is the name of the dump file, and @var{time} is the
time in seconds it took to restore the state from the dump file.
-If the current session was not restored from a portable dump file, the
+If the current session was not restored from a dump file, the
value is nil.
@end defun
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 6ad665a..b8eed0a 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1614,8 +1614,9 @@ with bindings made in the minor mode, local, or global
keymaps. I.e.,
the remapping only applies if the original key sequence would
otherwise not have any binding.
-@code{local-function-key-map} inherits from @code{function-key-map},
-but the latter should not be used directly.
+@code{local-function-key-map} inherits from @code{function-key-map}.
+The latter should only be altered if you want the binding to apply in
+all terminals, so using the former is almost always preferred.
@end defvar
@defvar key-translation-map
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index fef954e..b344483 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1466,6 +1466,60 @@ seconds east of Greenwich.
@strong{Common Lisp Note:} Common Lisp has different meanings for
@var{dow} and @var{utcoff}.
+
+To access (or alter) the elements in the time value, the
+@code{decoded-time-second}, @code{decoded-time-minute},
+@code{decoded-time-hour}, @code{decoded-time-day},
+@code{decoded-time-month}, @code{decoded-time-year},
+@code{decoded-time-weekday}, @code{decoded-time-dst} and
+@code{decoded-time-zone} accessors can be used.
+
+For instance, to increase the year in a decoded time, you could say:
+
+@lisp
+(setf (decoded-time-year decoded-time)
+ (+ (decoded-time-year decoded-time) 4))
+@end lisp
+
+Also see the following function.
+
+@end defun
+
+@defun decoded-time-add time delta
+This function takes a decoded time structure and adds @var{delta}
+(also a decoded time structure) to it. Elements in @var{delta} that
+are @code{nil} are ignored.
+
+For instance, if you want ``same time next month'', you
+could say:
+
+@lisp
+(let ((time (decode-time))
+ (delta (make-decoded-time :month 2)))
+ (encode-time (decoded-time-add time delta)))
+@end lisp
+
+If this date doesn't exist (if you're running this on January 31st,
+for instance), then the date will be shifted back until you get a
+valid date (which will be February 28th or 29th, depending).
+
+Fields are added in a most to least significant order, so if the
+adjustment described above happens, it happens before adding days,
+hours, minutes or seconds.
+
+The values in @var{delta} can be negative to subtract values instead.
+
+The return value is a decoded time structure.
+@end defun
+
+@defun make-decoded-time &key second minute hour day month year dst zone
+Return a decoded time structure with only the given keywords filled
+out, leaving the rest @code{nil}. For instance, to get a structure
+that represents ``two months'', you could say:
+
+@lisp
+(make-decoded-time :month 2)
+@end lisp
@end defun
@defun encode-time &optional time form &rest obsolescent-arguments
@@ -1568,6 +1622,19 @@ ISO 8601 string, like ``Fri, 25 Mar 2016 16:24:56
+0100'' or
less well-formed time strings as well.
@end defun
+@vindex ISO 8601 date/time strings
+@defun iso8601-parse string
+For a more strict function (that will error out upon invalid input),
+this function can be used instead. It's able to parse all variants of
+the ISO 8601 standard, so in addition to the formats mentioned above,
+it also parses things like ``1998W45-3'' (week number) and
+``1998-245'' (ordinal day number). To parse durations, there's
+@code{iso8601-parse-duration}, and to parse intervals, there's
+@code{iso8601-parse-interval}. All these functions return decoded
+time structures, except the final one, which returns three of them
+(the start, the end, and the duration).
+@end defun
+
@defun format-time-string format-string &optional time zone
This function converts @var{time} (or the current time, if
@@ -1867,6 +1934,16 @@ This returns the day number within the year
corresponding to @var{time-value}.
This function returns @code{t} if @var{year} is a leap year.
@end defun
+@defun date-days-in-month year month
+Return the number of days in @var{month} in @var{year}. For instance,
+there's 29 days in February 2004.
+@end defun
+
+@defun date-ordinal-to-time year ordinal
+Return the date of @var{ordinal} in @var{year} as a decoded time
+structure. For instance, the 120th day in 2004 is April 29th.
+@end defun
+
@node Timers
@section Timers for Delayed Execution
@cindex timers
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index ebc31c5..7a696f7 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3038,7 +3038,7 @@ for a process object representing a serial port
connection.
Serial ports are available on GNU/Linux, Unix, and MS Windows systems.
-@deffn Command serial-term port speed
+@deffn Command serial-term port speed &optional line-mode
Start a terminal-emulator for a serial port in a new buffer.
@var{port} is the name of the serial port to connect to. For
example, this could be @file{/dev/ttyS0} on Unix. On MS Windows, this
@@ -3051,6 +3051,8 @@ Lisp strings).
is a common value. The buffer is in Term mode; see @ref{Term Mode,,,
emacs, The GNU Emacs Manual}, for the commands to use in that buffer.
You can change the speed and the configuration in the mode line menu.
+If @var{line-mode} is non-@code{nil}, @code{term-line-mode} is used;
+otherwise @code{term-raw-mode} is used.
@end deffn
@defun make-serial-process &rest args
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 521f163..69d571f 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -923,9 +923,8 @@ Functions}). Thus, strings are enclosed in @samp{"}
characters, and
@cindex integer to octal
Replace the specification with the base-eight representation of an
integer. Negative integers are formatted in a platform-dependent
-way. The object can also be a nonnegative floating-point
-number that is formatted as an integer, dropping any fraction, if the
-integer does not exceed machine limits.
+way. The object can also be a floating-point number that is formatted
+as an integer, dropping any fraction.
@item %d
Replace the specification with the base-ten representation of a signed
@@ -938,9 +937,8 @@ formatted as an integer, dropping any fraction.
Replace the specification with the base-sixteen representation of an
integer. Negative integers are formatted in a platform-dependent
way. @samp{%x} uses lower case and @samp{%X} uses upper
-case. The object can also be a nonnegative floating-point number that
-is formatted as an integer, dropping any fraction, if the integer does
-not exceed machine limits.
+case. The object can also be a floating-point number that is
+formatted as an integer, dropping any fraction.
@item %c
Replace the specification with the character which is the value given.
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 30f2c98..01e9a3a 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -916,13 +916,16 @@ is discouraged.
When commenting out entire functions, use two semicolons.
@item ;;;;
-Comments that start with four semicolons, @samp{;;;;}, should be aligned
-to the left margin and are used for headings of major sections of a
-program. For example:
+Comments that start with four (or more) semicolons, @samp{;;;;},
+should be aligned to the left margin and are used for headings of
+major sections of a program. For example:
@smallexample
;;;; The kill ring
@end smallexample
+
+If you wish to have sub-headings under these heading, use more
+semicolons to nest these sub-headings.
@end table
@noindent
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index a919760..afe8f01 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -24,7 +24,7 @@ modify this GNU manual.''
@dircategory Emacs lisp libraries
@direntry
-* CL: (cl). Partial Common Lisp support for Emacs Lisp.
+* CL-Lib: (cl). Partial Common Lisp support for Emacs Lisp.
@end direntry
@finalout
@@ -4036,12 +4036,6 @@ is either a slot symbol or a list of the form
@samp{(@var{slot-name}
is a Lisp form that is evaluated any time an instance of the
structure type is created without specifying that slot's value.
-Common Lisp defines several slot options, but the only one
-implemented in this package is @code{:read-only}. A non-@code{nil}
-value for this option means the slot should not be @code{setf}-able;
-the slot's value is determined when the object is created and does
-not change afterward.
-
@example
(cl-defstruct person
(name nil :read-only t)
@@ -4049,7 +4043,23 @@ not change afterward.
(sex 'unknown))
@end example
-Any slot options other than @code{:read-only} are ignored.
+@var{slot-options} is a list of keyword-value pairs, where the
+following keywords can be used:
+
+@table @code
+@item :read-only
+A non-nil value means the slot should not be @code{setf}-able;
+the slot's value is determined when the object is created and does
+not change afterward.
+
+@item :type
+The expected type of the values held in this slot.
+
+@item :documentation
+A documentation string describing the slot.
+@end table
+
+Other slot options are currently ignored.
For obscure historical reasons, structure options take a different
form than slot options. A structure option is either a keyword
diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi
index 74224e9..c34efb6 100644
--- a/doc/misc/edt.texi
+++ b/doc/misc/edt.texi
@@ -190,7 +190,7 @@ key sequence, providing the @acronym{ASCII} key sequence
prefix is
already known by Emacs to be a prefix. As a result of providing this
support, some terminal/keyboard/window system configurations, which
don't have a complete set of sensible function key bindings built into
-Emacs in @code{function-key-map}, can still be configured for use with
+Emacs in @code{input-decode-map}, can still be configured for use with
EDT Emulation. (Note: In a few rare circumstances this does not work
properly. In particular, it does not work if a subset of the leading
@acronym{ASCII} characters in a key sequence are recognized by Emacs as
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 485776e..8fd3bf3 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -3887,7 +3887,7 @@ if you do build Emacs with Xt; please let us know if
you've done this!)
The only way to affect the behavior of keys within Emacs is through
@code{xmodmap} (outside Emacs) or @code{define-key} (inside Emacs). The
@code{define-key} command should be used in conjunction with the
-@code{function-key-map} map. For instance,
+@code{local-function-key-map} map. For instance,
@lisp
(define-key function-key-map [M-@key{TAB}] [?\M-\t])
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 8dc58e8..63f676e 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -187,7 +187,7 @@ switch EWW buffers through a minibuffer prompt, press
@kbd{s}
(@code{eww-switch-to-buffer}).
@findex eww-browse-with-external-browser
-@vindex shr-external-browser
+@vindex browse-url-secondary-browser-function
@vindex eww-use-external-browser-for-content-type
@kindex &
@cindex External Browser
@@ -197,10 +197,10 @@ or are not implemented (E.g., JavaScript). If you have
trouble
viewing a website with EWW then hit @kbd{&}
(@code{eww-browse-with-external-browser}) inside the EWW buffer to
open the website in the external browser specified by
-@code{shr-external-browser}. Some content types, such as video or
-audio content, do not make sense to display in GNU Emacs at all. You
-can tell EWW to open specific content automatically in an external
-browser by customizing
+@code{browse-url-secondary-browser-function}. Some content types,
+such as video or audio content, do not make sense to display in GNU
+Emacs at all. You can tell EWW to open specific content automatically
+in an external browser by customizing
@code{eww-use-external-browser-for-content-type}.
@node Advanced
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index f688e84..8f0023c 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -10163,8 +10163,8 @@ do so.
@cindex url
@findex gnus-summary-browse-url
Scan the article buffer for links, and offer them to the user for
-browsing with @code{browse-url}. By default, only scan the article
-body; with a prefix arg, also scan the article headers.
+browsing with @code{browse-url}. With a prefix argument, browse with
+@code{browse-url-secondary-browser-function} instead.
@end table
@@ -15720,7 +15720,7 @@ you. For example, add to your @file{~/.gnus.el}:
@end lisp
If @var{auto-update} is non-@code{nil}, @code{gnus-group-split-update}
-will be added to @code{nnmail-pre-get-new-mail-hook}, so you won't ever
+will be added to @code{gnus-get-top-new-news-hook}, so you won't ever
have to worry about updating @code{nnmail-split-fancy} again. If you
don't omit @var{catch-all} (it's optional, equivalent to @code{nil}),
@code{gnus-group-split-default-catch-all-group} will be set to its
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index 365f557..b2fc90a 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -221,10 +221,18 @@ they are allowed to send mail. Authentication usually
involves
supplying a user name and password.
If you have not configured anything, then the first time you try to
-send mail via a server, Emacs (version 24.1 and later) prompts you
+send mail via a server and the SMTP server reports back that it
+requires authentication, Emacs (version 24.1 and later) prompts you
for the user name and password to use, and then offers to save the
-information. By default, Emacs stores authentication information in
-a file @file{~/.authinfo}.
+information. By default, Emacs stores authentication information in a
+file @file{~/.authinfo}.
+
+@vindex smtpmail-servers-requiring-authorization
+Some SMTP servers may bandwidth-limit (or deny) requests from clients
+that try to post without authorization---even if they later do supply
+that information. To make this library supply that information on
+first attempt, set @code{smtpmail-servers-requiring-authorization} to
+a regexp that match the server name.
@cindex authinfo
The basic format of the @file{~/.authinfo} file is one line for each
diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi
index 922c91b..2c3fc02 100644
--- a/doc/misc/viper.texi
+++ b/doc/misc/viper.texi
@@ -2185,7 +2185,7 @@ Manual}, and the Emacs quick reference card for the
general info on key
bindings in Emacs.
@vindex input-decode-map
-@vindex function-key-map
+@vindex local-function-key-map
@vindex viper-vi-global-user-map
@vindex viper-insert-global-user-map
@vindex viper-emacs-global-user-map
diff --git a/etc/NEWS b/etc/NEWS
index 5378e56..7dfb082 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -49,7 +49,7 @@ functions 'json-serialize', 'json-insert',
'json-parse-string', and
'json-parse-buffer' are typically much faster than their Lisp
counterparts from json.el.
-** The configure option --with-cairo is no longer experimental.
+** The configure option '--with-cairo' is no longer experimental.
This builds Emacs with Cairo drawing, and supports built-in printing
when Emacs is built with GTK+.
@@ -92,11 +92,6 @@ and in particular better supports the Address Space Layout
Randomization (ASLR) feature, a security technique used by most modern
operating systems.
-Portable dumping can be disabled at configure time via the configure
-option '--with-dumping=unexec' (but we don't recommend that, unless
-the portable dumping doesn't work on your system for some
-reason---please report such systems to the Emacs developers as bugs).
-
When built with the portable dumping support (which is the default),
Emacs looks for the 'emacs.pdmp' file, generated during the build, in
its data directory at startup, and loads the dumped state from there.
@@ -104,6 +99,15 @@ The new command-line argument '--dump-file=FILE' allows to
specify a
non-default '.pdmp' file to load the state from; see the node "Initial
Options" in the Emacs manual for more information.
+An Emacs started via a dump file can create a new dump file only if it
+was invoked with the '-batch' option.
+
+Although the portable dumper has been tested, it may have a bug on
+unusual platforms. If you require traditional unexec dumping you can
+use the configure-time option '--with-dumping=unexec'; however, please
+file a bug report describing the situation, as unexec dumping is
+deprecated.
+
+++
** The new configure option '--enable-checking=structs' attempts to
check that the portable dumper code has been updated to match the last
@@ -183,9 +187,9 @@ loads files during completion of 'C-h f' and 'C-h v'
according to
** emacsclient
-*** emacsclient no longer passes --eval arguments to an alternate editor.
-Previously, --eval arguments were passed as file names to any
-alternate editor started by --alternate-editor/-a.
+*** emacsclient no longer passes '--eval' arguments to an alternate editor.
+Previously, '--eval' arguments were passed as file names to any
+alternate editor started by '--alternate-editor'.
+++
*** emacsclient now supports an 'EMACS_SOCKET_NAME' environment variable.
@@ -400,7 +404,14 @@ mode they are described in the manual "(emacs) Display".
---
** New variable 'xref-file-name-display' controls the display of file
names in xref buffers.
-** New variable `file-size-function' controls how file sizes are displayed
+
+** New variable 'file-size-function' controls how file sizes are displayed.
+
++++
+** Emacs now interprets RGB triplets like HTML, SVG, and CSS do.
+
+The X convention previously used differed slightly, particularly for
+RGB triplets with a single hexadecimal digit per component.
* Editing Changes in Emacs 27.1
@@ -487,21 +498,20 @@ current and the previous or the next line, as before.
+++
** winner
-*** A new variable, `winner-boring-buffers-regexp', has been added.
+*** A new variable, 'winner-boring-buffers-regexp', has been added.
** table
-** `table-generate-source' and friends now support outputting wiki and
+** 'table-generate-source' and friends now support outputting wiki and
mediawiki format tables.
---
** telnet-mode
-*** Reverting a buffer in `telnet-mode' will restart a closed
-connection.
+*** Reverting a buffer in 'telnet-mode' will restart a closed connection.
** goto-addr
*** A way to more conveniently specify what URI address schemes that
should be ignored have been added via the
-`goto-address-uri-schemes-ignored' variable.
+'goto-address-uri-schemes-ignored' variable.
+++
** tex-mode
@@ -510,7 +520,7 @@ You can use this new variable to control indentation of
arguments of
\emph, \footnote, and similar commands.
** byte compiler
-*** byte-compile-dynamic is now obsolete
+*** 'byte-compile-dynamic' is now obsolete.
This is because on the one hand it suffers from various misbehaviors in corner
cases that have plagued it for years, and on the other experiments indicated
that it doesn't bring any measurable benefit.
@@ -525,6 +535,12 @@ be functions.
*** 'cl-defstruct' has a new ':noinline' argument to prevent inlining
its functions.
++++
+*** 'cl-defstruct' slots accept a ':documentation' property
+
+---
+*** 'cl-values-list' will now signal an error if its argument isn't a list.
+
** doc-view.el
*** New commands 'doc-view-presentation' and 'doc-view-fit-window-to-page'.
*** Added support for password-protected PDF files
@@ -634,12 +650,16 @@ remapped to these, respectively.
*** New command 'dired-create-empty-file'.
+++
-*** New command and keystroke `dired-number-of-marked-files' bound to
-`* N'.
+*** New command and keystroke 'dired-number-of-marked-files' bound to
+'* N'.
*** The marking commands now report how many files were marked by the
command itself, not how many files are marked in total.
+---
+*** A new face, 'dired-socket', is used to highlight sockets, named
+pipes, block devices and character devices.
+
** Find-Dired
*** New customizable variable 'find-dired-refine-function'.
@@ -694,13 +714,13 @@ print diffs and logs between the merge base (common
ancestor) of two
given revisions.
+++
-*** The new `d' command (`vc-dir-clean-files') in `vc-dir-mode'
+*** The new 'd' command ('vc-dir-clean-files') in 'vc-dir-mode'
buffers will delete the marked files (or if no files are marked, the
file under point). This command does not notify the VC backend, and
is mostly useful for unregistered files.
-*** New command 'vc-log-search' asks for a pattern string, searches
-it in the revision log, and displays matched log entries in the
+*** New command 'vc-log-search' asks for a pattern, searches it
+in the revision log, and displays matched log entries in the
log buffer. For example, 'M-x vc-log-search RET bug#36644 RET'
displays all entries whose log messages match the bug number.
With a prefix argument asks for a command, so for example,
@@ -748,6 +768,12 @@ start of a sentence or at '(point-min)', else '@ref'.
It now treats the optional 2nd argument to mean that the URL should be
shown in the currently selected window.
+*** A new function, 'browse-url-add-buttons' can be used to add clickable
+links to most ordinary special-mode buffers that display text that
+have URLs embedded. 'browse-url-button-regexp' controls what's
+considered a button.
+
+*** A new variable, 'browse-url-secondary-browser-function', has been added.
** Comint
+++
@@ -819,6 +845,10 @@ be encrypted with GPG by adding an additional '.gpg'
suffix.
---
*** 'term-read-noecho' is now obsolete, use 'read-passwd' instead.
++++
+*** 'serial-term' now takes an optional parameter to leave the
+emulator in line mode.
+
** Flymake
+++
@@ -854,6 +884,12 @@ Now 't' only checks that at least one signature is valid
and the new 'all'
value needs to be used if you want to enforce that all signatures
are valid. This only affects packages with multiple signatures.
++++
+*** The meaning of 'allow-unsigned' in 'package-check-signature' has
+changed slightly: If a usable OpenPGP configuration can't be found
+(for instance, if gpg isn't installed), it now has the same meaning as
+nil.
+
*** New function 'package-get-version' lets packages query their own version.
Example use in auctex.el: '(defconst auctex-version (package-get-version))'
@@ -869,7 +905,7 @@ early init file.
*** New function 'package-activate-all'.
---
-*** Imenu support has been added to `package-menu-mode'.
+*** Imenu support has been added to 'package-menu-mode'.
** Info
@@ -924,8 +960,8 @@ Of course it will still find it if you have it in
'~/.ecompleterc'.
** Gnus
+++
-*** There's a new value for `gnus-article-date-headers',
-`combined-local-lapsed', which will show both the time (in the local
+*** There's a new value for 'gnus-article-date-headers',
+'combined-local-lapsed', which will show both the time (in the local
timezone) and the lapsed time.
---
@@ -973,6 +1009,14 @@ offers them to the user to open with 'browse-url'.
This option controls whether and how to use Gnus search groups as
'path:' search terms to 'notmuch'.
+---
++++ The buttons in the Gnus article buffer were formerly widgets
+(i.e., buttons from widget.el). This has now changed, and they are
+now buttons (from button.el), and commands like 'TAB' now search for
+buttons instead of widgets. There should be no user-visible changes,
+but out-of-tree code that relied on widgets being present might now
+fail.
+
** erc
---
@@ -980,9 +1024,9 @@ This option controls whether and how to use Gnus search
groups as
and its value has been changed to Duck Duck Go.
---
-*** `erc-send-pre-hook' and `erc-send-this' have been obsoleted. The
-variable to use instead to alter text to be sent is now
-`erc-pre-send-functions'.
+*** 'erc-send-pre-hook' and 'erc-send-this' have been obsoleted.
+The variable to use instead to alter text to be sent is now
+'erc-pre-send-functions'.
** EUDC
@@ -1010,11 +1054,15 @@ has been executed.
If set, shr will not render tags with attribute 'aria-hidden="true"'.
This attribute is meant to tell screen readers to ignore a tag.
++++
+*** 'shr-external-browser' has been made into an obsolete alias
+of 'browse-url-secondary-browser-function'.
+
---
*** 'shr-tag-ol' now respects the ordered list 'start' attribute.
---
-*** The following tags are now handled: <code>, <abbr>, and <acronym>.
+*** The following tags are now handled: '<code>', '<abbr>', and '<acronym>'.
** Htmlfontify
@@ -1033,9 +1081,13 @@ restored when the file is visited.
** Smtpmail
-Authentication mechanisms can be added via external packages, by
+*** Authentication mechanisms can be added via external packages, by
defining new 'cl-defmethod' of 'smtpmail-try-auth-method'.
+*** To always force smtpmail to send credentials over on the first
+attempt when communicating with the SMTP server(s), the
+'smtpmail-servers-requiring-authorization' variable can be used.
+
** Footnote mode
*** Support Hebrew-style footnotes
@@ -1139,9 +1191,9 @@ highlight in one iteration while processing the full
buffer.
'C-M-d'.
+++
-'M-s h l' invokes highlight-lines-matching-regexp using the search
+'M-s h l' invokes 'highlight-lines-matching-regexp' using the search
string to highlight lines matching the search string. This is similar
-to the existing binding 'M-s h r' (highlight-regexp) that highlights
+to the existing binding 'M-s h r' ('highlight-regexp') that highlights
JUST the search string.
+++
@@ -1163,6 +1215,23 @@ and case-sensitivity together with search strings in the
search ring.
+++
*** 'flush-lines' prints and returns the number of deleted matching lines.
+---
+*** 'char-fold-to-regexp' now matches more variants of a base character.
+The table used to check for equivalence of characters is now built
+using the complete chain of unicode decompositions of a character,
+rather than stopping after one level, such that searching for
+e.g. "GREEK SMALL LETTER IOTA" will now also find "GREEK SMALL LETTER
+IOTA WITH OXIA".
+
++++
+*** New char-folding options: 'char-fold-include' lets you add ad hoc
+foldings, 'char-fold-exclude' to remove foldings from default decomposition,
+and 'char-fold-symmetric' to search for any of an equivalence class of
+characters. For example, with a 'nil' value of 'char-fold-symmetric'
+you can search for "e" to find "é", but not vice versa. With a non-nil
+value you can search for either, for example, you can search for "é"
+to find "e".
+
** Debugger
+++
@@ -1367,7 +1436,7 @@ Setting this option to an integer causes URLs displayed
in Rcirc
buffers to be truncated to that many characters.
---
-*** The default /quit and /part reasons are now configurable.
+*** The default '/quit' and '/part' reasons are now configurable.
Two new user options are provided for this:
'rcirc-default-part-reason' and 'rcirc-default-quit-reason'.
@@ -1417,10 +1486,10 @@ The option is useful for two reasons when verifying the
signature:
1. GnuPG's TOFU statistics are updated for the specific user id
(email) only. See gpg(1) man page about "--sender".
- 2. GnuPG's --auto-key-retrieve functionality can use WKD (web key
+ 2. GnuPG's '--auto-key-retrieve' functionality can use WKD (web key
directory) method for finding the signer's key. You need GnuPG
2.2.17 to fully benefit from this feature. See gpg(1) man page for
- "--auto-key-retrieve".
+ '--auto-key-retrieve'.
---
** EasyPG
@@ -1435,11 +1504,11 @@ It now applies to epg functions as well as epa
functions.
been removed. Use 'encode-coding-string', 'decode-coding-string', and
'select-safe-coding-system' instead.
-*** 'epg-context' structure supports now 'sender' slot
+*** 'epg-context' structure supports now 'sender' slot.
The value of the new 'sender' slot (if a string) is used to set gpg's
---sender option. This feature is used by
+'--sender' option. This feature is used by
'mml-secure-openpgp-sign-with-sender'. See gpg(1) manual page about
-"--sender" for more information.
+'--sender' for more information.
---
** Rmail
@@ -1477,7 +1546,6 @@ automatically updates. In the buffer, you can use 's q'
or 's e' to
signal a thread with quit or error respectively, or get a snapshot
backtrace with 'b'.
-
** thingatpt.el
---
@@ -1552,7 +1620,7 @@ near the current column in Tabulated Lists (see variables
+++
*** Two new commands and keystrokes have been added to the tabulated
-list mode: `w' (which widens the current column) and `c' which makes
+list mode: 'w' (which widens the current column) and 'c' which makes
the current column contract.
** Text mode
@@ -1659,12 +1727,17 @@ the new variable 'buffer-auto-revert-by-notification'
to a non-nil
value. Auto Revert mode can use this information to avoid polling the
buffer periodically when 'auto-revert-avoid-polling' is non-nil.
+---
+*** 'global-auto-revert-ignore-buffer' can now also be a predicate
+function that can be used for more fine-grained control of which
+buffers to auto-revert.
+
** auth-source-pass
+++
*** New customizable variable 'auth-source-pass-filename'.
Allows setting the path to the password-store, defaults to
-~/.password-store.
+"~/.password-store".
+++
*** New customizable variable 'auth-source-pass-port-separator'.
@@ -1757,11 +1830,14 @@ immediately. Type 'M-x so-long-commentary' for full
documentation.
Likewise for 'magic-fallback-mode-alist'.
+++
-** add-hook does not always add to the front or the end any more.
-The replacement of `append` with `depth` implies that the function is not
-always added to the very front (when append/depth is nil) or the very end (when
-append/depth is t) any more because other functions on the hook may have
-specified higher/lower depths.
+** 'add-hook' does not always add to the front or the end any more.
+The replacement of 'append' with 'depth' implies that the function is
+not always added to the very front (when append/depth is nil) or the
+very end (when append/depth is t) any more because other functions on
+the hook may have specified higher/lower depths. This makes it
+possible to control the ordering of functions more precisely, as was
+already possible in 'add-function' and 'advice-add'.
+
** In 'compilation-error-regexp-alist' the old undocumented feature
where 'line' could be a function of 2 arguments has been dropped.
@@ -1794,6 +1870,9 @@ relative to the 'default-directory' of the current
buffer. We recommend
always setting "$HOME" to an absolute file name, so that its meaning is
independent of where Emacs was started.
+** 'file-name-absolute-p' no longer considers "~foo" to be an absolute
+file name if there is no user named "foo".
+
** The FILENAME argument to 'file-name-base' is now mandatory and no
longer defaults to 'buffer-file-name'.
@@ -1897,24 +1976,30 @@ valid event type.
* Lisp Changes in Emacs 27.1
-** defcustom now takes a :local keyword that can be either t or
-`permanent', which mean that the variable should be automatically
-buffer-local. `permanent' also sets the variable's
-`permanent-local' property.
++++
+** Buttons (created with 'make-button' and related functions) can
+now use the 'button-data' property. If present, the data in this
+property will be passed on to the 'action' function instead of the
+button itself in 'button-activate'.
+
+** 'defcustom' now takes a ':local' keyword that can be either t or
+'permanent', which mean that the variable should be automatically
+buffer-local. 'permanent' also sets the variable's 'permanent-local'
+property.
+++
-** The new macro `with-suppressed-warnings' can be used to suppress
+** The new macro 'with-suppressed-warnings' can be used to suppress
specific byte-compile warnings.
++++
+** The new macro 'ignore-error' is like 'ignore-errors', but takes a
+specific error condition, and will only ignore that condition. (This
+can also be a list of conditions.)
+
---
-** The new function `byte-compile-info-message' can be used to output
+** The new function 'byte-compile-info-message' can be used to output
informational messages that look pleasing during the Emacs build.
-+++
-** The 'append' arg of 'add-hook' is generalized to a finer notion of 'depth'
-This makes it possible to control the ordering of functions more precisely,
-as was already possible in 'add-function' and `advice-add`.
-
---
** New 'help-fns-describe-variable-functions' hook.
Makes it possible to add metadata information to 'describe-variable'.
@@ -1988,6 +2073,15 @@ TICKS is an integer and HZ is a positive integer
denoting a clock
frequency. The old 'encode-time' API is still supported.
+++
+*** A new package to parse ISO 8601 time, date, durations and
+intervals has been added. The main function to use is
+'iso8601-parse', but there's also 'iso8601-parse-date',
+'iso8601-parse-time', 'iso8601-parse-duration' and
+'iso8601-parse-interval'. All these functions return decoded time
+structures, except the final one, which returns three of them (start,
+end and duration).
+
++++
*** 'time-add', 'time-subtract', and 'time-less-p' now accept
infinities and NaNs too, and propagate them or return nil like
floating-point operators do.
@@ -2001,6 +2095,21 @@ that acts like the '0' flag but also puts a '+' before
nonnegative
years containing more than four digits. This is for compatibility
with POSIX.1-2017.
++++
+*** To access (or alter) the elements a decoded time value, the
+'decoded-time-second', 'decoded-time-minute', 'decoded-time-hour',
+'decoded-time-day', 'decoded-time-month', 'decoded-time-year',
+'decoded-time-weekday', 'decoded-time-dst' and 'decoded-time-zone'
+accessors can be used.
+
++++
+*** The new functions 'date-days-in-month' (which will say how many
+days there are in a month in a specific year), 'date-ordinal-to-time'
+(that computes the date of an ordinal day), 'decoded-time-add' for
+doing computations on a decoded time structure), and
+'make-decoded-time' (for making a decoded time structure with only the
+given keywords filled out) have been added.
+
** 'define-minor-mode' automatically documents the meaning of ARG.
+++
@@ -2293,11 +2402,11 @@ The history of variable names read by 'read-variable'
is recorded in
the new variable 'custom-variable-history'.
---
-** The function 'string-to-unibyte' and `string-to-multibyte' are no
+** The functions 'string-to-unibyte' and 'string-to-multibyte' are no
longer declared obsolete. We have found that there are legitimate use
cases for these functions, where there's no better alternative. We
believe that the incorrect uses of these functions all but disappeared
-by now, so we are un-obsoleting it.
+by now, so we are un-obsoleting them.
+++
** New function 'group-name' returns a group name corresponding to GID.
@@ -2359,15 +2468,17 @@ space or non-breaking space as third argument, and "B"
as fourth
argument, circumstances allowing.
+++
-** `format-spec' has been expanded with several modifiers to allow
+** 'format-spec' has been expanded with several modifiers to allow
greater flexibility when customizing variables. The modifiers include
zero-padding, upper- and lower-casing, and limiting the length of the
interpolated strings. The function has now also been documented in
the Emacs Lisp manual.
+++
-** `directory-files-recursively' can now take an optional PREDICATE
-parameter to control descending into subdirectories.
+** 'directory-files-recursively' can now take an optional PREDICATE
+parameter to control descending into subdirectories, and a
+FOLLOW-SYMLINK parameter to say that symbolic links that point to
+other directories should be followed.
* Changes in Emacs 27.1 on Non-Free Operating Systems
diff --git a/etc/TODO b/etc/TODO
index b2446b0..a065763 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -297,11 +297,7 @@ One way of doing this is to start with fx's dynamic
loading, and use it
to implement things like auto-loaded buffer parsers and database
access in cases which need more than Lisp.
-** Replace unexec with a more portable form of dumping
-See eg https://lists.gnu.org/r/emacs-devel/2014-01/msg01034.html
- https://lists.gnu.org/r/emacs-devel/2014-06/msg00452.html
-
-One way is to provide portable undumping using mmap (per gerd design).
+** Fix portable dumping so that you can redump without using -batch.
** Imenu could be extended into a file-structure browsing mechanism
using code like that of customize-groups.
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index bd99790..87a5048 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -57,6 +57,7 @@ Semantic, and Ansi-Color faces are included.")
(,class
(:foreground ,alum-1 :background "black"))))
`(cursor ((,class (:background ,butter-1))))
+ `(header-line ((,class (:background "#666"))))
;; Highlighting faces
`(fringe ((,class (:background ,alum-7))))
`(highlight ((,class (:foreground ,alum-6 :background ,butter-2))))
diff --git a/lib/fingerprint.h b/lib/fingerprint.h
index ba2e740..7d2160c 100644
--- a/lib/fingerprint.h
+++ b/lib/fingerprint.h
@@ -22,8 +22,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
/* We generate fingerprint.c and fingerprint.o from all the sources in
Emacs. This way, we have a unique value that we can use to pair
- data files (like a portable dump image) with a specific build of
- Emacs. */
+ data files (like a dump file) with a specific build of Emacs. */
extern volatile unsigned char fingerprint[32];
#endif
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 85fdbd2..79580e9 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -86,6 +86,7 @@
# d-type \
# diffseq \
# dosname \
+# double-slash-root \
# dtoastr \
# dtotimespec \
# dup2 \
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 5c79a7e..6cdc1d3 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -266,7 +266,10 @@ buffers. CPU usage depends on the version control system."
(defvar-local global-auto-revert-ignore-buffer nil
"When non-nil, Global Auto-Revert Mode will not revert this buffer.
-This variable becomes buffer local when set in any fashion.")
+This variable can also be a predicate function, in which case
+it'll be called with one parameter (the buffer in question), and
+it should return non-nil to make Global Auto-Revert Mode not
+revert this buffer.")
(defcustom auto-revert-remote-files nil
"If non-nil remote files are also reverted."
@@ -541,7 +544,11 @@ specifies in the mode line."
(not (eq buffer-stale-function
#'buffer-stale--default-function))))
(not (memq 'major-mode global-auto-revert-ignore-modes))
- (not global-auto-revert-ignore-buffer))
+ (or (null global-auto-revert-ignore-buffer)
+ (if (functionp global-auto-revert-ignore-buffer)
+ (not (funcall global-auto-revert-ignore-buffer
+ (current-buffer)))
+ nil)))
(setq auto-revert--global-mode t)))
(defun auto-revert--global-adopt-current-buffer ()
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 5205d49..64842c4 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -655,11 +655,11 @@ okay. See `mode-line-format'.")
(put 'minor-mode-alist 'risky-local-variable t)
;; Don't use purecopy here--some people want to change these strings.
(setq minor-mode-alist
- '((abbrev-mode " Abbrev")
+ `((abbrev-mode " Abbrev")
(overwrite-mode overwrite-mode)
(auto-fill-function " Fill")
;; not really a minor mode...
- (defining-kbd-macro " Def")))
+ (defining-kbd-macro ,(propertize " Def" 'face 'error))))
;; These variables are used by autoloadable packages.
;; They are defined here so that they do not get overridden
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 6406a59..3cea186 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -703,7 +703,8 @@ means list those buffers and no others."
(defun Buffer-menu--pretty-file-name (file)
(cond (file
(abbreviate-file-name file))
- ((bound-and-true-p list-buffers-directory))
+ ((bound-and-true-p list-buffers-directory)
+ (abbreviate-file-name list-buffers-directory))
(t "")))
;;; buff-menu.el ends here
diff --git a/lisp/button.el b/lisp/button.el
index 921e84d..ca6f0d3 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -235,15 +235,19 @@ The action can either be a marker or a function. If it's
a
marker then goto it. Otherwise if it is a function then it is
called with BUTTON as only argument. BUTTON is either an
overlay, a buffer position, or (for buttons in the mode-line or
-header-line) a string."
+header-line) a string.
+
+If BUTTON has a `button-data' value, call the function with this
+value instad of BUTTON."
(let ((action (or (and use-mouse-action (button-get button 'mouse-action))
- (button-get button 'action))))
+ (button-get button 'action)))
+ (data (button-get button 'button-data)))
(if (markerp action)
(save-selected-window
(select-window (display-buffer (marker-buffer action)))
(goto-char action)
(recenter 0))
- (funcall action button))))
+ (funcall action (or data button)))))
(defun button-label (button)
"Return BUTTON's text label."
@@ -324,6 +328,10 @@ using `make-text-button'. Note, however, that if there is
an existing
face property at the site of the button, the button face may not be visible.
You may want to use `make-button' in that case.
+If the property `button-data' is present, it will later be used
+as the argument for the `action' callback function instead of the
+default argument, which is the button itself.
+
BEG can also be a string, in which case it is made into a button.
Also see `insert-text-button'."
@@ -462,13 +470,17 @@ return t."
(button-activate button use-mouse-action)
t))))
-(defun forward-button (n &optional wrap display-message)
+(defun forward-button (n &optional wrap display-message no-error)
"Move to the Nth next button, or Nth previous button if N is negative.
If N is 0, move to the start of any button at point.
If WRAP is non-nil, moving past either end of the buffer continues from the
other end.
If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed.
Any button with a non-nil `skip' property is skipped over.
+
+If NO-ERROR, return nil if no further buttons could be found
+instead of erroring out.
+
Returns the button found."
(interactive "p\nd\nd")
(let (button)
@@ -497,22 +509,28 @@ Returns the button found."
(unless (button-get button 'skip)
(setq n (1- n)))))))
(if (null button)
- (user-error (if wrap "No buttons!" "No more buttons"))
+ (if no-error
+ nil
+ (user-error (if wrap "No buttons!" "No more buttons")))
(let ((msg (and display-message (button-get button 'help-echo))))
(when msg
(message "%s" msg)))
button)))
-(defun backward-button (n &optional wrap display-message)
+(defun backward-button (n &optional wrap display-message no-error)
"Move to the Nth previous button, or Nth next button if N is negative.
If N is 0, move to the start of any button at point.
If WRAP is non-nil, moving past either end of the buffer continues from the
other end.
If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed.
Any button with a non-nil `skip' property is skipped over.
+
+If NO-ERROR, return nil if no further buttons could be found
+instead of erroring out.
+
Returns the button found."
(interactive "p\nd\nd")
- (forward-button (- n) wrap display-message))
+ (forward-button (- n) wrap display-message no-error))
(provide 'button)
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index eb1a824..bdfc0e4 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -41,7 +41,9 @@
(calc-enter-result 0 "time"
(list 'mod
(list 'hms
- (nth 2 time) (nth 1 time) (nth 0 time))
+ (decoded-time-hour time)
+ (decoded-time-minute time)
+ (decoded-time-second time))
(list 'hms 24 0 0))))))
(defun calc-to-hms (arg)
@@ -523,7 +525,7 @@ in the Gregorian calendar and the remaining part determines
the time."
(defun math-this-year ()
- (nth 5 (decode-time)))
+ (decoded-time-year (decode-time)))
(defun math-leap-year-p (year &optional julian)
"Non-nil if YEAR is a leap year.
@@ -1341,8 +1343,12 @@ as measured in the integer number of days before
December 31, 1 BC (Gregorian)."
(defun calcFunc-now (&optional zone)
(let ((date (let ((now (decode-time)))
(list 'date (math-dt-to-date
- (list (nth 5 now) (nth 4 now) (nth 3 now)
- (nth 2 now) (nth 1 now) (nth 0 now)))))))
+ (list (decoded-time-year now)
+ (decoded-time-month now)
+ (decoded-time-day now)
+ (decoded-time-hour now)
+ (decoded-time-minute now)
+ (decoded-time-second now)))))))
(if zone
(math-add date (math-div (math-sub (calcFunc-tzone nil date)
(calcFunc-tzone zone date))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index eec7aff..281151c 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -1054,7 +1054,7 @@ the `left' or `right' when one of the standard modes is
used."
;; print with radix -- for binary, convert the octal number
(let* ((fmt (if (eq calculator-output-radix 'hex) "%x" "%o"))
(str (if calculator-2s-complement num (abs num)))
- (str (format fmt (calculator-truncate str)))
+ (str (format fmt (truncate str)))
(bins '((?0 "000") (?1 "001") (?2 "010") (?3 "011")
(?4 "100") (?5 "101") (?6 "110") (?7 "111")))
(str (if (not (eq calculator-output-radix 'bin)) str
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index b7aa212..944054e 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -325,7 +325,7 @@ displayed in a window:
(prev-appt-display-count appt-display-count)
;; Convert current time to minutes after midnight (12.01am = 1).
(now (decode-time))
- (now-mins (+ (* 60 (nth 2 now)) (nth 1 now)))
+ (now-mins (+ (* 60 (decoded-time-hour now)) (decoded-time-minute
now)))
appt-mins appt-warn-time min-to-app min-list string-list)
(save-excursion ; FIXME ?
;; At first check in any day, update appointments to today's list.
@@ -647,7 +647,8 @@ Any appointments made with `appt-add' are not affected by
this function."
;; Convert current time to minutes after midnight (12:01am = 1),
;; and remove elements in the list that are in the past.
(let* ((now (decode-time))
- (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))))
+ (now-mins (+ (* 60 (decoded-time-hour now))
+ (decoded-time-minute now))))
(while (and appt-time-msg-list
(< (caar (car appt-time-msg-list)) now-mins))
(setq appt-time-msg-list (cdr appt-time-msg-list)))))))
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index e0126a6..510cd68 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -259,7 +259,7 @@ for `calendar-current-time-zone'."
(car t2-date-sec) t1-utc-diff))
(t1-time (/ (cdr t1-date-sec) 60))
(t2-time (/ (cdr t2-date-sec) 60)))
- (if (nth 7 (decode-time t1))
+ (if (decoded-time-dst (decode-time t1))
(list (/ t0-utc-diff 60) (/ (- t1-utc-diff t0-utc-diff) 60)
t0-name t1-name t1-rules t2-rules t1-time t2-time)
(list (/ t1-utc-diff 60) (/ (- t0-utc-diff t1-utc-diff) 60)
@@ -291,7 +291,8 @@ the current year."
(condition-case nil
(encode-time 1 0 0 1 1 year)
(error
- (encode-time 1 0 0 1 1 (nth 5 (decode-time))))))
+ (encode-time 1 0 0 1 1
+ (decoded-time-year (decode-time))))))
f (nth 4 e)
e (list year f (nth 5 e))
calendar-dst-transition-cache
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index 897208f..59fe52a 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -100,13 +100,7 @@ Gregorian date Sunday, December 31, 1 BC."
(d2 ; prior days not in n2820 or n768
(mod d1 280506))
(n1 ; years not in n2820 or n768
- ;; Want:
- ;; (floor (+ (* 2820 d2) (* 2820 366)) 1029983))
- ;; but that causes overflow, so use the following.
- ;; Use 366 as the divisor because (2820*366 mod 1029983) is small.
- (let ((a (floor d2 366))
- (b (mod d2 366)))
- (+ 1 a (floor (+ (* 2137 a) (* 2820 b) 2137) 1029983))))
+ (floor (* 2820 (+ d2 366)) 1029983))
(year (+ (* 2820 n2820) ; complete 2820 year cycles
(* 768 n768) ; complete 768 year cycles
;; Remaining years.
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 1e988c2..14604a6 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1871,7 +1871,9 @@ the STRINGS are just concatenated and the result
truncated."
"Return the current date in a list (month day year).
Optional integer OFFSET is a number of days from the current date."
(let* ((now (decode-time))
- (now (list (nth 4 now) (nth 3 now) (nth 5 now))))
+ (now (list (decoded-time-month now)
+ (decoded-time-day now)
+ (decoded-time-year now))))
(if (zerop (or offset 0))
now
(calendar-gregorian-from-absolute
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 17316dd..cf3315b 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -721,12 +721,12 @@ Both times must be given in decoded form. One of these
times must be
valid (year > 1900 or something)."
;; FIXME: does this function exist already?
(decode-time (encode-time
- (+ (nth 0 time1) (nth 0 time2))
- (+ (nth 1 time1) (nth 1 time2))
- (+ (nth 2 time1) (nth 2 time2))
- (+ (nth 3 time1) (nth 3 time2))
- (+ (nth 4 time1) (nth 4 time2))
- (+ (nth 5 time1) (nth 5 time2))
+ (+ (decoded-time-second time1) (decoded-time-second time2))
+ (+ (decoded-time-minute time1) (decoded-time-minute time2))
+ (+ (decoded-time-hour time1) (decoded-time-hour time2))
+ (+ (decoded-time-day time1) (decoded-time-day time2))
+ (+ (decoded-time-month time1) (decoded-time-month time2))
+ (+ (decoded-time-year time1) (decoded-time-year time2))
nil
nil
;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
@@ -1623,9 +1623,9 @@ enumeration, given as a Lisp time value -- used for test
purposes."
(lambda (offset)
(let* ((day (decode-time (time-add now
(* 60 60 24 offset))))
- (d (nth 3 day))
- (m (nth 4 day))
- (y (nth 5 day))
+ (d (decoded-time-day day))
+ (m (decoded-time-month day))
+ (y (decoded-time-year day))
(se (diary-sexp-entry p1 p2 (list m d y)))
(see (cond ((stringp se) se)
((consp se) (cdr se))
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
new file mode 100644
index 0000000..ab0077a
--- /dev/null
+++ b/lisp/calendar/iso8601.el
@@ -0,0 +1,370 @@
+;;; iso8601.el --- parse ISO 8601 date/time strings -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Keywords: dates
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; ISO8601 times basically look like 1985-04-01T15:23:49... Or so
+;; you'd think. This is what everybody means when they say "ISO8601",
+;; but it's in reality a quite large collection of syntaxes, including
+;; week numbers, ordinal dates, durations and intervals. This package
+;; has functions for parsing them all.
+;;
+;; The interface functions are `iso8601-parse', `iso8601-parse-date',
+;; `iso8601-parse-time', `iso8601-parse-zone',
+;; `iso8601-parse-duration' and `iso8601-parse-interval'. They all
+;; return decoded time objects, except the last one, which returns a
+;; list of three of them.
+;;
+;; (iso8601-parse-interval "P1Y2M10DT2H30M/2008W32T153000-01")
+;; '((0 0 13 24 5 2007 nil nil -3600)
+;; (0 30 15 3 8 2008 nil nil -3600)
+;; (0 30 2 10 2 1 nil nil nil))
+;;
+;;
+;; The standard can be found at:
+;;
+;;
http://www.loc.gov/standards/datetime/iso-tc154-wg5_n0038_iso_wd_8601-1_2016-02-16.pdf
+;;
+;; The Wikipedia page on the standard is also informative:
+;;
+;; https://en.wikipedia.org/wiki/ISO_8601
+;;
+;; RFC3339 defines the subset that everybody thinks of as "ISO8601".
+
+;;; Code:
+
+(require 'time-date)
+(require 'cl-lib)
+
+(defun iso8601--concat-regexps (regexps)
+ (mapconcat (lambda (regexp)
+ (concat "\\(?:"
+ (replace-regexp-in-string "(" "(?:" regexp)
+ "\\)"))
+ regexps "\\|"))
+
+(defconst iso8601--year-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)")
+(defconst iso8601--full-date-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--without-day-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)")
+(defconst iso8601--outdated-date-match
+ "--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--week-date-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?")
+(defconst iso8601--ordinal-date-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9][0-9]\\)")
+(defconst iso8601--date-match
+ (iso8601--concat-regexps
+ (list iso8601--year-match
+ iso8601--full-date-match
+ iso8601--without-day-match
+ iso8601--outdated-date-match
+ iso8601--week-date-match
+ iso8601--ordinal-date-match)))
+
+(defconst iso8601--time-match
+
"\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?:?\\([0-9][0-9]\\)?\\.?\\([0-9][0-9][0-9]\\)?")
+
+(defconst iso8601--zone-match
+ "\\(Z\\|\\([-+]\\)\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)")
+
+(defconst iso8601--full-time-match
+ (concat "\\(" (replace-regexp-in-string "(" "(?:" iso8601--time-match) "\\)"
+ "\\(" iso8601--zone-match "\\)?"))
+
+(defconst iso8601--combined-match
+ (concat "\\(" iso8601--date-match "\\)"
+ "\\(?:T\\("
+ (replace-regexp-in-string "(" "(?:" iso8601--time-match)
+ "\\)"
+ "\\(" iso8601--zone-match "\\)?\\)?"))
+
+(defconst iso8601--duration-full-match
+
"P\\([0-9]+Y\\)?\\([0-9]+M\\)?\\([0-9]+D\\)?\\(T\\([0-9]+H\\)?\\([0-9]+M\\)?\\([0-9]+S\\)?\\)?")
+(defconst iso8601--duration-week-match
+ "P\\([0-9]+\\)W")
+(defconst iso8601--duration-combined-match
+ (concat "P" iso8601--combined-match))
+(defconst iso8601--duration-match
+ (iso8601--concat-regexps
+ (list iso8601--duration-full-match
+ iso8601--duration-week-match
+ iso8601--duration-combined-match)))
+
+(defun iso8601-parse (string)
+ "Parse an ISO 8601 date/time string and return a `decoded-time' structure.
+
+The ISO 8601 date/time strings look like \"2008-03-02T13:47:30\",
+but shorter, incomplete strings like \"2008-03-02\" are valid, as
+well as variants like \"2008W32\" (week number) and
+\"2008-234\" (ordinal day number)."
+ (if (not (iso8601-valid-p string))
+ (signal 'wrong-type-argument string)
+ (let* ((date-string (match-string 1 string))
+ (time-string (match-string 2 string))
+ (zone-string (match-string 3 string))
+ (date (iso8601-parse-date date-string)))
+ ;; The time portion is optional.
+ (when time-string
+ (let ((time (iso8601-parse-time time-string)))
+ (setf (decoded-time-hour date) (decoded-time-hour time))
+ (setf (decoded-time-minute date) (decoded-time-minute time))
+ (setf (decoded-time-second date) (decoded-time-second time))))
+ ;; The time zone is optional.
+ (when zone-string
+ (setf (decoded-time-zone date)
+ ;; The time zone in decoded times are in seconds.
+ (* (iso8601-parse-zone zone-string) 60)))
+ date)))
+
+(defun iso8601-parse-date (string)
+ "Parse STRING (which should be on ISO 8601 format) and return a time value."
+ (cond
+ ;; Just a year: [-+]YYYY.
+ ((iso8601--match iso8601--year-match string)
+ (iso8601--decoded-time
+ :year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string))))
+ ;; Calendar dates: YYYY-MM-DD and variants.
+ ((iso8601--match iso8601--full-date-match string)
+ (iso8601--decoded-time
+ :year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string))
+ :month (match-string 3 string)
+ :day (match-string 4 string)))
+ ;; Calendar date without day: YYYY-MM.
+ ((iso8601--match iso8601--without-day-match string)
+ (iso8601--decoded-time
+ :year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string))
+ :month (match-string 3 string)))
+ ;; Outdated date without year: --MM-DD
+ ((iso8601--match iso8601--outdated-date-match string)
+ (iso8601--decoded-time
+ :month (match-string 1 string)
+ :day (match-string 2 string)))
+ ;; Week dates: YYYY-Www-D
+ ((iso8601--match iso8601--week-date-match string)
+ (let* ((year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string)))
+ (week (string-to-number (match-string 3 string)))
+ (day-of-week (and (match-string 4 string)
+ (string-to-number (match-string 4 string))))
+ (jan-start (decoded-time-weekday
+ (decode-time
+ (iso8601--encode-time
+ (iso8601--decoded-time :year year
+ :month 1
+ :day 4)))))
+ (correction (+ (if (zerop jan-start) 7 jan-start)
+ 3))
+ (ordinal (+ (* week 7) (or day-of-week 0) (- correction))))
+ (cond
+ ;; Monday 29 December 2008 is written "2009-W01-1".
+ ((< ordinal 1)
+ (setq year (1- year)
+ ordinal (+ ordinal (if (date-leap-year-p year)
+ 366 365))))
+ ;; Sunday 3 January 2010 is written "2009-W53-7".
+ ((> ordinal (if (date-leap-year-p year)
+ 366 365))
+ (setq ordinal (- ordinal (if (date-leap-year-p year)
+ 366 365))
+ year (1+ year))))
+ (let ((month-day (date-ordinal-to-time year ordinal)))
+ (iso8601--decoded-time :year year
+ :month (decoded-time-month month-day)
+ :day (decoded-time-day month-day)))))
+ ;; Ordinal dates: YYYY-DDD
+ ((iso8601--match iso8601--ordinal-date-match string)
+ (let* ((year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string)))
+ (ordinal (string-to-number (match-string 3 string)))
+ (month-day (date-ordinal-to-time year ordinal)))
+ (iso8601--decoded-time :year year
+ :month (decoded-time-month month-day)
+ :day (decoded-time-day month-day))))
+ (t
+ (signal 'wrong-type-argument string))))
+
+(defun iso8601--adjust-year (sign year)
+ (save-match-data
+ (let ((year (if (stringp year)
+ (string-to-number year)
+ year)))
+ (if (string= sign "-")
+ ;; -0001 is 2 BCE.
+ (1- (- year))
+ year))))
+
+(defun iso8601-parse-time (string)
+ "Parse STRING, which should be an ISO 8601 time string, and return a time
value."
+ (if (not (iso8601--match iso8601--full-time-match string))
+ (signal 'wrong-type-argument string)
+ (let ((time (match-string 1 string))
+ (zone (match-string 2 string)))
+ (if (not (iso8601--match iso8601--time-match time))
+ (signal 'wrong-type-argument string)
+ (let ((hour (string-to-number (match-string 1 time)))
+ (minute (and (match-string 2 time)
+ (string-to-number (match-string 2 time))))
+ (second (and (match-string 3 time)
+ (string-to-number (match-string 3 time))))
+ ;; Hm...
+ (_millisecond (and (match-string 4 time)
+ (string-to-number (match-string 4 time)))))
+ (iso8601--decoded-time :hour hour
+ :minute (or minute 0)
+ :second (or second 0)
+ :zone (and zone
+ (* 60 (iso8601-parse-zone
+ zone)))))))))
+
+(defun iso8601-parse-zone (string)
+ "Parse STRING, which should be an ISO 8601 time zone.
+Return the number of minutes."
+ (if (not (iso8601--match iso8601--zone-match string))
+ (signal 'wrong-type-argument string)
+ (if (match-string 2 string)
+ ;; HH:MM-ish.
+ (let ((hour (string-to-number (match-string 3 string)))
+ (minute (and (match-string 4 string)
+ (string-to-number (match-string 4 string)))))
+ (* (if (equal (match-string 2 string) "-")
+ -1
+ 1)
+ (+ (* hour 60)
+ (or minute 0))))
+ ;; "Z".
+ 0)))
+
+(defun iso8601-valid-p (string)
+ "Say whether STRING is a valid ISO 8601 representation."
+ (iso8601--match iso8601--combined-match string))
+
+(defun iso8601-parse-duration (string)
+ "Parse ISO 8601 durations on the form P3Y6M4DT12H30M5S."
+ (cond
+ ((and (iso8601--match iso8601--duration-full-match string)
+ ;; Just a "P" isn't valid; there has to be at least one
+ ;; element, like P1M.
+ (> (length (match-string 0 string)) 2))
+ (iso8601--decoded-time :year (or (match-string 1 string) 0)
+ :month (or (match-string 2 string) 0)
+ :day (or (match-string 3 string) 0)
+ :hour (or (match-string 5 string) 0)
+ :minute (or (match-string 6 string) 0)
+ :second (or (match-string 7 string) 0)))
+ ;; PnW: Weeks.
+ ((iso8601--match iso8601--duration-week-match string)
+ (let ((weeks (string-to-number (match-string 1 string))))
+ ;; Does this make sense? Hm...
+ (iso8601--decoded-time :day (* weeks 7))))
+ ;; P<date>T<time>
+ ((iso8601--match iso8601--duration-combined-match string)
+ (iso8601-parse (substring string 1)))
+ (t
+ (signal 'wrong-type-argument string))))
+
+(defun iso8601-parse-interval (string)
+ "Parse ISO 8601 intervals."
+ (let ((bits (split-string string "/"))
+ start end duration)
+ (if (not (= (length bits) 2))
+ (signal 'wrong-type-argument string)
+ ;; The intervals may be an explicit start/end times, or either a
+ ;; start or an end, and an accompanying duration.
+ (cond
+ ((and (string-match "\\`P" (car bits))
+ (iso8601-valid-p (cadr bits)))
+ (setq duration (iso8601-parse-duration (car bits))
+ end (iso8601-parse (cadr bits))))
+ ((and (string-match "\\`P" (cadr bits))
+ (iso8601-valid-p (car bits)))
+ (setq duration (iso8601-parse-duration (cadr bits))
+ start (iso8601-parse (car bits))))
+ ((and (iso8601-valid-p (car bits))
+ (iso8601-valid-p (cadr bits)))
+ (setq start (iso8601-parse (car bits))
+ end (iso8601-parse (cadr bits))))
+ (t
+ (signal 'wrong-type-argument string))))
+ (unless end
+ (setq end (decoded-time-add start duration)))
+ (unless start
+ (setq start (decoded-time-add end
+ ;; We negate the duration so that
+ ;; we get a subtraction.
+ (mapcar (lambda (elem)
+ (if (numberp elem)
+ (- elem)
+ elem))
+ duration))))
+ (list start end
+ (or duration
+ (decode-time (time-subtract (iso8601--encode-time end)
+ (iso8601--encode-time start))
+ (or (decoded-time-zone end) 0))))))
+
+(defun iso8601--match (regexp string)
+ (string-match (concat "\\`" regexp "\\'") string))
+
+(defun iso8601--value (elem &optional default)
+ (if (stringp elem)
+ (string-to-number elem)
+ (or elem default)))
+
+(cl-defun iso8601--decoded-time (&key second minute hour
+ day month year
+ dst zone)
+ (list (iso8601--value second)
+ (iso8601--value minute)
+ (iso8601--value hour)
+ (iso8601--value day)
+ (iso8601--value month)
+ (iso8601--value year)
+ nil
+ dst
+ zone))
+
+(defun iso8601--encode-time (time)
+ "Like `encode-time', but fill in nil values in TIME."
+ (setq time (copy-sequence time))
+ (unless (decoded-time-second time)
+ (setf (decoded-time-second time) 0))
+ (unless (decoded-time-minute time)
+ (setf (decoded-time-minute time) 0))
+ (unless (decoded-time-hour time)
+ (setf (decoded-time-hour time) 0))
+
+ (unless (decoded-time-day time)
+ (setf (decoded-time-day time) 1))
+ (unless (decoded-time-month time)
+ (setf (decoded-time-month time) 1))
+ (unless (decoded-time-year time)
+ (setf (decoded-time-year time) 0))
+ (encode-time time))
+
+(provide 'iso8601)
+
+;;; iso8601.el ends here
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 2c0280c..e195f71 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -36,6 +36,9 @@
;;; Code:
+(require 'cl-lib)
+(require 'subr-x)
+
(defmacro with-decoded-time-value (varlist &rest body)
"Decode a time value and bind it according to VARLIST, then eval BODY.
@@ -234,7 +237,7 @@ DATE1 and DATE2 should be date-time strings."
TIME should be a time value.
The Gregorian date Sunday, December 31, 1bce is imaginary."
(let* ((tim (decode-time time))
- (year (nth 5 tim)))
+ (year (decoded-time-year tim)))
(+ (time-date--day-in-year tim) ; Days this year
(* 365 (1- year)) ; + Days in prior years
(/ (1- year) 4) ; + Julian leap years
@@ -349,6 +352,152 @@ is output until the first non-zero unit is encountered."
(<= (car here) delay)))
(concat (format "%.2f" (/ delay (car (cddr here)))) (cadr
here))))))
+(defun date-days-in-month (year month)
+ "The number of days in MONTH in YEAR."
+ (if (= month 2)
+ (if (date-leap-year-p year)
+ 29
+ 28)
+ (if (memq month '(1 3 5 7 8 10 12))
+ 31
+ 30)))
+
+(defun date-ordinal-to-time (year ordinal)
+ "Convert a YEAR/ORDINAL to the equivalent `decoded-time' structure.
+ORDINAL is the number of days since the start of the year, with
+January 1st being 1."
+ (let ((month 1))
+ (while (> ordinal (date-days-in-month year month))
+ (setq ordinal (- ordinal (date-days-in-month year month))
+ month (1+ month)))
+ (list nil nil nil ordinal month year nil nil nil)))
+
+(defun decoded-time-add (time delta)
+ "Add DELTA to TIME, both of which are `decoded-time' structures.
+TIME should represent a time, while DELTA should only have
+non-nil integers for the values that should be altered.
+
+For instance, if you want to \"add two months\" to TIME, then
+leave all other fields but the month field in DELTA nil, and make
+the month field 2. The values in DELTA can be negative.
+
+If applying a month/year delta leaves the time spec invalid, it
+is decreased to be valid (\"add one month\" to January 31st 2019
+will yield a result of February 28th 2019 and \"add one year\" to
+February 29th 2020 will result in February 28th 2021).
+
+Fields are added in a most to least significant order, so if the
+adjustment described above happens, it happens before adding
+days, hours, minutes or seconds.
+
+When changing the time bits in TIME (i.e., second/minute/hour),
+changes in daylight saving time are not taken into account."
+ (let ((time (copy-sequence time))
+ seconds)
+ ;; Years are simple.
+ (when (decoded-time-year delta)
+ (cl-incf (decoded-time-year time) (decoded-time-year delta)))
+
+ ;; Months are pretty simple.
+ (when (decoded-time-month delta)
+ (let ((new (+ (decoded-time-month time) (decoded-time-month delta))))
+ (setf (decoded-time-month time) (mod new 12))
+ (cl-incf (decoded-time-year time) (/ new 12))))
+
+ ;; Adjust for month length (as described in the doc string).
+ (setf (decoded-time-day time)
+ (min (date-days-in-month (decoded-time-year time)
+ (decoded-time-month time))
+ (decoded-time-day time)))
+
+ ;; Days are iterative.
+ (when-let* ((days (decoded-time-day delta)))
+ (let ((increase (> days 0))
+ (days (abs days)))
+ (while (> days 0)
+ (decoded-time--alter-day time increase)
+ (cl-decf days))))
+
+ ;; Do the time part, which is pretty simple (except for leap
+ ;; seconds, I guess).
+ (setq seconds (+ (* (or (decoded-time-hour delta) 0) 3600)
+ (* (or (decoded-time-minute delta) 0) 60)
+ (or (decoded-time-second delta) 0)))
+
+ ;; Time zone adjustments are basically the same as time adjustments.
+ (setq seconds (+ seconds (or (decoded-time-zone delta) 0)))
+
+ (cond
+ ((> seconds 0)
+ (decoded-time--alter-second time seconds t))
+ ((< seconds 0)
+ (decoded-time--alter-second time (abs seconds) nil)))
+
+ time))
+
+(defun decoded-time--alter-month (time increase)
+ "Increase or decrease the month in TIME by 1."
+ (if increase
+ (progn
+ (cl-incf (decoded-time-month time))
+ (when (> (decoded-time-month time) 12)
+ (setf (decoded-time-month time) 1)
+ (cl-incf (decoded-time-year time))))
+ (cl-decf (decoded-time-month time))
+ (when (zerop (decoded-time-month time))
+ (setf (decoded-time-month time) 12)
+ (cl-decf (decoded-time-year time)))))
+
+(defun decoded-time--alter-day (time increase)
+ "Increase or decrease the day in TIME by 1."
+ (if increase
+ (progn
+ (cl-incf (decoded-time-day time))
+ (when (> (decoded-time-day time)
+ (date-days-in-month (decoded-time-year time)
+ (decoded-time-month time)))
+ (setf (decoded-time-day time) 1)
+ (decoded-time--alter-month time t)))
+ (cl-decf (decoded-time-day time))
+ (when (zerop (decoded-time-day time))
+ (decoded-time--alter-month time nil)
+ (setf (decoded-time-day time)
+ (date-days-in-month (decoded-time-year time)
+ (decoded-time-month time))))))
+
+(defun decoded-time--alter-second (time seconds increase)
+ "Increase or decrease the time in TIME by SECONDS."
+ (let ((old (+ (* (or (decoded-time-hour time) 0) 3600)
+ (* (or (decoded-time-minute time) 0) 60)
+ (or (decoded-time-second time) 0))))
+
+ (if increase
+ (progn
+ (setq old (+ old seconds))
+ (setf (decoded-time-second time) (% old 60)
+ (decoded-time-minute time) (% (/ old 60) 60)
+ (decoded-time-hour time) (% (/ old 3600) 24))
+ ;; Hm... DST...
+ (let ((days (/ old (* 60 60 24))))
+ (while (> days 0)
+ (decoded-time--alter-day time t)
+ (cl-decf days))))
+ (setq old (abs (- old seconds)))
+ (setf (decoded-time-second time) (% old 60)
+ (decoded-time-minute time) (% (/ old 60) 60)
+ (decoded-time-hour time) (% (/ old 3600) 24))
+ ;; Hm... DST...
+ (let ((days (/ old (* 60 60 24))))
+ (while (> days 0)
+ (decoded-time--alter-day time nil)
+ (cl-decf days))))))
+
+(cl-defun make-decoded-time (&key second minute hour
+ day month year
+ dst zone)
+ "Return a `decoded-time' structure with only the keywords given filled out."
+ (list second minute hour day month year nil dst zone))
+
(provide 'time-date)
;;; time-date.el ends here
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 3735115..60586e7 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -1139,9 +1139,9 @@ discrepancy, today's discrepancy, and the time worked
today."
"Given a time within a day, return 0:0:0 within that day.
If optional argument TIME is non-nil, use that instead of the current time."
(let ((decoded (decode-time time)))
- (setcar (nthcdr 0 decoded) 0)
- (setcar (nthcdr 1 decoded) 0)
- (setcar (nthcdr 2 decoded) 0)
+ (setf (decoded-time-second decoded) 0)
+ (setf (decoded-time-minute decoded) 0)
+ (setf (decoded-time-hour decoded) 0)
(encode-time decoded)))
(defun timeclock-mean (l)
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index 9d3ea17..d8d2ebc 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -22,10 +22,29 @@
;;; Code:
-(eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1))
+(eval-and-compile
+ (put 'char-fold-table 'char-table-extra-slots 1)
+ (defconst char-fold--default-include
+ '((?\" "＂" "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝" "❠" "“" "„" "〝" "〟" "🙷"
"🙶" "🙸" "«" "»")
+ (?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "" "❮" "❯" "‹" "›")
+ (?` "❛" "‘" "‛" "" "❮" "‹")
+ (?ß "ss") ;; de
+ (?ι "ΐ") ;; el for (?ΐ "ΐ") decomposition
+ (?υ "ΰ") ;; el for (?ΰ "ΰ") decomposition
+ ))
+ (defconst char-fold--default-exclude
+ '(
+ (?и "й") ;; ru
+ ))
+ (defconst char-fold--default-symmetric nil)
+ (defvar char-fold--previous
+ (list char-fold--default-include
+ char-fold--default-exclude
+ char-fold--default-symmetric)))
+
(eval-and-compile
- (defun char-fold-make-table ()
+ (defun char-fold--make-table ()
(let* ((equiv (make-char-table 'char-fold-table))
(equiv-multi (make-char-table 'char-fold-table))
(table (unicode-property-table-internal 'decomposition)))
@@ -78,6 +97,25 @@
(cons (char-to-string char)
(aref equiv (car decomp))))))))
(funcall make-decomp-match-char decomp char)
+ ;; Check to see if the first char of the decomposition
+ ;; has a further decomposition. If so, add a mapping
+ ;; back from that second decomposition to the original
+ ;; character. This allows e.g. 'ι' (GREEK SMALL LETTER
+ ;; IOTA) to match both the Basic Greek block and
+ ;; Extended Greek block variants of IOTA +
+ ;; diacritical(s). Repeat until there are no more
+ ;; decompositions.
+ (let ((dec decomp)
+ next-decomp)
+ (while dec
+ (setq next-decomp (char-table-range table (car dec)))
+ (when (consp next-decomp)
+ (when (symbolp (car next-decomp))
+ (setq next-decomp (cdr next-decomp)))
+ (if (not (eq (car dec)
+ (car next-decomp)))
+ (funcall make-decomp-match-char (list (car
next-decomp)) char)))
+ (setq dec next-decomp)))
;; Do it again, without the non-spacing characters.
;; This allows 'a' to match 'ä'.
(let ((simpler-decomp nil)
@@ -97,27 +135,76 @@
(aref equiv (car simpler-decomp)))))))))))
table)
- ;; Add some manual entries.
- (dolist (it '((?\" "＂" "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝" "❠" "“"
"„" "〝" "〟" "🙷" "🙶" "🙸" "«" "»")
- (?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "" "❮" "❯" "‹" "›")
- (?` "❛" "‘" "‛" "" "❮" "‹")))
+ ;; Add some entries to default decomposition
+ (dolist (it (or (bound-and-true-p char-fold-include)
+ char-fold--default-include))
(let ((idx (car it))
(chars (cdr it)))
(aset equiv idx (append chars (aref equiv idx)))))
+ ;; Remove some entries from default decomposition
+ (dolist (it (or (bound-and-true-p char-fold-exclude)
+ char-fold--default-exclude))
+ (let ((idx (car it))
+ (chars (cdr it)))
+ (when (aref equiv idx)
+ (dolist (char chars)
+ (aset equiv idx (remove char (aref equiv idx)))))))
+
+ ;; Add symmetric entries
+ (when (or (bound-and-true-p char-fold-symmetric)
+ char-fold--default-symmetric)
+ (let ((symmetric (make-hash-table :test 'eq)))
+ ;; Initialize hashes
+ (map-char-table
+ (lambda (char decomp-list)
+ (puthash char (make-hash-table :test 'equal) symmetric)
+ (dolist (decomp decomp-list)
+ (puthash (string-to-char decomp) (make-hash-table :test 'equal)
symmetric)))
+ equiv)
+
+ (map-char-table
+ (lambda (char decomp-list)
+ (dolist (decomp decomp-list)
+ (if (< (length decomp) 2)
+ ;; Add single-char symmetric pairs to hash
+ (let ((decomp-list (cons (char-to-string char) decomp-list))
+ (decomp-hash (gethash (string-to-char decomp)
symmetric)))
+ (dolist (decomp2 decomp-list)
+ (unless (equal decomp decomp2)
+ (puthash decomp2 t decomp-hash)
+ (puthash decomp t (gethash (string-to-char decomp2)
symmetric)))))
+ ;; Add multi-char symmetric pairs to equiv-multi char-table
+ (let ((decomp-list (cons (char-to-string char) decomp-list))
+ (prefix (string-to-char decomp))
+ (suffix (substring decomp 1)))
+ (puthash decomp t (gethash char symmetric))
+ (dolist (decomp2 decomp-list)
+ (if (< (length decomp2) 2)
+ (aset equiv-multi prefix
+ (cons (cons suffix (regexp-quote decomp2))
+ (aref equiv-multi prefix)))))))))
+ equiv)
+
+ ;; Update equiv char-table from hash
+ (maphash
+ (lambda (char decomp-hash)
+ (let (schars)
+ (maphash (lambda (schar _) (push schar schars)) decomp-hash)
+ (aset equiv char schars)))
+ symmetric)))
+
;; Convert the lists of characters we compiled into regexps.
(map-char-table
(lambda (char decomp-list)
(let ((re (regexp-opt (cons (char-to-string char) decomp-list))))
- (if (consp char) ; FIXME: char never is consp?
- (set-char-table-range equiv char re)
- (aset equiv char re))))
+ (aset equiv char re)))
equiv)
equiv)))
(defconst char-fold-table
(eval-when-compile
- (char-fold-make-table))
+ (char-fold--make-table))
"Used for folding characters of the same group during search.
This is a char-table with the `char-fold-table' subtype.
@@ -140,6 +227,62 @@ For instance, the default alist for ?f includes:
Exceptionally for the space character (32), ALIST is ignored.")
+
+(defun char-fold-update-table ()
+ "Update char-fold-table only when one of the options changes its value."
+ (let ((new (list (or (bound-and-true-p char-fold-include)
+ char-fold--default-include)
+ (or (bound-and-true-p char-fold-exclude)
+ char-fold--default-exclude)
+ (or (bound-and-true-p char-fold-symmetric)
+ char-fold--default-symmetric))))
+ (unless (equal char-fold--previous new)
+ (setq char-fold-table (char-fold--make-table)
+ char-fold--previous new))))
+
+(defcustom char-fold-include char-fold--default-include
+ "Additional character foldings to include.
+Each entry is a list of a character and the strings that fold into it."
+ :type '(alist :key-type (character :tag "Fold to character")
+ :value-type (repeat (string :tag "Fold from string")))
+ :initialize #'custom-initialize-default
+ :set (lambda (sym val)
+ (custom-set-default sym val)
+ (char-fold-update-table))
+ :group 'isearch
+ :version "27.1")
+
+(defcustom char-fold-exclude char-fold--default-exclude
+ "Character foldings to remove from default decompisitions.
+Each entry is a list of a character and the strings to remove from folding."
+ :type '(alist :key-type (character :tag "Fold to character")
+ :value-type (repeat (string :tag "Fold from string")))
+ :initialize #'custom-initialize-default
+ :set (lambda (sym val)
+ (custom-set-default sym val)
+ (char-fold-update-table))
+ :group 'isearch
+ :version "27.1")
+
+(defcustom char-fold-symmetric char-fold--default-symmetric
+ "Non-nil means char-fold searching treats equivalent chars the same.
+That is, use of any of a set of char-fold equivalent chars in a search
+string finds any of them in the text being searched.
+
+If nil then only the \"base\" or \"canonical\" char of the set matches
+any of them. The others match only themselves, even when char-folding
+is turned on."
+ :type 'boolean
+ :initialize #'custom-initialize-default
+ :set (lambda (sym val)
+ (custom-set-default sym val)
+ (char-fold-update-table))
+ :group 'isearch
+ :version "27.1")
+
+(char-fold-update-table)
+
+
(defun char-fold--make-space-string (n)
"Return a string that matches N spaces."
(format "\\(?:%s\\|%s\\)"
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 8be2b94..ba53aeb 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -88,8 +88,6 @@ into help buttons that call `describe-text-category' or
(insert-text-button
(format "%S" value)
'type 'help-face 'help-args (list value)))
- ((widgetp value)
- (describe-text-widget value))
(t
(describe-text-sexp value))))
(insert "\n")))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6a1ebcc..30a941c 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -981,7 +981,7 @@ command with a prefix argument (the value does not matter)."
(goto-char start)
;; Now replace the current line with an entry for NEW-FILE.
(dired-update-file-line new-file) nil)
- (dired-log (concat "Failed to compress" from-file))
+ (dired-log (concat "Failed to (un)compress " from-file))
from-file)))
(defvar dired-compress-file-suffixes
@@ -1898,7 +1898,14 @@ Optional arg HOW-TO determines how to treat the target.
(set (make-local-variable
'minibuffer-default-add-function) nil)
(setq minibuffer-default defaults))
(dired-mark-read-file-name
- (concat (if dired-one-file op1 operation) " %s to: ")
+ (format "%s %%s %s: "
+ (if dired-one-file op1 operation)
+ (if (memq op-symbol '(symlink hardlink))
+ ;; Linking operations create links
+ ;; from the prompted file name; the
+ ;; other operations copy (etc) to the
+ ;; prompted file name.
+ "from" "to"))
target-dir op-symbol arg rfn-list default))))
(into-dir
(progn
diff --git a/lisp/dired.el b/lisp/dired.el
index c455a5c..d47393b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -340,6 +340,8 @@ The directory name must be absolute, but need not be fully
expanded.")
;; DOS/Windows-style drive letters in directory names, like in "d:/foo".
(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
+(defvar dired-re-socket (concat dired-re-maybe-mark dired-re-inode-size
+ "[bcsp][^:]"))
(defvar dired-re-exe;; match ls permission string of an executable file
(mapconcat (lambda (x)
(concat dired-re-maybe-mark dired-re-inode-size x))
@@ -445,6 +447,12 @@ Subexpression 2 must end right before the \\n.")
(defvar dired-symlink-face 'dired-symlink
"Face name used for symbolic links.")
+(defface dired-socket
+ '((t (:inherit font-lock-variable-name-face)))
+ "Face used for sockets, pipes, block devices and char devices."
+ :group 'dired-faces
+ :version "27.1")
+
(defface dired-ignored
'((t (:inherit shadow)))
"Face used for files suffixed with `completion-ignored-extensions'."
@@ -500,6 +508,10 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-sym
'(".+" (dired-move-to-filename) nil (0 dired-symlink-face)))
;;
+ ;; Sockets, pipes, block devices, char devices.
+ (list dired-re-socket
+ '(".+" (dired-move-to-filename) nil (0 'dired-socket)))
+ ;;
;; Files suffixed with `completion-ignored-extensions'.
'(eval .
;; It is quicker to first find just an extension, then go back to the
@@ -3314,7 +3326,7 @@ or \"* [3 files]\"."
(defun dired-pop-to-buffer (buf)
"Pop up buffer BUF in a way suitable for Dired."
- (declare (obsolete dired-mark-pop-up "24.3"))
+ (declare (obsolete pop-to-buffer "24.3"))
(let ((split-window-preferred-function
(lambda (window)
(or (and (let ((split-height-threshold 0))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index fa2c6cd..541b22e 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1125,7 +1125,10 @@ write its autoloads into the specified file instead."
;; Elements remaining in FILES have no existing autoload sections yet.
(let ((no-autoloads-time (or last-time '(0 0 0 0)))
(progress (make-progress-reporter
- (byte-compile-info-string "Scraping files for
autoloads")
+ (byte-compile-info-string
+ (concat "Scraping files for "
+ (file-relative-name
+ generated-autoload-file)))
0 (length files) nil 10))
(file-count 0)
file-time)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 125344b..6dcd4c6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2780,7 +2780,11 @@ If FORM is a lambda or a macro, byte-compile it as a
function."
(setq fun (byte-compile-top-level fun nil 'eval))
(if macro (push 'macro fun))
(if (symbolp form)
- (fset form fun)
+ ;; byte-compile-top-level returns an *expression* equivalent to the
+ ;; `fun' expression, so we need to evaluate it, tho normally
+ ;; this is not needed because the expression is just a constant
+ ;; byte-code object, which is self-evaluating.
+ (fset form (eval fun t))
fun)))))))
(defun byte-compile-sexp (sexp)
@@ -2982,7 +2986,6 @@ for symbols generated by the byte compiler itself."
lexenv reserved-csts)
;; OUTPUT-TYPE advises about how form is expected to be used:
;; 'eval or nil -> a single form,
- ;; 'progn or t -> a list of forms,
;; 'lambda -> body of a lambda,
;; 'file -> used at file-level.
(let ((byte-compile--for-effect for-effect)
@@ -3013,6 +3016,7 @@ for symbols generated by the byte compiler itself."
(byte-compile-out-toplevel byte-compile--for-effect output-type)))
(defun byte-compile-out-toplevel (&optional for-effect output-type)
+ ;; OUTPUT-TYPE can be like that of `byte-compile-top-level'.
(if for-effect
;; The stack is empty. Push a value to be returned from (byte-code ..).
(if (eq (car (car byte-compile-output)) 'byte-discard)
@@ -3041,12 +3045,8 @@ for symbols generated by the byte compiler itself."
;; Note that even (quote foo) must be parsed just as any subr by the
;; interpreter, so quote should be compiled into byte-code in some contexts.
;; What to leave uncompiled:
- ;; lambda -> never. we used to leave it uncompiled if the body was
- ;; a single atom, but that causes confusion if the docstring
- ;; uses the (file . pos) syntax. Besides, now that we have
- ;; the Lisp_Compiled type, the compiled form is faster.
+ ;; lambda -> never. The compiled form is always faster.
;; eval -> atom, quote or (function atom atom atom)
- ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
;; file -> as progn, but takes both quotes and atoms, and longer forms.
(let (rest
(maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
@@ -3076,8 +3076,9 @@ for symbols generated by the byte compiler itself."
(null (nthcdr 3 rest))
(setq tmp (get (car (car rest)) 'byte-opcode-invert))
(or (null (cdr rest))
- (and (memq output-type '(file progn t))
+ (and (eq output-type 'file)
(cdr (cdr rest))
+ (eql (length body) (cdr (car rest))) ;bug#34757
(eq (car (nth 1 rest)) 'byte-discard)
(progn (setq rest (cdr rest)) t))))
(setq maycall nil) ; Only allow one real function call.
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index f014f8e..7b22fa8 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -189,12 +189,16 @@ that the containing function should return.
\(fn &rest VALUES)")
-(cl--defalias 'cl-values-list #'identity
+(defun cl-values-list (list)
"Return multiple values, Common Lisp style, taken from a list.
-LIST specifies the list of values
-that the containing function should return.
-
-\(fn LIST)")
+LIST specifies the list of values that the containing function
+should return.
+
+Note that Emacs Lisp doesn't really support multiple values, so
+all this function does is return LIST."
+ (unless (listp list)
+ (signal 'wrong-type-argument list))
+ list)
(defsubst cl-multiple-value-list (expression)
"Return a list of the multiple values produced by EXPRESSION.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 4347b4b..1ae7266 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -695,8 +695,11 @@ its argument list allows full Common Lisp conventions."
"Bind the variables in ARGS to the result of EXPR and execute BODY."
(declare (indent 2)
(debug (&define cl-macro-list1 def-form cl-declarations def-body)))
- (let* ((cl--bind-lets nil) (cl--bind-forms nil)
- (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
+ (let* ((cl--bind-lets nil)
+ (cl--bind-forms nil)
+ (cl--bind-defs nil)
+ (cl--bind-block args)
+ (cl--bind-enquote nil))
(cl--do-arglist (or args '(&aux)) expr)
(macroexp-let* (nreverse cl--bind-lets)
(macroexp-progn (append (nreverse cl--bind-forms) body)))))
@@ -2719,8 +2722,10 @@ node `(cl)Structures' for the description of the options.
Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
pairs for that slot.
-Currently, only one keyword is supported, `:read-only'. If this has a
-non-nil value, that slot cannot be set via `setf'.
+Supported keywords for slots are:
+- `:read-only': If this has a non-nil value, that slot cannot be set via
`setf'.
+- `:documentation': this is a docstring describing the slot.
+- `:type': the type of the field; currently unused.
\(fn NAME &optional DOCSTRING &rest SLOTS)"
(declare (doc-string 2) (indent 1)
@@ -2899,14 +2904,17 @@ non-nil value, that slot cannot be set via `setf'.
defaults))
(if (assq slot descp)
(error "Duplicate slots named %s in %s" slot name))
- (let ((accessor (intern (format "%s%s" conc-name slot))))
+ (let ((accessor (intern (format "%s%s" conc-name slot)))
+ (default-value (pop desc))
+ (doc (plist-get desc :documentation)))
(push slot slots)
- (push (pop desc) defaults)
+ (push default-value defaults)
;; The arg "cl-x" is referenced by name in eg pred-form
;; and pred-check, so changing it is not straightforward.
(push `(,defsym ,accessor (cl-x)
- ,(format "Access slot \"%s\" of `%s' struct CL-X."
- slot name)
+ ,(format "Access slot \"%s\" of `%s' struct CL-X.%s"
+ slot name
+ (if doc (concat "\n" doc) ""))
(declare (side-effect-free t))
,@(and pred-check
(list `(or ,pred-check
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 6db0584..a6578e3 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -113,9 +113,9 @@
;;;###autoload
(defmacro define-derived-mode (child parent name &optional docstring &rest
body)
- "Create a new mode as a variant of an existing mode.
+ "Create a new mode CHILD which is a variant of an existing mode PARENT.
-The arguments to this command are as follow:
+The arguments are as follows:
CHILD: the name of the command for the derived mode.
PARENT: the name of the command for the parent mode (e.g. `text-mode')
@@ -123,24 +123,28 @@ PARENT: the name of the command for the parent mode
(e.g. `text-mode')
NAME: a string which will appear in the status line (e.g. \"Hypertext\")
DOCSTRING: an optional documentation string--if you do not supply one,
the function will attempt to invent something useful.
+KEYWORD-ARGS:
+ optional arguments in the form of pairs of keyword and value.
+ The following keyword arguments are currently supported:
+
+ :group GROUP
+ Declare the customization group that corresponds
+ to this mode. The command `customize-mode' uses this.
+ :syntax-table TABLE
+ Use TABLE instead of the default (CHILD-syntax-table).
+ A nil value means to simply use the same syntax-table
+ as the parent.
+ :abbrev-table TABLE
+ Use TABLE instead of the default (CHILD-abbrev-table).
+ A nil value means to simply use the same abbrev-table
+ as the parent.
+ :after-hook FORM
+ A single lisp form which is evaluated after the mode
+ hooks have been run. It should not be quoted.
+
BODY: forms to execute just before running the
hooks for the new mode. Do not use `interactive' here.
-BODY can start with a bunch of keyword arguments. The following keyword
- arguments are currently understood:
-:group GROUP
- Declare the customization group that corresponds to this mode.
- The command `customize-mode' uses this.
-:syntax-table TABLE
- Use TABLE instead of the default (CHILD-syntax-table).
- A nil value means to simply use the same syntax-table as the parent.
-:abbrev-table TABLE
- Use TABLE instead of the default (CHILD-abbrev-table).
- A nil value means to simply use the same abbrev-table as the parent.
-:after-hook FORM
- A single lisp form which is evaluated after the mode hooks have been
- run. It should not be quoted.
-
Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
(define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
@@ -149,7 +153,7 @@ You could then make new key bindings for
`LaTeX-thesis-mode-map'
without changing regular LaTeX mode. In this example, BODY is empty,
and DOCSTRING is generated by default.
-On a more complicated level, the following command uses `sgml-mode' as
+As a more complex example, the following command uses `sgml-mode' as
the parent, and then sets the variable `case-fold-search' to nil:
(define-derived-mode article-mode sgml-mode \"Article\"
@@ -162,7 +166,9 @@ been generated automatically, with a reference to the
keymap.
The new mode runs the hook constructed by the function
`derived-mode-hook-name'.
-See Info node `(elisp)Derived Modes' for more details."
+See Info node `(elisp)Derived Modes' for more details.
+
+\(fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)"
(declare (debug (&define name symbolp sexp [&optional stringp]
[&rest keywordp sexp] def-body))
(doc-string 4)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index ab5553b..c898da3 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -41,7 +41,7 @@
;; See the Emacs Lisp Reference Manual for more details.
;; If you wish to change the default edebug global command prefix, change:
-;; (setq edebug-global-prefix "\C-xX")
+;; (setq global-edebug-prefix "\C-xX")
;; Edebug was written by
;; Daniel LaLiberte
@@ -1428,7 +1428,7 @@ contains a circular object."
;; Create initial coverage vector.
;; Only need one per expression, but it is simpler to use stop points.
(put name 'edebug-coverage
- (make-vector (length edebug-offset-list) 'unknown)))
+ (make-vector (length edebug-offset-list) 'edebug-unknown)))
(defun edebug-form (cursor)
@@ -2470,12 +2470,12 @@ See `edebug-behavior-alist' for implementations.")
(defun edebug--update-coverage (after-index value)
(let ((old-result (aref edebug-coverage after-index)))
(cond
- ((eq 'ok-coverage old-result))
- ((eq 'unknown old-result)
+ ((eq 'edebug-ok-coverage old-result))
+ ((eq 'edebug-unknown old-result)
(aset edebug-coverage after-index value))
;; Test if a different result.
((not (eq value old-result))
- (aset edebug-coverage after-index 'ok-coverage)))))
+ (aset edebug-coverage after-index 'edebug-ok-coverage)))))
;; Dynamically declared unbound variables.
@@ -4204,7 +4204,7 @@ reinstrument it."
(max 0 (- col (- (point) start-of-count-line))) ?\s)
(if (and (< 0 count)
(not (memq coverage
- '(unknown ok-coverage))))
+ '(edebug-unknown edebug-ok-coverage))))
"=" "")
(if (= count last-count) "" (int-to-string count))
" ")
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index c90c06d..da241e6 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1351,15 +1351,13 @@ Returns the stats object."
(let ((unexpected (ert-stats-completed-unexpected stats))
(skipped (ert-stats-skipped stats))
(expected-failures (ert--stats-failed-expected stats)))
- (message "\n%sRan %s tests, %s results as expected%s%s (%s, %f
sec)%s\n"
+ (message "\n%sRan %s tests, %s results as expected, %s
unexpected%s (%s, %f sec)%s\n"
(if (not abortedp)
""
"Aborted: ")
(ert-stats-total stats)
(ert-stats-completed-expected stats)
- (if (zerop unexpected)
- ""
- (format ", %s unexpected" unexpected))
+ unexpected
(if (zerop skipped)
""
(format ", %s skipped" skipped))
@@ -1505,9 +1503,10 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
(setq nrun (+ nrun (string-to-number (match-string 2)))
nexpected (+ nexpected (string-to-number (match-string 3))))
(when (match-string 4)
- (push logfile unexpected)
- (setq nunexpected (+ nunexpected
- (string-to-number (match-string 4)))))
+ (let ((n (string-to-number (match-string 4))))
+ (unless (zerop n)
+ (push logfile unexpected)
+ (setq nunexpected (+ nunexpected n)))))
(when (match-string 5)
(push logfile skipped)
(setq nskipped (+ nskipped
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index dc54342..a9bb311 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -75,6 +75,8 @@ symbol, and each cdr is the same symbol without the `.'."
;; Return the cons cell inside a list, so it can be appended
;; with other results in the clause below.
(list (cons data (intern (replace-match "" nil nil name)))))))
+ ((vectorp data)
+ (apply #'nconc (mapcar #'let-alist--deep-dot-search data)))
((not (consp data)) nil)
((eq (car data) 'let-alist)
;; For nested ‘let-alist’ forms, ignore symbols appearing in the
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index 1486aeb..a84c63d 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -281,6 +281,7 @@ destination, prompt for one."
(let ((pkg-desc (package-buffer-info)))
(package-upload-buffer-internal pkg-desc "el")))))
+;;;###autoload
(defun package-upload-file (file)
"Upload the Emacs Lisp package FILE to the package archive.
Interactively, prompt for FILE. The package is considered a
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 53fa15d..e7e0bd1 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -151,6 +151,7 @@
(require 'tabulated-list)
(require 'macroexp)
(require 'url-handlers)
+(require 'browse-url)
(defgroup package nil
"Manager for Emacs Lisp packages."
@@ -331,15 +332,13 @@ default directory."
:risky t
:version "26.1")
-(defcustom package-check-signature
- (if (and (require 'epg-config)
- (epg-find-configuration 'OpenPGP))
- 'allow-unsigned)
+(defcustom package-check-signature 'allow-unsigned
"Non-nil means to check package signatures when installing.
More specifically the value can be:
- nil: package signatures are ignored.
-- `allow-unsigned': install a package even if it is unsigned,
- but if it is signed and we have the key for it, verify the signature.
+- `allow-unsigned': install a package even if it is unsigned, but
+ if it is signed, we have the key for it, and OpenGPG is
+ installed, verify the signature.
- t: accept a package only if it comes with at least one verified signature.
- `all': same as t, except when the package has several signatures,
in which case we verify all the signatures.
@@ -353,6 +352,18 @@ contents of the archive."
:risky t
:version "27.1")
+(defun package-check-signature ()
+ "Check whether we have a usable OpenPGP configuration.
+If true, and `package-check-signature' is `allow-unsigned',
+return `allow-unsigned', otherwise return the value of
+`package-check-signature'."
+ (if (eq package-check-signature 'allow-unsigned)
+ (progn
+ (require 'epg-config)
+ (and (epg-find-configuration 'OpenPGP)
+ 'allow-unsigned))
+ package-check-signature))
+
(defcustom package-unsigned-archives nil
"List of archives where we do not check for package signatures."
:type '(repeat (string :tag "Archive name"))
@@ -1279,15 +1290,15 @@ errors."
(dolist (sig (epg-context-result-for context 'verify))
(if (eq (epg-signature-status sig) 'good)
(push sig good-signatures)
- ;; If package-check-signature is allow-unsigned, don't
+ ;; If `package-check-signature' is allow-unsigned, don't
;; signal error when we can't verify signature because of
;; missing public key. Other errors are still treated as
;; fatal (bug#17625).
- (unless (and (eq package-check-signature 'allow-unsigned)
+ (unless (and (eq (package-check-signature) 'allow-unsigned)
(eq (epg-signature-status sig) 'no-pubkey))
(setq had-fatal-error t))))
(when (or (null good-signatures)
- (and (eq package-check-signature 'all)
+ (and (eq (package-check-signature) 'all)
had-fatal-error))
(package--display-verify-error context sig-file)
(signal 'bad-signature (list sig-file)))
@@ -1318,7 +1329,7 @@ else, even if an error is signaled."
:async async :noerror t
;; Connection error is assumed to mean "no sig-file".
:error-form (let ((allow-unsigned
- (eq package-check-signature 'allow-unsigned)))
+ (eq (package-check-signature) 'allow-unsigned)))
(when (and callback allow-unsigned)
(funcall callback nil))
(when unwind (funcall unwind))
@@ -1602,7 +1613,7 @@ similar to an entry in `package-alist'. Save the cached
copy to
(local-file (expand-file-name file dir)))
(when (listp (read content))
(make-directory dir t)
- (if (or (not package-check-signature)
+ (if (or (not (package-check-signature))
(member name package-unsigned-archives))
;; If we don't care about the signature, save the file and
;; we're done.
@@ -1654,7 +1665,7 @@ downloads in the background."
(let ((default-keyring (expand-file-name "package-keyring.gpg"
data-directory))
(inhibit-message (or inhibit-message async)))
- (when (and package-check-signature (file-exists-p default-keyring))
+ (when (and (package-check-signature) (file-exists-p default-keyring))
(condition-case-unless-debug error
(package-import-keyring default-keyring)
(error (message "Cannot import default keyring: %S" (cdr error))))))
@@ -1901,7 +1912,7 @@ if all the in-between dependencies are also in
PACKAGE-LIST."
(file (concat (package-desc-full-name pkg-desc)
(package-desc-suffix pkg-desc))))
(package--with-response-buffer location :file file
- (if (or (not package-check-signature)
+ (if (or (not (package-check-signature))
(member (package-desc-archive pkg-desc)
package-unsigned-archives))
;; If we don't care about the signature, unpack and we're
@@ -2494,44 +2505,47 @@ The description is read from the installed package
files."
(insert "\n")
- (if built-in
- ;; For built-in packages, get the description from the
- ;; Commentary header.
- (let ((fn (locate-file (format "%s.el" name) load-path
- load-file-rep-suffixes))
- (opoint (point)))
- (insert (or (lm-commentary fn) ""))
- (save-excursion
- (goto-char opoint)
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))))
-
- (if (package-installed-p desc)
- ;; For installed packages, get the description from the
- ;; installed files.
- (insert (package--get-description desc))
-
- ;; For non-built-in, non-installed packages, get description from
- ;; the archive.
- (let* ((basename (format "%s-readme.txt" name))
- readme-string)
-
- (package--with-response-buffer (package-archive-base desc)
- :file basename :noerror t
+ (let ((start-of-description (point)))
+ (if built-in
+ ;; For built-in packages, get the description from the
+ ;; Commentary header.
+ (let ((fn (locate-file (format "%s.el" name) load-path
+ load-file-rep-suffixes))
+ (opoint (point)))
+ (insert (or (lm-commentary fn) ""))
(save-excursion
- (goto-char (point-max))
- (unless (bolp)
- (insert ?\n)))
- (cl-assert (not enable-multibyte-characters))
- (setq readme-string
- ;; The readme.txt files are defined to contain utf-8 text.
- (decode-coding-region (point-min) (point-max) 'utf-8 t))
- t)
- (insert (or readme-string
- "This package does not provide a description.")))
- ))))
+ (goto-char opoint)
+ (when (re-search-forward "^;;; Commentary:\n" nil t)
+ (replace-match ""))
+ (while (re-search-forward "^\\(;+ ?\\)" nil t)
+ (replace-match ""))))
+
+ (if (package-installed-p desc)
+ ;; For installed packages, get the description from the
+ ;; installed files.
+ (insert (package--get-description desc))
+
+ ;; For non-built-in, non-installed packages, get description from
+ ;; the archive.
+ (let* ((basename (format "%s-readme.txt" name))
+ readme-string)
+
+ (package--with-response-buffer (package-archive-base desc)
+ :file basename :noerror t
+ (save-excursion
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert ?\n)))
+ (cl-assert (not enable-multibyte-characters))
+ (setq readme-string
+ ;; The readme.txt files are defined to contain utf-8 text.
+ (decode-coding-region (point-min) (point-max) 'utf-8 t))
+ t)
+ (insert (or readme-string
+ "This package does not provide a description.")))))
+ ;; Make URLs in the description into links.
+ (goto-char start-of-description)
+ (browse-url-add-buttons))))
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
@@ -3533,10 +3547,16 @@ shown."
(defun package-menu-filter (keyword)
"Filter the *Packages* buffer.
Show only those items that relate to the specified KEYWORD.
+
KEYWORD can be a string or a list of strings. If it is a list, a
package will be displayed if it matches any of the keywords.
Interactively, it is a list of strings separated by commas.
+KEYWORD can also be used to filter by status or archive name by
+using keywords like \"arc:gnu\" and \"status:available\".
+Statuses available include \"incompat\", \"available\",
+\"built-in\" and \"installed\".
+
To restore the full package list, type `q'."
(interactive
(list (completing-read-multiple
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 1b94aa8..2085180 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -246,7 +246,7 @@ BEFORE-INDEX is the form's index into the code-coverage
vector."
(let ((before-entry (aref testcover-vector before-index)))
(when (eq (car-safe before-entry) 'noreturn)
(let* ((after-index (cdr before-entry)))
- (aset testcover-vector after-index 'ok-coverage)))))
+ (aset testcover-vector after-index 'edebug-ok-coverage)))))
(defun testcover-after (_before-index after-index value)
"Update code coverage with the result of a form's evaluation.
@@ -254,10 +254,10 @@ AFTER-INDEX is the form's index into the code-coverage
vector. Return VALUE."
(let ((old-result (aref testcover-vector after-index)))
(cond
- ((eq 'unknown old-result)
+ ((eq 'edebug-unknown old-result)
(aset testcover-vector after-index (testcover--copy-object value)))
((eq 'maybe old-result)
- (aset testcover-vector after-index 'ok-coverage))
+ (aset testcover-vector after-index 'edebug-ok-coverage))
((eq '1value old-result)
(aset testcover-vector after-index
(cons old-result (testcover--copy-object value))))
@@ -271,7 +271,7 @@ vector. Return VALUE."
((not (condition-case ()
(equal value old-result)
(circular-list nil)))
- (aset testcover-vector after-index 'ok-coverage))))
+ (aset testcover-vector after-index 'edebug-ok-coverage))))
value)
;; Add these behaviors to Edebug.
@@ -356,13 +356,13 @@ eliminated by adding more test cases."
(while (> len 0)
(setq len (1- len)
data (aref coverage len))
- (when (and (not (eq data 'ok-coverage))
+ (when (and (not (eq data 'edebug-ok-coverage))
(not (memq (car-safe data)
'(1value maybe noreturn)))
(setq j (+ def-mark (aref points len))))
(setq ov (make-overlay (1- j) j))
(overlay-put ov 'face
- (if (memq data '(unknown maybe 1value))
+ (if (memq data '(edebug-unknown maybe 1value))
'testcover-nohits
'testcover-1value))))
(set-buffer-modified-p changed))))
@@ -410,7 +410,7 @@ coverage tests. This function creates many overlays."
;; identified and treated correctly.
;;
;; The code coverage vector entries for the beginnings of forms will
-;; be changed to `ok-coverage.', except for the beginnings of forms
+;; be changed to `edebug-ok-coverage.', except for the beginnings of forms
;; which should never return, which will be changed to
;; (noreturn . AFTER-INDEX) so that testcover-before can set the entry
;; for the end of the form just before it is executed.
@@ -513,7 +513,7 @@ where BEFORE-FORM is bound to either (edebug-before
BEFORE-ID) or
form to be treated accordingly."
(let (val)
(unless (eql before-form 0)
- (aset testcover-vector before-id 'ok-coverage))
+ (aset testcover-vector before-id 'edebug-ok-coverage))
(setq val (testcover-analyze-coverage-wrapped-form wrapped-form))
(when (or (eq wrapper '1value) val)
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 22ccc35..400f00a 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -375,8 +375,11 @@ This function returns a timer object which you can use in
(now (decode-time)))
(if (>= hhmm 0)
(setq time
- (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
- (nth 4 now) (nth 5 now) (nth 8 now)))))))
+ (encode-time 0 (% hhmm 100) (/ hhmm 100)
+ (decoded-time-day now)
+ (decoded-time-month now)
+ (decoded-time-year now)
+ (decoded-time-zone now)))))))
(or (consp time)
(error "Invalid time format"))
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index bb323e5..5549068 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -44,9 +44,18 @@
(defcustom epg-gpg-program (if (executable-find "gpg2")
"gpg2"
"gpg")
- "The `gpg' executable.
-Setting this variable directly does not take effect;
-instead use \\[customize] (see the info node `Easy Customization')."
+ "Say what gpg program to prefer (if it satisfies minimum requirements).
+
+If this variable is \"gpg2\", but the version of gpg2 installed
+is less than `epg-gpg2-minimum-version', then version 1 of
+GnuPG (i.e., \"gpg\") will be used instead. If the version of
+version 1 is less than `epg-gpg-minimum-version', then that won't
+be used either.
+
+If you want to explicitly specify what gpg program to use, you
+have to use \\[customize] instead (see the info node `Easy
+Customization'). Setting this variable without \\[customize] has
+no effect."
:version "25.1"
:type 'string)
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 89969d3..b1aab79 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -525,12 +525,14 @@ whose cdr is the list of file attributes."
" " (format-time-string
(concat
eshell-ls-date-format " "
- (if (= (nth 5 (decode-time))
- (nth 5 (decode-time
- (nth (cond
- ((eq sort-method 'by-atime) 4)
- ((eq sort-method 'by-ctime) 6)
- (t 5)) attrs))))
+ (if (= (decoded-time-year (decode-time))
+ (decoded-time-year
+ (decode-time
+ (nth (cond
+ ((eq sort-method 'by-atime) 4)
+ ((eq sort-method 'by-ctime) 6)
+ (t 5))
+ attrs))))
"%H:%M"
" %Y")) (nth (cond
((eq sort-method 'by-atime) 4)
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index 4a3b84e..6970dfc8 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -90,7 +90,6 @@ This includes when running `eshell-command'."
(defun eshell-source-file (file &optional args subcommand-p)
"Execute a series of Eshell commands in FILE, passing ARGS.
Comments begin with `#'."
- (interactive "f")
(let ((orig (point))
(here (point-max))
(inhibit-point-motion-hooks t))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index fe8eb35..4835e63 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -654,7 +654,7 @@ If NOSORT is non-nil, the list is not sorted--its order is
unpredictable.
(match-string 6))))
(if (nth 0 moment)
(setcar (nthcdr 5 moment)
- (nth 5 (decode-time)))
+ (decoded-time-year (decode-time)))
(setcar (nthcdr 0 moment) 0)
(setcar (nthcdr 1 moment) 0)
(setcar (nthcdr 2 moment) 0))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 47ceed4..33854a6 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1081,9 +1081,9 @@ If a given RFC isn't in these then `ffap-rfc-path' is
offered."
'(
;; The default, used when the `major-mode' is not found.
;; Slightly controversial decisions:
- ;; * strip trailing "@" and ":"
+ ;; * strip trailing "@", ":" and enclosing "{"/"}".
;; * no commas (good for latex)
- (file "--:\\\\${}+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
+ (file "--:\\\\${}+<>@-Z_[:alpha:]~*?" "{<@" "@>;.,!:}")
;; An url, or maybe an email/news message-id:
(url "--:=&?$+@-Z_[:alpha:]~#,%;*()!'" "^[0-9a-zA-Z]" ":;.,!?")
;; Find a string that does *not* contain a colon:
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index d77046d..e5dc353 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -105,175 +105,225 @@ Otherwise, signal a `file-notify-error'."
(signal 'file-notify-error
(cons "Not a valid file-notify event" event))))
-;; Needed for `inotify' and `w32notify'. In the latter case, COOKIE is nil.
-(defvar file-notify--pending-event nil
- "A pending file notification event for a future `renamed' action.
-It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
-
-(defun file-notify--event-watched-file (event)
- "Return file or directory being watched.
-Could be different from the directory watched by the backend library."
- (when-let* ((watch (gethash (car event) file-notify-descriptors)))
- (file-notify--watch-absolute-filename watch)))
-
-(defun file-notify--event-file-name (event)
- "Return file name of file notification event, or nil."
- (when-let* ((watch (gethash (car event) file-notify-descriptors)))
- (directory-file-name
- (expand-file-name
- (or (and (stringp (nth 2 event)) (nth 2 event)) "")
- (file-notify--watch-directory watch)))))
-
-;; Only `gfilenotify' could return two file names.
-(defun file-notify--event-file1-name (event)
- "Return second file name of file notification event, or nil.
-This is available in case a file has been moved."
- (when-let* ((watch (gethash (car event) file-notify-descriptors)))
- (and (stringp (nth 3 event))
- (directory-file-name
- (expand-file-name
- (nth 3 event) (file-notify--watch-directory watch))))))
-
-;; Cookies are offered by `inotify' only.
-(defun file-notify--event-cookie (event)
- "Return cookie of file notification event, or nil.
-This is available in case a file has been moved."
- (nth 3 event))
-
-;; The callback function used to map between specific flags of the
-;; respective file notifications, and the ones we return.
-(defun file-notify-callback (event)
- "Handle an EVENT returned from file notification.
-EVENT is the cadr of the event in `file-notify-handle-event'
-\(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."
- (let* ((desc (car event))
- (watch (gethash desc file-notify-descriptors))
- (actions (nth 1 event))
- (file (file-notify--event-file-name event))
- file1 pending-event stopped)
-
- ;; Make actions a list.
- (unless (consp actions) (setq actions (cons actions nil)))
-
+(cl-defstruct (file-notify--rename
+ (:constructor nil)
+ (:constructor
+ file-notify--rename-make (watch desc from-file cookie)))
+ watch desc from-file cookie)
+
+(defvar file-notify--pending-rename nil
+ "A pending rename event awaiting the destination file name.
+It is nil or a `file-notify--rename' where the cookie can be nil.")
+
+(defun file-notify--expand-file-name (watch file)
+ "Full file name of FILE reported for WATCH."
+ (directory-file-name
+ (expand-file-name file (file-notify--watch-directory watch))))
+
+(cl-defun file-notify--callback-inotify ((desc actions file
+ &optional file1-or-cookie))
+ "Notification callback for inotify."
+ (file-notify--handle-event
+ desc
+ (delq nil (mapcar (lambda (action)
+ (cond
+ ((eq action 'create) 'created)
+ ((eq action 'modify) 'changed)
+ ((eq action 'attrib) 'attribute-changed)
+ ((memq action '(delete delete-self move-self))
'deleted)
+ ((eq action 'moved-from) 'renamed-from)
+ ((eq action 'moved-to) 'renamed-to)
+ ((eq action 'ignored) 'stopped)))
+ actions))
+ file file1-or-cookie))
+
+(cl-defun file-notify--callback-kqueue ((desc actions file
+ &optional file1-or-cookie))
+ "Notification callback for kqueue."
+ (file-notify--handle-event
+ desc
+ (delq nil (mapcar (lambda (action)
+ (cond
+ ((eq action 'create) 'created)
+ ((eq action 'write) 'changed)
+ ((memq action '(attrib link)) 'attribute-changed)
+ ((eq action 'delete) 'deleted)
+ ((eq action 'rename) 'renamed)))
+ actions))
+ file file1-or-cookie))
+
+(cl-defun file-notify--callback-w32notify ((desc actions file
+ &optional file1-or-cookie))
+ "Notification callback for w32notify."
+ (let ((action (pcase actions
+ ('added 'created)
+ ('modified 'changed)
+ ('removed 'deleted)
+ ('renamed-from 'renamed-from)
+ ('renamed-to 'renamed-to))))
+ (when action
+ (file-notify--handle-event desc (list action) file file1-or-cookie))))
+
+(cl-defun file-notify--callback-gfilenotify ((desc actions file
+ &optional file1-or-cookie))
+ "Notification callback for gfilenotify."
+ (file-notify--handle-event
+ desc
+ (delq nil (mapcar (lambda (action)
+ (cond
+ ((memq action
+ '(created changed attribute-changed deleted))
+ action)
+ ((eq action 'moved) 'renamed)))
+ (if (consp actions) actions (list actions))))
+ file file1-or-cookie))
+
+(cl-defun file-notify-callback ((desc actions file &optional file1-or-cookie))
+ "Notification callback for file name handlers."
+ (file-notify--handle-event
+ desc
+ ;; File name handlers use gfilenotify or inotify actions.
+ (delq nil (mapcar
+ (lambda (action)
+ (cond
+ ;; gfilenotify actions:
+ ((memq action '(created changed attribute-changed deleted))
+ action)
+ ((eq action 'moved) 'renamed)
+ ;; inotify actions:
+ ((eq action 'create) 'created)
+ ((eq action 'modify) 'changed)
+ ((eq action 'attrib) 'attribute-changed)
+ ((memq action '(delete delete-self move-self)) 'deleted)
+ ((eq action 'moved-from) 'renamed-from)
+ ((eq action 'moved-to) 'renamed-to)
+ ((eq action 'ignored) 'stopped)))
+ (if (consp actions) actions (list actions))))
+ file file1-or-cookie))
+
+(defun file-notify--call-handler (watch desc action file file1)
+ "Call the handler of WATCH with the arguments DESC, ACTION, FILE and FILE1."
+ (when (or
+ ;; If there is no relative file name for that
+ ;; watch, we watch the whole directory.
+ (null (file-notify--watch-filename watch))
+ ;; File matches.
+ (string-equal
+ (file-notify--watch-filename watch)
+ (file-name-nondirectory file))
+
+ ;; Directory matches.
+ ;; FIXME: What purpose would this condition serve?
+ ;; Doesn't it just slip through events for files
+ ;; having the same name as the last component of the
+ ;; directory of the file that we are really watching?
+ ;;(string-equal
+ ;; (file-name-nondirectory file)
+ ;; (file-name-nondirectory (file-notify--watch-directory watch)))
+
+ ;; File1 matches.
+ (and (stringp file1)
+ (string-equal (file-notify--watch-filename watch)
+ (file-name-nondirectory file1))))
+ (when file-notify-debug
+ (message
+ "file-notify-callback %S %S %S %S %S %S %S"
+ desc action file file1 watch
+ (file-notify--watch-absolute-filename watch)
+ (file-notify--watch-directory watch)))
+ (funcall (file-notify--watch-callback watch)
+ (if file1
+ (list desc action file file1)
+ (list desc action file)))))
+
+(defun file-notify--handle-event (desc actions file file1-or-cookie)
+ "Handle an event returned from file notification.
+DESC is the back-end descriptor. ACTIONS is a list of:
+ `created'
+ `changed'
+ `attribute-changed'
+ `deleted'
+ `renamed' -- FILE is old name, FILE1-OR-COOKIE is new name or nil
+ `renamed-from' -- FILE is old name, FILE1-OR-COOKIE is cookie or nil
+ `renamed-to' -- FILE is new name, FILE1-OR-COOKIE is cookie or nil
+ `stopped' -- no more events after this should be sent"
+ (let* ((watch (gethash desc file-notify-descriptors))
+ (file (and watch (file-notify--expand-file-name watch file))))
(when watch
- ;; Loop over actions. In fact, more than one action happens only
- ;; for `inotify' and `kqueue'.
(while actions
(let ((action (pop actions)))
- ;; Send pending event, if it doesn't match.
;; We only handle {renamed,moved}-{from,to} pairs when these
;; arrive in order without anything else in-between.
- (when (and file-notify--pending-event
- (or
- ;; The cookie doesn't match.
- (not (equal (file-notify--event-cookie
- (car file-notify--pending-event))
- (file-notify--event-cookie event)))
- ;; inotify.
- (and (eq (nth 1 (car file-notify--pending-event))
- 'moved-from)
- (not (eq action 'moved-to)))
- ;; w32notify.
- (and (eq (nth 1 (car file-notify--pending-event))
- 'renamed-from)
- (not (eq action 'renamed-to)))))
- (setq pending-event file-notify--pending-event
- file-notify--pending-event nil)
- (setcar (cdar pending-event) 'deleted))
-
- ;; Map action. We ignore all events which cannot be mapped.
- (setq action
- (cond
- ((memq action
- '(attribute-changed changed created deleted renamed))
- action)
- ((memq action '(moved rename))
- ;; The kqueue rename event does not return file1 in
- ;; case a file monitor is established.
- (if (setq file1 (file-notify--event-file1-name event))
- 'renamed 'deleted))
- ((eq action 'ignored)
- (setq stopped t actions nil))
- ((memq action '(attrib link)) 'attribute-changed)
- ((memq action '(create added)) 'created)
- ((memq action '(modify modified write)) 'changed)
- ((memq action '(delete delete-self move-self removed))
- 'deleted)
- ;; Make the event pending.
- ((memq action '(moved-from renamed-from))
- (setq file-notify--pending-event
- `((,desc ,action ,file
- ,(file-notify--event-cookie event))
- ,(file-notify--watch-callback watch)))
- nil)
- ;; Look for pending event.
- ((memq action '(moved-to renamed-to))
- (if (null file-notify--pending-event)
- 'created
- (setq file1 file
- file (file-notify--event-file-name
- (car file-notify--pending-event)))
+ ;; If there is a pending rename that does not match this event,
+ ;; then send the former as a deletion (since we don't know the
+ ;; rename destination).
+ (when file-notify--pending-rename
+ (unless (and (equal (file-notify--rename-cookie
+ file-notify--pending-rename)
+ file1-or-cookie)
+ (eq action 'renamed-to))
+ (let ((callback (file-notify--watch-callback
+ (file-notify--rename-watch
+ file-notify--pending-rename))))
+ (when callback
+ (funcall callback (list (file-notify--rename-desc
+ file-notify--pending-rename)
+ 'deleted
+ (file-notify--rename-from-file
+ file-notify--pending-rename))))
+ (setq file-notify--pending-rename nil))))
+
+ (let ((file1 nil))
+ (cond
+ ((eq action 'renamed)
+ ;; A `renamed' event may not have a destination name;
+ ;; if none, treat it as a deletion.
+ (if file1-or-cookie
+ (setq file1
+ (file-notify--expand-file-name watch file1-or-cookie))
+ (setq action 'deleted)))
+ ((eq action 'stopped)
+ (file-notify-rm-watch desc)
+ (setq actions nil)
+ (setq action nil))
+ ;; Make the event pending.
+ ((eq action 'renamed-from)
+ (setq file-notify--pending-rename
+ (file-notify--rename-make watch desc file file1-or-cookie))
+ (setq action nil))
+ ;; Look for pending event.
+ ((eq action 'renamed-to)
+ (if file-notify--pending-rename
+ (let ((callback (file-notify--watch-callback
+ (file-notify--rename-watch
+ file-notify--pending-rename)))
+ (pending-desc (file-notify--rename-desc
+ file-notify--pending-rename))
+ (from-file (file-notify--rename-from-file
+ file-notify--pending-rename)))
+ (setq file1 file)
+ (setq file from-file)
;; If the source is handled by another watch, we
;; must fire the rename event there as well.
- (unless (equal desc (caar file-notify--pending-event))
- (setq pending-event
- `((,(caar file-notify--pending-event)
- renamed ,file ,file1)
- ,(cadr file-notify--pending-event))))
- (setq file-notify--pending-event nil)
- 'renamed))))
-
- ;; Apply pending callback.
- (when pending-event
- (funcall (cadr pending-event) (car pending-event))
- (setq pending-event nil))
-
- ;; Apply callback.
- (when (and action
- (or
- ;; If there is no relative file name for that
- ;; watch, we watch the whole directory.
- (null (file-notify--watch-filename watch))
- ;; File matches.
- (string-equal
- (file-notify--watch-filename watch)
- (file-name-nondirectory file))
-
- ;; Directory matches.
- ;; FIXME: What purpose would this condition serve?
- ;; Doesn't it just slip through events for files
- ;; having the same name as the last component of the
- ;; directory of the file that we are really watching?
- ;;(string-equal
- ;; (file-name-nondirectory file)
- ;; (file-name-nondirectory
- ;; (file-notify--watch-directory watch)))
-
- ;; File1 matches.
- (and (stringp file1)
- (string-equal
- (file-notify--watch-filename watch)
- (file-name-nondirectory file1)))))
- (when file-notify-debug
- (message
- "file-notify-callback %S %S %S %S %S %S %S"
- desc action file file1 watch
- (file-notify--event-watched-file event)
- (file-notify--watch-directory watch)))
- (funcall (file-notify--watch-callback watch)
- (if file1
- `(,desc ,action ,file ,file1)
- `(,desc ,action ,file))))
-
- ;; Send `stopped' event.
- (when (or stopped
- (and (memq action '(deleted renamed))
- ;; Not, when a file is backed up.
- (not (and (stringp file1) (backup-file-name-p file1)))
- ;; Watched file or directory is concerned.
- (string-equal
- file (file-notify--event-watched-file event))))
- (file-notify-rm-watch desc)))))))
+ (when (and (not (equal desc pending-desc))
+ callback)
+ (funcall callback
+ (list pending-desc 'renamed file file1)))
+ (setq file-notify--pending-rename nil)
+ (setq action 'renamed))
+ (setq action 'created))))
+
+ (when action
+ (file-notify--call-handler watch desc action file file1))
+
+ ;; Send `stopped' event.
+ (when (and (memq action '(deleted renamed))
+ ;; Not when a file is backed up.
+ (not (and (stringp file1) (backup-file-name-p file1)))
+ ;; Watched file or directory is concerned.
+ (string-equal
+ file (file-notify--watch-absolute-filename watch)))
+ (file-notify-rm-watch desc))))))))
(declare-function inotify-add-watch "inotify.c" (file flags callback))
(declare-function kqueue-add-watch "kqueue.c" (file flags callback))
@@ -288,7 +338,7 @@ EVENT is the cadr of the event in `file-notify-handle-event'
'(create delete delete-self modify move-self move))
(and (memq 'attribute-change flags)
'(attrib)))
- #'file-notify-callback))
+ #'file-notify--callback-inotify))
(defun file-notify--add-watch-kqueue (file _dir flags)
"Add a watch for FILE in DIR with FLAGS, using kqueue."
@@ -300,7 +350,7 @@ EVENT is the cadr of the event in `file-notify-handle-event'
'(create delete write extend rename))
(and (memq 'attribute-change flags)
'(attrib)))
- #'file-notify-callback))
+ #'file-notify--callback-kqueue))
(defun file-notify--add-watch-w32notify (_file dir flags)
"Add a watch for FILE in DIR with FLAGS, using w32notify."
@@ -310,13 +360,13 @@ EVENT is the cadr of the event in
`file-notify-handle-event'
'(file-name directory-name size last-write-time))
(and (memq 'attribute-change flags)
'(attributes)))
- #'file-notify-callback))
+ #'file-notify--callback-w32notify))
(defun file-notify--add-watch-gfilenotify (_file dir flags)
"Add a watch for FILE in DIR with FLAGS, using gfilenotify."
(gfile-add-watch dir
(append '(watch-mounts send-moved) flags)
- #'file-notify-callback))
+ #'file-notify--callback-gfilenotify))
(defun file-notify-add-watch (file flags callback)
"Add a watch for filesystem events pertaining to FILE.
diff --git a/lisp/files.el b/lisp/files.el
index 70865eb..184421f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -813,7 +813,8 @@ The path separator is colon in GNU and GNU-like systems."
(error "No such directory found via CDPATH environment variable"))))
(defun directory-files-recursively (dir regexp
- &optional include-directories
predicate)
+ &optional include-directories predicate
+ follow-symlinks)
"Return list of all files under DIR that have file names matching REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
@@ -827,7 +828,10 @@ PREDICATE can be either nil (which means that all
subdirectories
are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
name name of the subdirectory and should return non-nil if the
-subdirectory is to be descended into)."
+subdirectory is to be descended into).
+
+If FOLLOW-SYMLINKS, symbolic links that point to directories are
+followed. Note that this can lead to infinite recursion."
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
@@ -841,19 +845,22 @@ subdirectory is to be descended into)."
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
- (when (and (not (file-symlink-p full-file))
+ (when (and (or (not (file-symlink-p full-file))
+ (and (file-symlink-p full-file)
+ follow-symlinks))
;; Allow filtering subdirectories.
(or (eq predicate nil)
(eq predicate t)
(funcall predicate full-file)))
(let ((sub-files
(if (eq predicate t)
- (condition-case _
- (directory-files-recursively
- full-file regexp include-directories)
- (file-error nil))
+ (ignore-error file-error
+ (directory-files-recursively
+ full-file regexp include-directories
+ predicate follow-symlinks))
(directory-files-recursively
- full-file regexp include-directories))))
+ full-file regexp include-directories
+ predicate follow-symlinks))))
(setq result (nconc result sub-files))))
(when (and include-directories
(string-match regexp leaf))
@@ -4959,8 +4966,8 @@ Uses `backup-directory-alist' in the same way as
(list (make-backup-file-name fn))
(cons (format "%s.~%d~" basic-name (1+ high-water-mark))
(if (and (> number-to-delete 0)
- ;; Delete nothing if there is overflow
- ;; in the number of versions to keep.
+ ;; Delete nothing if kept-new-versions and
+ ;; kept-old-versions combine to an outlandish value.
(>= (+ kept-new-versions kept-old-versions -1) 0))
(mapcar (lambda (n)
(format "%s.~%d~" basic-name n))
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index a09b436..40d0d24 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1909,21 +1909,8 @@ article numbers will be returned."
(defsubst gnus-agent-read-article-number ()
"Reads the article number at point. Returns nil when a valid article number
can not be read."
- ;; It is unfortunate but the read function quietly overflows
- ;; integer. As a result, I have to use string operations to test
- ;; for overflow BEFORE calling read.
(when (looking-at "[0-9]+\t")
- (let ((len (- (match-end 0) (match-beginning 0))))
- (cond ((< len 9)
- (read (current-buffer)))
- ((= len 9)
- ;; Many 9 digit base-10 numbers can be represented in a 27-bit int
- ;; Back convert from int to string to ensure that this is one of
them.
- (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end
0))))
- (num (read (current-buffer)))
- (str2 (int-to-string num)))
- (when (equal str1 str2)
- num)))))))
+ (read (current-buffer))))
(defsubst gnus-agent-copy-nov-line (article)
"Copy the indicated ARTICLE from the overview buffer to the nntp server
buffer."
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 65e1c81..8f5a313 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3598,22 +3598,22 @@ possible values."
(let ((dtime (decode-time time)))
(concat
"Date: the "
- (number-to-string (nth 3 dtime))
- (let ((digit (% (nth 3 dtime) 10)))
+ (number-to-string (decoded-time-day dtime))
+ (let ((digit (% (decoded-time-day dtime) 10)))
(cond
- ((memq (nth 3 dtime) '(11 12 13)) "th")
+ ((memq (decoded-time-day dtime) '(11 12 13)) "th")
((= digit 1) "st")
((= digit 2) "nd")
((= digit 3) "rd")
(t "th")))
" of "
- (nth (1- (nth 4 dtime)) gnus-english-month-names)
+ (nth (1- (decoded-time-month dtime)) gnus-english-month-names)
" "
- (number-to-string (nth 5 dtime))
+ (number-to-string (decoded-time-year dtime))
" at "
- (format "%02d" (nth 2 dtime))
+ (format "%02d" (decoded-time-hour dtime))
":"
- (format "%02d" (nth 1 dtime)))))))
+ (format "%02d" (decoded-time-minute dtime)))))))
(foo
(format "Date: %s (from Gnus)" date))))
@@ -4381,7 +4381,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
;;; Gnus article mode
;;;
-(set-keymap-parent gnus-article-mode-map widget-keymap)
+(set-keymap-parent gnus-article-mode-map button-buffer-map)
(gnus-define-keys gnus-article-mode-map
" " gnus-article-goto-next-page
@@ -4874,6 +4874,7 @@ General format specifiers can also be used. See Info node
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'gnus-article-push-button)
(define-key map [mouse-2] 'gnus-article-push-button)
(define-key map [down-mouse-3] 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
@@ -4888,7 +4889,9 @@ General format specifiers can also be used. See Info node
gnus-mime-button-commands)))
(defvar gnus-url-button-commands
- '((gnus-article-copy-string "u" "Copy URL to kill ring")))
+ '((gnus-article-copy-string "u" "Copy URL to kill ring")
+ (push-button "\r" "Push the button")
+ (push-button [mouse-2] "Push the button")))
(defvar gnus-url-button-map
(let ((map (make-sparse-keymap)))
@@ -5849,26 +5852,12 @@ all parts."
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :mime-handle handle
- :action 'gnus-widget-press-button
- :button-keymap gnus-mime-button-map
- :help-echo
- (lambda (widget)
- (format
- "%S: %s the MIME part; %S: more options"
- 'mouse-2
- (if (mm-handle-displayed-p (widget-get widget :mime-handle))
- "hide" "show")
- 'down-mouse-3)))))
-
-(defun gnus-widget-press-button (elems _el)
- (goto-char (widget-get elems :from))
- (gnus-article-press-button))
+ (make-text-button
+ b e
+ 'keymap gnus-mime-button-map
+ 'face gnus-article-button-face
+ 'help-echo
+ "mouse-2: toggle the MIME part; down-mouse-3: more options")))
(defvar gnus-displaying-mime nil)
@@ -6151,10 +6140,9 @@ If nil, don't show those extra buttons."
mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
+ button t
article-type multipart
rear-nonsticky t))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
;; Do the handles
(while (setq handle (pop handles))
(add-text-properties
@@ -6175,10 +6163,9 @@ If nil, don't show those extra buttons."
mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
+ button t
gnus-data ,handle
rear-nonsticky t))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
(insert " "))
(insert "\n\n"))
(when preferred
@@ -7343,27 +7330,9 @@ groups."
;; Written by Per Abrahamsen <address@hidden>.
-;;; Internal Variables:
-
-(defcustom gnus-button-url-regexp
- (concat
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
- "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
- "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
- (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
- (punct "!?:;.,"))
- (concat
- "\\(?:"
- ;; Match paired parentheses, e.g. in Wikipedia URLs:
- ;; http://thread.gmane.org/address@hidden
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
- "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
- "\\|"
- "[" chars punct "]+" "[" chars "]"
- "\\)"))
- "\\)")
+(defcustom gnus-button-url-regexp browse-url-button-regexp
"Regular expression that matches URLs."
- :version "24.4"
+ :version "27.1"
:group 'gnus-article-buttons
:type 'regexp)
@@ -7770,7 +7739,7 @@ positives are possible."
1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
;; Raw URLs.
(gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url 0)
+ 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; man pages
("\\b\\([a-z][a-z]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
@@ -8043,7 +8012,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(match-beginning 1))
points)))))
(match-beginning 2)))
- (let (gnus-article-mouse-face widget-mouse-face)
+ (let (gnus-article-mouse-face)
(while points
(gnus-article-add-button (pop points) (pop points)
'gnus-button-push
@@ -8092,18 +8061,19 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-article-add-button (from to fun &optional data text)
"Create a button between FROM and TO with callback FUN and data DATA."
- (when gnus-article-button-face
- (overlay-put (make-overlay from to nil t)
- 'face gnus-article-button-face))
(add-text-properties
from to
(nconc (and gnus-article-mouse-face
(list 'mouse-face gnus-article-mouse-face))
- (list 'gnus-callback fun)
+ (list 'gnus-callback fun
+ 'button-data data
+ 'action fun
+ 'keymap gnus-url-button-map
+ 'category t
+ 'button t)
(and data (list 'gnus-data data))))
- (widget-convert-button 'link from to :action 'gnus-widget-press-button
- :help-echo (or text "Follow the link")
- :keymap gnus-url-button-map))
+ (when gnus-article-button-face
+ (add-face-text-property from to gnus-article-button-face t)))
(defun gnus-article-copy-string ()
"Copy the string in the button to the kill ring."
@@ -8431,13 +8401,8 @@ url is put as the `gnus-button-url' overlay property on
the button."
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :action 'gnus-button-prev-page
- :button-keymap gnus-prev-page-map)))
+ (make-text-button b e 'keymap gnus-prev-page-map
+ 'face gnus-article-button-face)))
(defun gnus-button-next-page (&optional _args _more-args)
"Go to the next page."
@@ -8467,13 +8432,8 @@ url is put as the `gnus-button-url' overlay property on
the button."
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :action 'gnus-button-next-page
- :button-keymap gnus-next-page-map)))
+ (make-text-button b e 'keymap gnus-next-page-map
+ 'face gnus-article-button-face)))
(defun gnus-article-button-next-page (_arg)
"Go to the next page."
@@ -8726,6 +8686,7 @@ For example:
(defvar gnus-mime-security-button-map
(let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'gnus-article-push-button)
(define-key map [mouse-2] 'gnus-article-push-button)
(define-key map [down-mouse-3] 'gnus-mime-security-button-menu)
(dolist (c gnus-mime-security-button-commands)
@@ -8861,20 +8822,8 @@ For example:
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :mime-handle handle
- :action 'gnus-widget-press-button
- :button-keymap gnus-mime-security-button-map
- :help-echo
- (lambda (_widget)
- (format
- "%S: show detail; %S: more options"
- 'mouse-2
- 'down-mouse-3)))))
+ (make-text-button b e 'keymap gnus-mime-security-button-map
+ 'face gnus-article-button-face)))
(defun gnus-mime-display-security (handle)
(save-restriction
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 615b2b9..fb8b300 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -254,7 +254,10 @@ DOC is a documentation string for the parameter.")
(defconst gnus-extra-group-parameters
'((uidvalidity (string :tag "IMAP uidvalidity") "\
Server-assigned value attached to IMAP groups, used to maintain consistency.")
- (modseq (string :tag "modseq") "modseq")
+ (modseq (choice :tag "modseq"
+ (const :tag "None" nil)
+ (string :tag "Sequence number"))
+ "Modification seqence number")
(active (cons :tag "active" (integer :tag "min") (integer :tag "max"))
"active")
(permanent-flags (repeat :tag "Permanent Flags" (symbol :tag "Flag"))
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index cb70d95..b26aaa1 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -176,22 +176,25 @@ marked with SPECIAL."
(thenHour (elt thenParts 2))
(thenMin (elt thenParts 1))
;; convert time as elements into number of seconds since EPOCH.
- (then (encode-time 0
- thenMin
- thenHour
- ;; If THEN is earlier than NOW, make it
- ;; same time tomorrow. Doc for encode-time
- ;; says that this is OK.
- (+ (elt nowParts 3)
- (if (or (< thenHour (elt nowParts 2))
- (and (= thenHour (elt nowParts 2))
- (<= thenMin (elt nowParts 1))))
- 1 0))
- (elt nowParts 4)
- (elt nowParts 5)
- (elt nowParts 6)
- (elt nowParts 7)
- (elt nowParts 8)))
+ (then (encode-time
+ 0
+ thenMin
+ thenHour
+ ;; If THEN is earlier than NOW, make it
+ ;; same time tomorrow. Doc for encode-time
+ ;; says that this is OK.
+ (+ (decoded-time-day nowParts)
+ (if (or (< thenHour (decoded-time-hour nowParts))
+ (and (= thenHour
+ (decoded-time-hour nowParts))
+ (<= thenMin
+ (decoded-time-minute nowParts))))
+ 1 0))
+ (decoded-time-month nowParts)
+ (decoded-time-year nowParts)
+ (decoded-time-weekday nowParts)
+ (decoded-time-dst nowParts)
+ (decoded-time-zone nowParts)))
(diff (float-time (time-subtract then now))))
;; Return number of timesteps in the number of seconds.
(round diff gnus-demon-timestep)))
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index f36c389..92d760f 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -84,7 +84,7 @@ fit these criteria."
(define-key map "i" 'gnus-html-browse-image)
(define-key map "\r" 'gnus-html-browse-url)
(define-key map "u" 'gnus-article-copy-string)
- (define-key map [tab] 'widget-forward)
+ (define-key map [tab] 'button-forward)
map))
(defun gnus-html-encode-url (url)
@@ -180,12 +180,10 @@ fit these criteria."
'image-displayer `(lambda (url start end)
(gnus-html-display-image url start end
,alt-text))
+ 'help-echo alt-text
+ 'button t
+ 'keymap gnus-html-image-map
'gnus-image (list url start end alt-text)))
- (widget-convert-button
- 'url-link start (point)
- :help-echo alt-text
- :keymap gnus-html-image-map
- url)
(if (string-match "\\`cid:" url)
;; URLs with cid: have their content stashed in other
;; parts of the MIME structure, so just insert them
@@ -207,21 +205,15 @@ fit these criteria."
(delete-region start end))
"*")
'cid))
- (widget-convert-button
- 'link start end
- :action 'gnus-html-insert-image
- :help-echo url
- :keymap gnus-html-image-map
- :button-keymap gnus-html-image-map)))
+ (make-text-button start end
+ 'help-echo url
+ 'keymap gnus-html-image-map)))
;; Normal, external URL.
(if (or inhibit-images
(gnus-html-image-url-blocked-p url blocked-images))
- (widget-convert-button
- 'link start end
- :action 'gnus-html-insert-image
- :help-echo url
- :keymap gnus-html-image-map
- :button-keymap gnus-html-image-map)
+ (make-text-button start end
+ 'help-echo url
+ 'keymap gnus-html-image-map)
;; Non-blocked url
(let ((width
(when (string-match "width=\"?\\([0-9]+\\)" parameters)
@@ -444,11 +436,9 @@ Return a string with image data."
(let ((image (gnus-rescale-image image
(gnus-html-maximum-image-size))))
(delete-region start end)
(gnus-put-image image alt-text 'external)
- (widget-convert-button
- 'url-link start (point)
- :help-echo alt-text
- :keymap gnus-html-displayed-image-map
- url)
+ (make-text-button start (point)
+ 'help-echo alt-text
+ 'keymap gnus-html-displayed-image-map)
(put-text-property start (point) 'gnus-alt-text alt-text)
(when url
(add-text-properties
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 402e233..529cafe 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -777,9 +777,8 @@ These will be used to retrieve the RSVP information from
ical events."
,callback
keymap ,gnus-mime-button-map
face ,gnus-article-button-face
- gnus-data ,data))
- (widget-convert-button 'link start (point)
- :action 'gnus-widget-press-button)))
+ button t
+ gnus-data ,data))))
(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject)
(let ((message-signature nil))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index e23e53b..b27a8a1 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -63,6 +63,8 @@ server denied."
(const :tag "Deny server" denied)
(const :tag "Unplug Agent" offline)))
+;; Note: When this option is finally removed, also remove the entire
+;; `gnus-start-news-server' function.
(defcustom gnus-nntp-server nil
"The name of the host running the NNTP server."
:group 'gnus-server
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index e9c0de9..74e132b 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -48,7 +48,7 @@ group parameters.
If AUTO-UPDATE is non-nil (prefix argument accepted, if called
interactively), it makes sure nnmail-split-fancy is re-computed before
getting new mail, by adding `gnus-group-split-update' to
-`nnmail-pre-get-new-mail-hook'.
+`gnus-get-top-new-news-hook'.
A non-nil CATCH-ALL replaces the current value of
`gnus-group-split-default-catch-all-group'. This variable is only used
@@ -64,9 +64,14 @@ match any of the group-specified splitting rules. See
(setq nnmail-split-methods 'nnmail-split-fancy)
(when catch-all
(setq gnus-group-split-default-catch-all-group catch-all))
- (gnus-group-split-update)
- (when auto-update
- (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-group-split-update)))
+ (add-hook
+ (if auto-update
+ 'gnus-get-top-new-news-hook
+ ;; Split updating requires `gnus-newsrc-hashtb' to be
+ ;; initialized; the read newsrc hook is the only hook that comes
+ ;; after initialization, but before checking for new news.
+ 'gnus-read-newsrc-el-hook)
+ #'gnus-group-split-update))
;;;###autoload
(defun gnus-group-split-update (&optional catch-all)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 1f330e3..73f0eb3 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -67,6 +67,8 @@
(require 'gnus-util)
(require 'gmm-utils)
(require 'mm-decode)
+(require 'shr)
+(require 'url)
(require 'nnoo)
(eval-when-compile
(require 'subr-x))
@@ -9408,7 +9410,9 @@ Obeys the standard process/prefix convention."
(t
(error "Couldn't select virtual nndoc group")))))
-(defun gnus-summary-widget-forward (arg)
+(define-obsolete-function-alias 'gnus-summary-widget-forward
+ #'gnus-summary-button-forward "27.1")
+(defun gnus-summary-button-forward (arg)
"Move point to the next field or button in the article.
With optional ARG, move across that many fields."
(interactive "p")
@@ -9418,9 +9422,11 @@ With optional ARG, move across that many fields."
(error "No article window found"))))
(select-window win)
(select-frame-set-input-focus (window-frame win))
- (widget-forward arg)))
+ (forward-button arg)))
-(defun gnus-summary-widget-backward (arg)
+(define-obsolete-function-alias 'gnus-summary-widget-backward
+ #'gnus-summary-button-backward "27.1")
+(defun gnus-summary-button-backward (arg)
"Move point to the previous field or button in the article.
With optional ARG, move across that many fields."
(interactive "p")
@@ -9430,54 +9436,76 @@ With optional ARG, move across that many fields."
(error "No article window found"))))
(select-window win)
(select-frame-set-input-focus (window-frame win))
- (unless (widget-at (point))
+ (unless (button-at (point))
(goto-char (point-max)))
- (widget-backward arg)))
+ (backward-button arg)))
+
+(defcustom gnus-collect-urls-primary-text "Link"
+ "The button text for the default link in `gnus-summary-browse-url'."
+ :version "27.1"
+ :type 'string
+ :group 'gnus-article-various)
(defun gnus-collect-urls ()
"Return the list of URLs in the buffer after (point).
-The 1st element is the one named 'Link', if any."
- (let ((pt (point)) urls link)
- (while (progn (widget-move 1)
- ;; `widget-move' wraps around to top of buffer.
- (> (point) pt))
+The 1st element is the button named by `gnus-collect-urls-primary-text'."
+ (let ((pt (point)) urls primary)
+ (while (forward-button 1 nil nil t)
(setq pt (point))
- (when-let ((w (widget-at pt))
- (u (or (widget-value w)
+ (when-let ((w (button-at pt))
+ (u (or (button-get w 'shr-url)
(get-text-property pt 'gnus-string))))
(when (string-match-p "\\`[[:alpha:]]+://" u)
- (if (and (null link) (string= "Link" (widget-text w)))
- (setq link u)
+ (if (and gnus-collect-urls-primary-text (null primary)
+ (string= gnus-collect-urls-primary-text (button-label w)))
+ (setq primary u)
(push u urls)))))
(setq urls (nreverse urls))
- (when link
- (push link urls))
+ (when primary
+ (push primary urls))
(delete-dups urls)))
-(defun gnus-summary-browse-url (arg)
+(defun gnus-shorten-url (url max)
+ "Return an excerpt from URL."
+ (if (<= (length url) max)
+ url
+ (let ((parsed (url-generic-parse-url url)))
+ (concat (url-host parsed)
+ "..."
+ (substring (url-filename parsed)
+ (- (length (url-filename parsed))
+ (max (- max (length (url-host parsed))) 0)))))))
+
+(defun gnus-summary-browse-url (&optional external)
"Scan the current article body for links, and offer to browse them.
-With prefix ARG, also collect links from message headers.
-Links are opened using `browse-url'. If only one link is found,
-browse that directly, otherwise use completion to select a link."
+Links are opened using `browse-url' unless a prefix argument is
+given: Then `browse-url-secondary-browser-function' is used instead.
+
+If only one link is found, browse that directly, otherwise use
+completion to select a link. The first link marked in the
+article text with `gnus-collect-urls-primary-text' is the
+default."
(interactive "P")
(let (urls target)
(gnus-summary-select-article)
- (gnus-configure-windows 'article)
(gnus-with-article-buffer
- (if arg
- (goto-char (point-min))
- (article-goto-body)
- ;; Back up a char, in case body starts with a widget.
- (backward-char))
+ (article-goto-body)
+ ;; Back up a char, in case body starts with a button.
+ (backward-char)
(setq urls (gnus-collect-urls))
(setq target
(cond ((= (length urls) 1)
(car urls))
((> (length urls) 1)
- (completing-read "URL to browse: " urls nil t (car urls)))))
+ (completing-read (format "URL to browse (default %s): "
+ (gnus-shorten-url (car urls) 40))
+ urls nil t nil nil
+ (car urls)))))
(if target
- (browse-url target)
+ (if external
+ (funcall browse-url-secondary-browser-function target)
+ (browse-url target))
(message "No URLs found.")))))
(defun gnus-summary-isearch-article (&optional regexp-p)
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 31421cc..9ccdb83 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -359,20 +359,26 @@ Symbols are also allowed; their print names are used
instead."
(defun gnus-seconds-today ()
"Return the number of seconds passed today."
(let ((now (decode-time)))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
+ (+ (decoded-time-second now)
+ (* (decoded-time-minute now) 60)
+ (* (decoded-time-hour now) 3600))))
(defun gnus-seconds-month ()
"Return the number of seconds passed this month."
(let ((now (decode-time)))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
- (* (- (car (nthcdr 3 now)) 1) 3600 24))))
+ (+ (decoded-time-second now)
+ (* (decoded-time-minute now) 60)
+ (* (decoded-time-hour now) 3600)
+ (* (- (decoded-time-day now) 1) 3600 24))))
(defun gnus-seconds-year ()
"Return the number of seconds passed this year."
(let* ((current (current-time))
(now (decode-time current))
(days (format-time-string "%j" current)))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
+ (+ (decoded-time-second now)
+ (* (decoded-time-minute now) 60)
+ (* (decoded-time-hour now) 3600)
(* (- (string-to-number days) 1) 3600 24))))
(defmacro gnus-date-get-time (date)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 3f190ed..ea7a282 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -5509,8 +5509,8 @@ If NOW, use that time instead."
In posting styles use `(\"Expires\" (make-expires-date 30))'."
(let* ((cur (decode-time))
- (nday (+ days (nth 3 cur))))
- (setf (nth 3 cur) nday)
+ (nday (+ days (decoded-time-day cur))))
+ (setf (decoded-time-day cur) nday)
(message-make-date (encode-time cur))))
(defun message-make-message-id ()
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 85aa694..cba9633 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -896,11 +896,11 @@ external if displayed external."
(buffer-live-p gnus-summary-buffer))
(when attachment-filename
(with-current-buffer mm
- (rename-buffer (format "*mm* %s"
attachment-filename) t)))
+ (rename-buffer
+ (format "*mm* %s" attachment-filename) t)))
;; So that we pop back to the right place, sort of.
(switch-to-buffer gnus-summary-buffer)
(switch-to-buffer mm))
- (delete-other-windows)
(funcall method))
(mm-save-part handle))
(when (and (not non-viewer)
@@ -1829,7 +1829,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t)
(shr-insert-document document)
(unless (bobp)
(insert "\n"))
- (mm-convert-shr-links)
(mm-handle-set-undisplayer
handle
(let ((min (point-min-marker))
@@ -1838,40 +1837,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil
t)
(let ((inhibit-read-only t))
(delete-region min max))))))))
-(defvar shr-image-map)
-(defvar shr-map)
-(autoload 'widget-convert-button "wid-edit")
-(defvar widget-keymap)
-
-(defun mm-convert-shr-links ()
- (let ((start (point-min))
- end keymap)
- (while (and start
- (< start (point-max)))
- (when (setq start (text-property-not-all start (point-max) 'shr-url nil))
- (setq end (next-single-property-change start 'shr-url nil (point-max)))
- (widget-convert-button
- 'url-link start end
- :help-echo (get-text-property start 'help-echo)
- :keymap (setq keymap (copy-keymap
- (if (mm-images-in-region-p start end)
- shr-image-map
- shr-map)))
- (get-text-property start 'shr-url))
- ;; Mask keys that launch `widget-button-click'.
- ;; Those bindings are provided by `widget-keymap'
- ;; that is a parent of `gnus-article-mode-map'.
- (dolist (key (where-is-internal 'widget-button-click widget-keymap))
- (unless (lookup-key keymap key)
- (define-key keymap key #'ignore)))
- ;; Avoid `shr-next-link' and `shr-previous-link' in `keymap' so
- ;; TAB and M-TAB run `widget-forward' and `widget-backward' instead.
- (substitute-key-definition 'shr-next-link nil keymap)
- (substitute-key-definition 'shr-previous-link nil keymap)
- (dolist (overlay (overlays-at start))
- (overlay-put overlay 'face nil))
- (setq start end)))))
-
(defun mm-handle-filename (handle)
"Return filename of HANDLE if any."
(or (mail-content-type-get (mm-handle-type handle)
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index f8ec222..2ad0634 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1264,12 +1264,12 @@ all. This may very well take some time.")
(date-elts (decode-time date))
;; ### NOTE: out-of-range values are accepted by encode-time. This
;; makes our life easier.
- (monday (- (nth 3 date-elts)
+ (monday (- (decoded-time-day date-elts)
(if nndiary-week-starts-on-monday
- (if (zerop (nth 6 date-elts))
+ (if (zerop (decoded-time-weekday date-elts))
6
- (- (nth 6 date-elts) 1))
- (nth 6 date-elts))))
+ (- (decoded-time-weekday date-elts) 1))
+ (decoded-time-weekday date-elts))))
reminder res)
;; remove the DOW and DST entries
(setcdr (nthcdr 5 date-elts) (nthcdr 8 date-elts))
@@ -1343,9 +1343,10 @@ all. This may very well take some time.")
;; have to know which day is the 1st one for this month.
;; Maybe there's simpler, but decode-time(encode-time) will
;; give us the answer.
- (let ((first (nth 6 (decode-time
- (encode-time 0 0 0 1 month year
- time-zone))))
+ (let ((first (decoded-time-weekday
+ (decode-time
+ (encode-time 0 0 0 1 month year
+ time-zone))))
(max (cond ((= month 2)
(if (date-leap-year-p year) 29 28))
((<= month 7)
@@ -1390,11 +1391,11 @@ all. This may very well take some time.")
;; If there's no next occurrence, returns the last one (if any) which is then
;; in the past.
(let* ((today (decode-time now))
- (this-minute (nth 1 today))
- (this-hour (nth 2 today))
- (this-day (nth 3 today))
- (this-month (nth 4 today))
- (this-year (nth 5 today))
+ (this-minute (decoded-time-minute today))
+ (this-hour (decoded-time-hour today))
+ (this-day (decoded-time-day today))
+ (this-month (decoded-time-month today))
+ (this-year (decoded-time-year today))
(minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<))
(hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<))
(dom-list (nth 2 sched))
@@ -1445,9 +1446,10 @@ all. This may very well take some time.")
;; have to know which day is the 1st one for this month.
;; Maybe there's simpler, but decode-time(encode-time) will
;; give us the answer.
- (let ((first (nth 6 (decode-time
- (encode-time 0 0 0 1 month year
- time-zone))))
+ (let ((first (decoded-time-weekday
+ (decode-time
+ (encode-time 0 0 0 1 month year
+ time-zone))))
(max (cond ((= month 2)
(if (date-leap-year-p year) 29 28))
((<= month 7)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 4a1ab2c..c6eaa54 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -270,7 +270,7 @@ textual parts.")
(forward-line)
(null (looking-at-p
;; We're expecting a mail header.
- "^[!-9;-~]+: "))))
+ "^[!-9;-~]+:[[:space:]]"))))
(delete-region (line-beginning-position)
(1+ (line-end-position)))
(setq lines nil)
@@ -1100,7 +1100,7 @@ textual parts.")
(format-time-string
(format "%%d-%s-%%Y"
(upcase
- (car (rassoc (nth 4 (decode-time cutoff))
+ (car (rassoc (decoded-time-month (decode-time cutoff))
parse-time-months))))
cutoff))))
(and (car result)
@@ -1340,7 +1340,7 @@ If LIMIT, first try to limit the search to the N last
articles."
(progn (end-of-line)
(skip-chars-backward " \r\"")
(point)))))
- (unless (member '%NoSelect flags)
+ (unless (member '%Noselect flags)
(let* ((group (utf7-decode (if (stringp group) group
(format "%s" group)) t))
(group (cond ((or (not prefix)
@@ -1702,18 +1702,19 @@ If LIMIT, first try to limit the search to the N last
articles."
(cdr (or (assoc (caddr type) flags) ; %Flagged
(assoc (intern (cadr type) obarray) flags)
(assoc (cadr type) flags))))) ; "\Flagged"
- (setq marks (delq ticks marks))
- (pop ticks)
- ;; Add the new marks we got.
- (setq ticks (gnus-add-to-range ticks new-marks))
- ;; Remove the marks from messages that don't have them.
- (setq ticks (gnus-remove-from-range
- ticks
- (gnus-compress-sequence
- (gnus-sorted-complement existing new-marks))))
- (when ticks
- (push (cons (car type) ticks) marks)))
- (gnus-info-set-marks info marks t))
+ (when new-marks
+ (setq marks (delq ticks marks))
+ (pop ticks)
+ ;; Add the new marks we got.
+ (setq ticks (gnus-add-to-range ticks new-marks))
+ ;; Remove the marks from messages that don't have them.
+ (setq ticks (gnus-remove-from-range
+ ticks
+ (gnus-compress-sequence
+ (gnus-sorted-complement existing new-marks))))
+ (when ticks
+ (push (cons (car type) ticks) marks))
+ (gnus-info-set-marks info marks t))))
;; Add vanished to the list of unexisting articles.
(when vanished
(let* ((old-unexists (assq 'unexist marks))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 3becee3..246f52c 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -322,8 +322,6 @@ This variable is set by `nnmaildir-request-article'.")
(setq ino-opened (file-attribute-inode-number attr)
nlink (file-attribute-link-number attr)
number-linked (+ number-opened nlink))
- (if (or (< nlink 1) (< number-linked nlink))
- (signal 'error '("Arithmetic overflow")))
(setq attr (file-attributes
(concat dir (number-to-string number-linked))))
(or attr (throw 'return (1- number-linked)))
@@ -395,9 +393,7 @@ This variable is set by `nnmaildir-request-article'.")
(let* ((attr (file-attributes path-open))
(nlink (file-attribute-link-number attr)))
(setq ino-open (file-attribute-inode-number attr)
- number-link (+ number-open nlink))
- (if (or (< nlink 1) (< number-link nlink))
- (signal 'error '("Arithmetic overflow"))))
+ number-link (+ number-open nlink)))
(if (= number-link previous-number-link)
;; We've already tried this number, in the previous loop iteration,
;; and failed.
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 929336c..23f7a2a 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -24,9 +24,22 @@
;;; Commentary:
-;; ibuffer.el is an advanced replacement for the `buffer-menu' which
-;; is normally distributed with Emacs. Its interface is intended to
-;; be analogous to that of Dired.
+;; Ibuffer is an advanced replacement for the `buffer-menu' which is
+;; distributed with Emacs. It lets you operate on buffers in a
+;; Dired-like way, with the ability to sort, mark by regular
+;; expression, and filter displayed buffers by various criteria. Its
+;; interface is intended to be analogous to that of Dired.
+;;
+;; To start using it, type `M-x ibuffer'. If you use it regularly,
+;; you might be interested in replacing the default `list-buffers' key
+;; binding by adding the following to your init file:
+;;
+;; (global-set-key (kbd "C-x C-b") 'ibuffer)
+;;
+;; See also the various customization options, not least the
+;; documentation for `ibuffer-formats'.
+;;
+;; For more help, type `?' in the "*Ibuffer*" buffer.
;;; Code:
@@ -139,15 +152,13 @@ value for this variable would be
Using \\[ibuffer-switch-format], you can rotate the display between
the specified formats in the list."
:version "26.1"
- :type '(repeat sexp)
- :group 'ibuffer)
+ :type '(repeat sexp))
(defcustom ibuffer-always-compile-formats (featurep 'bytecomp)
"If non-nil, then use the byte-compiler to optimize `ibuffer-formats'.
This will increase the redisplay speed, at the cost of loading the
elisp byte-compiler."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-fontification-alist
'((10 buffer-read-only font-lock-constant-face)
@@ -174,34 +185,28 @@ recreate it for the change to take effect."
:type '(repeat
(list (integer :tag "Priority")
(sexp :tag "Test Form")
- face))
- :group 'ibuffer)
+ face)))
(defcustom ibuffer-use-other-window nil
"If non-nil, display Ibuffer in another window by default."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-default-shrink-to-minimum-size nil
"If non-nil, minimize the size of the Ibuffer window by default."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defvar ibuffer-shrink-to-minimum-size nil)
(defcustom ibuffer-display-summary t
"If non-nil, summarize Ibuffer columns."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-truncate-lines t
"If non-nil, do not display continuation lines."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-case-fold-search case-fold-search
"If non-nil, ignore case when searching."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-default-sorting-mode 'recency
"The criteria by which to sort the buffers.
@@ -213,21 +218,18 @@ view of the buffers."
(const :tag "Lexicographic" :value alphabetic)
(const :tag "Buffer size" :value size)
(const :tag "File name" :value filename/process)
- (const :tag "Major mode" :value major-mode))
- :group 'ibuffer)
+ (const :tag "Major mode" :value major-mode)))
(defvar ibuffer-sorting-mode nil)
(defvar ibuffer-last-sorting-mode nil)
(defcustom ibuffer-default-sorting-reversep nil
"If non-nil, reverse the default sorting order."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defvar ibuffer-sorting-reversep nil)
(defcustom ibuffer-eliding-string "..."
"The string to use for eliding long columns."
- :type 'string
- :group 'ibuffer)
+ :type 'string)
(defcustom ibuffer-maybe-show-predicates `(,(lambda (buf)
(and (string-match "^ "
(buffer-name buf))
@@ -243,13 +245,11 @@ Viewing of buffers hidden because of these predicates may
be customized
via `ibuffer-default-display-maybe-show-predicates' and is toggled by
giving a non-nil prefix argument to `ibuffer-update'.
Note that this specialized filtering occurs before real filtering."
- :type '(repeat (choice regexp function))
- :group 'ibuffer)
+ :type '(repeat (choice regexp function)))
(defcustom ibuffer-default-display-maybe-show-predicates nil
"Non-nil means show buffers that match `ibuffer-maybe-show-predicates'."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defvar ibuffer-display-maybe-show-predicates nil)
@@ -257,47 +257,39 @@ Note that this specialized filtering occurs before real
filtering."
(defcustom ibuffer-movement-cycle t
"If non-nil, then forward and backwards movement commands cycle."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-modified-char ?*
"The character to display for modified buffers."
- :type 'character
- :group 'ibuffer)
+ :type 'character)
(defcustom ibuffer-read-only-char ?%
"The character to display for read-only buffers."
- :type 'character
- :group 'ibuffer)
+ :type 'character)
(defcustom ibuffer-marked-char ?>
"The character to display for marked buffers."
- :type 'character
- :group 'ibuffer)
+ :type 'character)
(defcustom ibuffer-locked-char ?L
"The character to display for locked buffers."
:version "26.1"
- :type 'character
- :group 'ibuffer)
+ :type 'character)
(defcustom ibuffer-deletion-char ?D
"The character to display for buffers marked for deletion."
- :type 'character
- :group 'ibuffer)
+ :type 'character)
(defcustom ibuffer-expert nil
"If non-nil, don't ask for confirmation of \"dangerous\" operations."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-view-ibuffer nil
"If non-nil, display the current Ibuffer buffer itself.
Note that this has a drawback - the data about the current Ibuffer
buffer will most likely be inaccurate. This includes modification
state, size, etc."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-always-show-last-buffer nil
"If non-nil, always display the previous buffer.
@@ -305,19 +297,16 @@ This variable takes precedence over filtering, and even
`ibuffer-never-show-predicates'."
:type '(choice (const :tag "Always" :value t)
(const :tag "Never" :value nil)
- (const :tag "Always except minibuffer" :value :nomini))
- :group 'ibuffer)
+ (const :tag "Always except minibuffer" :value :nomini)))
(defcustom ibuffer-jump-offer-only-visible-buffers nil
"If non-nil, only offer buffers visible in the Ibuffer buffer
in completion lists of the `ibuffer-jump-to-buffer' command."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-use-header-line (boundp 'header-line-format)
"If non-nil, display a header line containing current filters."
- :type 'boolean
- :group 'ibuffer)
+ :type 'boolean)
(defcustom ibuffer-default-directory nil
"The default directory to use for a new Ibuffer buffer.
@@ -325,65 +314,54 @@ If nil, inherit the directory of the buffer in which
`ibuffer' was
called. Otherwise, this variable should be a string naming a
directory, like `default-directory'."
:type '(choice (const :tag "Inherit" :value nil)
- string)
- :group 'ibuffer)
+ string))
(defcustom ibuffer-help-buffer-modes
'(help-mode apropos-mode Info-mode Info-edit-mode)
"List of \"Help\" major modes."
- :type '(repeat function)
- :group 'ibuffer)
+ :type '(repeat function))
(defcustom ibuffer-compressed-file-name-regexp
"\\.\\(arj\\|bgz\\|bz2\\|gz\\|lzh\\|taz\\|tgz\\|xz\\|zip\\|z\\)$"
"Regexp to match compressed file names."
:version "24.1" ; added xz
- :type 'regexp
- :group 'ibuffer)
+ :type 'regexp)
(defcustom ibuffer-hook nil
"Hook run when `ibuffer' is called."
- :type 'hook
- :group 'ibuffer)
+ :type 'hook)
(defcustom ibuffer-mode-hook nil
"Hook run upon entry into `ibuffer-mode'."
:type 'hook
- :options '(ibuffer-auto-mode)
- :group 'ibuffer)
+ :options '(ibuffer-auto-mode))
(defcustom ibuffer-load-hook nil
"Hook run when Ibuffer is loaded."
- :type 'hook
- :group 'ibuffer)
+ :type 'hook)
(defcustom ibuffer-marked-face 'warning
"Face used for displaying marked buffers."
- :type 'face
- :group 'ibuffer)
+ :type 'face)
(defcustom ibuffer-deletion-face 'error
"Face used for displaying buffers marked for deletion."
- :type 'face
- :group 'ibuffer)
+ :type 'face)
(defcustom ibuffer-title-face 'font-lock-type-face
"Face used for the title string."
- :type 'face
- :group 'ibuffer)
+ :type 'face)
(defcustom ibuffer-filter-group-name-face 'bold
"Face used for displaying filtering group names."
- :type 'face
- :group 'ibuffer)
+ :type 'face)
(defcustom ibuffer-directory-abbrev-alist nil
"An alist of file name abbreviations like `directory-abbrev-alist'."
:type '(repeat (cons :format "%v"
:value ("" . "")
(regexp :tag "From")
- (regexp :tag "To")))
- :group 'ibuffer)
+ (regexp :tag "To"))))
(defvar ibuffer-mode-groups-popup
(let ((groups-map (make-sparse-keymap "Filter Groups")))
@@ -443,6 +421,49 @@ directory, like `default-directory'."
groups-map))
+(defvar ibuffer--filter-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'ibuffer-filter-by-mode)
+ (define-key map (kbd "m") 'ibuffer-filter-by-used-mode)
+ (define-key map (kbd "M") 'ibuffer-filter-by-derived-mode)
+ (define-key map (kbd "n") 'ibuffer-filter-by-name)
+ (define-key map (kbd "E") 'ibuffer-filter-by-process)
+ (define-key map (kbd "*") 'ibuffer-filter-by-starred-name)
+ (define-key map (kbd "f") 'ibuffer-filter-by-filename)
+ (define-key map (kbd "b") 'ibuffer-filter-by-basename)
+ (define-key map (kbd ".") 'ibuffer-filter-by-file-extension)
+ (define-key map (kbd "<") 'ibuffer-filter-by-size-lt)
+ (define-key map (kbd ">") 'ibuffer-filter-by-size-gt)
+ (define-key map (kbd "i") 'ibuffer-filter-by-modified)
+ (define-key map (kbd "v") 'ibuffer-filter-by-visiting-file)
+ (define-key map (kbd "c") 'ibuffer-filter-by-content)
+ (define-key map (kbd "e") 'ibuffer-filter-by-predicate)
+
+ (define-key map (kbd "r") 'ibuffer-switch-to-saved-filters)
+ (define-key map (kbd "a") 'ibuffer-add-saved-filters)
+ (define-key map (kbd "x") 'ibuffer-delete-saved-filters)
+ (define-key map (kbd "d") 'ibuffer-decompose-filter)
+ (define-key map (kbd "s") 'ibuffer-save-filters)
+ (define-key map (kbd "p") 'ibuffer-pop-filter)
+ (define-key map (kbd "<up>") 'ibuffer-pop-filter)
+ (define-key map (kbd "!") 'ibuffer-negate-filter)
+ (define-key map (kbd "t") 'ibuffer-exchange-filters)
+ (define-key map (kbd "TAB") 'ibuffer-exchange-filters)
+ (define-key map (kbd "o") 'ibuffer-or-filter)
+ (define-key map (kbd "|") 'ibuffer-or-filter)
+ (define-key map (kbd "&") 'ibuffer-and-filter)
+ (define-key map (kbd "g") 'ibuffer-filters-to-filter-group)
+ (define-key map (kbd "P") 'ibuffer-pop-filter-group)
+ (define-key map (kbd "S-<up>") 'ibuffer-pop-filter-group)
+ (define-key map (kbd "D") 'ibuffer-decompose-filter-group)
+ (define-key map (kbd "/") 'ibuffer-filter-disable)
+
+ (define-key map (kbd "S") 'ibuffer-save-filter-groups)
+ (define-key map (kbd "R") 'ibuffer-switch-to-saved-filter-groups)
+ (define-key map (kbd "X") 'ibuffer-delete-saved-filter-groups)
+ (define-key map (kbd "\\") 'ibuffer-clear-filter-groups)
+ map))
+
(defvar ibuffer-mode-map
(let ((map (make-keymap)))
(define-key map (kbd "0") 'digit-argument)
@@ -506,41 +527,6 @@ directory, like `default-directory'."
(define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process)
(define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode)
- (define-key map (kbd "/ RET") 'ibuffer-filter-by-mode)
- (define-key map (kbd "/ m") 'ibuffer-filter-by-used-mode)
- (define-key map (kbd "/ M") 'ibuffer-filter-by-derived-mode)
- (define-key map (kbd "/ n") 'ibuffer-filter-by-name)
- (define-key map (kbd "/ E") 'ibuffer-filter-by-process)
- (define-key map (kbd "/ *") 'ibuffer-filter-by-starred-name)
- (define-key map (kbd "/ f") 'ibuffer-filter-by-filename)
- (define-key map (kbd "/ b") 'ibuffer-filter-by-basename)
- (define-key map (kbd "/ .") 'ibuffer-filter-by-file-extension)
- (define-key map (kbd "/ <") 'ibuffer-filter-by-size-lt)
- (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt)
- (define-key map (kbd "/ i") 'ibuffer-filter-by-modified)
- (define-key map (kbd "/ v") 'ibuffer-filter-by-visiting-file)
- (define-key map (kbd "/ c") 'ibuffer-filter-by-content)
- (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate)
-
- (define-key map (kbd "/ r") 'ibuffer-switch-to-saved-filters)
- (define-key map (kbd "/ a") 'ibuffer-add-saved-filters)
- (define-key map (kbd "/ x") 'ibuffer-delete-saved-filters)
- (define-key map (kbd "/ d") 'ibuffer-decompose-filter)
- (define-key map (kbd "/ s") 'ibuffer-save-filters)
- (define-key map (kbd "/ p") 'ibuffer-pop-filter)
- (define-key map (kbd "/ <up>") 'ibuffer-pop-filter)
- (define-key map (kbd "/ !") 'ibuffer-negate-filter)
- (define-key map (kbd "/ t") 'ibuffer-exchange-filters)
- (define-key map (kbd "/ TAB") 'ibuffer-exchange-filters)
- (define-key map (kbd "/ o") 'ibuffer-or-filter)
- (define-key map (kbd "/ |") 'ibuffer-or-filter)
- (define-key map (kbd "/ &") 'ibuffer-and-filter)
- (define-key map (kbd "/ g") 'ibuffer-filters-to-filter-group)
- (define-key map (kbd "/ P") 'ibuffer-pop-filter-group)
- (define-key map (kbd "/ S-<up>") 'ibuffer-pop-filter-group)
- (define-key map (kbd "/ D") 'ibuffer-decompose-filter-group)
- (define-key map (kbd "/ /") 'ibuffer-filter-disable)
-
(define-key map (kbd "M-n") 'ibuffer-forward-filter-group)
(define-key map "\t" 'ibuffer-forward-filter-group)
(define-key map (kbd "M-p") 'ibuffer-backward-filter-group)
@@ -548,10 +534,6 @@ directory, like `default-directory'."
(define-key map (kbd "M-j") 'ibuffer-jump-to-filter-group)
(define-key map (kbd "C-k") 'ibuffer-kill-line)
(define-key map (kbd "C-y") 'ibuffer-yank)
- (define-key map (kbd "/ S") 'ibuffer-save-filter-groups)
- (define-key map (kbd "/ R") 'ibuffer-switch-to-saved-filter-groups)
- (define-key map (kbd "/ X") 'ibuffer-delete-saved-filter-groups)
- (define-key map (kbd "/ \\") 'ibuffer-clear-filter-groups)
(define-key map (kbd "% n") 'ibuffer-mark-by-name-regexp)
(define-key map (kbd "% m") 'ibuffer-mark-by-mode-regexp)
@@ -602,6 +584,8 @@ directory, like `default-directory'."
(define-key map (kbd "C-x 4 RET") 'ibuffer-visit-buffer-other-window)
(define-key map (kbd "C-x 5 RET") 'ibuffer-visit-buffer-other-frame)
+ (define-key map (kbd "/") ibuffer--filter-map)
+
(define-key map [menu-bar view]
(cons "View" (make-sparse-keymap "View")))
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 39ee1fb..3b50064 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -116,6 +116,7 @@ Examples of image filename patterns to match:
(defun iimage-mode-buffer (arg)
"Display images if ARG is non-nil, undisplay them otherwise."
(let ((image-path (cons default-directory iimage-mode-image-search-path))
+ (edges (window-inside-pixel-edges (get-buffer-window)))
file)
(with-silent-modifications
(save-excursion
@@ -128,10 +129,15 @@ Examples of image filename patterns to match:
;; remove them either (we may leave some of ours, and we
;; may remove other packages's display properties).
(if arg
- (add-text-properties (match-beginning 0) (match-end 0)
- `(display ,(create-image file)
- modification-hooks
- (iimage-modification-hook)))
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ `(display
+ ,(create-image file nil nil
+ :max-width (- (nth 2 edges) (nth 0 edges))
+ :max-height (- (nth 3 edges) (nth 1 edges)))
+ keymap ,image-map
+ modification-hooks
+ (iimage-modification-hook)))
(remove-text-properties (match-beginning 0) (match-end 0)
'(display modification-hooks))))))))))
diff --git a/lisp/image.el b/lisp/image.el
index c3e2865..b36a513 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -549,7 +549,7 @@ height of the image; integer values are taken as pixel
values."
`(display ,(if slice
(list (cons 'slice slice) image)
image)
- rear-nonsticky (display)
+ rear-nonsticky t
keymap ,image-map))))
diff --git a/lisp/info.el b/lisp/info.el
index 3203c5f..cc18ea1 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2452,11 +2452,12 @@ Table of contents is created from the tree structure of
menus."
"Insert table of contents with references to nodes."
(let ((section "Top"))
(while nodes
- (let ((node (assoc (car nodes) node-list)))
- (unless (member (nth 2 node) (list nil section))
- (insert (setq section (nth 2 node)) "\n"))
- (insert (make-string level ?\t))
- (insert "*Note " (car nodes) ":: \n")
+ (let ((node (assoc (car nodes) node-list))
+ (indentation (make-string level ?\t)))
+ (when (and (not (member (nth 2 node) (list nil section)))
+ (not (equal (nth 1 node) (nth 2 node))))
+ (insert indentation (setq section (nth 2 node)) "\n"))
+ (insert indentation "*Note " (car nodes) ":: \n")
(Info-toc-insert (nth 3 node) node-list (1+ level) curr-file)
(setq nodes (cdr nodes))))))
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index 93b1250..e247739 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -454,10 +454,10 @@ system, including many technical ones. Examples:
("\\lneq" ?≨)
("\\lneqq" ?≨)
("\\lnsim" ?⋦)
- ("\\longleftarrow" ?←)
- ("\\longleftrightarrow" ?↔)
- ("\\longmapsto" ?↦)
- ("\\longrightarrow" ?→)
+ ("\\longleftarrow" ?⟵)
+ ("\\longleftrightarrow" ?⟷)
+ ("\\longmapsto" ?⟼)
+ ("\\longrightarrow" ?⟶)
("\\looparrowleft" ?↫)
("\\looparrowright" ?↬)
("\\lozenge" ?✧)
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 66c56f0..e802c24 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -420,14 +420,7 @@ not contain `d', so that a full listing is expected."
attr (cdr elt)
file-size (file-attribute-size attr))
(and attr
- (setq sum (+ file-size
- ;; Even if neither SUM nor file's size
- ;; overflow, their sum could.
- (if (or (< sum (- 134217727 file-size))
- (floatp sum)
- (floatp file-size))
- sum
- (float sum))))
+ (setq sum (+ file-size sum))
(insert (ls-lisp-format short attr file-size
switches time-index))))
;; Insert total size of all files:
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index c637e24..13219a4 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -430,14 +430,10 @@ usually do not have translators for other
languages.\n\n")))
report-emacs-bug-orig-text)
(error "No text entered in bug report"))
;; Warning for novice users.
- (unless (or report-emacs-bug-no-confirmation
- (yes-or-no-p
- "Send this bug report to the Emacs maintainers? "))
- (goto-char (point-min))
- (if (search-forward "To: ")
- (delete-region (point) (line-end-position)))
- (if report-emacs-bug-send-hook
- (kill-local-variable report-emacs-bug-send-hook))
+ (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to"))
+ (not report-emacs-bug-no-confirmation)
+ (not (yes-or-no-p
+ "Send this bug report to the Emacs maintainers? ")))
(with-output-to-temp-buffer "*Bug Help*"
(princ (substitute-command-keys
(format "\
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 42ab35b..fc74122 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -695,8 +695,9 @@ footnote area, returns `point-max'."
;; If not within a footnote's text, fallback to the default.
(funcall orig-fun)))
-(defun footnote--fill-paragraph (justify)
- (when (footnote--text-under-cursor)
+(defun footnote--fill-paragraph (orig-fun justify)
+ (if (not (footnote--text-under-cursor))
+ (funcall orig-fun justify)
(let ((fill-paragraph-function nil)
(fill-prefix (if footnote-align-to-fn-text
(footnote--fill-prefix-string)
@@ -855,6 +856,23 @@ being set it is automatically widened."
map)
"Keymap used for binding footnote minor mode.")
+(defmacro footnote--local-advice (mode variable function)
+ "Add advice to a variable holding buffer-local functions.
+Typical use would be to advice variables like
+`fill-paragraph-function' from minor modes.
+
+MODE is the minor mode symbol, VARIABLE is the variable to get
+advice, and FUNCTION is what'll be added as an :around advice."
+ `(progn
+ (unless ,variable
+ ;; nil and `ignore' have the same semantics for adaptive-fill-function,
+ ;; but only `ignore' behaves correctly with add/remove-function.
+ (setq-local ,variable #'ignore))
+ (remove-function (local ',variable) #',function)
+ (when ,mode
+ (add-function :around (local ',variable)
+ #',function))))
+
;;;###autoload
(define-minor-mode footnote-mode
"Toggle Footnote mode.
@@ -865,13 +883,10 @@ play around with the following keys:
\\{footnote-minor-mode-map}"
:lighter footnote-mode-line-string
:keymap footnote-minor-mode-map
- ;; (filladapt-mode t)
- (unless adaptive-fill-function
- ;; nil and `ignore' have the same semantics for adaptive-fill-function,
- ;; but only `ignore' behaves correctly with add/remove-function.
- (setq adaptive-fill-function #'ignore))
- (remove-function (local 'adaptive-fill-function)
- #'footnote--adaptive-fill-function)
+ (footnote--local-advice footnote-mode adaptive-fill-function
+ footnote--adaptive-fill-function)
+ (footnote--local-advice footnote-mode fill-paragraph-function
+ footnote--fill-paragraph)
(when footnote-mode
;; (footnote-setup-keybindings)
(make-local-variable 'footnote-style)
@@ -882,9 +897,6 @@ play around with the following keys:
(make-local-variable 'footnote-start-tag)
(make-local-variable 'footnote-end-tag)
(make-local-variable 'adaptive-fill-function)
- (add-function :around (local 'adaptive-fill-function)
- #'footnote--adaptive-fill-function)
- (setq-local fill-paragraph-function #'footnote--fill-paragraph)
;; Filladapt was an XEmacs package which is now in GNU ELPA.
(when (boundp 'filladapt-token-table)
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index cbcbdfa..fd00dd1 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -284,11 +284,13 @@ comma-separated list, and return the pruned list."
;;;###autoload
-(defun mail-fetch-field (field-name &optional last all list)
+(defun mail-fetch-field (field-name &optional last all list delete)
"Return the value of the header field whose type is FIELD-NAME.
If second arg LAST is non-nil, use the last field of type FIELD-NAME.
If third arg ALL is non-nil, concatenate all such fields with commas between.
If 4th arg LIST is non-nil, return a list of all such fields.
+If 5th arg DELETE is non-nil, delete all header lines that are
+included in the result.
The buffer should be narrowed to just the header, else false
matches may be returned from the message body."
(save-excursion
@@ -311,7 +313,9 @@ matches may be returned from the message body."
(setq value (concat value
(if (string= value "") "" ", ")
(buffer-substring-no-properties
- opoint (point)))))))
+ opoint (point)))))
+ (if delete
+ (delete-region (point-at-bol) (point)))))
(if list
value
(and (not (string= value "")) value)))
@@ -324,7 +328,10 @@ matches may be returned from the message body."
;; Back up over newline, then trailing spaces or tabs
(forward-char -1)
(skip-chars-backward " \t" opoint)
- (buffer-substring-no-properties opoint (point)))))))))
+ (prog1
+ (buffer-substring-no-properties opoint (point))
+ (if delete
+ (delete-region (point-at-bol) (1+ (point))))))))))))
;; Parse a list of tokens separated by commas.
;; It runs from point to the end of the visible part of the buffer.
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 741c439..f6fd1cd 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -70,34 +70,29 @@
(defcustom smtpmail-default-smtp-server nil
"Specify default SMTP server.
This only has effect if you specify it before loading the smtpmail library."
- :type '(choice (const nil) string)
- :group 'smtpmail)
+ :type '(choice (const nil) string))
(defcustom smtpmail-smtp-server
(or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
"The name of the host running SMTP server."
- :type '(choice (const nil) string)
- :group 'smtpmail)
+ :type '(choice (const nil) string))
(defcustom smtpmail-smtp-service 25
"SMTP service port number.
The default value would be \"smtp\" or 25."
- :type '(choice (integer :tag "Port") (string :tag "Service"))
- :group 'smtpmail)
+ :type '(choice (integer :tag "Port") (string :tag "Service")))
(defcustom smtpmail-smtp-user nil
"User name to use when looking up credentials in the authinfo file.
If non-nil, only consider credentials for the specified user."
:version "24.1"
- :type '(choice (const nil) string)
- :group 'smtpmail)
+ :type '(choice (const nil) string))
(defcustom smtpmail-local-domain nil
"Local domain name without a host name.
If the function `system-name' returns the full internet address,
don't define this value."
- :type '(choice (const nil) string)
- :group 'smtpmail)
+ :type '(choice (const nil) string))
(defcustom smtpmail-stream-type nil
"Type of SMTP connections to use.
@@ -105,7 +100,6 @@ This may be either nil (upgrade with STARTTLS if possible),
`starttls' (refuse to send if STARTTLS isn't available),
`plain' (never use STARTTLS), or `ssl' (to use TLS/SSL)."
:version "24.1"
- :group 'smtpmail
:type '(choice (const :tag "Possibly upgrade to STARTTLS" nil)
(const :tag "Always use STARTTLS" starttls)
(const :tag "Never use STARTTLS" plain)
@@ -119,55 +113,57 @@ not include an @-sign, so that each RCPT TO address is
fully qualified.
Don't bother to set this unless you have get an error like:
Sending failed; 501 <someone>: recipient address must contain a domain."
- :type '(choice (const nil) string)
- :group 'smtpmail)
+ :type '(choice (const nil) string))
(defcustom smtpmail-debug-info nil
"Whether to print info in buffer *trace of SMTP session to <somewhere>*.
See also `smtpmail-debug-verb' which determines if the SMTP protocol should
be verbose as well."
- :type 'boolean
- :group 'smtpmail)
+ :type 'boolean)
(defcustom smtpmail-debug-verb nil
"Whether this library sends the SMTP VERB command or not.
The commands enables verbose information from the SMTP server."
- :type 'boolean
- :group 'smtpmail)
+ :type 'boolean)
(defcustom smtpmail-code-conv-from nil
"Coding system for encoding outgoing mail.
Used for the value of `sendmail-coding-system' when
`select-message-coding-system' is called."
- :type 'coding-system
- :group 'smtpmail)
+ :type 'coding-system)
(defcustom smtpmail-queue-mail nil
"Non-nil means mail is queued; otherwise it is sent immediately.
If queued, it is stored in the directory `smtpmail-queue-dir'
and sent with `smtpmail-send-queued-mail'."
- :type 'boolean
- :group 'smtpmail)
+ :type 'boolean)
(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
"Directory where `smtpmail.el' stores queued mail.
This directory should not be writable by other users."
- :type 'directory
- :group 'smtpmail)
+ :type 'directory)
(defcustom smtpmail-warn-about-unknown-extensions nil
"If set, print warnings about unknown SMTP extensions.
This is mainly useful for development purposes, to learn about
new SMTP extensions that might be useful to support."
:type 'boolean
- :version "21.1"
- :group 'smtpmail)
+ :version "21.1")
(defcustom smtpmail-queue-index-file "index"
"File name of queued mail index.
This is relative to `smtpmail-queue-dir'."
- :type 'string
- :group 'smtpmail)
+ :type 'string)
+
+(defcustom smtpmail-servers-requiring-authorization nil
+ "Regexp matching servers that require authorization.
+Normally smtpmail will try first to send emails via SMTP without
+user/password credentials, and then retry using credentials if
+the server says that it requires it. If the server name matches
+this regexp, smtpmail will send over the credentials on the first
+attempt."
+ :type '(choice regexp (const :tag "None" nil))
+ :version "27.1")
;; End of customizable variables.
@@ -679,6 +675,12 @@ Returns an error if the server cannot be contacted."
result
auth-mechanisms
(supported-extensions '()))
+
+ (when (and smtpmail-servers-requiring-authorization
+ (string-match-p smtpmail-servers-requiring-authorization
+ smtpmail-smtp-server))
+ (setq ask-for-password t))
+
(unwind-protect
(catch 'done
;; get or create the trace buffer
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index c017bae..ca74b2e 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -717,7 +717,7 @@ parsed."
((equal token "and") (push 'and op-stack))
((equal token ")")
(multiple-value-setq (op-stack operand-stack)
- (values-list (mh-index-evaluate op-stack operand-stack)))
+ (cl-values-list (mh-index-evaluate op-stack operand-stack)))
(when (eq (car op-stack) 'not)
(setq op-stack (cdr op-stack))
(push `(not ,(pop operand-stack)) operand-stack))
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 3e89d1b..fc661c8 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -452,7 +452,7 @@ be handled next."
(substring output position line-end))
mh-speed-partial-line "")
(multiple-value-setq (folder unseen total)
- (values-list
+ (cl-values-list
(mh-parse-flist-output-line line mh-speed-current-folder)))
(when (and folder unseen total
(let ((old-pair (gethash folder mh-speed-flists-cache)))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index aa31e25..6382e66 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -131,9 +131,36 @@
:group 'external
:group 'comm)
+(defvar browse-url--browser-defcustom-type
+ '(choice
+ (function-item :tag "Emacs W3" :value browse-url-w3)
+ (function-item :tag "eww" :value eww-browse-url)
+ (function-item :tag "Mozilla" :value browse-url-mozilla)
+ (function-item :tag "Firefox" :value browse-url-firefox)
+ (function-item :tag "Google Chrome" :value browse-url-chrome)
+ (function-item :tag "Chromium" :value browse-url-chromium)
+ (function-item :tag "Epiphany" :value browse-url-epiphany)
+ (function-item :tag "Conkeror" :value browse-url-conkeror)
+ (function-item :tag "Text browser in an xterm window"
+ :value browse-url-text-xterm)
+ (function-item :tag "Text browser in an Emacs window"
+ :value browse-url-text-emacs)
+ (function-item :tag "KDE" :value browse-url-kde)
+ (function-item :tag "Elinks" :value browse-url-elinks)
+ (function-item :tag "Specified by `Browse Url Generic Program'"
+ :value browse-url-generic)
+ (function-item :tag "Default Windows browser"
+ :value browse-url-default-windows-browser)
+ (function-item :tag "Default macOS browser"
+ :value browse-url-default-macosx-browser)
+ (function-item :tag "Default browser"
+ :value browse-url-default-browser)
+ (function :tag "Your own function")
+ (alist :tag "Regexp/function association list"
+ :key-type regexp :value-type function)))
+
;;;###autoload
-(defcustom browse-url-browser-function
- 'browse-url-default-browser
+(defcustom browse-url-browser-function 'browse-url-default-browser
"Function to display the current buffer in a WWW browser.
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
@@ -143,34 +170,17 @@ If the value is not a function it should be a list of
pairs
associated with the first REGEXP which matches the current URL. The
function is passed the URL and any other args of `browse-url'. The last
regexp should probably be \".\" to specify a default browser."
- :type '(choice
- (function-item :tag "Emacs W3" :value browse-url-w3)
- (function-item :tag "eww" :value eww-browse-url)
- (function-item :tag "Mozilla" :value browse-url-mozilla)
- (function-item :tag "Firefox" :value browse-url-firefox)
- (function-item :tag "Google Chrome" :value browse-url-chrome)
- (function-item :tag "Chromium" :value browse-url-chromium)
- (function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Conkeror" :value browse-url-conkeror)
- (function-item :tag "Text browser in an xterm window"
- :value browse-url-text-xterm)
- (function-item :tag "Text browser in an Emacs window"
- :value browse-url-text-emacs)
- (function-item :tag "KDE" :value browse-url-kde)
- (function-item :tag "Elinks" :value browse-url-elinks)
- (function-item :tag "Specified by `Browse Url Generic Program'"
- :value browse-url-generic)
- (function-item :tag "Default Windows browser"
- :value browse-url-default-windows-browser)
- (function-item :tag "Default macOS browser"
- :value browse-url-default-macosx-browser)
- (function-item :tag "Default browser"
- :value browse-url-default-browser)
- (function :tag "Your own function")
- (alist :tag "Regexp/function association list"
- :key-type regexp :value-type function))
- :version "24.1"
- :group 'browse-url)
+ :type browse-url--browser-defcustom-type
+ :version "24.1")
+
+(defcustom browse-url-secondary-browser-function 'browse-url-default-browser
+ "Function used to launch an alternative browser.
+This should usually be an external browser (that is, not eww or
+w3m), used as the secondary browser choice, and is typically used
+when giving a prefix argument to the URL-opening command (in
+those modes that support this (for instance, eww/shr)."
+ :version "27.1"
+ :type browse-url--browser-defcustom-type)
(defcustom browse-url-mailto-function 'browse-url-mail
"Function to display mailto: links.
@@ -181,8 +191,7 @@ be used instead."
:type '(choice
(function-item :tag "Emacs Mail" :value browse-url-mail)
(function-item :tag "None" nil))
- :version "24.1"
- :group 'browse-url)
+ :version "24.1")
(defcustom browse-url-man-function 'browse-url-man
"Function to display man: links."
@@ -190,8 +199,28 @@ be used instead."
(function-item :tag "Emacs Man" :value browse-url-man)
(const :tag "None" nil)
(function :tag "Other function"))
- :version "26.1"
- :group 'browse-url)
+ :version "26.1")
+
+(defcustom browse-url-button-regexp
+ (concat
+ "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
+ "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
+ "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
+ (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
+ (punct "!?:;.,"))
+ (concat
+ "\\(?:"
+ ;; Match paired parentheses, e.g. in Wikipedia URLs:
+ ;; http://thread.gmane.org/address@hidden
+ "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
+ "\\|"
+ "[" chars punct "]+" "[" chars "]"
+ "\\)"))
+ "\\)")
+ "Regular expression that matches URLs."
+ :version "27.1"
+ :type 'regexp)
(defcustom browse-url-netscape-program "netscape"
;; Info about netscape-remote from Karl Berry.
@@ -202,15 +231,13 @@ The free program `netscape-remote' from
up very much quicker than `netscape'. Reported to compile on a GNU
system, given vroot.h from the same directory, with cc flags
-DSTANDALONE -L/usr/X11R6/lib -lXmu -lX11."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-netscape-program nil "25.1")
(defcustom browse-url-netscape-arguments nil
"A list of strings to pass to Netscape as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-netscape-arguments nil "25.1")
@@ -218,33 +245,27 @@ system, given vroot.h from the same directory, with cc
flags
"A list of strings to pass to Netscape when it starts up.
Defaults to the value of `browse-url-netscape-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
-
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-netscape-startup-arguments nil "25.1")
(defcustom browse-url-browser-display nil
"The X display for running the browser, if not same as Emacs's."
- :type '(choice string (const :tag "Default" nil))
- :group 'browse-url)
+ :type '(choice string (const :tag "Default" nil)))
(defcustom browse-url-mozilla-program "mozilla"
"The name by which to invoke Mozilla."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-mozilla-arguments nil
"A list of strings to pass to Mozilla as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-mozilla-startup-arguments browse-url-mozilla-arguments
"A list of strings to pass to Mozilla when it starts up.
Defaults to the value of `browse-url-mozilla-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-firefox-program
(let ((candidates '("icecat" "iceweasel" "firefox")))
@@ -252,20 +273,17 @@ Defaults to the value of `browse-url-mozilla-arguments'
at the time
(setq candidates (cdr candidates)))
(or (car candidates) "firefox"))
"The name by which to invoke Firefox or a variant of it."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-firefox-arguments nil
"A list of strings to pass to Firefox (or variant) as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-firefox-startup-arguments browse-url-firefox-arguments
"A list of strings to pass to Firefox (or variant) when it starts up.
Defaults to the value of `browse-url-firefox-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-firefox-startup-arguments
"it no longer has any effect." "24.5")
@@ -277,14 +295,12 @@ Defaults to the value of `browse-url-firefox-arguments'
at the time
(or (car candidates) "chromium"))
"The name by which to invoke the Chrome browser."
:type 'string
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-chrome-arguments nil
"A list of strings to pass to Google Chrome as arguments."
:type '(repeat (string :tag "Argument"))
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-chromium-program
(let ((candidates '("chromium" "chromium-browser")))
@@ -293,26 +309,22 @@ Defaults to the value of `browse-url-firefox-arguments'
at the time
(or (car candidates) "chromium"))
"The name by which to invoke Chromium."
:type 'string
- :version "24.1"
- :group 'browse-url)
+ :version "24.1")
(defcustom browse-url-chromium-arguments nil
"A list of strings to pass to Chromium as arguments."
:type '(repeat (string :tag "Argument"))
- :version "24.1"
- :group 'browse-url)
+ :version "24.1")
(defcustom browse-url-galeon-program "galeon"
"The name by which to invoke Galeon."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-galeon-program nil "25.1")
(defcustom browse-url-galeon-arguments nil
"A list of strings to pass to Galeon as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-galeon-arguments nil "25.1")
@@ -320,27 +332,23 @@ Defaults to the value of `browse-url-firefox-arguments'
at the time
"A list of strings to pass to Galeon when it starts up.
Defaults to the value of `browse-url-galeon-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-galeon-startup-arguments nil "25.1")
(defcustom browse-url-epiphany-program "epiphany"
"The name by which to invoke Epiphany."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-epiphany-arguments nil
"A list of strings to pass to Epiphany as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-epiphany-startup-arguments browse-url-epiphany-arguments
"A list of strings to pass to Epiphany when it starts up.
Defaults to the value of `browse-url-epiphany-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
;; GNOME means of invoking either Mozilla or Netscape.
(defvar browse-url-gnome-moz-program "gnome-moz-remote")
@@ -350,8 +358,7 @@ Defaults to the value of `browse-url-epiphany-arguments' at
the time
(defcustom browse-url-gnome-moz-arguments '()
"A list of strings passed to the GNOME mozilla viewer as arguments."
:version "21.1"
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-gnome-moz-arguments nil "25.1")
@@ -359,30 +366,26 @@ Defaults to the value of `browse-url-epiphany-arguments'
at the time
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-mozilla' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-firefox-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-firefox' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-conkeror-new-window-is-buffer nil
"Whether to open up new windows in a buffer or a new window.
If non-nil, then open the URL in a new buffer rather than a new window if
`browse-url-conkeror' is asked to open it in a new window."
:version "25.1"
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-galeon-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-galeon' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(make-obsolete-variable 'browse-url-galeon-new-window-is-tab nil "25.1")
@@ -390,16 +393,14 @@ If non-nil, then open the URL in a new tab rather than a
new window if
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-epiphany' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-netscape-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new
window if `browse-url-netscape' is asked to open it in a new
window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(make-obsolete-variable 'browse-url-netscape-new-window-is-tab nil "25.1")
@@ -407,42 +408,36 @@ window."
"Non-nil means always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
commands reverses the effect of this variable."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-mosaic-program "xmosaic"
"The name by which to invoke Mosaic (or mMosaic)."
:type 'string
- :version "20.3"
- :group 'browse-url)
+ :version "20.3")
(make-obsolete-variable 'browse-url-mosaic-program nil "25.1")
(defcustom browse-url-mosaic-arguments nil
"A list of strings to pass to Mosaic as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1")
(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
"The name of the pidfile created by Mosaic."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1")
(defcustom browse-url-conkeror-program "conkeror"
"The name by which to invoke Conkeror."
:type 'string
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-conkeror-arguments nil
"A list of strings to pass to Conkeror as arguments."
:version "25.1"
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-filename-alist
`(("^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*" . "ftp://\\2/";)
@@ -473,26 +468,22 @@ address to an HTTP URL:
:type '(repeat (cons :format "%v"
(regexp :tag "Regexp")
(string :tag "Replacement")))
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-save-file nil
"If non-nil, save the buffer before displaying its file.
Used by the `browse-url-of-file' command."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-of-file-hook nil
"Hook run after `browse-url-of-file' has asked a browser to load a file."
- :type 'hook
- :group 'browse-url)
+ :type 'hook)
(defcustom browse-url-CCI-port 3003
"Port to access XMosaic via CCI.
This can be any number between 1024 and 65535 but must correspond to
the value set in the browser."
- :type 'integer
- :group 'browse-url)
+ :type 'integer)
(make-obsolete-variable 'browse-url-CCI-port nil "25.1")
@@ -500,8 +491,7 @@ the value set in the browser."
"Host to access XMosaic via CCI.
This should be the host name of the machine running XMosaic with CCI
enabled. The port number should be set in `browse-url-CCI-port'."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-CCI-host nil "25.1")
@@ -511,57 +501,48 @@ enabled. The port number should be set in
`browse-url-CCI-port'."
(defcustom browse-url-xterm-program "xterm"
"The name of the terminal emulator used by `browse-url-text-xterm'.
This might, for instance, be a separate color version of xterm."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-xterm-args nil
"A list of strings defining options for `browse-url-xterm-program'.
These might set its size, for instance."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-gnudoit-program "gnudoit"
"The name of the `gnudoit' program used by `browse-url-w3-gnudoit'."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-gnudoit-args '("-q")
"A list of strings defining options for `browse-url-gnudoit-program'.
These might set the port, for instance."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-generic-program nil
"The name of the browser program used by `browse-url-generic'."
- :type '(choice string (const :tag "None" nil))
- :group 'browse-url)
+ :type '(choice string (const :tag "None" nil)))
(defcustom browse-url-generic-args nil
"A list of strings defining options for `browse-url-generic-program'."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-temp-dir temporary-file-directory
"The name of a directory for browse-url's temporary files.
Such files are generated by functions like `browse-url-of-region'.
You might want to set this to somewhere with restricted read permissions
for privacy's sake."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-netscape-version 3
"The version of Netscape you are using.
This affects how URL reloading is done; the mechanism changed
incompatibly at version 4."
- :type 'number
- :group 'browse-url)
+ :type 'number)
(make-obsolete-variable 'browse-url-netscape-version nil "25.1")
(defcustom browse-url-text-browser "lynx"
"The name of the text browser to invoke."
:type 'string
- :group 'browse-url
:version "23.1")
(defcustom browse-url-text-emacs-args (and (not window-system)
@@ -572,8 +553,7 @@ The default is none in a window system, otherwise
`-show_cursor' to
indicate the position of the current link in the absence of
highlighting, assuming the normal default for showing the cursor."
:type '(repeat (string :tag "Argument"))
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-text-input-field 'avoid
"Action on selecting an existing text browser buffer at an input field.
@@ -586,36 +566,30 @@ down (this *won't* always work)."
:type '(choice (const :tag "Move to try to avoid field" :value avoid)
(const :tag "Disregard" :value nil)
(const :tag "Warn, don't emit URL" :value warn))
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-text-input-attempts 10
"How many times to try to move down from a series of text browser input
fields."
:type 'integer
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-text-input-delay 0.2
"Seconds to wait for a text browser between moves down from an input field."
:type 'number
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-kde-program "kfmclient"
"The name by which to invoke the KDE web browser."
:type 'string
- :version "21.1"
- :group 'browse-url)
+ :version "21.1")
(defcustom browse-url-kde-args '("openURL")
"A list of strings defining options for `browse-url-kde-program'."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-elinks-wrapper '("xterm" "-e")
"Wrapper command prepended to the Elinks command-line."
- :type '(repeat (string :tag "Wrapper"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Wrapper")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding
@@ -1673,6 +1647,67 @@ from `browse-url-elinks-wrapper'."
(error "Unrecognized exit-code %d of process `elinks'"
exit-status))))
+;;; Adding buttons to a buffer to call `browse-url' when you hit them.
+
+(defvar browse-url-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'browse-url-button-open)
+ (define-key map [mouse-2] 'browse-url-button-open)
+ (define-key map "w" 'browse-url-button-copy)
+ map)
+ "The keymap used for browse-url buttons.")
+
+(defface browse-url-button
+ '((t :inherit link))
+ "Face for browse-url buttons (i.e., links)."
+ :version "27.1")
+
+(defun browse-url-add-buttons ()
+ "Add clickable buttons to the text following point in the current buffer.
+Everything that matches `browse-url-button-regexp' will be made
+clickable and will use `browse-url' to open the URLs in question."
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (while (re-search-forward browse-url-button-regexp nil t)
+ (add-text-properties (match-beginning 0)
+ (match-end 0)
+ `(help-echo "Open the URL under point"
+ keymap ,browse-url-button-map
+ face browse-url-button
+ button t
+ category browse-url
+ browse-url-data ,(match-string
0)))))))
+
+(defun browse-url-button-open (&optional external mouse-event)
+ "Follow the link under point using `browse-url'.
+If EXTERNAL (the prefix if used interactively), open with the
+external browser instead of the default one."
+ (interactive (list current-prefix-arg last-nonmenu-event))
+ (mouse-set-point mouse-event)
+ (let ((url (get-text-property (point) 'browse-url-data)))
+ (unless url
+ (error "No URL under point"))
+ (if external
+ (funcall browse-url-secondary-browser-function url)
+ (browse-url url))))
+
+(defun browse-url-button-open-url (url)
+ "Open URL using `browse-url'.
+If `current-prefix-arg' is non-nil, use
+`browse-url-secondary-browser-function' instead."
+ (if current-prefix-arg
+ (funcall browse-url-secondary-browser-function url)
+ (browse-url url)))
+
+(defun browse-url-button-copy ()
+ "Copy the URL under point"
+ (interactive)
+ (let ((url (get-text-property (point) 'browse-url-data)))
+ (unless url
+ (error "No URL under point"))
+ (kill-new url)
+ (message "Copied %s" url)))
+
(provide 'browse-url)
;;; browse-url.el ends here
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 206f9cf..77e6cec 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1501,13 +1501,17 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-browse-with-external-browser (&optional url)
"Browse the current URL with an external browser.
-The browser to used is specified by the `shr-external-browser' variable."
+The browser to used is specified by the
+`browse-url-secondary-browser-function' variable."
(interactive)
- (funcall shr-external-browser (or url (plist-get eww-data :url))))
+ (funcall browse-url-secondary-browser-function
+ (or url (plist-get eww-data :url))))
(defun eww-follow-link (&optional external mouse-event)
"Browse the URL under point.
-If EXTERNAL is single prefix, browse the URL using `shr-external-browser'.
+If EXTERNAL is single prefix, browse the URL using
+`browse-url-secondary-browser-function'.
+
If EXTERNAL is double prefix, browse in new buffer."
(interactive (list current-prefix-arg last-nonmenu-event))
(mouse-set-point mouse-event)
@@ -1518,7 +1522,7 @@ If EXTERNAL is double prefix, browse in new buffer."
((string-match "^mailto:"; url)
(browse-url-mail url))
((and (consp external) (<= (car external) 4))
- (funcall shr-external-browser url)
+ (funcall browse-url-secondary-browser-function url)
(shr--blink-link))
;; This is a #target url in the same page as the current one.
((and (url-target (url-generic-parse-url url))
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index 599e230..ddb4139 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -611,14 +611,14 @@ Return the response string if optional second argument is
non-nil."
If NOW, use that time instead."
(require 'parse-time)
(let* ((now (or now (current-time)))
- (zone (nth 8 (decode-time now))))
+ (zone (decoded-time-zone (decode-time now))))
(when (< zone 0)
(setq zone (- zone)))
(concat
(format-time-string "%d" now)
;; The month name of the %b spec is locale-specific. Pfff.
(format " %s "
- (capitalize (car (rassoc (nth 4 (decode-time now))
+ (capitalize (car (rassoc (decoded-time-month (decode-time now))
parse-time-months))))
(format-time-string "%Y %H:%M:%S %z" now))))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 24084c8..5722582 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -44,6 +44,7 @@
(require 'cl-lib)
(require 'ring)
(require 'time-date)
+(eval-when-compile (require 'subr-x))
(defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))
@@ -1181,6 +1182,8 @@ with it."
rcirc-log-directory)
(rcirc-log-write))
(rcirc-clean-up-buffer "Killed buffer")
+ (when-let ((process (get-buffer-process (current-buffer))))
+ (delete-process process))
(when (and rcirc-buffer-alist ;; it's a server buffer
rcirc-kill-channel-buffers)
(dolist (channel rcirc-buffer-alist)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 5001743..fbd1a9b 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -53,53 +53,44 @@ width and height of the window. If they are larger than
this,
and Emacs supports it, then the images will be rescaled down to
fit these criteria."
:version "24.1"
- :group 'shr
:type 'float)
(defcustom shr-blocked-images nil
"Images that have URLs matching this regexp will be blocked."
:version "24.1"
- :group 'shr
:type '(choice (const nil) regexp))
(defcustom shr-use-fonts t
"If non-nil, use proportional fonts for text."
:version "25.1"
- :group 'shr
:type 'boolean)
(defcustom shr-discard-aria-hidden nil
"If non-nil, don't render tags with `aria-hidden=\"true\"'.
This attribute is meant to tell screen readers to ignore a tag."
:version "27.1"
- :group 'shr
:type 'boolean)
(defcustom shr-use-colors t
"If non-nil, respect color specifications in the HTML."
:version "26.1"
- :group 'shr
:type 'boolean)
(defcustom shr-table-horizontal-line nil
"Character used to draw horizontal table lines.
If nil, don't draw horizontal table lines."
- :group 'shr
:type '(choice (const nil) character))
(defcustom shr-table-vertical-line ?\s
"Character used to draw vertical table lines."
- :group 'shr
:type 'character)
(defcustom shr-table-corner ?\s
"Character used to draw table corners."
- :group 'shr
:type 'character)
(defcustom shr-hr-line ?-
"Character used to draw hr lines."
- :group 'shr
:type 'character)
(defcustom shr-width nil
@@ -110,8 +101,7 @@ If `shr-use-fonts' is set, the mean character width is used
to
compute the pixel width, which is used instead."
:version "25.1"
:type '(choice (integer :tag "Fixed width in characters")
- (const :tag "Use the width of the window" nil))
- :group 'shr)
+ (const :tag "Use the width of the window" nil)))
(defcustom shr-bullet "* "
"Bullet used for unordered lists.
@@ -119,19 +109,14 @@ Alternative suggestions are:
- \" \"
- \" \""
:version "24.4"
- :type 'string
- :group 'shr)
+ :type 'string)
-(defcustom shr-external-browser 'browse-url-default-browser
- "Function used to launch an external browser."
- :version "24.4"
- :group 'shr
- :type 'function)
+(define-obsolete-variable-alias 'shr-external-browser
+ 'browse-url-secondary-browser-function "27.1")
(defcustom shr-image-animate t
"Non nil means that images that can be animated will be."
:version "24.4"
- :group 'shr
:type 'boolean)
(defvar shr-content-function nil
@@ -144,28 +129,24 @@ cid: URL as the argument.")
(defface shr-strike-through '((t :strike-through t))
"Face for <s> elements."
- :version "24.1"
- :group 'shr)
+ :version "24.1")
(defface shr-link
'((t :inherit link))
"Face for link elements."
- :version "24.1"
- :group 'shr)
+ :version "24.1")
(defface shr-selected-link
'((t :inherit shr-link :background "red"))
"Temporary face for externally visited link elements.
When a link is visited with an external browser, the link
temporarily blinks with this face."
- :version "27.1"
- :group 'shr)
+ :version "27.1")
(defface shr-abbreviation
'((t :inherit underline :underline (:style wave)))
"Face for <abbr> elements."
- :version "27.1"
- :group 'shr)
+ :version "27.1")
(defvar shr-inhibit-images nil
"If non-nil, inhibit loading images.")
@@ -973,7 +954,7 @@ size, and full-buffer size."
(defun shr-browse-url (&optional external mouse-event)
"Browse the URL at point using `browse-url'.
If EXTERNAL is non-nil (interactively, the prefix argument), browse
-the URL using `shr-external-browser'.
+the URL using `browse-url-secondary-browser-function'.
If this function is invoked by a mouse click, it will browse the URL
at the position of the click. Optional argument MOUSE-EVENT describes
the mouse click event."
@@ -988,7 +969,7 @@ the mouse click event."
(t
(if external
(progn
- (funcall shr-external-browser url)
+ (funcall browse-url-secondary-browser-function url)
(shr--blink-link))
(browse-url url))))))
@@ -1226,6 +1207,8 @@ START, and END. Note that START and END should be
markers."
(add-text-properties
start (point)
(list 'shr-url url
+ 'button t
+ 'category 'shr ; For button.el button buffers.
'help-echo (let ((parsed (url-generic-parse-url
(or (ignore-errors
(decode-coding-string
@@ -1534,7 +1517,6 @@ The key element should be a regexp matched against the
type of the source or
url if no type is specified. The value should be a float in the range 0.0 to
1.0. Media elements with higher value are preferred."
:version "24.4"
- :group 'shr
:type '(alist :key-type regexp :value-type float))
(defun shr--get-media-pref (elem)
@@ -1745,7 +1727,7 @@ The preference is a float determined from
`shr-prefer-media-type'."
(svg-gradient svg "background" 'linear '((0 . "#b0b0b0") (100 .
"#808080")))
(svg-rectangle svg 0 0 width height :gradient "background"
:stroke-width 2 :stroke-color "black")
- (let ((image (svg-image svg)))
+ (let ((image (svg-image svg :scale 1)))
(setf (image-property image :ascent) 100)
image)))
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 1632ee1..5526d62 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -464,8 +464,14 @@ position.
This is a specialization of `soap-encode-value' for
`soap-xs-basic-type' objects."
- (let ((kind (soap-xs-basic-type-kind type)))
-
+ (let ((kind (soap-xs-basic-type-kind type))
+ ;; Handle conversions of this form:
+ ;; (Element (AttrA . "A") (AttrB . "B") "Value here")
+ ;; to:
+ ;; <ns:Element AttrA="A" AttrB="B">Value here</ns:Element>
+ ;; by assuming that if this is a list, it must have attributes
+ ;; preceding the basic value.
+ (value (if (listp value) (progn (car (last value))) value)))
(when (eq kind 'anyType)
(cond ((stringp value)
(setq kind 'string))
@@ -1346,14 +1352,25 @@ See also `soap-wsdl-resolve-references'."
(defun soap-encode-xs-simple-type-attributes (value type)
"Encode the XML attributes for VALUE according to TYPE.
-The xsi:type and an optional xsi:nil attributes are added. The
-attributes are inserted in the current buffer at the current
-position.
+The attributes are inserted in the current buffer at the current
+position. If TYPE has no attributes, the xsi:type attribute and
+an optional xsi:nil attribute are added.
This is a specialization of `soap-encode-attributes' for
`soap-xs-simple-type' objects."
- (insert " xsi:type=\"" (soap-element-fq-name type) "\"")
- (unless value (insert " xsi:nil=\"true\"")))
+ (let ((attributes (soap-get-xs-attributes type)))
+ (dolist (a attributes)
+ (let ((element-name (soap-element-name a)))
+ (if (soap-xs-attribute-default a)
+ (insert " " element-name
+ "=\"" (soap-xs-attribute-default a) "\"")
+ (dolist (value-pair value)
+ (when (equal element-name (symbol-name (car-safe value-pair)))
+ (insert " " element-name
+ "=\"" (cdr value-pair) "\""))))))
+ (unless attributes
+ (insert " xsi:type=\"" (soap-element-fq-name type) "\"")
+ (unless value (insert " xsi:nil=\"true\"")))))
(defun soap-encode-xs-simple-type (value type)
"Encode the VALUE according to TYPE.
@@ -1643,7 +1660,8 @@ This is a specialization of `soap-encode-value' for
(array
(error "Arrays of type soap-encode-xs-complex-type are handled
elsewhere"))
((sequence choice all nil)
- (let ((type-list (list type)))
+ (let ((type-list (list type))
+ (type-elements '()))
;; Collect all base types
(let ((base (soap-xs-complex-type-base type)))
@@ -1651,60 +1669,66 @@ This is a specialization of `soap-encode-value' for
(push base type-list)
(setq base (soap-xs-complex-type-base base))))
+ ;; Collect type elements, eliminating duplicates from the type
+ ;; hierarchy.
(dolist (type type-list)
(dolist (element (soap-xs-complex-type-elements type))
- (catch 'done
- (let ((instance-count 0))
- (dolist (candidate (soap-get-candidate-elements element))
- (let ((e-name (soap-xs-element-name candidate)))
- (if e-name
- (let ((e-name (intern e-name)))
- (dolist (v value)
- (when (equal (car v) e-name)
- (cl-incf instance-count)
- (soap-encode-value (cdr v) candidate))))
- (if (soap-xs-complex-type-indicator type)
- (let ((current-point (point)))
- ;; Check if encoding happened by checking if
- ;; characters were inserted in the buffer.
- (soap-encode-value value candidate)
- (when (not (equal current-point (point)))
- (cl-incf instance-count)))
+ (unless (member element type-elements)
+ (setq type-elements (append type-elements (list element))))))
+
+ (dolist (element type-elements)
+ (catch 'done
+ (let ((instance-count 0))
+ (dolist (candidate (soap-get-candidate-elements element))
+ (let ((e-name (soap-xs-element-name candidate)))
+ (if e-name
+ (let ((e-name (intern e-name)))
(dolist (v value)
- (let ((current-point (point)))
- (soap-encode-value v candidate)
- (when (not (equal current-point (point)))
- (cl-incf instance-count))))))))
- ;; Do some sanity checking
- (let* ((indicator (soap-xs-complex-type-indicator type))
- (element-type (soap-xs-element-type element))
- (reference (soap-xs-element-reference element))
- (e-name (or (soap-xs-element-name element)
- (and reference
- (soap-xs-element-name reference)))))
- (cond ((and (eq indicator 'choice)
- (> instance-count 0))
- ;; This was a choice node and we encoded
- ;; one instance.
- (throw 'done t))
- ((and (not (eq indicator 'choice))
- (= instance-count 0)
- (not (soap-xs-element-optional? element))
- (and (soap-xs-complex-type-p element-type)
- (not (soap-xs-complex-type-optional-p
- element-type))))
- (soap-warning
- "While encoding %s: missing non-nillable slot %s"
- value e-name))
- ((and (> instance-count 1)
- (not (soap-xs-element-multiple? element))
- (and (soap-xs-complex-type-p element-type)
- (not (soap-xs-complex-type-multiple-p
- element-type))))
- (soap-warning
- (concat "While encoding %s: expected single,"
- " found multiple elements for slot %s")
- value e-name))))))))))
+ (when (equal (car v) e-name)
+ (cl-incf instance-count)
+ (soap-encode-value (cdr v) candidate))))
+ (if (soap-xs-complex-type-indicator type)
+ (let ((current-point (point)))
+ ;; Check if encoding happened by checking if
+ ;; characters were inserted in the buffer.
+ (soap-encode-value value candidate)
+ (when (not (equal current-point (point)))
+ (cl-incf instance-count)))
+ (dolist (v value)
+ (let ((current-point (point)))
+ (soap-encode-value v candidate)
+ (when (not (equal current-point (point)))
+ (cl-incf instance-count))))))))
+ ;; Do some sanity checking
+ (let* ((indicator (soap-xs-complex-type-indicator type))
+ (element-type (soap-xs-element-type element))
+ (reference (soap-xs-element-reference element))
+ (e-name (or (soap-xs-element-name element)
+ (and reference
+ (soap-xs-element-name reference)))))
+ (cond ((and (eq indicator 'choice)
+ (> instance-count 0))
+ ;; This was a choice node and we encoded
+ ;; one instance.
+ (throw 'done t))
+ ((and (not (eq indicator 'choice))
+ (= instance-count 0)
+ (not (soap-xs-element-optional? element))
+ (and (soap-xs-complex-type-p element-type)
+ (not (soap-xs-complex-type-optional-p
+ element-type))))
+ (soap-warning
+ "While encoding %s: missing non-nillable slot %s"
+ value e-name))
+ ((and (> instance-count 1)
+ (not (soap-xs-element-multiple? element))
+ (and (soap-xs-complex-type-p element-type)
+ (not (soap-xs-complex-type-multiple-p
+ element-type))))
+ (soap-warning
+ (concat "While encoding %s: expected single,"
+ " found multiple elements for slot %s")
+ value e-name)))))))))
(t
(error "Don't know how to encode complex type: %s"
(soap-xs-complex-type-indicator type)))))
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index ad78d08..623a666 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -530,16 +530,13 @@ Many aspects this mode can be customized using
(setq-local syntax-propertize-function #'nxml-syntax-propertize)
(add-hook 'change-major-mode-hook #'nxml-cleanup nil t)
- ;; Emacs 23 handles the encoding attribute on the xml declaration
- ;; transparently to nxml-mode, so there is no longer a need for the below
- ;; hook. The hook also had the drawback of overriding explicit user
- ;; instruction to save as some encoding other than utf-8.
- ;;(add-hook 'write-contents-hooks #'nxml-prepare-to-save)
(when (not (and (buffer-file-name) (file-exists-p (buffer-file-name))))
(when (and nxml-default-buffer-file-coding-system
(not (local-variable-p 'buffer-file-coding-system)))
(setq buffer-file-coding-system nxml-default-buffer-file-coding-system))
- (when nxml-auto-insert-xml-declaration-flag
+ ;; When starting a new file, insert the XML declaraction.
+ (when (and nxml-auto-insert-xml-declaration-flag
+ (zerop (buffer-size)))
(nxml-insert-xml-declaration)))
(setq font-lock-defaults
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index 2cb2766..15e9564 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -242,9 +242,7 @@ If `org-store-link' was called with a prefix arg the
meaning of
(_
(let ((articles 1)
group-opened)
- (while (and (not group-opened)
- ;; Stop on integer overflows.
- (> articles 0))
+ (while (not group-opened)
(setq group-opened (gnus-group-read-group articles t group))
(setq articles (if (< articles 16)
(1+ articles)
diff --git a/lisp/proced.el b/lisp/proced.el
index b05046b..5f35fa3 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1367,12 +1367,12 @@ Prefix ARG controls sort order, see
`proced-sort-interactive'."
The return string is always 6 characters wide."
(let ((d-start (decode-time start))
(d-current (decode-time)))
- (cond ( ;; process started in previous years
- (< (nth 5 d-start) (nth 5 d-current))
+ (cond (;; process started in previous years
+ (< (decoded-time-year d-start) (decoded-time-year d-current))
(format-time-string " %Y" start))
;; process started today
- ((and (= (nth 3 d-start) (nth 3 d-current))
- (= (nth 4 d-start) (nth 4 d-current)))
+ ((and (= (decoded-time-day d-start) (decoded-time-day d-current))
+ (= (decoded-time-month d-start) (decoded-time-month
d-current)))
(format-time-string " %H:%M" start))
(t ;; process started this year
(format-time-string "%b %e" start)))))
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 7750962..92495e2 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -473,6 +473,7 @@ this variable directly.")
(fboundp entry))
(propertize (symbol-name entry)
'face 'link
+ 'follow-link "\r"
'mouse-face 'highlight
'help-echo "\
mouse-2: jump to definition\n\
@@ -534,9 +535,9 @@ RET: expand or collapse"))
(define-key map "\r" 'profiler-report-toggle-entry)
(define-key map "\t" 'profiler-report-toggle-entry)
(define-key map "i" 'profiler-report-toggle-entry)
- (define-key map [mouse-1] 'profiler-report-toggle-entry)
(define-key map "f" 'profiler-report-find-entry)
(define-key map "j" 'profiler-report-find-entry)
+ (define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'profiler-report-find-entry)
(define-key map "d" 'profiler-report-describe-entry)
(define-key map "C" 'profiler-report-render-calltree)
@@ -614,9 +615,12 @@ return it."
(profiler-report-render-calltree))
buffer))
+(defun profiler--xref-backend () 'elisp)
+
(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
"Profiler Report Mode."
(add-to-invisibility-spec '(profiler . t))
+ (add-hook 'xref-backend-functions #'profiler--xref-backend nil t)
(setq buffer-read-only t
buffer-undo-list t
truncate-lines t))
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 1a67a95..0fd850e 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -215,10 +215,10 @@
(defconst c-awk-neutrals*-re
(concat "\\(" c-awk-neutral-re "\\)*"))
;; A (possibly empty) string of neutral characters (or character pairs).
-(defconst c-awk-var-num-ket-re "[])0-9a-zA-Z_$.\x80-\xff]+")
+(defconst c-awk-var-num-ket-re "[])0-9a-zA-Z_$.]+")
;; Matches a char which is a constituent of a variable or number, or a ket
-;; (i.e. closing bracKET), round or square. Assume that all characters \x80 to
-;; \xff are "letters".
+;; (i.e. closing bracKET), round or square. (2019-07): No longer assume that
+;; all characters \x80 to \xff are "letters".
(defconst c-awk-div-sign-re
(concat c-awk-var-num-ket-re c-awk-neutrals*-re "/"))
;; Will match a piece of AWK buffer ending in / which is a division sign, in
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index efc6747..2ccdc1d 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1775,7 +1775,7 @@ defun."
(setq arg (1+ arg)))
(if (< arg 0)
(c-while-widening-to-decl-block
- (< (setq arg (- (c-forward-to-nth-EOF-} (- arg) where))) 0)))
+ (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where)))
0)))
;; Move forward to the next opening brace....
(when (and (= arg 0)
(progn
@@ -1811,10 +1811,11 @@ defun."
(c-keep-region-active)
(= arg 0)))))
-(defun c-forward-to-nth-EOF-} (n where)
- ;; Skip to the closing brace of the Nth function after point. If
- ;; point is inside a function, this counts as the first. Point must be
- ;; outside any comment/string or macro.
+(defun c-forward-to-nth-EOF-\;-or-} (n where)
+ ;; Skip to the closing brace or semicolon of the Nth function after point.
+ ;; We move to a semicolon only for things like structs which don't end at a
+ ;; closing brace. If point is inside a function, this counts as the first.
+ ;; Point must be outside any comment/string or macro.
;;
;; N must be strictly positive.
;; WHERE describes the position of point, one of the symbols `at-header',
@@ -1836,23 +1837,24 @@ defun."
(forward-sexp)
(setq n (1- n)))
((eq where 'in-trailer)
- (c-syntactic-skip-backward "^}")
+ ;; The actual movement is done below.
(setq n (1- n)))
((memq where '(at-function-end outwith-function at-header in-header))
(when (c-syntactic-re-search-forward "{" nil 'eob)
(backward-char)
(forward-sexp)
(setq n (1- n))))
- (t (error "c-forward-to-nth-EOF-}: `where' is %s" where)))
+ (t (error "c-forward-to-nth-EOF-\\;-or-}: `where' is %s" where)))
+
+ (when (c-in-function-trailer-p)
+ (c-syntactic-re-search-forward ";" nil 'eob t))
;; Each time round the loop, go forward to a "}" at the outermost level.
(while (and (> n 0) (not (eobp)))
- ;(c-parse-state) ; This call
speeds up the following one by a factor
- ; of ~6. Hmmm. 2006/4/5.
(when (c-syntactic-re-search-forward "{" nil 'eob)
(backward-char)
- (forward-sexp))
- (setq n (1- n)))
+ (forward-sexp)
+ (setq n (1- n))))
n)
(defun c-end-of-defun (&optional arg)
@@ -1907,7 +1909,7 @@ the open-parenthesis that starts a defun; see
`beginning-of-defun'."
;; Move forward to the } of a function
(if (> arg 0)
(c-while-widening-to-decl-block
- (> (setq arg (c-forward-to-nth-EOF-} arg where)) 0))))
+ (> (setq arg (c-forward-to-nth-EOF-\;-or-} arg where)) 0))))
;; Do we need to move forward from the brace to the semicolon?
(when (eq arg 0)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e7bae0e..37d4591 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -713,6 +713,10 @@ comment at the start of cc-engine.el for more info."
;; the byte compiler.
(defvar c-maybe-labelp)
+(defvar c-commas-bound-stmts nil)
+ ;; Set to non-nil when `c-beginning-of-statement-1' is to regard a comma as
+ ;; a statement terminator.
+
;; New awk-compatible version of c-beginning-of-statement-1, ACM 2002/6/22
;; Macros used internally in c-beginning-of-statement-1 for the
@@ -897,9 +901,7 @@ comment at the start of cc-engine.el for more info."
(start (point))
macro-start
(delims (if comma-delim '(?\; ?,) '(?\;)))
- (c-stmt-delim-chars (if comma-delim
- c-stmt-delim-chars-with-comma
- c-stmt-delim-chars))
+ (c-commas-bound-stmts (or c-commas-bound-stmts comma-delim))
c-maybe-labelp after-case:-pos saved
;; Current position.
pos
@@ -1422,21 +1424,12 @@ the line. If this virtual semicolon is _at_ from, the
function recognizes it.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
- (let* ((skip-chars
- ;; If the current language has CPP macros, insert # into skip-chars.
- (if c-opt-cpp-symbol
- (concat (substring c-stmt-delim-chars 0 1) ; "^"
- c-opt-cpp-symbol ; usually "#"
- (substring c-stmt-delim-chars 1)) ; e.g. ";{}?:"
- c-stmt-delim-chars))
- (skip-chars
- (if (c-major-mode-is 'c++-mode)
- (concat (substring skip-chars 0 1) ; "^"
- "[" ; to catch C++ attributes
- (substring skip-chars 1)) ; e.g. "#;{}?:"
- skip-chars))
- (non-skip-list
- (append (substring skip-chars 1) nil)) ; e.g. (?# ?\; ?{ ?} ?? ?:)
+ (let* ((skip-chars (if c-commas-bound-stmts
+ c-stmt-boundary-skip-chars-with-comma
+ c-stmt-boundary-skip-chars)) ; e.g. "^#;{}?:"
+ (non-skip-list (if c-commas-bound-stmts
+ c-stmt-boundary-skip-list-with-comma
+ c-stmt-boundary-skip-list)) ; e.g. (?# ?\; ?{ ?} ??
?:)
lit-range lit-start vsemi-pos attr-end)
(save-restriction
(widen)
@@ -1477,7 +1470,11 @@ comment at the start of cc-engine.el for more info."
;; A question mark. Can't be a label, so stop
;; looking for more : and ?.
(setq c-maybe-labelp nil
- skip-chars (substring c-stmt-delim-chars 0 -2)))
+ skip-chars
+ (substring (if c-commas-bound-stmts
+ c-stmt-delim-chars-with-comma
+ c-stmt-delim-chars)
+ 0 -2)))
;; At a CPP construct or a "#" or "##" operator?
((and c-opt-cpp-symbol (looking-at c-opt-cpp-symbol))
(if (save-excursion
@@ -1513,7 +1510,13 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(let ((end (point))
c-maybe-labelp)
- (c-syntactic-skip-backward (substring c-stmt-delim-chars 1) nil t)
+ (c-syntactic-skip-backward
+ (substring
+ (if c-commas-bound-stmts
+ c-stmt-delim-chars-with-comma
+ c-stmt-delim-chars)
+ 1)
+ nil t)
(or (bobp)
(eq (char-before) ?})
(and (eq (char-before) ?{)
@@ -1540,9 +1543,10 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(let ((end (point))
- (c-stmt-delim-chars c-stmt-delim-chars-with-comma)
+ (c-commas-bound-stmts t)
c-maybe-labelp)
- (c-syntactic-skip-backward (substring c-stmt-delim-chars 1) nil t)
+ (c-syntactic-skip-backward (substring c-stmt-delim-chars-with-comma 1)
+ nil t)
(or (bobp)
(memq (char-before) '(?{ ?}))
(save-excursion (backward-char)
@@ -2977,6 +2981,7 @@ comment at the start of cc-engine.el for more info."
;; element is a list (HERE STATE END)), where HERE is the buffer position the
;; function was called for, STATE is the `parse-partial-sexp' state there, and
;; END is the end of the literal enclosing HERE, if any, or nil otherwise.
+;; N.B. END will be nil if the literal ends at EOB without a delimiter.
(defun c-full-trim-near-cache ()
;; Remove stale entries in `c-full-lit-near-cache', i.e. those whose END
@@ -3045,7 +3050,8 @@ comment at the start of cc-engine.el for more info."
;; (STATE) otherwise,
;; where STATE is the parsing state at HERE, TYPE is the type of the literal
;; enclosing HERE, (one of 'string, 'c, 'c++) and (BEG . END) is the
- ;; boundaries of that literal (including the delimiters).
+ ;; boundaries of that literal (including the delimiters), with END being nil
+ ;; if there is no end delimiter (i.e. the literal ends at EOB).
;;
;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character
;; comment opener, this is recognized as being in a comment literal.
@@ -3064,6 +3070,7 @@ comment at the start of cc-engine.el for more info."
(base (car elt))
(near-base base)
(s (cadr elt))
+ s1
(end (car (cddr elt)))
far-base-and-state far-base far-s ty start)
(if (or
@@ -3104,12 +3111,17 @@ comment at the start of cc-engine.el for more info."
(t 'c)))
(setq start (nth 8 s))
(unless end
- (parse-partial-sexp here (point-max)
- nil ; TARGETDEPTH
- nil ; STOPBEFORE
- s ; OLDSTATE
- 'syntax-table) ; stop at end of literal
- (setq end (point)))
+ (setq s1 (parse-partial-sexp here (point-max)
+ nil ; TARGETDEPTH
+ nil ; STOPBEFORE
+ s ; OLDSTATE
+ 'syntax-table)); stop at EO literal
+ (unless (or (nth 3 s1) ; still in a string
+ (and (nth 4 s1)
+ (not (eq (nth 7 s1) 'syntax-table)))) ; still
+ ; in a
+ ; comment
+ (setq end (point))))
(unless (eq near-base here)
(c-full-put-near-cache-entry here s end))
(list s ty (cons start end)))
@@ -5555,8 +5567,11 @@ comment at the start of cc-engine.el for more info."
s
'syntax-table)
(point)))))
- (let ((pp-to-lit (c-full-pp-to-literal pos not-in-delimiter)))
- (car (cddr pp-to-lit))))))
+ (let* ((pp-to-lit (c-full-pp-to-literal pos not-in-delimiter))
+ (limits (car (cddr pp-to-lit))))
+ (if (and limits (null (cdr limits)))
+ (cons (car limits) (point-max))
+ limits)))))
(cond
(lit-limits)
@@ -7968,7 +7983,7 @@ comment at the start of cc-engine.el for more info."
(if (save-excursion
(c-backward-token-2)
- (looking-at c-multichar->-op-not->>-regexp))
+ (looking-at c-multichar->-op-not->>->>>-regexp))
(progn
(goto-char (match-end 0))
t) ; Continue the loop.
@@ -12576,7 +12591,7 @@ comment at the start of cc-engine.el for more info."
;; There's always at most one syntactic element which got
;; an anchor pos. It's stored in syntactic-relpos.
syntactic-relpos
- (c-stmt-delim-chars c-stmt-delim-chars))
+ (c-commas-bound-stmts c-commas-bound-stmts))
;; Check if we're directly inside an enclosing declaration
;; level block.
@@ -12628,7 +12643,7 @@ comment at the start of cc-engine.el for more info."
;; arglists.
(when (and containing-sexp
(eq (char-after containing-sexp) ?\())
- (setq c-stmt-delim-chars c-stmt-delim-chars-with-comma))
+ (setq c-commas-bound-stmts t))
;; cache char before and after indent point, and move point to
;; the most likely position to perform the majority of tests
(goto-char indent-point)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index d8842c8..f58caf2 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -2798,7 +2798,7 @@ need for `pike-font-lock-extra-types'.")
(defconst gtkdoc-font-lock-keywords
`((,(lambda (limit)
- (c-font-lock-doc-comments "/\\*\\*\\([^*\n\r].*\\)?$" limit
+ (c-font-lock-doc-comments "/\\*\\*\\([^*/\n\r].*\\)?$" limit
gtkdoc-font-lock-doc-comments)
(c-font-lock-doc-comments "/\\*< " limit
gtkdoc-font-lock-doc-protection)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index a0d4559..f3dd0c6 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1409,15 +1409,17 @@ operators."
(c-lang-defvar c->-op-without->-cont-regexp
(c-lang-const c->-op-without->-cont-regexp))
-(c-lang-defconst c-multichar->-op-not->>-regexp
- ;; Regexp matching multichar tokens containing ">", except ">>"
+(c-lang-defconst c-multichar->-op-not->>->>>-regexp
+ ;; Regexp matching multichar tokens containing ">", except ">>" and ">>>"
t (c-make-keywords-re nil
- (delete ">>"
- (c-filter-ops (c-lang-const c-all-op-syntax-tokens)
- t
- "\\(.>\\|>.\\)"))))
-(c-lang-defvar c-multichar->-op-not->>-regexp
- (c-lang-const c-multichar->-op-not->>-regexp))
+ (c--set-difference
+ (c-filter-ops (c-lang-const c-all-op-syntax-tokens)
+ t
+ "\\(.>\\|>.\\)")
+ '(">>" ">>>")
+ :test 'string-equal)))
+(c-lang-defvar c-multichar->-op-not->>->>>-regexp
+ (c-lang-const c-multichar->-op-not->>->>>-regexp))
(c-lang-defconst c-:-op-cont-tokens
;; A list of second and subsequent characters of all multicharacter tokens
@@ -1442,12 +1444,56 @@ operators."
t "^;{}?:")
(c-lang-defvar c-stmt-delim-chars (c-lang-const c-stmt-delim-chars))
+(c-lang-defconst c-stmt-boundary-skip-chars
+ ;; Like `c-stmt-delim-chars', but augmented by "#" for languages with CPP
+ ;; constructs, and for C++ Mode, also by "[", to help deal with C++
+ ;; attributes.
+ t (if (c-lang-const c-opt-cpp-symbol)
+ (concat (substring (c-lang-const c-stmt-delim-chars) 0 1) ; "^"
+ (c-lang-const c-opt-cpp-symbol) ; usually #
+ (substring (c-lang-const c-stmt-delim-chars) 1)) ; ";{}?:"
+ (c-lang-const c-stmt-delim-chars))
+ c++ (concat (substring (c-lang-const c-stmt-boundary-skip-chars) 0 1) ; "^"
+ "["
+ (substring (c-lang-const c-stmt-boundary-skip-chars) 1))) ;
";{}?:"
+(c-lang-defvar c-stmt-boundary-skip-chars
+ (c-lang-const c-stmt-boundary-skip-chars))
+
+(c-lang-defconst c-stmt-boundary-skip-list
+ ;; The characters (apart from the initial ^) in `c-stmt-boundary-skip-chars'
+ ;; as a list of characters.
+ t (append (substring (c-lang-const c-stmt-boundary-skip-chars) 1) nil))
+(c-lang-defvar c-stmt-boundary-skip-list
+ (c-lang-const c-stmt-boundary-skip-list))
+
(c-lang-defconst c-stmt-delim-chars-with-comma
;; Variant of `c-stmt-delim-chars' that additionally contains ','.
t "^;,{}?:")
(c-lang-defvar c-stmt-delim-chars-with-comma
(c-lang-const c-stmt-delim-chars-with-comma))
+(c-lang-defconst c-stmt-boundary-skip-chars-with-comma
+ ;; Variant of `c-stmt-boundary-skip-chars' also containing ','.
+ t (if (c-lang-const c-opt-cpp-symbol)
+ (concat (substring (c-lang-const c-stmt-delim-chars-with-comma) 0 1)
+ (c-lang-const c-opt-cpp-symbol) ; usually #
+ (substring (c-lang-const c-stmt-delim-chars-with-comma) 1))
+ (c-lang-const c-stmt-delim-chars-with-comma))
+ c++ (concat
+ (substring (c-lang-const c-stmt-boundary-skip-chars-with-comma) 0 1) ;
"^"
+ "["
+ (substring (c-lang-const c-stmt-boundary-skip-chars-with-comma) 1))) ;
";,{}?:"
+(c-lang-defvar c-stmt-boundary-skip-chars-with-comma
+ (c-lang-const c-stmt-boundary-skip-chars-with-comma))
+
+(c-lang-defconst c-stmt-boundary-skip-list-with-comma
+ ;; Variant of `c-stmt-boundary-skip-list' also including a comma.
+ t (append (substring (c-lang-const c-stmt-boundary-skip-chars-with-comma)
+ 1)
+ nil))
+(c-lang-defvar c-stmt-boundary-skip-list-with-comma
+ (c-lang-const c-stmt-boundary-skip-list-with-comma))
+
(c-lang-defconst c-pack-ops
"Ops which signal C++11's \"parameter pack\""
t nil
@@ -1608,7 +1654,7 @@ backslash."
current line, if any, or nil in those languages without block
comments. When a match is found, submatch 1 contains the comment
ender."
- t "\\(\\*/\\)\\([^*]\\|\\*+[^/]\\)*$"
+ t "\\(\\*/\\)\\([^*]\\|\\*+\\([^*/]\\|$\\)\\)*$"
awk nil)
(c-lang-defvar c-last-c-comment-end-on-line-re
(c-lang-const c-last-c-comment-end-on-line-re))
@@ -1618,7 +1664,7 @@ ender."
current ine, if any, or nil in those languages without block
comments. When a match is found, submatch 1 contains the comment
starter."
- t "\\(/\\*\\)\\([^*]\\|\\*+[^/]\\)*$"
+ t "\\(/\\*\\)\\([^*]\\|\\*+\\([^*/]\\|$\\)\\)*$"
awk nil)
(c-lang-defvar c-last-open-c-comment-start-on-line-re
(c-lang-const c-last-open-c-comment-start-on-line-re))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index a5e1589..5e373b6 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1527,7 +1527,9 @@ Note that the style variables are always made local to
the buffer."
(or (not (nth 3 s))
(not (memq (char-before) c-string-delims))))))
;; We're at the start of a string.
- (memq (char-before) c-string-delims)))
+ (and (memq (char-before) c-string-delims)
+ (not (nth 4 s))))) ; Check we're actually out of the
+ ; comment. not stuck at EOB
(unless (and (c-major-mode-is 'c++-mode)
(c-maybe-re-mark-raw-string))
(if (c-unescaped-nls-in-string-p (1- (point)))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 7537525..4cc1daf 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -107,9 +107,33 @@ and a string describing how the process finished.")
(defvar compilation-in-progress nil
"List of compilation processes now running.")
-(or (assq 'compilation-in-progress minor-mode-alist)
- (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
- minor-mode-alist)))
+(or (assq 'compilation-in-progress mode-line-modes)
+ (add-to-list 'mode-line-modes
+ (list 'compilation-in-progress
+ (propertize "[Compiling] "
+ 'help-echo "Compiling; mouse-2: Goto Buffer"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ (make-mode-line-mouse-map
+ 'mouse-2
+ #'compilation-goto-in-progress-buffer)))))
+
+(defun compilation-goto-in-progress-buffer ()
+ "Switch to the compilation buffer."
+ (interactive)
+ (cond
+ ((> (length compilation-in-progress) 1)
+ (switch-to-buffer (completing-read
+ "Several compilation buffers; switch to: "
+ (mapcar
+ (lambda (process)
+ (buffer-name (process-buffer process)))
+ compilation-in-progress)
+ nil t)))
+ (compilation-in-progress
+ (switch-to-buffer (process-buffer (car compilation-in-progress))))
+ (t
+ (error "No ongoing compilations"))))
(defvar compilation-error "error"
"Stem of message to print when no matches are found.")
@@ -1590,6 +1614,11 @@ If nil, ask to kill it."
:type 'boolean
:version "24.3")
+(defun compilation--update-in-progress-mode-line ()
+ ;; `compilation-in-progress' affects the mode-line of all
+ ;; buffers when it changes from nil to non-nil or vice-versa.
+ (unless compilation-in-progress (force-mode-line-update t)))
+
;;;###autoload
(defun compilation-start (command &optional mode name-function
highlight-regexp)
"Run compilation command COMMAND (low level interface).
@@ -1783,8 +1812,8 @@ Returns the compilation buffer created."
;; The process may have exited already.
(error nil)))
(run-hook-with-args 'compilation-start-hook proc)
- (setq compilation-in-progress
- (cons proc compilation-in-progress)))
+ (compilation--update-in-progress-mode-line)
+ (push proc compilation-in-progress))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
;; Fake mode line display as if `start-process' were run.
@@ -2217,7 +2246,8 @@ commands of Compilation major mode are available. See
;; process is dead, we can delete it now. Otherwise it
;; will stay around until M-x list-processes.
(delete-process proc)))
- (setq compilation-in-progress (delq proc compilation-in-progress)))))
+ (setq compilation-in-progress (delq proc compilation-in-progress))
+ (compilation--update-in-progress-mode-line))))
(defun compilation-filter (proc string)
"Process filter for compilation buffers.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index da7a731..36797fc 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -500,16 +500,26 @@ functions are annotated with \"<f>\" via the
(scan-error pos))))
;; t if in function position.
(funpos (eq (char-before beg) ?\())
- (quoted (elisp--form-quoted-p beg)))
+ (quoted (elisp--form-quoted-p beg))
+ (fun-sym (condition-case nil
+ (save-excursion
+ (up-list -1)
+ (forward-char 1)
+ (and (memq (char-syntax (char-after)) '(?w ?_))
+ (read (current-buffer))))
+ (error nil))))
(when (and end (or (not (nth 8 (syntax-ppss)))
(memq (char-before beg) '(?` ?‘))))
(let ((table-etc
(if (or (not funpos) quoted)
- ;; FIXME: We could look at the first element of the list and
- ;; use it to provide a more specific completion table in
some
- ;; cases. E.g. filter out keywords that are not understood
by
- ;; the macro/function being called.
(cond
+ ;; FIXME: We could look at the first element of
+ ;; the current form and use it to provide a more
+ ;; specific completion table in more cases.
+ ((eq fun-sym 'ignore-error)
+ (list t obarray
+ :predicate (lambda (sym)
+ (get sym 'error-conditions))))
((elisp--expect-function-p beg)
(list nil obarray
:predicate #'fboundp
@@ -568,6 +578,11 @@ functions are annotated with \"<f>\" via the
(< (point) beg)))))
(list t obarray
:predicate (lambda (sym) (get sym
'error-conditions))))
+ ;; `ignore-error' with a list CONDITION parameter.
+ ('ignore-error
+ (list t obarray
+ :predicate (lambda (sym)
+ (get sym 'error-conditions))))
((and (or ?\( 'let 'let*)
(guard (save-excursion
(goto-char (1- beg))
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 7bf5753..a052ad2 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2070,14 +2070,15 @@ for \\[find-tag] (which see)."
(beginning-of-line)
(pcase-let* ((tag-info (etags-snarf-tag))
(`(,hint ,line . _) tag-info))
- (unless (eq hint t) ; hint==t if we are in a filename line
- (let* ((file (file-of-tag))
- (mark-key (cons file line)))
- (unless (gethash mark-key marks)
- (let ((loc (xref-make-etags-location
- tag-info (expand-file-name file))))
- (push (xref-make hint loc) xrefs)
- (puthash mark-key t marks)))))))))))
+ (let* ((file (file-of-tag))
+ (mark-key (cons file line)))
+ (unless (gethash mark-key marks)
+ (let ((loc (xref-make-etags-location
+ tag-info (expand-file-name file))))
+ (push (xref-make (if (eq hint t) "(filename match)" hint)
+ loc)
+ xrefs)
+ (puthash mark-key t marks))))))))))
(nreverse xrefs)))
(defclass xref-etags-location (xref-location)
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 7d51816..95589c2 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -42,6 +42,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup opascal nil
"Major mode for editing OPascal source in Emacs."
:version "24.4"
@@ -147,10 +149,6 @@ That is, regardless of where in the line point is at the
time."
'(comment-single-line comment-multi-line-1 comment-multi-line-2)
"Tokens that represent comments.")
-(defconst opascal-strings
- '(string double-quoted-string)
- "Tokens that represent string literals.")
-
(defconst opascal-whitespace `(space newline ,@opascal-comments)
"Tokens that are considered whitespace.")
@@ -274,15 +272,17 @@ routine.")
(defmacro opascal-save-excursion (&rest forms)
;; Executes the forms such that any movements have no effect, including
;; searches.
+ (declare (debug t))
`(save-excursion
(save-match-data
(let ((inhibit-point-motion-hooks t)
(deactivate-mark nil))
(progn ,@forms)))))
-(defsubst opascal-is (element in-set)
- ;; If the element is in the set, the element cdr is returned, otherwise nil.
- (memq element in-set))
+
+(eval-when-compile
+ (pcase-defmacro opascal--in (set)
+ `(pred (pcase--flip memq ,set))))
(defun opascal-string-of (start end)
;; Returns the buffer string from start to end.
@@ -415,15 +415,6 @@ routine.")
(string . "'")
(double-quoted-string . "\"")))))
-(defun opascal-literal-end-pattern (literal-kind)
- ;; Returns the end pattern of the literal kind.
- (cdr (assoc literal-kind
- '((comment-single-line . "\n")
- (comment-multi-line-1 . "}")
- (comment-multi-line-2 . "*)")
- (string . "'")
- (double-quoted-string . "\"")))))
-
(defun opascal-literal-stop-pattern (literal-kind)
;; Returns the pattern that delimits end of the search for the literal kind.
;; These are regular expressions.
@@ -495,7 +486,7 @@ routine.")
(let* ((word-image (downcase (opascal-token-string word)))
(keyword (intern-soft word-image)))
(when (and (or keyword (string= "nil" word-image))
- (opascal-is keyword opascal-keywords))
+ (memq keyword opascal-keywords))
(opascal-set-token-kind word keyword))
word))))
@@ -562,7 +553,7 @@ routine.")
(let (next-token)
(while (progn
(setq next-token (opascal-next-token token))
- (opascal-is (opascal-token-kind next-token) '(space newline))))
+ (memq (opascal-token-kind next-token) '(space newline))))
next-token))
(defun opascal-group-start (from-token)
@@ -608,6 +599,18 @@ routine.")
indent (if offset offset 0)))
indent))
+(defmacro opascal--scan-non-whitespace-backward (token-var last-var
+ &rest pcases)
+ (declare (debug (symbolp symbolp &rest (pcase-PAT body)))
+ (indent 2))
+ `(let ((,token-var ,token-var))
+ (while (setq ,token-var (opascal-previous-token ,token-var))
+ ,(macroexp-let2 nil kind-var `(opascal-token-kind ,token-var)
+ `(unless (memq ,kind-var opascal-whitespace)
+ (pcase ,kind-var
+ ,@pcases)
+ ,(when last-var `(setq ,last-var ,token-var)))))))
+
(defun opascal-line-indent-of (from-token &optional offset &rest terminators)
;; Returns the column of first non-space character on the token's line, plus
;; any offset. We also stop if one of the terminators or an open ( or [ is
@@ -616,6 +619,8 @@ routine.")
(last-token from-token)
(kind nil))
(catch 'done
+ ;; FIXME: Can't use opascal--scan-non-whitespace-backward here, because
+ ;; we do need to pay attention to `newline'!
(while token
(setq kind (opascal-token-kind token))
(cond
@@ -623,11 +628,11 @@ routine.")
((eq 'close-group kind) (setq token (opascal-group-start token)))
;; Stop at the beginning of the line or an open group.
- ((opascal-is kind '(newline open-group)) (throw 'done nil))
+ ((memq kind '(newline open-group)) (throw 'done nil))
;; Stop at one of the specified terminators.
- ((opascal-is kind terminators) (throw 'done nil)))
- (unless (opascal-is kind opascal-whitespace) (setq last-token token))
+ ((memq kind terminators) (throw 'done nil)))
+ (unless (memq kind opascal-whitespace) (setq last-token token))
(setq token (opascal-previous-token token))))
(opascal-indent-of last-token offset)))
@@ -638,23 +643,25 @@ routine.")
(last-token from-token)
(kind nil))
(catch 'done
+ ;; FIXME: Can't use opascal--scan-non-whitespace-backward here, because
+ ;; we do need to pay attention to `newline'!
(while token
(setq kind (opascal-token-kind token))
(cond
((and (eq 'colon kind)
- (opascal-is (opascal-token-kind last-token)
- `(,@opascal-block-statements
- ,@opascal-expr-statements)))
+ (memq (opascal-token-kind last-token)
+ `(,@opascal-block-statements
+ ,@opascal-expr-statements)))
;; We hit a label followed by a statement. Indent to the statement.
(throw 'done nil))
;; Skip over ()/[] groups.
((eq 'close-group kind) (setq token (opascal-group-start token)))
- ((opascal-is kind `(newline open-group ,@opascal-use-clauses))
+ ((memq kind `(newline open-group ,@opascal-use-clauses))
;; Stop at the beginning of the line, an open group, or a use clause
(throw 'done nil)))
- (unless (opascal-is kind opascal-whitespace) (setq last-token token))
+ (unless (memq kind opascal-whitespace) (setq last-token token))
(setq token (opascal-previous-token token))))
(opascal-indent-of last-token offset)))
@@ -671,7 +678,7 @@ routine.")
;; dispinterface), (= interface), (= object), or (= record), and nil
;; otherwise.
(if (and (eq 'equals (opascal-token-kind token))
- (opascal-is (opascal-token-kind last-token)
opascal-composite-types))
+ (memq (opascal-token-kind last-token) opascal-composite-types))
last-token))
(defun opascal-is-simple-class-type (at-token limit-token)
@@ -679,7 +686,7 @@ routine.")
;; class of TClass;
;; class (TBaseClass);
;; class;
- (when (opascal-is (opascal-token-kind at-token) opascal-class-types)
+ (when (memq (opascal-token-kind at-token) opascal-class-types)
(catch 'done
;; Scan until the semi colon.
(let ((token (opascal-next-token at-token))
@@ -695,7 +702,7 @@ routine.")
((eq 'open-group token-kind) (setq token (opascal-group-end token)))
;; Only allow "of" and whitespace, and an identifier
- ((opascal-is token-kind `(of word ,@opascal-whitespace)))
+ ((memq token-kind `(of word ,@opascal-whitespace)))
;; Otherwise we are not in a simple class declaration.
((throw 'done nil)))
@@ -703,85 +710,76 @@ routine.")
(defun opascal-block-start (from-token &optional stop-on-class)
;; Returns the token that denotes the start of the block.
- (let ((token (opascal-previous-token from-token))
- (last-token nil)
- (token-kind nil))
+ (let ((token from-token)
+ (last-token nil))
(catch 'done
- (while token
- (setq token-kind (opascal-token-kind token))
- (cond
- ;; Skip over nested blocks.
- ((opascal-is token-kind opascal-end-block-statements)
- (setq token (opascal-block-start token)))
-
- ;; Regular block start found.
- ((opascal-is token-kind opascal-block-statements)
- (throw 'done
- ;; As a special case, when a "case" block appears
- ;; within a record declaration (to denote a variant
- ;; part), the record declaration should be considered
- ;; the enclosing block.
- (if (eq 'case token-kind)
- (let ((enclosing-token
- (opascal-block-start token
- 'stop-on-class)))
- (if
- (eq 'record
- (opascal-token-kind enclosing-token))
- (if stop-on-class
- enclosing-token
- (opascal-previous-token enclosing-token))
- token))
- token)))
-
- ;; A class/record start also begins a block.
- ((opascal-composite-type-start token last-token)
- (throw 'done (if stop-on-class last-token token)))
- )
- (unless (opascal-is token-kind opascal-whitespace)
- (setq last-token token))
- (setq token (opascal-previous-token token)))
+ (opascal--scan-non-whitespace-backward token last-token
+ ;; Skip over nested blocks.
+ ((opascal--in opascal-end-block-statements)
+ (setq token (opascal-block-start token)))
+
+ ;; Case block start found.
+ ('case
+ (throw 'done
+ ;; As a special case, when a "case" block appears
+ ;; within a record declaration (to denote a variant
+ ;; part), the record declaration should be considered
+ ;; the enclosing block.
+ (let ((enclosing-token
+ (opascal-block-start token
+ 'stop-on-class)))
+ (if (eq 'record
+ (opascal-token-kind enclosing-token))
+ (if stop-on-class
+ enclosing-token
+ (opascal-previous-token enclosing-token))
+ token))))
+
+ ;; Regular block start found.
+ ((opascal--in opascal-block-statements)
+ (throw 'done token))
+
+ ;; A class/record start also begins a block.
+ ((guard (opascal-composite-type-start token last-token))
+ (throw 'done (if stop-on-class last-token token)))
+ )
;; Start not found.
nil)))
(defun opascal-else-start (from-else)
;; Returns the token of the if or case statement.
- (let ((token (opascal-previous-token from-else))
- (token-kind nil)
+ (let ((token from-else)
(semicolon-count 0))
(catch 'done
- (while token
- (setq token-kind (opascal-token-kind token))
- (cond
- ;; Skip over nested groups.
- ((eq 'close-group token-kind) (setq token (opascal-group-start
token)))
-
- ;; Skip over any nested blocks.
- ((opascal-is token-kind opascal-end-block-statements)
- (setq token (opascal-block-start token)))
-
- ((eq 'semicolon token-kind)
- ;; Semicolon means we are looking for an enclosing if, unless we
- ;; are in a case statement. Keep counts of the semicolons and decide
- ;; later.
- (setq semicolon-count (1+ semicolon-count)))
-
- ((and (eq 'if token-kind) (= semicolon-count 0))
- ;; We only can match an if when there have been no intervening
- ;; semicolons.
- (throw 'done token))
-
- ((eq 'case token-kind)
- ;; We have hit a case statement start.
- (throw 'done token)))
- (setq token (opascal-previous-token token)))
+ (opascal--scan-non-whitespace-backward token nil
+ ;; Skip over nested groups.
+ ('close-group (setq token (opascal-group-start token)))
+
+ ;; Skip over any nested blocks.
+ ((opascal--in opascal-end-block-statements)
+ (setq token (opascal-block-start token)))
+
+ ('semicolon
+ ;; Semicolon means we are looking for an enclosing if, unless we
+ ;; are in a case statement. Keep counts of the semicolons and decide
+ ;; later.
+ (setq semicolon-count (1+ semicolon-count)))
+
+ ((and 'if (guard (= semicolon-count 0)))
+ ;; We only can match an if when there have been no intervening
+ ;; semicolons.
+ (throw 'done token))
+
+ ('case
+ ;; We have hit a case statement start.
+ (throw 'done token)))
;; No if or case statement found.
nil)))
(defun opascal-comment-content-start (comment)
;; Returns the point of the first non-space character in the comment.
(let ((kind (opascal-token-kind comment)))
- (when (opascal-is kind opascal-comments)
+ (when (memq kind opascal-comments)
(opascal-save-excursion
(goto-char (+ (opascal-token-start comment)
(length (opascal-literal-start-pattern kind))))
@@ -851,7 +849,8 @@ routine.")
(opascal-indent-of comment))
;; Indent according to the comment's content start.
- ((opascal-column-of (opascal-comment-content-start
comment)))))))
+ (t
+ (opascal-column-of (opascal-comment-content-start
comment)))))))
))
(defun opascal-is-use-clause-end (at-token last-token last-colon from-kind)
@@ -861,439 +860,426 @@ routine.")
(eq 'comma (opascal-token-kind at-token))
(eq 'semicolon from-kind))
;; Scan for the uses statement, just to be sure.
- (let ((token (opascal-previous-token at-token))
- (token-kind nil))
+ (let ((token at-token))
(catch 'done
- (while token
- (setq token-kind (opascal-token-kind token))
- (cond ((opascal-is token-kind opascal-use-clauses)
- (throw 'done t))
-
- ;; Whitespace, identifiers, strings, "in" keyword, and commas
- ;; are allowed in use clauses.
- ((or (opascal-is token-kind '(word comma in newline))
- (opascal-is token-kind opascal-whitespace)
- (opascal-is token-kind opascal-strings)))
-
- ;; Nothing else is.
- ((throw 'done nil)))
- (setq token (opascal-previous-token token)))
+ (opascal--scan-non-whitespace-backward token nil
+ ((opascal--in opascal-use-clauses)
+ (throw 'done t))
+
+ ;; Identifiers, strings, "in" keyword, and commas
+ ;; are allowed in use clauses.
+ ((or 'word 'comma 'in 'string 'double-quoted-string))
+
+ ;; Nothing else is.
+ (_ (throw 'done nil)))
nil))))
(defun opascal-is-block-after-expr-statement (token)
;; Returns true if we have a block token trailing an expression delimiter (of
;; presumably an expression statement).
- (when (opascal-is (opascal-token-kind token) opascal-block-statements)
+ (when (memq (opascal-token-kind token) opascal-block-statements)
(let ((previous (opascal-previous-token token))
(previous-kind nil))
(while (progn
(setq previous-kind (opascal-token-kind previous))
(eq previous-kind 'space))
(setq previous (opascal-previous-token previous)))
- (or (opascal-is previous-kind opascal-expr-delimiters)
+ (or (memq previous-kind opascal-expr-delimiters)
(eq previous-kind 'else)))))
(defun opascal-previous-indent-of (from-token)
;; Returns the indentation of the previous statement of the token.
- (let ((token (opascal-previous-token from-token))
- (token-kind nil)
+ (let ((token from-token)
(from-kind (opascal-token-kind from-token))
(last-colon nil)
(last-of nil)
(last-token nil))
(catch 'done
- (while token
- (setq token-kind (opascal-token-kind token))
- (cond
- ;; An open ( or [ always is an indent point.
- ((eq 'open-group token-kind)
- (throw 'done (opascal-open-group-indent token last-token)))
-
- ;; Skip over any ()/[] groups.
- ((eq 'close-group token-kind) (setq token (opascal-group-start
token)))
-
- ((opascal-is token-kind opascal-end-block-statements)
- (if (eq 'newline (opascal-token-kind (opascal-previous-token token)))
- ;; We can stop at an end token that is right up against the
- ;; margin.
- (throw 'done 0)
- ;; Otherwise, skip over any nested blocks.
- (setq token (opascal-block-start token))))
-
- ;; Special case: if we encounter a ", word;" then we assume that we
- ;; are in some kind of uses clause, and thus indent to column 0. This
- ;; works because no other constructs are known to have that form.
- ;; This fixes the irritating case of having indents after a uses
- ;; clause look like:
- ;; uses
- ;; someUnit,
- ;; someOtherUnit;
- ;; // this should be at column 0!
- ((opascal-is-use-clause-end token last-token last-colon from-kind)
- (throw 'done 0))
-
- ;; A previous terminator means we can stop. If we are on a directive,
- ;; however, then we are not actually encountering a new statement.
- ((and last-token
- (opascal-is token-kind opascal-previous-terminators)
- (not (opascal-is (opascal-token-kind last-token)
- opascal-directives)))
- (throw 'done (opascal-stmt-line-indent-of last-token 0)))
-
- ;; Ignore whitespace.
- ((opascal-is token-kind opascal-whitespace))
-
- ;; Remember any "of" we encounter, since that affects how we
- ;; indent to a case statement within a record declaration
- ;; (i.e. a variant part).
- ((eq 'of token-kind)
- (setq last-of token))
-
- ;; Remember any ':' we encounter (until we reach an "of"),
- ;; since that affects how we indent to case statements in
- ;; general.
- ((eq 'colon token-kind)
- (unless last-of (setq last-colon token)))
-
- ;; A case statement delimits a previous statement. We indent labels
- ;; specially.
- ((eq 'case token-kind)
- (throw 'done
+ (opascal--scan-non-whitespace-backward token last-token
+ ;; An open ( or [ always is an indent point.
+ ('open-group
+ (throw 'done (opascal-open-group-indent token last-token)))
+
+ ;; Skip over any ()/[] groups.
+ ('close-group (setq token (opascal-group-start token)))
+
+ ((opascal--in opascal-end-block-statements)
+ (if (eq 'newline (opascal-token-kind (opascal-previous-token token)))
+ ;; We can stop at an end token that is right up against the
+ ;; margin.
+ (throw 'done 0)
+ ;; Otherwise, skip over any nested blocks.
+ (setq token (opascal-block-start token))))
+
+ ;; Special case: if we encounter a ", word;" then we assume that we
+ ;; are in some kind of uses clause, and thus indent to column 0. This
+ ;; works because no other constructs are known to have that form.
+ ;; This fixes the irritating case of having indents after a uses
+ ;; clause look like:
+ ;; uses
+ ;; someUnit,
+ ;; someOtherUnit;
+ ;; // this should be at column 0!
+ ((guard
+ (opascal-is-use-clause-end token last-token last-colon from-kind))
+ (throw 'done 0))
+
+ ;; A previous terminator means we can stop. If we are on a directive,
+ ;; however, then we are not actually encountering a new statement.
+ ((and (guard last-token)
+ (opascal--in opascal-previous-terminators)
+ (guard (not (memq (opascal-token-kind last-token)
+ opascal-directives))))
+ (throw 'done (opascal-stmt-line-indent-of last-token 0)))
+
+ ;; Remember any "of" we encounter, since that affects how we
+ ;; indent to a case statement within a record declaration
+ ;; (i.e. a variant part).
+ ('of
+ (setq last-of token))
+
+ ;; Remember any ':' we encounter (until we reach an "of"),
+ ;; since that affects how we indent to case statements in
+ ;; general.
+ ('colon
+ (unless last-of (setq last-colon token)))
+
+ ;; A case statement delimits a previous statement. We indent labels
+ ;; specially.
+ ('case
+ (throw 'done
(if last-colon (opascal-line-indent-of last-colon)
(opascal-line-indent-of token opascal-case-label-indent))))
- ;; If we are in a use clause then commas mark an enclosing rather than
- ;; a previous statement.
- ((opascal-is token-kind opascal-use-clauses)
- (throw 'done
- (if (eq 'comma from-kind)
- (if last-token
- ;; Indent to first unit in use clause.
- (opascal-indent-of last-token)
- ;; Indent from use clause keyword.
- (opascal-line-indent-of token opascal-indent-level))
- ;; Indent to use clause keyword.
- (opascal-line-indent-of token))))
-
- ;; Assembly sections always indent in from the asm keyword.
- ((eq token-kind 'asm)
- (throw 'done (opascal-stmt-line-indent-of token
opascal-indent-level)))
-
- ;; An enclosing statement delimits a previous statement.
- ;; We try to use the existing indent of the previous statement,
- ;; otherwise we calculate from the enclosing statement.
- ((opascal-is token-kind opascal-previous-enclosing-statements)
- (throw 'done (if last-token
- ;; Otherwise indent to the last token
- (opascal-line-indent-of last-token)
- ;; Just indent from the enclosing keyword
- (opascal-line-indent-of token opascal-indent-level))))
-
- ;; A class or record declaration also delimits a previous statement.
- ((opascal-composite-type-start token last-token)
- (throw
- 'done
- (if (opascal-is-simple-class-type last-token from-token)
- ;; c = class; or c = class of T; are previous statements.
- (opascal-line-indent-of token)
- ;; Otherwise c = class ... or r = record ... are enclosing
- ;; statements.
- (opascal-line-indent-of last-token opascal-indent-level))))
-
- ;; We have a definite previous statement delimiter.
- ((opascal-is token-kind opascal-previous-statements)
- (throw 'done (opascal-stmt-line-indent-of token 0)))
- )
- (unless (opascal-is token-kind opascal-whitespace)
- (setq last-token token))
- (setq token (opascal-previous-token token)))
+ ;; If we are in a use clause then commas mark an enclosing rather than
+ ;; a previous statement.
+ ((opascal--in opascal-use-clauses)
+ (throw 'done
+ (if (eq 'comma from-kind)
+ (if last-token
+ ;; Indent to first unit in use clause.
+ (opascal-indent-of last-token)
+ ;; Indent from use clause keyword.
+ (opascal-line-indent-of token opascal-indent-level))
+ ;; Indent to use clause keyword.
+ (opascal-line-indent-of token))))
+
+ ;; Assembly sections always indent in from the asm keyword.
+ ('asm
+ (throw 'done (opascal-stmt-line-indent-of token
opascal-indent-level)))
+
+ ;; An enclosing statement delimits a previous statement.
+ ;; We try to use the existing indent of the previous statement,
+ ;; otherwise we calculate from the enclosing statement.
+ ((opascal--in opascal-previous-enclosing-statements)
+ (throw 'done (if last-token
+ ;; Otherwise indent to the last token
+ (opascal-line-indent-of last-token)
+ ;; Just indent from the enclosing keyword
+ (opascal-line-indent-of token opascal-indent-level))))
+
+ ;; A class or record declaration also delimits a previous statement.
+ ((guard (opascal-composite-type-start token last-token))
+ (throw
+ 'done
+ (if (opascal-is-simple-class-type last-token from-token)
+ ;; c = class; or c = class of T; are previous statements.
+ (opascal-line-indent-of token)
+ ;; Otherwise c = class ... or r = record ... are enclosing
+ ;; statements.
+ (opascal-line-indent-of last-token opascal-indent-level))))
+
+ ;; We have a definite previous statement delimiter.
+ ((opascal--in opascal-previous-statements)
+ (throw 'done (opascal-stmt-line-indent-of token 0)))
+ )
;; We ran out of tokens. Indent to column 0.
0)))
(defun opascal-section-indent-of (section-token)
;; Returns the indentation appropriate for begin/var/const/type/label
;; tokens.
- (let* ((token (opascal-previous-token section-token))
- (token-kind nil)
+ (let* ((token section-token)
(last-token nil)
(nested-block-count 0)
(expr-delimited nil)
(last-terminator nil))
(catch 'done
- (while token
- (setq token-kind (opascal-token-kind token))
- (cond
- ;; Always stop at unmatched ( or [.
- ((eq token-kind 'open-group)
- (throw 'done (opascal-open-group-indent token last-token)))
-
- ;; Skip over any ()/[] groups.
- ((eq 'close-group token-kind) (setq token (opascal-group-start
token)))
-
- ((opascal-is token-kind opascal-end-block-statements)
- (if (eq 'newline (opascal-token-kind (opascal-previous-token token)))
- ;; We can stop at an end token that is right up against the
- ;; margin.
- (throw 'done 0)
- ;; Otherwise, skip over any nested blocks.
- (setq token (opascal-block-start token)
- nested-block-count (1+ nested-block-count))))
-
- ;; Remember if we have encountered any forward routine declarations.
- ((eq 'forward token-kind)
- (setq nested-block-count (1+ nested-block-count)))
-
- ;; Mark the completion of a nested routine traversal.
- ((and (opascal-is token-kind opascal-routine-statements)
- (> nested-block-count 0))
- (setq nested-block-count (1- nested-block-count)))
-
- ;; Remember if we have encountered any statement terminators.
- ((eq 'semicolon token-kind) (setq last-terminator token))
-
- ;; Remember if we have encountered any expression delimiters.
- ((opascal-is token-kind opascal-expr-delimiters)
- (setq expr-delimited token))
-
- ;; Enclosing body statements are delimiting. We indent the compound
- ;; bodies specially.
- ((and (not last-terminator)
- (opascal-is token-kind opascal-body-statements))
- (throw 'done
- (opascal-stmt-line-indent-of token opascal-compound-block-indent)))
-
- ;; An enclosing ":" means a label.
- ((and (eq 'colon token-kind)
- (opascal-is (opascal-token-kind section-token)
- opascal-block-statements)
- (not last-terminator)
- (not expr-delimited)
- (not (eq 'equals (opascal-token-kind last-token))))
- (throw 'done
- (opascal-stmt-line-indent-of token opascal-indent-level)))
-
- ;; Block and mid block tokens are always enclosing
- ((opascal-is token-kind opascal-begin-enclosing-tokens)
- (throw 'done
- (opascal-stmt-line-indent-of token opascal-indent-level)))
-
- ;; Declaration sections and routines are delimiters, unless they
- ;; are part of a nested routine.
- ((and (opascal-is token-kind opascal-decl-delimiters)
- (= 0 nested-block-count))
- (throw 'done (opascal-line-indent-of token 0)))
-
- ;; Unit statements mean we indent right to the left.
- ((opascal-is token-kind opascal-unit-statements) (throw 'done 0))
- )
- (unless (opascal-is token-kind opascal-whitespace)
- (setq last-token token))
- (setq token (opascal-previous-token token)))
+ (opascal--scan-non-whitespace-backward token last-token
+ ;; Always stop at unmatched ( or [.
+ ('open-group
+ (throw 'done (opascal-open-group-indent token last-token)))
+
+ ;; Skip over any ()/[] groups.
+ ('close-group (setq token (opascal-group-start token)))
+
+ ((opascal--in opascal-end-block-statements)
+ (if (eq 'newline (opascal-token-kind (opascal-previous-token token)))
+ ;; We can stop at an end token that is right up against the
+ ;; margin.
+ (throw 'done 0)
+ ;; Otherwise, skip over any nested blocks.
+ (setq token (opascal-block-start token)
+ nested-block-count (1+ nested-block-count))))
+
+ ;; Remember if we have encountered any forward routine declarations.
+ ('forward
+ (setq nested-block-count (1+ nested-block-count)))
+
+ ;; Mark the completion of a nested routine traversal.
+ ((and (opascal--in opascal-routine-statements)
+ (guard (> nested-block-count 0)))
+ (setq nested-block-count (1- nested-block-count)))
+
+ ;; Remember if we have encountered any statement terminators.
+ ('semicolon (setq last-terminator token))
+
+ ;; Remember if we have encountered any expression delimiters.
+ ((opascal--in opascal-expr-delimiters)
+ (setq expr-delimited token))
+
+ ;; Enclosing body statements are delimiting. We indent the compound
+ ;; bodies specially.
+ ((and (guard (not last-terminator))
+ (opascal--in opascal-body-statements))
+ (throw 'done
+ (opascal-stmt-line-indent-of token
+ opascal-compound-block-indent)))
+
+ ;; An enclosing ":" means a label.
+ ((and 'colon
+ (guard (and (memq (opascal-token-kind section-token)
+ opascal-block-statements)
+ (not last-terminator)
+ (not expr-delimited)
+ (not (eq 'equals
+ (opascal-token-kind last-token))))))
+ (throw 'done
+ (opascal-stmt-line-indent-of token opascal-indent-level)))
+
+ ;; Block and mid block tokens are always enclosing
+ ((opascal--in opascal-begin-enclosing-tokens)
+ (throw 'done
+ (opascal-stmt-line-indent-of token opascal-indent-level)))
+
+ ;; Declaration sections and routines are delimiters, unless they
+ ;; are part of a nested routine.
+ ((and (opascal--in opascal-decl-delimiters)
+ (guard (= 0 nested-block-count)))
+ (throw 'done (opascal-line-indent-of token 0)))
+
+ ;; Unit statements mean we indent right to the left.
+ ((opascal--in opascal-unit-statements) (throw 'done 0))
+ )
;; We ran out of tokens. Indent to column 0.
0)))
(defun opascal-enclosing-indent-of (from-token)
;; Returns the indentation offset from the enclosing statement of the token.
- (let ((token (opascal-previous-token from-token))
+ (let ((token from-token)
(from-kind (opascal-token-kind from-token))
- (token-kind nil)
(stmt-start nil)
(last-token nil)
(equals-encountered nil)
(before-equals nil)
(expr-delimited nil))
(catch 'done
- (while token
- (setq token-kind (opascal-token-kind token))
- (cond
- ;; An open ( or [ always is an indent point.
- ((eq 'open-group token-kind)
- (throw 'done
- (opascal-open-group-indent
- token last-token
- (if (opascal-is from-kind opascal-binary-ops)
- ;; Keep binary operations aligned with the open group.
- 0
- opascal-indent-level))))
-
- ;; Skip over any ()/[] groups.
- ((eq 'close-group token-kind) (setq token (opascal-group-start
token)))
-
- ;; Skip over any nested blocks.
- ((opascal-is token-kind opascal-end-block-statements)
- (setq token (opascal-block-start token)))
-
- ;; An expression delimiter affects indentation depending on whether
- ;; the point is before or after it. Remember that we encountered one.
- ;; Also remember the last encountered token, since if it exists it
- ;; should be the actual indent point.
- ((opascal-is token-kind opascal-expr-delimiters)
- (setq expr-delimited token stmt-start last-token))
-
- ;; With a non-delimited expression statement we indent after the
- ;; statement's keyword, unless we are on the delimiter itself.
- ((and (not expr-delimited)
- (opascal-is token-kind opascal-expr-statements))
- (throw 'done
- (cond ((opascal-is from-kind opascal-expr-delimiters)
- ;; We are indenting a delimiter. Indent to the statement.
- (opascal-stmt-line-indent-of token 0))
-
- ((and last-token (opascal-is from-kind opascal-binary-ops))
- ;; Align binary ops with the expression.
- (opascal-indent-of last-token))
-
- (last-token
- ;; Indent in from the expression.
- (opascal-indent-of last-token opascal-indent-level))
-
- ;; Indent in from the statement's keyword.
- ((opascal-indent-of token opascal-indent-level)))))
-
- ;; A delimited case statement indents the label according to
- ;; a special rule.
- ((eq 'case token-kind)
- (throw 'done
- (if stmt-start
- ;; We are not actually indenting to the case statement,
- ;; but are within a label expression.
- (opascal-stmt-line-indent-of
- stmt-start opascal-indent-level)
- ;; Indent from the case keyword.
- (opascal-stmt-line-indent-of
- token opascal-case-label-indent))))
-
- ;; Body expression statements are enclosing. Indent from the
- ;; statement's keyword, unless we have a non-block statement following
- ;; it.
- ((opascal-is token-kind opascal-body-expr-statements)
- (throw 'done
- (opascal-stmt-line-indent-of
- (or stmt-start token) opascal-indent-level)))
-
- ;; An else statement is enclosing, but it doesn't have an expression.
- ;; Thus we take into account last-token instead of stmt-start.
- ((eq 'else token-kind)
- (throw 'done (opascal-stmt-line-indent-of
- (or last-token token) opascal-indent-level)))
-
- ;; We indent relative to an enclosing declaration section.
- ((opascal-is token-kind opascal-decl-sections)
- (throw 'done (opascal-indent-of (if last-token last-token token)
+ (opascal--scan-non-whitespace-backward token last-token
+ ;; An open ( or [ always is an indent point.
+ ('open-group
+ (throw 'done
+ (opascal-open-group-indent
+ token last-token
+ (if (memq from-kind opascal-binary-ops)
+ ;; Keep binary operations aligned with the open group.
+ 0
+ opascal-indent-level))))
+
+ ;; Skip over any ()/[] groups.
+ ('close-group (setq token (opascal-group-start token)))
+
+ ;; Skip over any nested blocks.
+ ((opascal--in opascal-end-block-statements)
+ (setq token (opascal-block-start token)))
+
+ ;; An expression delimiter affects indentation depending on whether
+ ;; the point is before or after it. Remember that we encountered one.
+ ;; Also remember the last encountered token, since if it exists it
+ ;; should be the actual indent point.
+ ((opascal--in opascal-expr-delimiters)
+ (setq expr-delimited token stmt-start last-token))
+
+ ;; With a non-delimited expression statement we indent after the
+ ;; statement's keyword, unless we are on the delimiter itself.
+ ((and (guard (not expr-delimited))
+ (opascal--in opascal-expr-statements))
+ (throw 'done
+ (cond
+ ((memq from-kind opascal-expr-delimiters)
+ ;; We are indenting a delimiter. Indent to the statement.
+ (opascal-stmt-line-indent-of token 0))
+
+ ((and last-token (memq from-kind opascal-binary-ops))
+ ;; Align binary ops with the expression.
+ (opascal-indent-of last-token))
+
+ (last-token
+ ;; Indent in from the expression.
+ (opascal-indent-of last-token opascal-indent-level))
+
+ ;; Indent in from the statement's keyword.
+ ((opascal-indent-of token opascal-indent-level)))))
+
+ ;; A delimited case statement indents the label according to
+ ;; a special rule.
+ ('case
+ (throw 'done
+ (if stmt-start
+ ;; We are not actually indenting to the case statement,
+ ;; but are within a label expression.
+ (opascal-stmt-line-indent-of
+ stmt-start opascal-indent-level)
+ ;; Indent from the case keyword.
+ (opascal-stmt-line-indent-of
+ token opascal-case-label-indent))))
+
+ ;; Body expression statements are enclosing. Indent from the
+ ;; statement's keyword, unless we have a non-block statement following
+ ;; it.
+ ((opascal--in opascal-body-expr-statements)
+ (throw 'done (opascal-stmt-line-indent-of
+ (or stmt-start token) opascal-indent-level)))
+
+ ;; An else statement is enclosing, but it doesn't have an expression.
+ ;; Thus we take into account last-token instead of stmt-start.
+ ('else
+ (throw 'done (opascal-stmt-line-indent-of
+ (or last-token token) opascal-indent-level)))
+
+ ;; We indent relative to an enclosing declaration section,
+ ;; unless this is within the a delimited expression
+ ;; (bug#36348).
+ ((and (guard (not expr-delimited))
+ (opascal--in opascal-decl-sections))
+ (throw 'done (opascal-indent-of (if last-token last-token token)
opascal-indent-level)))
- ;; In unit sections we indent right to the left.
- ((opascal-is token-kind opascal-unit-sections)
- (throw 'done
- ;; Handle specially the case of "interface", which can be used
- ;; to start either a unit section or an interface definition.
- (if (opascal-is token-kind opascal-interface-types)
- (progn
- ;; Find the previous non-whitespace token.
- (while (progn
- (setq last-token token
- token (opascal-previous-token token)
- token-kind (opascal-token-kind token))
- (and token
- (opascal-is token-kind
- opascal-whitespace))))
- ;; If this token is an equals sign, "interface" is being
- ;; used to start an interface definition and we should
- ;; treat it as a composite type; otherwise, we should
- ;; consider it the start of a unit section.
- (if (and token (eq token-kind 'equals))
- (opascal-line-indent-of last-token
- opascal-indent-level)
- 0))
- 0)))
-
- ;; A previous terminator means we can stop.
- ((opascal-is token-kind opascal-previous-terminators)
- (throw 'done
- (cond ((and last-token
- (eq 'comma token-kind)
- (opascal-is from-kind opascal-binary-ops))
- ;; Align binary ops with the expression.
- (opascal-indent-of last-token))
-
- (last-token
- ;; Indent in from the expression.
- (opascal-indent-of last-token opascal-indent-level))
-
- ;; No enclosing expression; use the previous statement's
- ;; indent.
- ((opascal-previous-indent-of token)))))
-
- ;; A block statement after an expression delimiter has its start
- ;; column as the expression statement. E.g.
- ;; if (a = b)
- ;; and (a != c) then begin
- ;; //...
- ;; end;
- ;; Remember it for when we encounter the expression statement start.
- ((opascal-is-block-after-expr-statement token)
- (throw 'done
- (cond (last-token (opascal-indent-of last-token
opascal-indent-level))
-
- ((+ (opascal-section-indent-of token)
opascal-indent-level)))))
-
- ;; Assembly sections always indent in from the asm keyword.
- ((eq token-kind 'asm)
- (throw 'done (opascal-stmt-line-indent-of token
opascal-indent-level)))
-
- ;; Stop at an enclosing statement and indent from it.
- ((opascal-is token-kind opascal-enclosing-statements)
- (throw 'done (opascal-stmt-line-indent-of
- (or last-token token) opascal-indent-level)))
-
- ;; A class/record declaration is also enclosing.
- ((opascal-composite-type-start token last-token)
- (throw 'done
- (opascal-line-indent-of last-token opascal-indent-level)))
-
- ;; A ":" we indent relative to its line beginning. If we are in a
- ;; parameter list, then stop also if we hit a ";".
- ((and (eq token-kind 'colon)
- (not expr-delimited)
- (not (opascal-is from-kind opascal-expr-delimiters))
- (not equals-encountered)
- (not (eq from-kind 'equals)))
- (throw 'done
- (if last-token
- (opascal-indent-of last-token opascal-indent-level)
- (opascal-line-indent-of token opascal-indent-level 'semicolon))))
-
- ;; If the ":" was not processed above and we have token after the "=",
- ;; then indent from the "=". Ignore :=, however.
- ((and (eq token-kind 'colon) equals-encountered before-equals)
- (cond
- ;; Ignore binary ops for now. It would do, for example:
- ;; val := 1 + 2
- ;; + 3;
- ;; which is good, but also
- ;; val := Foo
- ;; (foo, args)
- ;; + 2;
- ;; which doesn't look right.
- ;;;; Align binary ops with the before token.
- ;;((opascal-is from-kind opascal-binary-ops)
- ;;(throw 'done (opascal-indent-of before-equals 0)))
-
- ;; Assignments (:=) we skip over to get a normal indent.
- ((eq (opascal-token-kind last-token) 'equals))
-
- ;; Otherwise indent in from the equals.
- ((throw 'done
- (opascal-indent-of before-equals opascal-indent-level)))))
-
- ;; Remember any "=" we encounter if it has not already been processed.
- ((eq token-kind 'equals)
- (setq equals-encountered token
- before-equals last-token))
- )
- (unless (opascal-is token-kind opascal-whitespace)
- (setq last-token token))
- (setq token (opascal-previous-token token)))
+ ;; In unit sections we indent right to the left.
+ ;; Handle specially the case of "interface", which can be used
+ ;; to start either a unit section or an interface definition.
+ ('interface ;FIXME: Generalize to all `opascal-interface-types'?
+ (throw 'done
+ (let (token-kind)
+ ;; Find the previous non-whitespace token.
+ (while (progn
+ (setq last-token token
+ token (opascal-previous-token token)
+ token-kind (opascal-token-kind token))
+ (and token
+ (memq token-kind
+ opascal-whitespace))))
+ ;; If this token is an equals sign, "interface" is being
+ ;; used to start an interface definition and we should
+ ;; treat it as a composite type; otherwise, we should
+ ;; consider it the start of a unit section.
+ (if (and token (eq token-kind 'equals))
+ (opascal-line-indent-of last-token
+ opascal-indent-level)
+ 0))))
+
+ ;; In unit sections we indent right to the left.
+ ((opascal--in opascal-unit-sections)
+ ;; Note: The `interface' case is handled specially above.
+ (throw 'done 0))
+
+ ;; A previous terminator means we can stop.
+ ((and (opascal--in opascal-previous-terminators) token-kind)
+ (throw 'done
+ (cond ((and last-token
+ (eq 'comma token-kind)
+ (memq from-kind opascal-binary-ops))
+ ;; Align binary ops with the expression.
+ (opascal-indent-of last-token))
+
+ (last-token
+ ;; Indent in from the expression.
+ (opascal-indent-of last-token opascal-indent-level))
+
+ ;; No enclosing expression; use the previous statement's
+ ;; indent.
+ ((opascal-previous-indent-of token)))))
+
+ ;; A block statement after an expression delimiter has its start
+ ;; column as the expression statement. E.g.
+ ;; if (a = b)
+ ;; and (a != c) then begin
+ ;; //...
+ ;; end;
+ ;; Remember it for when we encounter the expression statement start.
+ ((guard (opascal-is-block-after-expr-statement token))
+ (throw 'done
+ (cond (last-token
+ (opascal-indent-of last-token opascal-indent-level))
+
+ (t (+ (opascal-section-indent-of token)
+ opascal-indent-level)))))
+
+ ;; Assembly sections always indent in from the asm keyword.
+ ('asm
+ (throw 'done (opascal-stmt-line-indent-of token
opascal-indent-level)))
+
+ ;; Stop at an enclosing statement and indent from it.
+ ((opascal--in opascal-enclosing-statements)
+ (throw 'done (opascal-stmt-line-indent-of
+ (or last-token token) opascal-indent-level)))
+
+ ;; A class/record declaration is also enclosing.
+ ((guard (opascal-composite-type-start token last-token))
+ (throw 'done
+ (opascal-line-indent-of last-token opascal-indent-level)))
+
+ ;; A ":" we indent relative to its line beginning. If we are in a
+ ;; parameter list, then stop also if we hit a ";".
+ ((and 'colon
+ (guard (not (or expr-delimited
+ (memq from-kind opascal-expr-delimiters)
+ equals-encountered
+ (eq from-kind 'equals)))))
+ (throw 'done
+ (if last-token
+ (opascal-indent-of last-token opascal-indent-level)
+ (opascal-line-indent-of token opascal-indent-level
+ 'semicolon))))
+
+ ;; If the ":" was not processed above and we have token after the "=",
+ ;; then indent from the "=". Ignore :=, however.
+ ((and 'colon (guard (and equals-encountered before-equals)))
+ (cond
+ ;; Ignore binary ops for now. It would do, for example:
+ ;; val := 1 + 2
+ ;; + 3;
+ ;; which is good, but also
+ ;; val := Foo
+ ;; (foo, args)
+ ;; + 2;
+ ;; which doesn't look right.
+
+ ;; ;; Align binary ops with the before token.
+ ;;((memq from-kind opascal-binary-ops)
+ ;;(throw 'done (opascal-indent-of before-equals 0)))
+
+ ;; Assignments (:=) we skip over to get a normal indent.
+ ((eq (opascal-token-kind last-token) 'equals))
+
+ ;; Otherwise indent in from the equals.
+ (t (throw 'done
+ (opascal-indent-of before-equals opascal-indent-level)))))
+
+ ;; Remember any "=" we encounter if it has not already been processed.
+ ('equals
+ (setq equals-encountered token
+ before-equals last-token))
+ )
;; We ran out of tokens. Indent to column 0.
0)))
@@ -1301,9 +1287,12 @@ routine.")
;; Returns the corrected indentation for the current line.
(opascal-save-excursion
(opascal-progress-start)
- ;; Move to the first token on the line.
- (beginning-of-line)
- (skip-chars-forward opascal-space-chars)
+ ;; The caller should make sure we're at the first token on the line.
+ (cl-assert (eql (point)
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward opascal-space-chars)
+ (point))))
(let* ((token (opascal-current-token))
(token-kind (opascal-token-kind token))
(indent
@@ -1311,17 +1300,17 @@ routine.")
;; Indent to the matching start ( or [.
(opascal-indent-of (opascal-group-start token)))
- ((opascal-is token-kind opascal-unit-statements) 0)
+ ((memq token-kind opascal-unit-statements) 0)
- ((opascal-is token-kind opascal-comments)
+ ((memq token-kind opascal-comments)
;; In a comment.
(opascal-comment-indent-of token))
- ((opascal-is token-kind opascal-decl-matchers)
+ ((memq token-kind opascal-decl-matchers)
;; Use a previous section/routine's indent.
(opascal-section-indent-of token))
- ((opascal-is token-kind opascal-match-block-statements)
+ ((memq token-kind opascal-match-block-statements)
;; Use the block's indentation.
(let ((block-start
(opascal-block-start token 'stop-on-class)))
@@ -1339,8 +1328,9 @@ routine.")
(opascal-stmt-line-indent-of (opascal-else-start token) 0))
;; Otherwise indent in from enclosing statement.
- ((opascal-enclosing-indent-of
- (if token token (opascal-token-at (1- (point)))))))))
+ (t
+ (opascal-enclosing-indent-of
+ (or token (opascal-token-at (1- (point)))))))))
(opascal-progress-done)
indent)))
@@ -1349,25 +1339,18 @@ routine.")
If before the indent, the point is moved to the indent."
(interactive)
(save-match-data
- (let ((marked-point (point-marker)) ; Maintain our position reliably.
- (line-start nil)
- (old-indent 0)
- (new-indent 0))
- (beginning-of-line)
- (setq line-start (point))
- (skip-chars-forward opascal-space-chars)
- (setq old-indent (current-column))
- (setq new-indent (opascal-corrected-indentation))
- (if (< marked-point (point))
- ;; If before the indent column, then move to it.
- (set-marker marked-point (point)))
- ;; Advance our marked point after inserted spaces.
- (set-marker-insertion-type marked-point t)
- (when (/= old-indent new-indent)
- (delete-region line-start (point))
- (insert (make-string new-indent ?\s)))
- (goto-char marked-point)
- (set-marker marked-point nil))))
+ (let ((marked-point (point-marker))) ; Maintain our position reliably.
+ (beginning-of-line)
+ (skip-chars-forward opascal-space-chars)
+ (let ((new-indent (opascal-corrected-indentation)))
+ (if (< marked-point (point))
+ ;; If before the indent column, then move to it.
+ (set-marker marked-point (point)))
+ ;; Advance our marked point after inserted spaces.
+ (set-marker-insertion-type marked-point t)
+ (indent-line-to new-indent)
+ (goto-char marked-point)
+ (set-marker marked-point nil)))))
(defvar opascal-mode-abbrev-table nil
"Abbrev table in use in OPascal mode buffers.")
@@ -1580,7 +1563,7 @@ An error is raised if not in a comment."
(save-restriction
(let* ((comment (opascal-current-token))
(comment-kind (opascal-token-kind comment)))
- (if (not (opascal-is comment-kind opascal-comments))
+ (if (not (memq comment-kind opascal-comments))
(error "Not in a comment")
(let* ((start-comment (opascal-comment-block-start comment))
(end-comment (opascal-comment-block-end comment))
@@ -1658,6 +1641,9 @@ An error is raised if not in a comment."
"If in a // comment, do a newline, indented such that one is still in the
comment block. If not in a // comment, just does a normal newline."
(interactive)
+ (declare
+ (obsolete "use comment-indent-new-line with comment-multi-line instead"
+ "27.1"))
(let ((comment (opascal-current-token)))
(if (not (eq 'comment-single-line (opascal-token-kind comment)))
;; Not in a // comment. Just do the normal newline.
@@ -1733,7 +1719,7 @@ comment block. If not in a // comment, just does a
normal newline."
;; '("\C-cb" opascal-find-current-body)
'("\C-cu" opascal-find-unit)
'("\M-q" opascal-fill-comment)
- '("\M-j" opascal-new-comment-line)
+ ;; '("\M-j" opascal-new-comment-line)
;; Debug bindings:
(list "\C-c\C-d" opascal-debug-mode-map)))
(define-key kmap (car binding) (cadr binding)))
@@ -1742,7 +1728,7 @@ comment block. If not in a // comment, just does a
normal newline."
(define-obsolete-variable-alias 'delphi-mode-hook 'opascal-mode-hook "24.4")
;;;###autoload
-(define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4")
+(define-obsolete-function-alias 'delphi-mode #'opascal-mode "24.4")
;;;###autoload
(define-derived-mode opascal-mode prog-mode "OPascal"
"Major mode for editing OPascal code.\\<opascal-mode-map>
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 2b05735..79fe56a 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -211,6 +211,9 @@ You can enable this mode locally in desired buffers, or use
`global-prettify-symbols-mode' to enable it for all modes that
support it."
:init-value nil
+ (when prettify-symbols--keywords
+ (font-lock-remove-keywords nil prettify-symbols--keywords)
+ (setq prettify-symbols--keywords nil))
(if prettify-symbols-mode
;; Turn on
(when (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
@@ -226,9 +229,6 @@ support it."
(font-lock-flush))
;; Turn off
(remove-hook 'post-command-hook #'prettify-symbols--post-command-hook t)
- (when prettify-symbols--keywords
- (font-lock-remove-keywords nil prettify-symbols--keywords)
- (setq prettify-symbols--keywords nil))
(when (memq 'composition font-lock-extra-managed-props)
(setq font-lock-extra-managed-props (delq 'composition
font-lock-extra-managed-props))
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 8eadf01..340c689 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1690,7 +1690,8 @@ See `add-log-current-defun-function'."
(when (eq (char-before) ?\})
(delete-char -1)
(when (save-excursion
- (skip-chars-backward " \t")
+ (let ((n (skip-chars-backward " \t")))
+ (if (< n 0) (delete-char (- n))))
(not (bolp)))
(insert "\n"))
(insert "end")
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 13d0cfa..9eedbf9 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -126,13 +126,15 @@
;;; Code:
-(eval-when-compile (require 'cl))
-(eval-and-compile
- ;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin'
- ;; even for relatively simple cases such as used here. We only test <25
- ;; because it's easier and sufficient.
- (when (or (featurep 'xemacs) (< emacs-major-version 25))
- (require 'cl)))
+(eval-when-compile
+ (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))
+ (defalias 'vhdl--pushnew (if (fboundp 'cl-pushnew) 'cl-pushnew 'pushnew)))
+
+;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin'
+;; even for relatively simple cases such as used here. We only test <25
+;; because it's easier and sufficient.
+(when (< emacs-major-version 25)
+ (condition-case nil (require 'cl-lib) (file-missing (require 'cl))))
;; Emacs 21+ handling
(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep
'xemacs)))
@@ -14315,7 +14317,7 @@ of PROJECT."
(vhdl-scan-directory-contents dir-name project nil
(format "(%s/%s) " act-dir num-dir)
(cdr dir-list))
- (pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal)
+ (vhdl--pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal)
(setq dir-list (cdr dir-list)
act-dir (1+ act-dir)))
(vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
@@ -16407,8 +16409,8 @@ component instantiation."
(if (or (member constant-name single-list)
(member constant-name multi-list))
(progn (setq single-list (delete constant-name single-list))
- (pushnew constant-name multi-list :test #'equal))
- (pushnew constant-name single-list :test #'equal))
+ (vhdl--pushnew constant-name multi-list :test #'equal))
+ (vhdl--pushnew constant-name single-list :test #'equal))
(unless (match-string 1)
(setq generic-alist (cdr generic-alist)))
(vhdl-forward-syntactic-ws))
@@ -16434,12 +16436,12 @@ component instantiation."
(member signal-name multi-out-list))
(setq single-out-list (delete signal-name single-out-list))
(setq multi-out-list (delete signal-name multi-out-list))
- (pushnew signal-name local-list :test #'equal))
+ (vhdl--pushnew signal-name local-list :test #'equal))
((member signal-name single-in-list)
(setq single-in-list (delete signal-name single-in-list))
- (pushnew signal-name multi-in-list :test #'equal))
+ (vhdl--pushnew signal-name multi-in-list :test #'equal))
((not (member signal-name multi-in-list))
- (pushnew signal-name single-in-list :test #'equal)))
+ (vhdl--pushnew signal-name single-in-list :test #'equal)))
;; output signal
(cond
((member signal-name local-list)
@@ -16448,12 +16450,12 @@ component instantiation."
(member signal-name multi-in-list))
(setq single-in-list (delete signal-name single-in-list))
(setq multi-in-list (delete signal-name multi-in-list))
- (pushnew signal-name local-list :test #'equal))
+ (vhdl--pushnew signal-name local-list :test #'equal))
((member signal-name single-out-list)
(setq single-out-list (delete signal-name single-out-list))
- (pushnew signal-name multi-out-list :test #'equal))
+ (vhdl--pushnew signal-name multi-out-list :test #'equal))
((not (member signal-name multi-out-list))
- (pushnew signal-name single-out-list :test #'equal))))
+ (vhdl--pushnew signal-name single-out-list :test #'equal))))
(unless (match-string 1)
(setq port-alist (cdr port-alist)))
(vhdl-forward-syntactic-ws))
@@ -16536,14 +16538,14 @@ component instantiation."
generic-end-pos
(vhdl-compose-insert-generic constant-entry)))
(setq generic-pos (point-marker))
- (pushnew constant-name written-list :test #'equal))
+ (vhdl--pushnew constant-name written-list :test #'equal))
(t
(vhdl-goto-marker
(vhdl-max-marker generic-inst-pos generic-pos))
(setq generic-end-pos
(vhdl-compose-insert-generic constant-entry))
(setq generic-inst-pos (point-marker))
- (pushnew constant-name written-list :test #'equal))))
+ (vhdl--pushnew constant-name written-list :test #'equal))))
(setq constant-alist (cdr constant-alist)))
(when (/= constant-temp-pos generic-inst-pos)
(vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
@@ -16562,14 +16564,14 @@ component instantiation."
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-in-pos (point-marker))
- (pushnew signal-name written-list :test #'equal))
+ (vhdl--pushnew signal-name written-list :test #'equal))
((member signal-name multi-out-list)
(vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
(setq port-end-pos
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-out-pos (point-marker))
- (pushnew signal-name written-list :test #'equal))
+ (vhdl--pushnew signal-name written-list :test #'equal))
((or (member signal-name single-in-list)
(member signal-name single-out-list))
(vhdl-goto-marker
@@ -16578,12 +16580,12 @@ component instantiation."
(vhdl-max-marker port-out-pos port-in-pos)))
(setq port-end-pos (vhdl-compose-insert-port signal-entry))
(setq port-inst-pos (point-marker))
- (pushnew signal-name written-list :test #'equal))
+ (vhdl--pushnew signal-name written-list :test #'equal))
((equal (upcase (nth 2 signal-entry)) "OUT")
(vhdl-goto-marker signal-pos)
(vhdl-compose-insert-signal signal-entry)
(setq signal-pos (point-marker))
- (pushnew signal-name written-list :test #'equal)))
+ (vhdl--pushnew signal-name written-list :test #'equal)))
(setq signal-alist (cdr signal-alist)))
(when (/= port-temp-pos port-inst-pos)
(vhdl-goto-marker
@@ -16934,7 +16936,7 @@ no project is defined."
"Remove duplicate elements from IN-LIST."
(let (out-list)
(while in-list
- (pushnew (car in-list) out-list :test #'equal)
+ (vhdl--pushnew (car in-list) out-list :test #'equal)
(setq in-list (cdr in-list)))
out-list))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 8dc4f3c..57d8038 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -99,7 +99,11 @@ This is typically the filename.")
;;;; Commonly needed location classes are defined here:
(defcustom xref-file-name-display 'abs
- "Style of file name display in *xref* buffers."
+ "Style of file name display in *xref* buffers.
+If the value is the symbol `abs', the default, show the file names
+in their full absolute form.
+If `nondirectory', show only the nondirectory (a.k.a. \"base name\")
+part of the file name."
:type '(choice (const :tag "absolute file name" abs)
(const :tag "nondirectory file name" nondirectory))
:version "27.1")
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index dc0df7a..61fa754 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -49,9 +49,7 @@ from a scroll bar event, then (scroll-bar-scale SCROLL-BAR-POS
\(buffer-size)) is the position in the current buffer corresponding to
that scroll bar position."
;; We multiply before we divide to maintain precision.
- ;; We use floating point because the product of a large buffer size
- ;; with a large scroll bar portion can easily overflow a lisp int.
- (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom))))
+ (truncate (* (car num-denom) whole) (cdr num-denom)))
(defun scroll-bar-columns (side)
"Return the width, measured in columns, of the vertical scrollbar on SIDE.
diff --git a/lisp/ses.el b/lisp/ses.el
index 7fdacc7..37d0d61 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1509,8 +1509,9 @@ Newlines in the data are escaped."
,printer
,(ses-cell-references cell))))
(ses-goto-data row col)
- (delete-region (point) (line-end-position))
- (insert text)))
+ (let ((inhibit-quit t))
+ (delete-region (point) (line-end-position))
+ (insert text))))
(message " "))))
diff --git a/lisp/simple.el b/lisp/simple.el
index 00265ec..0bc39f0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1037,12 +1037,8 @@ is supplied, or Transient Mark mode is enabled and the
mark is active."
(push-mark))
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
- (+ (point-min)
- (if (> size 10000)
- ;; Avoid overflow for large buffer sizes!
- (* (prefix-numeric-value arg)
- (/ size 10))
- (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
+ (+ (point-min) 1
+ (/ (* size (prefix-numeric-value arg)) 10))
(point-min))))
(if (and arg (not (consp arg))) (forward-line 1)))
@@ -1060,11 +1056,7 @@ is supplied, or Transient Mark mode is enabled and the
mark is active."
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
(- (point-max)
- (if (> size 10000)
- ;; Avoid overflow for large buffer sizes!
- (* (prefix-numeric-value arg)
- (/ size 10))
- (/ (* size (prefix-numeric-value arg)) 10)))
+ (/ (* size (prefix-numeric-value arg)) 10))
(point-max))))
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
@@ -4980,10 +4972,11 @@ Normally set from the UNDO element of a yank-handler;
see `insert-for-yank'.")
(defun yank-pop (&optional arg)
"Replace just-yanked stretch of killed text with a different stretch.
-This command is allowed only immediately after a `yank' or a `yank-pop'.
-At such a time, the region contains a stretch of reinserted
-previously-killed text. `yank-pop' deletes that text and inserts in its
-place a different stretch of killed text.
+This command is allowed only immediately after a `yank' or a
+`yank-pop'. At such a time, the region contains a stretch of
+reinserted previously-killed text. `yank-pop' deletes that text
+and inserts in its place a different stretch of killed text by
+traversing the value of the `kill-ring' variable.
With no argument, the previous kill is inserted.
With argument N, insert the Nth previous kill.
@@ -5637,7 +5630,14 @@ separate contiguous regions for each line."
(eq (overlay-start rol) start)
(eq (overlay-end rol) end))
(move-overlay rol start end (current-buffer)))
- rol)))
+ rol))
+ "Function to move the region-highlight overlay.
+This function is called with four parameters, START, END, WINDOW
+and OVERLAY. If OVERLAY is nil, a new overlay is created. In
+any case, the overlay is adjusted to reflect the other three
+parameters.
+
+The overlay is returned by the function.")
(defun redisplay--update-region-highlight (window)
(let ((rol (window-parameter window 'internal-region-overlay)))
@@ -9063,6 +9063,30 @@ to capitalize ARG words."
(capitalize-region (region-beginning) (region-end))
(capitalize-word arg)))
+;;; Accessors for `decode-time' values.
+
+(cl-defstruct (decoded-time
+ (:constructor nil)
+ (:copier nil)
+ (:type list))
+ (second nil :documentation "\
+This is an integer between 0 and 60 (inclusive). (60 is a leap
+second, which only some operating systems support.)")
+ (minute nil :documentation "This is an integer between 0 and 59
(inclusive).")
+ (hour nil :documentation "This is an integer between 0 and 23 (inclusive).")
+ (day nil :documentation "This is an integer between 1 and 31 (inclusive).")
+ (month nil :documentation "\
+This is an integer between 1 and 12 (inclusive). January is 1.")
+ (year nil :documentation "This is a four digit integer.")
+ (weekday nil :documentation "\
+This is a number between 0 and 6, and 0 is Sunday.")
+ (dst nil :documentation "\
+This is t if daylight saving time is in effect, and nil if not.")
+ (zone nil :documentation "\
+This is an integer indicating the UTC offset in seconds, i.e.,
+the number of seconds east of Greenwich.")
+ )
+
(provide 'simple)
diff --git a/lisp/startup.el b/lisp/startup.el
index 7759ed5..5644285 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -354,8 +354,8 @@ Setting `init-file-user' does not prevent Emacs from loading
"File containing site-wide run-time initializations.
This file is loaded at run-time before `~/.emacs'. It contains inits
that need to be in place for the entire site, but which, due to their
-higher incidence of change, don't make sense to load into Emacs's
-dumped image. Thus, the run-time load order is: 1. file described in
+higher incidence of change, don't make sense to put into Emacs's
+dump file. Thus, the run-time load order is: 1. file described in
this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
Don't use the `site-start.el' file for things some users may not like.
diff --git a/lisp/subr.el b/lisp/subr.el
index 4a1649f..eea4e04 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -302,6 +302,14 @@ See also `with-demoted-errors' that does something similar
without silencing all errors."
(declare (debug t) (indent 0))
`(condition-case nil (progn ,@body) (error nil)))
+
+(defmacro ignore-error (condition &rest body)
+ "Execute BODY; if the error CONDITION occurs, return nil.
+Otherwise, return result of last form in BODY.
+
+CONDITION can also be a list of error conditions."
+ (declare (debug t) (indent 1))
+ `(condition-case nil (progn ,@body) (,condition nil)))
;;;; Basic Lisp functions.
@@ -679,16 +687,13 @@ of course, also replace TO with a slightly larger value
(list from)
(or inc (setq inc 1))
(when (zerop inc) (error "The increment can not be zero"))
- (let (seq (n 0) (next from) (last from))
+ (let (seq (n 0) (next from))
(if (> inc 0)
- ;; The (>= next last) condition protects against integer
- ;; overflow in computing NEXT.
- (while (and (>= next last) (<= next to))
+ (while (<= next to)
(setq seq (cons next seq)
n (1+ n)
- last next
next (+ from (* n inc))))
- (while (and (<= next last) (>= next to))
+ (while (>= next to)
(setq seq (cons next seq)
n (1+ n)
next (+ from (* n inc)))))
diff --git a/lisp/term.el b/lisp/term.el
index f341104..b5f4c62 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -4395,18 +4395,26 @@ Try to be nice by providing useful defaults and
history."
x))
;;;###autoload
-(defun serial-term (port speed)
+(defun serial-term (port speed &optional line-mode)
"Start a terminal-emulator for a serial port in a new buffer.
PORT is the path or name of the serial port. For example, this
could be \"/dev/ttyS0\" on Unix. On Windows, this could be
\"COM1\" or \"\\\\.\\COM10\".
+
SPEED is the speed of the serial port in bits per second. 9600
is a common value. SPEED can be nil, see
`serial-process-configure' for details.
+
+Usually `term-char-mode' is used, but if LINE-MODE (the prefix
+when used interactively) is non-nil, `term-line-mode' is used
+instead.
+
The buffer is in Term mode; see `term-mode' for the commands to
use in that buffer.
+
\\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer."
- (interactive (list (serial-read-name) (serial-read-speed)))
+ (interactive (list (serial-read-name) (serial-read-speed)
+ current-prefix-arg))
(serial-supported-or-barf)
(let* ((process (make-serial-process
:port port
@@ -4416,7 +4424,8 @@ use in that buffer.
(buffer (process-buffer process)))
(with-current-buffer buffer
(term-mode)
- (term-char-mode)
+ (unless line-mode
+ (term-char-mode))
(goto-char (point-max))
(set-marker (process-mark process) (point))
(set-process-filter process #'term-emulate-terminal)
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 5af8170..43c1071 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -919,57 +919,63 @@ FRAME defaults to the selected frame."
The result is a list of integer RGB values--(RED GREEN BLUE).
These values range from 0 to 65535; white is (65535 65535 65535).
-The returned value reflects the standard X definition of COLOR,
-regardless of whether the terminal can display it, so the return value
-should be the same regardless of what display is being used."
+The returned value reflects the standard Emacs definition of
+COLOR (see the info node `(emacs) Colors'), regardless of whether
+the terminal can display it, so the return value should be the
+same regardless of what display is being used."
(let ((len (length color)))
- (cond ((and (>= len 4) ;; X-style "#XXYYZZ" color spec
+ (cond ((and (>= len 4) ;; HTML/CSS/SVG-style "#XXYYZZ" color spec
(eq (aref color 0) ?#)
(member (aref color 1)
'(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?a ?b ?c ?d ?e ?f)))
- ;; Translate the string "#XXYYZZ" into a list
- ;; of numbers (XX YY ZZ). If the primary colors
- ;; are specified with less than 4 hex digits,
- ;; the used digits represent the most significant
- ;; bits of the value (e.g. #XYZ = #X000Y000Z000).
+ ?a ?b ?c ?d ?e ?f
+ ?A ?B ?C ?D ?E ?F)))
+ ;; Translate the string "#XXYYZZ" into a list of numbers
+ ;; (XX YY ZZ), scaling each to the {0..65535} range. This
+ ;; follows the HTML color convention, where both "#fff" and
+ ;; "#ffffff" represent the same color, white.
(let* ((ndig (/ (- len 1) 3))
+ (maxval (1- (ash 1 (* 4 ndig))))
(i1 1)
(i2 (+ i1 ndig))
- (i3 (+ i2 ndig)))
+ (i3 (+ i2 ndig))
+ (i4 (+ i3 ndig)))
(list
- (ash
- (string-to-number (substring color i1 i2) 16)
- (* 4 (- 4 ndig)))
- (ash
- (string-to-number (substring color i2 i3) 16)
- (* 4 (- 4 ndig)))
- (ash
- (string-to-number (substring color i3) 16)
- (* 4 (- 4 ndig))))))
- ((and (>= len 9) ;; X-style RGB:xx/yy/zz color spec
+ (/ (* (string-to-number
+ (substring color i1 i2) 16)
+ 65535)
+ maxval)
+ (/ (* (string-to-number
+ (substring color i2 i3) 16)
+ 65535)
+ maxval)
+ (/ (* (string-to-number
+ (substring color i3 i4) 16)
+ 65535)
+ maxval))))
+ ((and (>= len 9) ;; X-style rgb:xx/yy/zz color spec
(string= (substring color 0 4) "rgb:"))
- ;; Translate the string "RGB:XX/YY/ZZ" into a list
- ;; of numbers (XX YY ZZ). If fewer than 4 hex
- ;; digits are used, they represent the fraction
- ;; of the maximum value (RGB:X/Y/Z = #XXXXYYYYZZZZ).
+ ;; Translate the string "rgb:XX/YY/ZZ" into a list of
+ ;; numbers (XX YY ZZ), scaling each to the {0..65535}
+ ;; range. "rgb:F/F/F" is white.
(let* ((ndig (/ (- len 3) 3))
(maxval (1- (ash 1 (* 4 (- ndig 1)))))
(i1 4)
(i2 (+ i1 ndig))
- (i3 (+ i2 ndig)))
+ (i3 (+ i2 ndig))
+ (i4 (+ i3 ndig)))
(list
(/ (* (string-to-number
(substring color i1 (- i2 1)) 16)
- 255)
+ 65535)
maxval)
(/ (* (string-to-number
(substring color i2 (- i3 1)) 16)
- 255)
+ 65535)
maxval)
(/ (* (string-to-number
- (substring color i3) 16)
- 255)
+ (substring color i3 (1- i4)) 16)
+ 65535)
maxval))))
(t
(cdr (assoc color color-name-rgb-alist))))))
@@ -977,9 +983,9 @@ should be the same regardless of what display is being
used."
(defun tty-color-translate (color &optional frame)
"Given a color COLOR, return the index of the corresponding TTY color.
-COLOR must be a string that is either the color's name, or its X-style
-specification like \"#RRGGBB\" or \"RGB:rr/gg/bb\", where each primary.
-color can be given with 1 to 4 hex digits.
+COLOR must be a string that is either the color's name, or its
+color triplet specification like \"#RRGGBB\" or \"rgb:RR/GG/BB\",
+where each primary color can be given with 1 to 4 hex digits.
If COLOR is a color name that is found among supported colors in
`tty-color-alist', the associated index is returned. Otherwise, the
@@ -987,7 +993,7 @@ RGB values of the color, either as given by the argument or
from
looking up the name in `color-name-rgb-alist', are used to find the
supported color that is the best approximation for COLOR in the RGB
space.
-If COLOR is neither a valid X RGB specification of the color, nor a
+If COLOR is neither a valid RGB specification of the color, nor a
name of a color in `color-name-rgb-alist', the returned value is nil.
If FRAME is unspecified or nil, it defaults to the selected frame."
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index ad9f60f..3b3d5d4 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -135,7 +135,7 @@ not align (only setting space according to
`conf-assignment-space')."
(modify-syntax-entry ?_ "_" table)
(modify-syntax-entry ?- "_" table)
(modify-syntax-entry ?. "_" table)
- (modify-syntax-entry ?\' "\"" table)
+ (modify-syntax-entry ?' "\"" table)
(modify-syntax-entry ?\; "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?\r ">" table)
@@ -194,7 +194,7 @@ not align (only setting space according to
`conf-assignment-space')."
(1 'font-lock-variable-name-face)
(2 'font-lock-constant-face nil t))
;; section { ... } (do this last because some assign ...{...)
- ("^[ \t]*\\([^=:\n]+?\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face prepend))
+ ("^[ \t]*\\([^#=:\n]+?\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face
prepend))
"Keywords to highlight in Conf mode.")
(defvar conf-javaprop-font-lock-keywords
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 60a20e2..319f4b2 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -194,7 +194,9 @@ The bounds of THING are determined by
`bounds-of-thing-at-point'."
(if (or (eq char-syntax ?\))
(and (eq char-syntax ?\") (nth 3 (syntax-ppss))))
(forward-char 1)
- (forward-sexp 1))))
+ (condition-case _
+ (forward-sexp 1)
+ (scan-error nil)))))
(define-obsolete-function-alias 'end-of-sexp
'thing-at-point--end-of-sexp "25.1"
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index f423683..ec6a45c 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -223,10 +223,17 @@ The fourth part is a regexp identifying the pattern
following the time stamp.
This part may be omitted to use the normal pattern.
Examples:
-\"-10/\"
-\"-9/^Last modified: %%$\"
-\"@set Time-stamp: %:b %:d, %:y$\"
-\"newcommand{\\\\\\\\timestamp}{%%}\"
+
+\"-10/\" (sets only `time-stamp-line-limit')
+
+\"-9/^Last modified: %%$\" (sets `time-stamp-line-limit',
+`time-stamp-start', `time-stamp-end' and `time-stamp-format')
+
+\"@set Time-stamp: %:b %:d, %:y$\" (sets `time-stamp-start',
+`time-stamp-end' and `time-stamp-format')
+
+\"newcommand{\\\\\\\\timestamp}{%%}\" (sets `time-stamp-start',
+`time-stamp-end' and `time-stamp-format')
Do not change `time-stamp-pattern' `time-stamp-line-limit',
`time-stamp-start', or `time-stamp-end' for yourself or you will be
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 5277601..838f0a3 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -453,6 +453,14 @@ Return the number of characters removed."
auth
(strength 0))
+ ;; If we're here, then we got a 40x Unauthorized response from the
+ ;; server. If we already have "Authorization" in the extra
+ ;; headers, then this means that we've already tried sending
+ ;; credentials to the server, and they were wrong, so just give
+ ;; up.
+ (when (assoc "Authorization" url-http-extra-headers)
+ (error "Wrong authorization used for %s" url))
+
;; find strongest supported auth
(dolist (this-auth auths)
(setq this-auth (url-eat-trailing-space
@@ -951,7 +959,7 @@ should be shown to the user."
(start end &optional allow-partial))
(defun url-handle-content-transfer-encoding ()
- (let ((encoding (mail-fetch-field "content-encoding")))
+ (let ((encoding (mail-fetch-field "content-encoding" nil nil nil t)))
(when (and encoding
(fboundp 'zlib-available-p)
(zlib-available-p)
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index b666900..1bdaca2 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -1205,13 +1205,12 @@ behavior."
;; TIME is like the output of decode-time
(defun ediff-format-date (time)
(format "%s %2d %4d %s:%s:%s"
- (cdr (assoc (nth 4 time) ediff-months)) ; month
- (nth 3 time) ; day
- (nth 5 time) ; year
- (ediff-fill-leading-zero (nth 2 time)) ; hour
- (ediff-fill-leading-zero (nth 1 time)) ; min
- (ediff-fill-leading-zero (nth 0 time)) ; sec
- ))
+ (cdr (assoc (decoded-time-month time) ediff-months))
+ (decoded-time-day time)
+ (decoded-time-year time)
+ (ediff-fill-leading-zero (decoded-time-hour time))
+ (ediff-fill-leading-zero (decoded-time-minute time))
+ (ediff-fill-leading-zero (decoded-time-second time))))
;; Draw the directories
(defun ediff-insert-dirs-in-meta-buffer (meta-list)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index d4833d8..9715aea 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -74,6 +74,9 @@
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
+;; * log-outgoing (buffer remote-location) OK
+;; * log-incoming (buffer remote-location) OK
+;; - log-search (buffer pattern) OK
;; - log-view-mode () OK
;; - show-log-entry (revision) OK
;; - comment-history (file) ??
@@ -1074,6 +1077,13 @@ If LIMIT is a revision string, use it as an
end-revision."
remote-location))))
(defun vc-git-log-search (buffer pattern)
+ "Search the log of changes for PATTERN and output results into BUFFER.
+
+PATTERN is a basic regular expression by default in Git.
+
+Display all entries that match log messages in long format.
+With a prefix argument, ask for a command to run that will output
+log entries."
(let ((args `("log" "--no-color" "-i"
,(format "--grep=%s" (or pattern "")))))
(when current-prefix-arg
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index a68beb5..4cac153 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -339,7 +339,7 @@
;;
;; - log-search (pattern)
;;
-;; Search for string PATTERN in the revision log.
+;; Search for PATTERN in the revision log.
;;
;; - log-view-mode ()
;;
@@ -2532,7 +2532,12 @@ When called interactively with a prefix argument, prompt
for REMOTE-LOCATION."
;;;###autoload
(defun vc-log-search (pattern)
- "Search a log of changes for PATTERN string.
+ "Search the log of changes for PATTERN.
+
+PATTERN is usually interpreted as a regular expression. However, its
+exact semantics is up to the backend's log search command; some can
+only match fixed strings.
+
Display all entries that match log messages in long format.
With a prefix argument, ask for a command to run that will output
log entries."
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index b96f6aa..dd03a24 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1040,9 +1040,11 @@ POS defaults to the value of (point)."
"If non-nil, use overlay change functions to tab around in the buffer.
This is much faster.")
-(defun widget-move (arg)
+(defun widget-move (arg &optional suppress-echo)
"Move point to the ARG next field or button.
-ARG may be negative to move backward."
+ARG may be negative to move backward.
+When the second optional argument is non-nil,
+nothing is shown in the echo area."
(or (bobp) (> arg 0) (backward-char))
(let ((wrapped 0)
(number arg)
@@ -1084,7 +1086,8 @@ ARG may be negative to move backward."
(while (eq (widget-tabable-at) new)
(backward-char)))
(forward-char))
- (widget-echo-help (point))
+ (unless suppress-echo
+ (widget-echo-help (point)))
(run-hooks 'widget-move-hook))
(defun widget-forward (arg)
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index d6b2009..77563ed 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -70,6 +70,7 @@ AC_DEFUN([gl_EARLY],
# Code from module dirent:
# Code from module dirfd:
# Code from module dosname:
+ # Code from module double-slash-root:
# Code from module dtoastr:
# Code from module dtotimespec:
# Code from module dup2:
@@ -227,6 +228,7 @@ AC_DEFUN([gl_INIT],
gl_SHA512
gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE
gl_DIRENT_H
+ gl_DOUBLE_SLASH_ROOT
gl_FUNC_DUP2
if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
AC_LIBOBJ([dup2])
diff --git a/src/alloc.c b/src/alloc.c
index aa9200f..5e08931 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -4531,9 +4531,9 @@ mark_maybe_object (Lisp_Object obj)
void *po = XPNTR (obj);
- /* If the pointer is in the dumped image and the dump has a record
+ /* If the pointer is in the dump image and the dump has a record
of the object starting at the place where the pointer points, we
- definitely have an object. If the pointer is in the dumped image
+ definitely have an object. If the pointer is in the dump image
and the dump has no idea what the pointer is pointing at, we
definitely _don't_ have an object. */
if (pdumper_object_p (po))
@@ -4964,15 +4964,6 @@ flush_stack_call_func (void (*func) (void *arg), void
*arg)
eassert (current_thread == self);
}
-static bool
-c_symbol_p (struct Lisp_Symbol *sym)
-{
- char *lispsym_ptr = (char *) lispsym;
- char *sym_ptr = (char *) sym;
- ptrdiff_t lispsym_offset = sym_ptr - lispsym_ptr;
- return 0 <= lispsym_offset && lispsym_offset < sizeof lispsym;
-}
-
/* Determine whether it is safe to access memory at address P. */
static int
valid_pointer_p (void *p)
@@ -5507,7 +5498,7 @@ staticpro (Lisp_Object const *varaddress)
static void
allow_garbage_collection (intmax_t consing)
{
- consing_until_gc = consing;
+ consing_until_gc = consing - (OBJECT_CT_MAX - consing_until_gc);
garbage_collection_inhibited--;
}
diff --git a/src/bytecode.c b/src/bytecode.c
index d668a9a..9aad1eb 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1406,18 +1406,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,
/* h->count is a faster approximation for HASH_TABLE_SIZE (h)
here. */
- if (h->count <= 5)
+ if (h->count <= 5 && !h->test.cmpfn)
{ /* Do a linear search if there are not many cases
FIXME: 5 is arbitrarily chosen. */
- Lisp_Object hash_code
- = h->test.cmpfn ? h->test.hashfn (v1, h) : Qnil;
-
- for (i = h->count; 0 <= --i; )
- if (EQ (v1, HASH_KEY (h, i))
- || (h->test.cmpfn
- && EQ (hash_code, HASH_HASH (h, i))
- && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), h))))
- break;
+ for (i = h->count; 0 <= --i; )
+ if (EQ (v1, HASH_KEY (h, i)))
+ break;
}
else
i = hash_lookup (h, v1, NULL);
diff --git a/src/editfns.c b/src/editfns.c
index 8e0c0c4..1b33f39 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3594,6 +3594,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
sprintf_bytes = prec != 0;
}
else if (BIGNUMP (arg))
+ bignum_arg:
{
int base = ((conversion == 'd' || conversion == 'i') ? 10
: conversion == 'o' ? 8 : 16);
@@ -3655,11 +3656,17 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
else
{
double d = XFLOAT_DATA (arg);
- double uintmax = UINTMAX_MAX;
- if (! (0 <= d && d < uintmax + 1))
- xsignal1 (Qoverflow_error, arg);
- x = d;
- negative = false;
+ double abs_d = fabs (d);
+ if (abs_d < UINTMAX_MAX + 1.0)
+ {
+ negative = d <= -1;
+ x = abs_d;
+ }
+ else
+ {
+ arg = double_to_integer (d);
+ goto bignum_arg;
+ }
}
p[0] = negative ? '-' : plus_flag ? '+' : ' ';
bool signedp = negative | plus_flag | space_flag;
diff --git a/src/emacs.c b/src/emacs.c
index ad661a0..cc58183 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -686,7 +686,7 @@ dump_error_to_string (enum pdumper_load_result result)
}
/* Find a path (absolute or relative) to the Emacs executable.
- Called early in initialization by portable dump loading code, so we
+ Called early in initialization by portable dumper loading code, so we
can't use lisp and associated machinery. On success, *EXENAME is
set to a heap-allocated string giving a path to the Emacs
executable or to NULL if we can't determine the path immediately.
@@ -801,12 +801,12 @@ load_pdump (int argc, char **argv)
;
/* TODO: maybe more thoroughly scrub process environment in order to
- make this use case (loading a pdumper image in an unexeced emacs)
+ make this use case (loading a dump file in an unexeced emacs)
possible? Right now, we assume that things we don't touch are
zero-initialized, and in an unexeced Emacs, this assumption
doesn't hold. */
if (initialized)
- fatal ("cannot load pdumper image in unexeced Emacs");
+ fatal ("cannot load dump file in unexeced Emacs");
/* Look for an explicitly-specified dump file. */
const char *path_exec = PATH_EXEC;
diff --git a/src/fileio.c b/src/fileio.c
index 4c7625c..968a55e 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -744,6 +744,31 @@ file_name_absolute_no_tilde_p (Lisp_Object name)
return IS_ABSOLUTE_FILE_NAME (SSDATA (name));
}
+/* Return the home directory of the user NAME, or a null pointer if
+ NAME is empty or the user does not exist or the user's home
+ directory is not an absolute file name. NAME is an array of bytes
+ that continues up to (but not including) the next NUL byte or
+ directory separator. The returned string lives in storage good
+ until the next call to this or similar functions. */
+static char *
+user_homedir (char const *name)
+{
+ ptrdiff_t length;
+ for (length = 0; name[length] && !IS_DIRECTORY_SEP (name[length]); length++)
+ continue;
+ if (length == 0)
+ return NULL;
+ USE_SAFE_ALLOCA;
+ char *p = SAFE_ALLOCA (length + 1);
+ memcpy (p, name, length);
+ p[length] = 0;
+ struct passwd *pw = getpwnam (p);
+ SAFE_FREE ();
+ if (!pw || (pw->pw_dir && !IS_ABSOLUTE_FILE_NAME (pw->pw_dir)))
+ return NULL;
+ return pw->pw_dir;
+}
+
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
@@ -788,7 +813,6 @@ the root directory. */)
char *target;
ptrdiff_t tlen;
- struct passwd *pw;
#ifdef DOS_NT
int drive = 0;
bool collapse_newdir = true;
@@ -1153,39 +1177,29 @@ the root directory. */)
}
else /* ~user/filename */
{
- char *o, *p;
- for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
- continue;
- o = SAFE_ALLOCA (p - nm + 1);
- memcpy (o, nm, p - nm);
- o[p - nm] = 0;
-
- block_input ();
- pw = getpwnam (o + 1);
- unblock_input ();
- if (pw)
+ char *nmhome = user_homedir (nm + 1);
+ if (nmhome)
{
- Lisp_Object tem;
-
- newdir = pw->pw_dir;
- /* `getpwnam' may return a unibyte string, which will
- bite us when we expect the directory to be multibyte. */
- tem = make_unibyte_string (newdir, strlen (newdir));
- newdirlim = newdir + SBYTES (tem);
- if (multibyte && !STRING_MULTIBYTE (tem))
+ ptrdiff_t nmhomelen = strlen (nmhome);
+ newdir = nmhome;
+ newdirlim = newdir + nmhomelen;
+ if (multibyte)
{
- hdir = DECODE_FILE (tem);
+ AUTO_STRING_WITH_LEN (lisp_nmhome, nmhome, nmhomelen);
+ hdir = DECODE_FILE (lisp_nmhome);
newdir = SSDATA (hdir);
newdirlim = newdir + SBYTES (hdir);
}
- nm = p;
+
+ while (*++nm && !IS_DIRECTORY_SEP (*nm))
+ continue;
#ifdef DOS_NT
collapse_newdir = false;
#endif
}
/* If we don't find a user of that name, leave the name
- unchanged; don't move nm forward to p. */
+ unchanged. */
}
}
@@ -1667,18 +1681,6 @@ See also the function `substitute-in-file-name'.")
}
#endif
-bool
-file_name_absolute_p (const char *filename)
-{
- return
- (IS_DIRECTORY_SEP (*filename) || *filename == '~'
-#ifdef DOS_NT
- || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
- && IS_DIRECTORY_SEP (filename[2]))
-#endif
- );
-}
-
/* Put into BUF the concatenation of DIR and FILE, with an intervening
directory separator if needed. Return a pointer to the NUL byte
at the end of the concatenated string. */
@@ -1774,46 +1776,21 @@ get_homedir (void)
return ahome;
}
-/* If /~ or // appears, discard everything through first slash. */
+/* If a directory separator followed by an absolute file name (e.g.,
+ "//foo", "/~", "/~someuser") appears in NM, return the address of
+ the absolute file name. Otherwise return NULL. ENDP is the
+ address of the null byte at the end of NM. */
static char *
search_embedded_absfilename (char *nm, char *endp)
{
- char *p, *s;
-
- for (p = nm + 1; p < endp; p++)
- {
- if (IS_DIRECTORY_SEP (p[-1])
- && file_name_absolute_p (p)
-#if defined (WINDOWSNT) || defined (CYGWIN)
- /* // at start of file name is meaningful in Apollo,
- WindowsNT and Cygwin systems. */
- && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
-#endif /* not (WINDOWSNT || CYGWIN) */
- )
- {
- for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
- if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
- {
- USE_SAFE_ALLOCA;
- char *o = SAFE_ALLOCA (s - p + 1);
- struct passwd *pw;
- memcpy (o, p, s - p);
- o [s - p] = 0;
-
- /* If we have ~user and `user' exists, discard
- everything up to ~. But if `user' does not exist, leave
- ~user alone, it might be a literal file name. */
- block_input ();
- pw = getpwnam (o + 1);
- unblock_input ();
- SAFE_FREE ();
- if (pw)
- return p;
- }
- else
- return p;
- }
- }
+ char *p = nm + 1;
+#ifdef DOUBLE_SLASH_IS_DISTINCT_ROOT
+ p += (IS_DIRECTORY_SEP (p[-1]) && IS_DIRECTORY_SEP (p[0])
+ && !IS_DIRECTORY_SEP (p[1]));
+#endif
+ for (; p < endp; p++)
+ if (IS_DIRECTORY_SEP (p[-1]) && file_name_absolute_p (p))
+ return p;
return NULL;
}
@@ -2698,13 +2675,24 @@ This happens for interactive use with M-x. */)
DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
1, 1, 0,
- doc: /* Return t if FILENAME is an absolute file name or starts with
`~'.
-On Unix, absolute file names start with `/'. */)
+ doc: /* Return t if FILENAME is an absolute file name.
+On Unix, absolute file names start with `/'. In Emacs, an absolute
+file name can also start with an initial `~' or `~USER' component,
+where USER is a valid login name. */)
(Lisp_Object filename)
{
CHECK_STRING (filename);
return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
}
+
+bool
+file_name_absolute_p (char const *filename)
+{
+ return (IS_ABSOLUTE_FILE_NAME (filename)
+ || (filename[0] == '~'
+ && (!filename[1] || IS_DIRECTORY_SEP (filename[1])
+ || user_homedir (&filename[1]))));
+}
DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
doc: /* Return t if file FILENAME exists (whether or not you can read
it).
diff --git a/src/fns.c b/src/fns.c
index 8eefa7c..acc6d46 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -47,6 +47,7 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
static bool internal_equal (Lisp_Object, Lisp_Object,
enum equal_kind, int, Lisp_Object);
+static EMACS_UINT sxhash_bignum (struct Lisp_Bignum *);
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
doc: /* Return the argument unchanged. */
@@ -4017,11 +4018,12 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h)
/* Given HT, return a hash code for KEY which uses a user-defined
function to compare keys. */
-static Lisp_Object
+Lisp_Object
hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
{
Lisp_Object args[] = { h->test.user_hash_function, key };
- return hash_table_user_defined_call (ARRAYELTS (args), args, h);
+ Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
+ return FIXNUMP (hash) ? hash : make_fixnum (sxhash (hash, 0));
}
struct hash_table_test const
@@ -4051,6 +4053,19 @@ allocate_hash_table (void)
- header_size - GCALIGNMENT) \
/ word_size)))
+static ptrdiff_t
+hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size)
+{
+ double threshold = h->rehash_threshold;
+ double index_float = size / threshold;
+ ptrdiff_t index_size = (index_float < INDEX_SIZE_BOUND + 1
+ ? next_almost_prime (index_float)
+ : INDEX_SIZE_BOUND + 1);
+ if (INDEX_SIZE_BOUND < index_size)
+ error ("Hash table too large");
+ return index_size;
+}
+
/* Create and initialize a new hash table.
TEST specifies the test the hash table will use to compare keys.
@@ -4084,9 +4099,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT
size,
{
struct Lisp_Hash_Table *h;
Lisp_Object table;
- EMACS_INT index_size;
ptrdiff_t i;
- double index_float;
/* Preconditions. */
eassert (SYMBOLP (test.name));
@@ -4097,14 +4110,6 @@ make_hash_table (struct hash_table_test test, EMACS_INT
size,
if (size == 0)
size = 1;
- double threshold = rehash_threshold;
- index_float = size / threshold;
- index_size = (index_float < INDEX_SIZE_BOUND + 1
- ? next_almost_prime (index_float)
- : INDEX_SIZE_BOUND + 1);
- if (INDEX_SIZE_BOUND < max (index_size, 2 * size))
- error ("Hash table too large");
-
/* Allocate a table and initialize it. */
h = allocate_hash_table ();
@@ -4114,10 +4119,10 @@ make_hash_table (struct hash_table_test test, EMACS_INT
size,
h->rehash_threshold = rehash_threshold;
h->rehash_size = rehash_size;
h->count = 0;
- h->key_and_value = make_nil_vector (2 * size);
+ h->key_and_value = make_vector (2 * size, Qunbound);
h->hash = make_nil_vector (size);
h->next = make_vector (size, make_fixnum (-1));
- h->index = make_vector (index_size, make_fixnum (-1));
+ h->index = make_vector (hash_index_size (h, size), make_fixnum (-1));
h->next_weak = NULL;
h->purecopy = purecopy;
h->mutable = true;
@@ -4188,21 +4193,22 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
avoid problems if memory is exhausted. larger_vecalloc
finishes computing the size of the replacement vectors. */
Lisp_Object next = larger_vecalloc (h->next, new_size - old_size,
- PTRDIFF_MAX / 2);
+ new_size);
ptrdiff_t next_size = ASIZE (next);
for (ptrdiff_t i = old_size; i < next_size - 1; i++)
gc_aset (next, i, make_fixnum (i + 1));
gc_aset (next, next_size - 1, make_fixnum (-1));
- double threshold = h->rehash_threshold;
- double index_float = next_size / threshold;
- EMACS_INT index_size = (index_float < INDEX_SIZE_BOUND + 1
- ? next_almost_prime (index_float)
- : INDEX_SIZE_BOUND + 1);
- if (INDEX_SIZE_BOUND < index_size)
- error ("Hash table too large to resize");
+ ptrdiff_t index_size = hash_index_size (h, next_size);
+
+ /* Build the new&larger key_and_value vector, making sure the new
+ fields are initialized to `unbound`. */
Lisp_Object key_and_value
- = larger_vector (h->key_and_value, 2 * (next_size - old_size),
- 2 * next_size);
+ = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size),
+ 2 * next_size);
+ for (ptrdiff_t i = ASIZE (h->key_and_value);
+ i < ASIZE (key_and_value); i++)
+ ASET (key_and_value, i, Qunbound);
+
Lisp_Object hash = larger_vector (h->hash, next_size - old_size,
next_size);
h->index = make_vector (index_size, make_fixnum (-1));
@@ -4240,19 +4246,18 @@ hash_table_rehash (struct Lisp_Hash_Table *h)
/* These structures may have been purecopied and shared
(bug#36447). */
+ Lisp_Object hash = make_nil_vector (size);
h->next = Fcopy_sequence (h->next);
h->index = Fcopy_sequence (h->index);
- h->hash = Fcopy_sequence (h->hash);
/* Recompute the actual hash codes for each entry in the table.
Order is still invalid. */
for (ptrdiff_t i = 0; i < size; ++i)
- if (!NILP (HASH_HASH (h, i)))
- {
- Lisp_Object key = HASH_KEY (h, i);
- Lisp_Object hash_code = h->test.hashfn (key, h);
- set_hash_hash_slot (h, i, hash_code);
- }
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ if (!EQ (key, Qunbound))
+ ASET (hash, i, h->test.hashfn (key, h));
+ }
/* Reset the index so that any slot we don't fill below is marked
invalid. */
@@ -4260,9 +4265,9 @@ hash_table_rehash (struct Lisp_Hash_Table *h)
/* Rebuild the collision chains. */
for (ptrdiff_t i = 0; i < size; ++i)
- if (!NILP (HASH_HASH (h, i)))
+ if (!NILP (AREF (hash, i)))
{
- EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i));
+ EMACS_UINT hash_code = XUFIXNUM (AREF (hash, i));
ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
set_hash_index_slot (h, start_of_bucket, i);
@@ -4272,8 +4277,8 @@ hash_table_rehash (struct Lisp_Hash_Table *h)
/* Finally, mark the hash table as having a valid hash order.
Do this last so that if we're interrupted, we retry on next
access. */
- eassert (h->count < 0);
- h->count = -h->count;
+ eassert (hash_rehash_needed_p (h));
+ h->hash = hash;
eassert (!hash_rehash_needed_p (h));
}
@@ -4330,6 +4335,8 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key,
Lisp_Object value,
/* Store key/value in the key_and_value vector. */
i = h->next_free;
+ eassert (NILP (HASH_HASH (h, i)));
+ eassert (EQ (Qunbound, (HASH_KEY (h, i))));
h->next_free = HASH_NEXT (h, i);
set_hash_key_slot (h, i, key);
set_hash_value_slot (h, i, value);
@@ -4373,7 +4380,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h,
Lisp_Object key)
/* Clear slots in key_and_value and add the slots to
the free list. */
- set_hash_key_slot (h, i, Qnil);
+ set_hash_key_slot (h, i, Qunbound);
set_hash_value_slot (h, i, Qnil);
set_hash_hash_slot (h, i, Qnil);
set_hash_next_slot (h, i, h->next_free);
@@ -4400,7 +4407,7 @@ hash_clear (struct Lisp_Hash_Table *h)
for (i = 0; i < size; ++i)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
- set_hash_key_slot (h, i, Qnil);
+ set_hash_key_slot (h, i, Qunbound);
set_hash_value_slot (h, i, Qnil);
set_hash_hash_slot (h, i, Qnil);
}
@@ -4459,6 +4466,8 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool
remove_entries_p)
if (remove_entries_p)
{
+ eassert (!remove_p
+ == (key_known_to_survive_p &&
value_known_to_survive_p));
if (remove_p)
{
/* Take out of collision chain. */
@@ -4472,9 +4481,10 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool
remove_entries_p)
h->next_free = i;
/* Clear key, value, and hash. */
- set_hash_key_slot (h, i, Qnil);
+ set_hash_key_slot (h, i, Qunbound);
set_hash_value_slot (h, i, Qnil);
- set_hash_hash_slot (h, i, Qnil);
+ if (!NILP (h->hash))
+ set_hash_hash_slot (h, i, Qnil);
eassert (h->count != 0);
h->count += h->count > 0 ? -1 : 1;
@@ -4707,7 +4717,7 @@ sxhash (Lisp_Object obj, int depth)
***********************************************************************/
DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0,
- doc: /* Return a fixnum hash code for OBJ suitable for `eq'.
+ doc: /* Return an integer hash code for OBJ suitable for `eq'.
If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)).
Hash codes are not guaranteed to be preserved across Emacs sessions. */)
@@ -4717,7 +4727,7 @@ Hash codes are not guaranteed to be preserved across
Emacs sessions. */)
}
DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0,
- doc: /* Return a fixnum hash code for OBJ suitable for `eql'.
+ doc: /* Return an integer hash code for OBJ suitable for `eql'.
If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)).
Hash codes are not guaranteed to be preserved across Emacs sessions. */)
@@ -4727,7 +4737,7 @@ Hash codes are not guaranteed to be preserved across
Emacs sessions. */)
}
DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0,
- doc: /* Return a fixnum hash code for OBJ suitable for `equal'.
+ doc: /* Return an integer hash code for OBJ suitable for `equal'.
If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)).
Hash codes are not guaranteed to be preserved across Emacs sessions. */)
@@ -4751,7 +4761,7 @@ keys. Default is `eql'. Predefined are the tests `eq',
`eql', and
Default is 65.
:rehash-size REHASH-SIZE - Indicates how to expand the table when it
-fills up. If REHASH-SIZE is a fixnum, increase the size by that
+fills up. If REHASH-SIZE is an integer, increase the size by that
amount. If it is a float, it must be > 1.0, and the new size is the
old size multiplied by that factor. Default is 1.5.
@@ -4880,7 +4890,7 @@ DEFUN ("hash-table-count", Fhash_table_count,
Shash_table_count, 1, 1, 0,
(Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- hash_rehash_if_needed (h);
+ eassert (h->count >= 0);
return make_fixnum (h->count);
}
@@ -5010,8 +5020,11 @@ FUNCTION is called with two arguments, KEY and VALUE.
struct Lisp_Hash_Table *h = check_hash_table (table);
for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- if (!NILP (HASH_HASH (h, i)))
- call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i));
+ {
+ Lisp_Object k = HASH_KEY (h, i);
+ if (!EQ (k, Qunbound))
+ call2 (function, k, HASH_VALUE (h, i));
+ }
return Qnil;
}
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 1d15aec..16d7655 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -2035,11 +2035,11 @@ xg_get_file_with_chooser (struct frame *f,
gtk_widget_show (wbox);
wtoggle = gtk_check_button_new_with_label ("Show hidden files.");
- if (x_gtk_show_hidden_files)
- {
- g_object_set (G_OBJECT (filewin), "show-hidden", TRUE, NULL);
- gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON (wtoggle), TRUE);
- }
+ g_object_set (G_OBJECT (filewin), "show-hidden",
+ x_gtk_show_hidden_files, NULL);
+ gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON (wtoggle),
+ x_gtk_show_hidden_files);
+
gtk_widget_show (wtoggle);
g_signal_connect (G_OBJECT (wtoggle), "clicked",
G_CALLBACK (xg_toggle_visibility_cb), filewin);
diff --git a/src/image.c b/src/image.c
index 355c849..8cab860 100644
--- a/src/image.c
+++ b/src/image.c
@@ -9530,10 +9530,13 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
if (base_file)
g_object_unref (base_file);
g_object_unref (input_stream);
- if (err) goto rsvg_error;
+
+ /* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */
+ if (!rsvg_handle || err) goto rsvg_error;
#else
/* Make a handle to a new rsvg object. */
rsvg_handle = rsvg_handle_new ();
+ eassume (rsvg_handle);
/* Set base_uri for properly handling referenced images (via 'href').
See rsvg bug 596114 - "image refs are relative to curdir, not .svg file"
@@ -9654,7 +9657,8 @@ svg_load_image (struct frame *f, struct image *img, char
*contents,
return 1;
rsvg_error:
- g_object_unref (rsvg_handle);
+ if (rsvg_handle)
+ g_object_unref (rsvg_handle);
/* FIXME: Use error->message so the user knows what is the actual
problem with the image. */
image_error ("Error parsing SVG image `%s'", img->spec);
diff --git a/src/json.c b/src/json.c
index d05f2c5..5a3d001 100644
--- a/src/json.c
+++ b/src/json.c
@@ -361,28 +361,31 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp,
count = SPECPDL_INDEX ();
record_unwind_protect_ptr (json_release_object, json);
for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- if (!NILP (HASH_HASH (h, i)))
- {
- Lisp_Object key = json_encode (HASH_KEY (h, i));
- /* We can't specify the length, so the string must be
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ if (!EQ (key, Qunbound))
+ {
+ Lisp_Object ekey = json_encode (key);
+ /* We can't specify the length, so the string must be
NUL-terminated. */
- check_string_without_embedded_nuls (key);
- const char *key_str = SSDATA (key);
- /* Reject duplicate keys. These are possible if the hash
+ check_string_without_embedded_nuls (ekey);
+ const char *key_str = SSDATA (ekey);
+ /* Reject duplicate keys. These are possible if the hash
table test is not `equal'. */
- if (json_object_get (json, key_str) != NULL)
- wrong_type_argument (Qjson_value_p, lisp);
- int status = json_object_set_new (json, key_str,
- lisp_to_json (HASH_VALUE (h, i),
- conf));
- if (status == -1)
- {
- /* A failure can be caused either by an invalid key or
+ if (json_object_get (json, key_str) != NULL)
+ wrong_type_argument (Qjson_value_p, lisp);
+ int status
+ = json_object_set_new (json, key_str,
+ lisp_to_json (HASH_VALUE (h, i), conf));
+ if (status == -1)
+ {
+ /* A failure can be caused either by an invalid key or
by low memory. */
- json_check_utf8 (key);
- json_out_of_memory ();
- }
- }
+ json_check_utf8 (ekey);
+ json_out_of_memory ();
+ }
+ }
+ }
}
else if (NILP (lisp))
return json_check (json_object ());
diff --git a/src/keyboard.c b/src/keyboard.c
index b86ad03..db5ca4e 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -11324,7 +11324,8 @@ syms_of_keyboard (void)
defsubr (&Sposn_at_x_y);
DEFVAR_LISP ("last-command-event", last_command_event,
- doc: /* Last input event that was part of a command. */);
+ doc: /* Last input event of a key sequence that called a
command.
+See Info node `(elisp)Command Loop Info'.*/);
DEFVAR_LISP ("last-nonmenu-event", last_nonmenu_event,
doc: /* Last input event in a command, except for mouse menu
events.
diff --git a/src/lisp.h b/src/lisp.h
index 9d37629..f437609 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1024,6 +1024,20 @@ builtin_lisp_symbol (int index)
return make_lisp_symbol (&lispsym[index]);
}
+INLINE bool
+c_symbol_p (struct Lisp_Symbol *sym)
+{
+ char *bp = (char *) lispsym;
+ char *sp = (char *) sym;
+ if (PTRDIFF_MAX < INTPTR_MAX)
+ return bp <= sp && sp < bp + sizeof lispsym;
+ else
+ {
+ ptrdiff_t offset = sp - bp;
+ return 0 <= offset && offset < sizeof lispsym;
+ }
+}
+
INLINE void
(CHECK_SYMBOL) (Lisp_Object x)
{
@@ -2260,8 +2274,8 @@ struct Lisp_Hash_Table
weakness of the table. */
Lisp_Object weak;
- /* Vector of hash codes. If hash[I] is nil, this means that the
- I-th entry is unused. */
+ /* Vector of hash codes.
+ If the I-th entry is unused, then hash[I] should be nil. */
Lisp_Object hash;
/* Vector used to chain entries. If entry I is free, next[I] is the
@@ -2309,6 +2323,7 @@ struct Lisp_Hash_Table
/* Vector of keys and values. The key of item I is found at index
2 * I, the value is found at index 2 * I + 1.
+ If the key is equal to Qunbound, then this slot is unused.
This is gc_marked specially if the table is weak. */
Lisp_Object key_and_value;
@@ -2373,7 +2388,7 @@ void hash_table_rehash (struct Lisp_Hash_Table *h);
INLINE bool
hash_rehash_needed_p (const struct Lisp_Hash_Table *h)
{
- return h->count < 0;
+ return NILP (h->hash);
}
INLINE void
@@ -3606,6 +3621,7 @@ EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *);
Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *);
+Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *);
Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
Lisp_Object, bool);
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *);
diff --git a/src/minibuf.c b/src/minibuf.c
index d9a6e15..14a0dbe 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1245,7 +1245,7 @@ is used to further constrain the set of candidates. */)
else /* if (type == hash_table) */
{
while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
- && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
+ && EQ (HASH_KEY (XHASH_TABLE (collection), idx), Qunbound))
idx++;
if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
break;
@@ -1497,7 +1497,7 @@ with a space are ignored unless STRING itself starts with
a space. */)
else /* if (type == 3) */
{
while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
- && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
+ && EQ (HASH_KEY (XHASH_TABLE (collection), idx), Qunbound))
idx++;
if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
break;
@@ -1724,8 +1724,8 @@ the values STRING, PREDICATE and `lambda'. */)
else
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
{
- if (NILP (HASH_HASH (h, i))) continue;
tem = HASH_KEY (h, i);
+ if (EQ (tem, Qunbound)) continue;
Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem);
if (!STRINGP (strkey)) continue;
if (EQ (Fcompare_strings (string, Qnil, Qnil,
@@ -1885,7 +1885,7 @@ init_minibuf_once_for_pdumper (void)
PDUMPER_IGNORE (minibuf_prompt_width);
/* We run this function on first initialization and whenever we
- restore from a pdumper image. pdumper doesn't try to preserve
+ restore from a dump file. pdumper doesn't try to preserve
frames, windows, and so on, so reset everything related here. */
Vminibuffer_list = Qnil;
minibuf_level = 0;
diff --git a/src/nsterm.m b/src/nsterm.m
index 0233182..b875427 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -3913,10 +3913,13 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
if (!s->background_filled_p)
{
n = ns_get_glyph_string_clip_rect (s, r);
- *r = NSMakeRect (s->x, s->y, s->background_width, s->height);
if (ns_clip_to_rect (s->f, r, n))
{
+ /* FIXME: Why are we reusing the clipping rectangles? The
+ other terms don't appear to do anything like this. */
+ *r = NSMakeRect (s->x, s->y, s->background_width, s->height);
+
if (s->hl == DRAW_MOUSE_FACE)
{
face = FACE_FROM_ID_OR_NULL (s->f,
@@ -3951,13 +3954,6 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
r[i].origin.x += leftoverrun;
r[i].size.width -= leftoverrun;
}
-
- /* XXX: Try to work between problem where a stretch glyph
on
- a partially-visible bottom row will clear part of the
- modeline, and another where list-buffers headers and
similar
- rows erroneously have visible_height set to 0. Not sure
- where this is coming from as other terms seem not to
show. */
- r[i].size.height = min (s->height, s->row->visible_height);
}
[bgCol set];
diff --git a/src/pdumper.c b/src/pdumper.c
index 2abac80..31f4f33 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -118,10 +118,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# endif
#endif
-/* We require an architecture in which all pointers are the same size
- and have the same layout, where pointers are either 32 or 64 bits
- long, and where bytes have eight bits --- that is, a
- general-purpose computer made after 1990. */
+/* Require an architecture in which pointers, ptrdiff_t and intptr_t
+ are the same size and have the same layout, and where bytes have
+ eight bits --- that is, a general-purpose computer made after 1990.
+ Also require Lisp_Object to be at least as wide as pointers. */
verify (sizeof (ptrdiff_t) == sizeof (void *));
verify (sizeof (intptr_t) == sizeof (ptrdiff_t));
verify (sizeof (void (*) (void)) == sizeof (void *));
@@ -333,8 +333,8 @@ dump_fingerprint (char const *label,
fprintf (stderr, "%s: %.*s\n", label, hexbuf_size, hexbuf);
}
-/* Format of an Emacs portable dump file. All offsets are relative to
- the beginning of the file. An Emacs portable dump file is coupled
+/* Format of an Emacs dump file. All offsets are relative to
+ the beginning of the file. An Emacs dump file is coupled
to exactly the Emacs binary that produced it, so details of
alignment and endianness are unimportant.
@@ -719,12 +719,7 @@ emacs_offset (const void *emacs_ptr)
static bool
dump_builtin_symbol_p (Lisp_Object object)
{
- if (!SYMBOLP (object))
- return false;
- char *bp = (char *) lispsym;
- struct Lisp_Symbol *s = XSYMBOL (object);
- char *sp = (char *) s;
- return bp <= sp && sp < bp + sizeof (lispsym);
+ return SYMBOLP (object) && c_symbol_p (XSYMBOL (object));
}
/* Return whether OBJECT has the same bit pattern in all Emacs
@@ -2628,20 +2623,26 @@ dump_vectorlike_generic (struct dump_context *ctx,
static bool
dump_hash_table_stable_p (const struct Lisp_Hash_Table *hash)
{
+ if (hash->test.hashfn == hashfn_user_defined)
+ error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */
bool is_eql = hash->test.hashfn == hashfn_eql;
bool is_equal = hash->test.hashfn == hashfn_equal;
ptrdiff_t size = HASH_TABLE_SIZE (hash);
for (ptrdiff_t i = 0; i < size; ++i)
- if (!NILP (HASH_HASH (hash, i)))
- {
- Lisp_Object key = HASH_KEY (hash, i);
- bool key_stable = (dump_builtin_symbol_p (key)
- || FIXNUMP (key)
- || (is_equal && STRINGP (key))
- || ((is_equal || is_eql) && FLOATP (key)));
- if (!key_stable)
- return false;
- }
+ {
+ Lisp_Object key = HASH_KEY (hash, i);
+ if (!EQ (key, Qunbound))
+ {
+ bool key_stable = (dump_builtin_symbol_p (key)
+ || FIXNUMP (key)
+ || (is_equal
+ && (STRINGP (key) || BOOL_VECTOR_P (key)))
+ || ((is_equal || is_eql)
+ && (FLOATP (key) || BIGNUMP (key))));
+ if (!key_stable)
+ return false;
+ }
+ }
return true;
}
@@ -2653,8 +2654,11 @@ hash_table_contents (Lisp_Object table)
Lisp_Object contents = Qnil;
struct Lisp_Hash_Table *h = XHASH_TABLE (table);
for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- if (!NILP (HASH_HASH (h, i)))
- dump_push (&contents, Fcons (HASH_KEY (h, i), HASH_VALUE (h, i)));
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ if (!EQ (key, Qunbound))
+ dump_push (&contents, Fcons (key, HASH_VALUE (h, i)));
+ }
return Fnreverse (contents);
}
@@ -2663,13 +2667,14 @@ hash_table_contents (Lisp_Object table)
static void
check_hash_table_rehash (Lisp_Object table_orig)
{
+ ptrdiff_t count = XHASH_TABLE (table_orig)->count;
hash_rehash_if_needed (XHASH_TABLE (table_orig));
Lisp_Object table_rehashed = Fcopy_hash_table (table_orig);
- eassert (XHASH_TABLE (table_rehashed)->count >= 0);
- XHASH_TABLE (table_rehashed)->count *= -1;
- eassert (XHASH_TABLE (table_rehashed)->count <= 0);
+ eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
+ XHASH_TABLE (table_rehashed)->hash = Qnil;
+ eassert (count == 0 || hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
hash_rehash_if_needed (XHASH_TABLE (table_rehashed));
- eassert (XHASH_TABLE (table_rehashed)->count >= 0);
+ eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed)));
Lisp_Object expected_contents = hash_table_contents (table_orig);
while (!NILP (expected_contents))
{
@@ -2733,7 +2738,13 @@ dump_hash_table (struct dump_context *ctx,
the need to rehash-on-access if we can load the dump where we
want. */
if (hash->count > 0 && !is_stable)
- hash->count = -hash->count;
+ /* Hash codes will have to be recomputed anyway, so let's not dump them.
+ Also set `hash` to nil for hash_rehash_needed_p.
+ We could also refrain from dumping the `next' and `index' vectors,
+ except that `next' is currently used for HASH_TABLE_SIZE and
+ we'd have to rebuild the next_free list as well as adjust
+ sweep_weak_hash_table for the case where there's no `index'. */
+ hash->hash = Qnil;
START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out);
dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header);
@@ -3657,8 +3668,7 @@ dump_check_overlap_dump_reloc (Lisp_Object lreloc_a,
static struct emacs_reloc
decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
{
- struct emacs_reloc reloc;
- memset (&reloc, 0, sizeof (reloc));
+ struct emacs_reloc reloc = {0};
ALLOW_IMPLICIT_CONVERSION;
int type = XFIXNUM (dump_pop (&lreloc));
DISALLOW_IMPLICIT_CONVERSION;
@@ -3817,8 +3827,7 @@ drain_reloc_list (struct dump_context *ctx,
*reloc_list = Qnil;
dump_align_output (ctx, max (alignof (struct dump_reloc),
alignof (struct emacs_reloc)));
- struct dump_table_locator locator;
- memset (&locator, 0, sizeof (locator));
+ struct dump_table_locator locator = {0};
locator.offset = ctx->offset;
for (; !NILP (relocs); locator.nr_entries += 1)
{
@@ -3988,7 +3997,7 @@ dump_drain_deferred_symbols (struct dump_context *ctx)
DEFUN ("dump-emacs-portable",
Fdump_emacs_portable, Sdump_emacs_portable,
1, 2, 0,
- doc: /* Dump current state of Emacs into portable dump file FILENAME.
+ doc: /* Dump current state of Emacs into dump file FILENAME.
If TRACK-REFERRERS is non-nil, keep additional debugging information
that can help track down the provenance of unsupported object
types. */)
@@ -4028,9 +4037,8 @@ types. */)
filename = Fexpand_file_name (filename, Qnil);
filename = ENCODE_FILE (filename);
- struct dump_context ctx_buf;
+ struct dump_context ctx_buf = {0};
struct dump_context *ctx = &ctx_buf;
- memset (ctx, 0, sizeof (*ctx));
ctx->fd = -1;
ctx->objects_dumped = make_eq_hash_table ();
@@ -4923,9 +4931,7 @@ dump_bitset_set_bit (struct dump_bitset *bitset, size_t
bit_number)
static void
dump_bitset_clear (struct dump_bitset *bitset)
{
- int xword_size = sizeof (bitset->bits[0]);
- if (bitset->number_words)
- memset (bitset->bits, 0, bitset->number_words * xword_size);
+ memset (bitset->bits, 0, bitset->number_words * sizeof bitset->bits[0]);
}
struct pdumper_loaded_dump_private
@@ -5468,14 +5474,14 @@ pdumper_record_wd (const char *wd)
DEFUN ("pdumper-stats", Fpdumper_stats, Spdumper_stats, 0, 0, 0,
doc: /* Return statistics about portable dumping used by this session.
-If this Emacs sesion was started from a portable dump file,
+If this Emacs session was started from a dump file,
the return value is an alist of the form:
((dumped-with-pdumper . t) (load-time . TIME) (dump-file-name . FILE))
where TIME is the time in seconds it took to restore Emacs state
from the dump file, and FILE is the name of the dump file.
-Value is nil if this session was not started using a portable dump file.*/)
+Value is nil if this session was not started using a dump file.*/)
(void)
{
if (!dumped_with_pdumper_p ())
diff --git a/src/pdumper.h b/src/pdumper.h
index ab2f426..5d1e9c3 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -35,7 +35,7 @@ INLINE_HEADER_BEGIN
variables to which the Lisp heap points. It doesn't know anything
about other C variables. The functions below allow code from other
parts of Emacs to tell the portable dumper about other bits of
- information to preserve in dumped images.
+ information to preserve in dump files.
These memory-records are themselves preserved in the dump, so call
the functions below only on the !initialized init path, just
@@ -44,7 +44,7 @@ INLINE_HEADER_BEGIN
There are no special functions to preserve a global Lisp_Object.
You should just staticpro these. */
-/* Remember the value of THING in dumped images. THING must not
+/* Remember the value of THING in dump files. THING must not
contain any pointers or Lisp_Object variables: these values are not
valid across dump and load. */
#define PDUMPER_REMEMBER_SCALAR(thing) \
diff --git a/src/print.c b/src/print.c
index cb34090..7c3da68 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1135,9 +1135,12 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool
escapeflag)
ptrdiff_t i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
- if (!NILP (HASH_HASH (h, i))
- && EQ (HASH_VALUE (h, i), Qt))
- Fremhash (HASH_KEY (h, i), Vprint_number_table);
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ if (!EQ (key, Qunbound)
+ && EQ (HASH_VALUE (h, i), Qt))
+ Fremhash (key, Vprint_number_table);
+ }
}
}
@@ -1593,13 +1596,16 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
printchar ('(', printcharfun);
for (ptrdiff_t i = 0; i < size; i++)
- if (!NILP (HASH_HASH (h, i)))
- {
- if (i) printchar (' ', printcharfun);
- print_object (HASH_KEY (h, i), printcharfun, escapeflag);
- printchar (' ', printcharfun);
- print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
- }
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ if (!EQ (key, Qunbound))
+ {
+ if (i) printchar (' ', printcharfun);
+ print_object (key, printcharfun, escapeflag);
+ printchar (' ', printcharfun);
+ print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
+ }
+ }
if (size < real_size)
print_c_string (" ...", printcharfun);
diff --git a/src/profiler.c b/src/profiler.c
index ed0e9dd..6b482ab 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -530,7 +530,9 @@ the same lambda expression, or are really unrelated
function. */)
static Lisp_Object
cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct Lisp_Hash_Table *h)
{
- if (VECTORP (bt1) && VECTORP (bt2))
+ if (EQ (bt1, bt2))
+ return Qt;
+ else if (VECTORP (bt1) && VECTORP (bt2))
{
ptrdiff_t l = ASIZE (bt1);
if (l != ASIZE (bt2))
@@ -541,7 +543,7 @@ cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct
Lisp_Hash_Table *h)
return Qt;
}
else
- return EQ (bt1, bt2) ? Qt : Qnil;
+ return Qnil;
}
static Lisp_Object
diff --git a/src/timefns.c b/src/timefns.c
index 3b7ed46..cce9dd5 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -1326,6 +1326,12 @@ the TZ environment variable. It can also be a list (as
from
`current-time-zone') or an integer (the UTC offset in seconds) applied
without consideration for daylight saving time.
+To access (or alter) the elements in the time value, the
+`decoded-time-second', `decoded-time-minute', `decoded-time-hour',
+`decoded-time-day', `decoded-time-month', `decoded-time-year',
+`decoded-time-weekday', `decoded-time-dst' and `decoded-time-zone'
+accessors can be used.
+
The list has the following nine members: SEC is an integer between 0
and 60; SEC is 60 for a leap second, which only some operating systems
support. MINUTE is an integer between 0 and 59. HOUR is an integer
diff --git a/src/unexaix.c b/src/unexaix.c
index 349d365..c95486c 100644
--- a/src/unexaix.c
+++ b/src/unexaix.c
@@ -1,4 +1,4 @@
-/* Dump an executable image.
+/* Dump an executable file.
Copyright (C) 1985-1988, 1999, 2001-2019 Free Software Foundation,
Inc.
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index aa6bebd..8fbbe7e 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -32,6 +32,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <usp10.h>
#ifdef HAVE_HARFBUZZ
# include <hb.h>
+# include <hb-ot.h> /* for hb_ot_font_set_funcs */
# if GNUC_PREREQ (4, 3, 0)
# define bswap_32(v) __builtin_bswap32(v)
# else
@@ -87,6 +88,7 @@ DEF_DLL_FN (hb_bool_t, hb_font_get_nominal_glyph,
(hb_font_t *, hb_codepoint_t, hb_codepoint_t *));
DEF_DLL_FN (hb_bool_t, hb_font_get_variation_glyph,
(hb_font_t *, hb_codepoint_t, hb_codepoint_t, hb_codepoint_t *));
+DEF_DLL_FN (void, hb_ot_font_set_funcs, (hb_font_t *));
#define hb_blob_create fn_hb_blob_create
#define hb_face_create_for_tables fn_hb_face_create_for_tables
@@ -97,6 +99,7 @@ DEF_DLL_FN (hb_bool_t, hb_font_get_variation_glyph,
#define hb_face_get_upem fn_hb_face_get_upem
#define hb_font_get_nominal_glyph fn_hb_font_get_nominal_glyph
#define hb_font_get_variation_glyph fn_hb_font_get_variation_glyph
+#define hb_ot_font_set_funcs fn_hb_ot_font_set_funcs
#endif
/* Used by uniscribe_otf_capability. */
@@ -1305,7 +1308,12 @@ w32hb_get_font (struct font *font, double *scale)
hb_face_t *hb_face =
hb_face_create_for_tables (w32hb_get_font_table, font_handle, NULL);
if (hb_face_get_glyph_count (hb_face) > 0)
- hb_font = hb_font_create (hb_face);
+ {
+ hb_font = hb_font_create (hb_face);
+ /* This is needed for HarfBuzz before 2.0.0; it is the default
+ in later versions. */
+ hb_ot_font_set_funcs (hb_font);
+ }
struct uniscribe_font_info *uniscribe_font =
(struct uniscribe_font_info *) font;
@@ -1486,6 +1494,7 @@ load_harfbuzz_funcs (HMODULE library)
LOAD_DLL_FN (library, hb_face_destroy);
LOAD_DLL_FN (library, hb_font_get_nominal_glyph);
LOAD_DLL_FN (library, hb_font_get_variation_glyph);
+ LOAD_DLL_FN (library, hb_ot_font_set_funcs);
return hbfont_init_w32_funcs (library);
}
#endif /* HAVE_HARFBUZZ */
diff --git a/src/xterm.c b/src/xterm.c
index c96aa74..75568a8 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -2381,6 +2381,8 @@ x_query_frame_background_color (struct frame *f, XColor
*bgcolor)
x_query_colors (f, bgcolor, 1);
}
+#define HEX_COLOR_NAME_LENGTH 32
+
/* On frame F, translate the color name to RGB values. Use cached
information, if possible.
@@ -2398,9 +2400,36 @@ Status x_parse_color (struct frame *f, const char
*color_name,
if (color_name[0] == '#')
{
- /* The hex form is parsed directly by XParseColor without
+ /* Don't pass #RGB strings directly to XParseColor, because that
+ follows the X convention of zero-extending each channel
+ value: #f00 means #f00000. We want the convention of scaling
+ channel values, so #f00 means #ff0000, just as it does for
+ HTML, SVG, and CSS.
+
+ So we translate #f00 to rgb:f/0/0, which X handles
+ differently. */
+ char rgb_color_name[HEX_COLOR_NAME_LENGTH];
+ int len = strlen (color_name);
+ int digits_per_channel;
+ if (len == 4)
+ digits_per_channel = 1;
+ else if (len == 7)
+ digits_per_channel = 2;
+ else if (len == 10)
+ digits_per_channel = 3;
+ else if (len == 13)
+ digits_per_channel = 4;
+ else
+ return 0;
+
+ snprintf (rgb_color_name, sizeof rgb_color_name, "rgb:%.*s/%.*s/%.*s",
+ digits_per_channel, color_name + 1,
+ digits_per_channel, color_name + digits_per_channel + 1,
+ digits_per_channel, color_name + 2 * digits_per_channel + 1);
+
+ /* The rgb form is parsed directly by XParseColor without
talking to the X server. No need for caching. */
- return XParseColor (dpy, cmap, color_name, color);
+ return XParseColor (dpy, cmap, rgb_color_name, color);
}
for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names; cache_entry;
diff --git a/test/lisp/calendar/iso8601-tests.el
b/test/lisp/calendar/iso8601-tests.el
new file mode 100644
index 0000000..2959f54
--- /dev/null
+++ b/test/lisp/calendar/iso8601-tests.el
@@ -0,0 +1,291 @@
+;;; iso8601-tests.el --- tests for calendar/iso8601.el -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'iso8601)
+
+(ert-deftest test-iso8601-date-years ()
+ (should (equal (iso8601-parse-date "1985")
+ '(nil nil nil nil nil 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "-0003")
+ '(nil nil nil nil nil -4 nil nil nil)))
+ (should (equal (iso8601-parse-date "+1985")
+ '(nil nil nil nil nil 1985 nil nil nil))))
+
+(ert-deftest test-iso8601-date-dates ()
+ (should (equal (iso8601-parse-date "1985-03-14")
+ '(nil nil nil 14 3 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "19850314")
+ '(nil nil nil 14 3 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-02")
+ '(nil nil nil nil 2 1985 nil nil nil))))
+
+(ert-deftest test-iso8601-date-obsolete ()
+ (should (equal (iso8601-parse-date "--02-01")
+ '(nil nil nil 1 2 nil nil nil nil)))
+ (should (equal (iso8601-parse-date "--0201")
+ '(nil nil nil 1 2 nil nil nil nil))))
+
+(ert-deftest test-iso8601-date-weeks ()
+ (should (equal (iso8601-parse-date "2008W39-6")
+ '(nil nil nil 27 9 2008 nil nil nil)))
+ (should (equal (iso8601-parse-date "2009W01-1")
+ '(nil nil nil 29 12 2008 nil nil nil)))
+ (should (equal (iso8601-parse-date "2009W53-7")
+ '(nil nil nil 3 1 2010 nil nil nil))))
+
+(ert-deftest test-iso8601-date-ordinals ()
+ (should (equal (iso8601-parse-date "1981-095")
+ '(nil nil nil 5 4 1981 nil nil nil))))
+
+(ert-deftest test-iso8601-time ()
+ (should (equal (iso8601-parse-time "13:47:30")
+ '(30 47 13 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "134730")
+ '(30 47 13 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "1347")
+ '(0 47 13 nil nil nil nil nil nil))))
+
+(ert-deftest test-iso8601-combined ()
+ (should (equal (iso8601-parse "2008-03-02T13:47:30")
+ '(30 47 13 2 3 2008 nil nil nil)))
+ (should (equal (iso8601-parse "2008-03-02T13:47:30Z")
+ '(30 47 13 2 3 2008 nil nil 0)))
+ (should (equal (iso8601-parse "2008-03-02T13:47:30+01:00")
+ '(30 47 13 2 3 2008 nil nil 3600)))
+ (should (equal (iso8601-parse "2008-03-02T13:47:30-01")
+ '(30 47 13 2 3 2008 nil nil -3600))))
+
+(ert-deftest test-iso8601-duration ()
+ (should (equal (iso8601-parse-duration "P3Y6M4DT12H30M5S")
+ '(5 30 12 4 6 3 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P1M")
+ '(0 0 0 0 1 0 nil nil nil)))
+ (should (equal (iso8601-parse-duration "PT1M")
+ '(0 1 0 0 0 0 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P0003-06-04T12:30:05")
+ '(5 30 12 4 6 3 nil nil nil))))
+
+(ert-deftest test-iso8601-invalid ()
+ (should-not (iso8601-valid-p " 2008-03-02T13:47:30-01"))
+ (should-not (iso8601-valid-p "2008-03-02T13:47:30-01:200"))
+ (should-not (iso8601-valid-p "2008-03-02T13:47:30-01 "))
+ (should-not (iso8601-valid-p "2008-03-02 T 13:47:30-01 "))
+ (should-not (iso8601-valid-p "20008-03-02T13:47:30-01")))
+
+(ert-deftest test-iso8601-intervals ()
+ (should (equal
+ (iso8601-parse-interval "2007-03-01T13:00:00Z/2008-05-11T15:30:00Z")
+ '((0 0 13 1 3 2007 nil nil 0)
+ (0 30 15 11 5 2008 nil nil 0)
+ ;; Hm... can't really use decode-time for time differences...
+ (0 30 2 14 3 1971 0 nil 0))))
+ (should (equal (iso8601-parse-interval "2007-03-01T13:00:00Z/P1Y2M10DT2H30M")
+ '((0 0 13 1 3 2007 nil nil 0)
+ (0 30 15 11 5 2008 nil nil 0)
+ (0 30 2 10 2 1 nil nil nil))))
+ (should (equal (iso8601-parse-interval "P1Y2M10DT2H30M/2008-05-11T15:30:00Z")
+ '((0 0 13 1 3 2007 nil nil 0)
+ (0 30 15 11 5 2008 nil nil 0)
+ (0 30 2 10 2 1 nil nil nil)))))
+
+(ert-deftest standard-test-dates ()
+ (should (equal (iso8601-parse-date "19850412")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-04-12")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985102")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-102")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985W155")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-W15-5")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985W15")
+ '(nil nil nil 7 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-W15")
+ '(nil nil nil 7 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985-04")
+ '(nil nil nil nil 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985")
+ '(nil nil nil nil nil 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "+1985-04-12")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "+19850412")
+ '(nil nil nil 12 4 1985 nil nil nil))))
+
+(ert-deftest standard-test-time-of-day-local-time ()
+ (should (equal (iso8601-parse-time "152746")
+ '(46 27 15 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "15:27:46")
+ '(46 27 15 nil nil nil nil nil nil)))
+
+ (should (equal (iso8601-parse-time "1528")
+ '(0 28 15 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "15:28")
+ '(0 28 15 nil nil nil nil nil nil)))
+
+ (should (equal (iso8601-parse-time "15")
+ '(0 0 15 nil nil nil nil nil nil))))
+
+(ert-deftest standard-test-time-of-day-fractions ()
+ ;; decoded-time doesn't support sub-second times.
+ ;; (should (equal (iso8601-parse-time "152735,5")
+ ;; '(46 27 15 nil nil nil nil nil nil)))
+ ;; (should (equal (iso8601-parse-time "15:27:35,5")
+ ;; '(46 27 15 nil nil nil nil nil nil)))
+ )
+
+(ert-deftest standard-test-time-of-day-beginning-of-day ()
+ (should (equal (iso8601-parse-time "000000")
+ '(0 0 0 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "00:00:00")
+ '(0 0 0 nil nil nil nil nil nil)))
+
+ (should (equal (iso8601-parse-time "0000")
+ '(0 0 0 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "00:00")
+ '(0 0 0 nil nil nil nil nil nil))))
+
+(ert-deftest standard-test-time-of-day-utc ()
+ (should (equal (iso8601-parse-time "232030Z")
+ '(30 20 23 nil nil nil nil nil 0)))
+ (should (equal (iso8601-parse-time "23:20:30Z")
+ '(30 20 23 nil nil nil nil nil 0)))
+
+ (should (equal (iso8601-parse-time "2320Z")
+ '(0 20 23 nil nil nil nil nil 0)))
+ (should (equal (iso8601-parse-time "23:20Z")
+ '(0 20 23 nil nil nil nil nil 0)))
+
+ (should (equal (iso8601-parse-time "23Z")
+ '(0 0 23 nil nil nil nil nil 0))))
+
+
+(ert-deftest standard-test-time-of-day-zone ()
+ (should (equal (iso8601-parse-time "152746+0100")
+ '(46 27 15 nil nil nil nil nil 3600)))
+ (should (equal (iso8601-parse-time "15:27:46+0100")
+ '(46 27 15 nil nil nil nil nil 3600)))
+
+ (should (equal (iso8601-parse-time "152746+01")
+ '(46 27 15 nil nil nil nil nil 3600)))
+ (should (equal (iso8601-parse-time "15:27:46+01")
+ '(46 27 15 nil nil nil nil nil 3600)))
+
+ (should (equal (iso8601-parse-time "152746-0500")
+ '(46 27 15 nil nil nil nil nil -18000)))
+ (should (equal (iso8601-parse-time "15:27:46-0500")
+ '(46 27 15 nil nil nil nil nil -18000)))
+
+ (should (equal (iso8601-parse-time "152746-05")
+ '(46 27 15 nil nil nil nil nil -18000)))
+ (should (equal (iso8601-parse-time "15:27:46-05")
+ '(46 27 15 nil nil nil nil nil -18000))))
+
+(ert-deftest standard-test-date-and-time-of-day ()
+ (should (equal (iso8601-parse "19850412T101530")
+ '(30 15 10 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse "1985-04-12T10:15:30")
+ '(30 15 10 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse "1985102T235030Z")
+ '(30 50 23 12 4 1985 nil nil 0)))
+ (should (equal (iso8601-parse "1985-102T23:50:30Z")
+ '(30 50 23 12 4 1985 nil nil 0)))
+
+ (should (equal (iso8601-parse "1985W155T235030")
+ '(30 50 23 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse "1985-W155T23:50:30")
+ '(30 50 23 12 4 1985 nil nil nil))))
+
+(ert-deftest standard-test-interval ()
+ ;; A time interval starting at 20 minutes and 50 seconds past 23
+ ;; hours on 12 April 1985 and ending at 30 minutes past 10 hours on
+ ;; 25 June 1985.
+ (should (equal (iso8601-parse-interval "19850412T232050/19850625T103000")
+ '((50 20 23 12 4 1985 nil nil nil)
+ (0 30 10 25 6 1985 nil nil nil)
+ (10 9 11 15 3 1970 0 nil 0))))
+ (should (equal (iso8601-parse-interval
+ "1985-04-12T23:20:50/1985-06-25T10:30:00")
+ '((50 20 23 12 4 1985 nil nil nil)
+ (0 30 10 25 6 1985 nil nil nil)
+ (10 9 11 15 3 1970 0 nil 0))))
+
+ ;; A time interval starting at 12 April 1985 and ending on 25 June
+ ;; 1985.
+
+ ;; This example doesn't seem valid according to the standard.
+ ;; "0625" is unambiguous, and means "the year 625". Weird.
+ ;; (should (equal (iso8601-parse-interval "19850412/0625")
+ ;; '((nil nil nil 12 4 1985 nil nil nil)
+ ;; (nil nil nil nil nil 625 nil nil nil)
+ ;; (0 17 0 22 9 609 5 nil 0))))
+
+ ;; A time interval of 2 years, 10 months, 15 days, 10 hours, 20
+ ;; minutes and 30 seconds.
+ (should (equal (iso8601-parse-duration "P2Y10M15DT10H20M30S")
+ '(30 20 10 15 10 2 nil nil nil)))
+
+ (should (equal (iso8601-parse-duration "P00021015T102030")
+ '(30 20 10 15 10 2 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P0002-10-15T10:20:30")
+ '(30 20 10 15 10 2 nil nil nil)))
+
+ ;; A time interval of 1 year and 6 months.
+ (should (equal (iso8601-parse-duration "P1Y6M")
+ '(0 0 0 0 6 1 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P0001-06")
+ '(nil nil nil nil 6 1 nil nil nil)))
+
+ ;; A time interval of seventy-two hours.
+ (should (equal (iso8601-parse-duration "PT72H")
+ '(0 0 72 0 0 0 nil nil nil)))
+
+ ;; Defined by start and duration
+ ;; A time interval of 1 year, 2 months, 15 days and 12 hours,
+ ;; beginning on 12 April 1985 at 20 minutes past 23 hours.
+ (should (equal (iso8601-parse-interval "19850412T232000/P1Y2M15DT12H")
+ '((0 20 23 12 4 1985 nil nil nil)
+ (0 20 11 28 6 1986 nil nil nil)
+ (0 0 12 15 2 1 nil nil nil))))
+ (should (equal (iso8601-parse-interval "1985-04-12T23:20:00/P1Y2M15DT12H")
+ '((0 20 23 12 4 1985 nil nil nil)
+ (0 20 11 28 6 1986 nil nil nil)
+ (0 0 12 15 2 1 nil nil nil))))
+
+ ;; Defined by duration and end
+ ;; A time interval of 1 year, 2 months, 15 days and 12 hours, ending
+ ;; on 12 April 1985 at 20 minutes past 23 hour.
+ (should (equal (iso8601-parse-interval "P1Y2M15DT12H/19850412T232000")
+ '((0 20 11 28 1 1984 nil nil nil)
+ (0 20 23 12 4 1985 nil nil nil)
+ (0 0 12 15 2 1 nil nil nil)))))
+
+;;; iso8601-tests.el ends here
diff --git a/test/lisp/calendar/time-date-tests.el
b/test/lisp/calendar/time-date-tests.el
new file mode 100644
index 0000000..b46a247
--- /dev/null
+++ b/test/lisp/calendar/time-date-tests.el
@@ -0,0 +1,109 @@
+;;; time-date-tests.el --- tests for calendar/time-date.el -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'time-date)
+
+(ert-deftest test-leap-year ()
+ (should-not (date-leap-year-p 1999))
+ (should-not (date-leap-year-p 1900))
+ (should (date-leap-year-p 2000))
+ (should (date-leap-year-p 2004)))
+
+(ert-deftest test-days-in-month ()
+ (should (= (date-days-in-month 2004 2) 29))
+ (should (= (date-days-in-month 2004 3) 31))
+ (should-not (= (date-days-in-month 1900 3) 28)))
+
+(ert-deftest test-ordinal ()
+ (should (equal (date-ordinal-to-time 2008 271)
+ '(nil nil nil 27 9 2008 nil nil nil)))
+ (should (equal (date-ordinal-to-time 2008 1)
+ '(nil nil nil 1 1 2008 nil nil nil)))
+ (should (equal (date-ordinal-to-time 2008 32)
+ '(nil nil nil 1 2 2008 nil nil nil)))
+ (should (equal (date-ordinal-to-time 1981 095)
+ '(nil nil nil 5 4 1981 nil nil nil))))
+
+(cl-defmethod mdec (&key second minute hour
+ day month year
+ dst zone)
+ (list second minute hour day month year nil dst zone))
+
+(ert-deftest test-decoded-add ()
+ (let ((time '(12 15 16 8 7 2019 1 t 7200)))
+ (should (equal (decoded-time-add time (mdec :year 1))
+ '(12 15 16 8 7 2020 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :year -2))
+ '(12 15 16 8 7 2017 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :month 1))
+ '(12 15 16 8 8 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :month 10))
+ '(12 15 16 8 5 2020 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day 1))
+ '(12 15 16 9 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day -1))
+ '(12 15 16 7 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day 30))
+ '(12 15 16 7 8 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day -365))
+ '(12 15 16 8 7 2018 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day 365))
+ '(12 15 16 7 7 2020 1 t 7200)))
+
+ ;; 2020 is a leap year.
+ (should (equal (decoded-time-add time (mdec :day 366))
+ '(12 15 16 8 7 2020 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :second 1))
+ '(13 15 16 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :second -1))
+ '(11 15 16 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :second 61))
+ '(13 16 16 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :hour 1 :minute 2 :second 3))
+ '(15 17 17 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :hour 24))
+ '(12 15 16 9 7 2019 1 t 7200)))
+ ))
+
+(ert-deftest test-decoded-add-zone ()
+ (let ((time '(12 15 16 8 7 2019 1 t 7200)))
+ (should (equal (decoded-time-add time (mdec :zone -3600))
+ '(12 15 15 8 7 2019 1 t 7200)))
+ (should (equal (decoded-time-add time (mdec :zone -7200))
+ '(12 15 14 8 7 2019 1 t 7200)))))
+
+(require 'ert)
+
+;;; time-date-tests.el ends here
diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el
index e9dfd2b..241f7bf 100644
--- a/test/lisp/char-fold-tests.el
+++ b/test/lisp/char-fold-tests.el
@@ -44,6 +44,16 @@
(should (string-match (char-fold--ascii-upcase re) (downcase it)))
(should (string-match (char-fold--ascii-downcase re) (upcase it)))))))
+(defun char-fold--test-no-match-exactly (string &rest strings-to-match)
+ (let ((re (concat "\\`" (char-fold-to-regexp string) "\\'")))
+ (dolist (it strings-to-match)
+ (should-not (string-match re it)))
+ ;; Case folding
+ (let ((case-fold-search t))
+ (dolist (it strings-to-match)
+ (should-not (string-match (char-fold--ascii-upcase re) (downcase it)))
+ (should-not (string-match (char-fold--ascii-downcase re) (upcase
it)))))))
+
(defun char-fold--test-search-with-contents (contents string)
(with-temp-buffer
(insert contents)
@@ -53,6 +63,11 @@
(should (char-fold-search-forward string nil 'noerror))
(should (char-fold-search-backward string nil 'noerror))))
+(defun char-fold--permutation (strings)
+ (mapcar (lambda (string)
+ (cons string (remove string strings)))
+ strings))
+
(ert-deftest char-fold--test-consistency ()
(dotimes (n 30)
@@ -132,5 +147,77 @@
;; Ensure it took less than a second.
(should (< (- (time-to-seconds) time) 1))))))
+(ert-deftest char-fold--test-without-customization ()
+ (let* ((matches
+ '(
+ ("'" "’")
+ ("e" "ℯ" "ḗ" "ë" "ë")
+ ("ι"
+ "ί" ;; 1 level decomposition
+ "ί" ;; 2 level decomposition
+ "ΐ" ;; 3 level decomposition
+ )
+ ("ß" "ss")
+ ))
+ (no-matches
+ '(
+ ("и" "й")
+ )))
+ (dolist (strings matches)
+ (apply 'char-fold--test-match-exactly strings))
+ (dolist (strings no-matches)
+ (apply 'char-fold--test-no-match-exactly strings))))
+
+(ert-deftest char-fold--test-with-customization ()
+ :tags '(:expensive-test)
+ ;; FIXME: move some language-specific settings to defaults
+ (let ((char-fold-include
+ (append char-fold-include
+ '(
+ (?o "ø") ;; da no nb nn
+ (?l "ł") ;; pl
+ (?æ "ae")
+ (?→ "->")
+ (?⇒ "=>")
+ )))
+ (char-fold-exclude
+ (append char-fold-exclude
+ '(
+ (?a "å") ;; da no nb nn sv
+ (?a "ä") ;; et fi sv
+ (?o "ö") ;; et fi sv
+ (?n "ñ") ;; es
+ )))
+ (char-fold-symmetric t)
+ (matches
+ '(
+ ("e" "ℯ" "ḗ" "ë" "ë")
+ ("е" "ё" "ё")
+ ("ι" "ί" "ί" "ΐ")
+ ("ß" "ss")
+ ("o" "ø")
+ ("l" "ł")
+ ("æ" "ae")
+ ("→" "->")
+ ("⇒" "=>")
+ ))
+ (no-matches
+ '(
+ ("a" "å")
+ ("a" "ä")
+ ("o" "ö")
+ ("n" "ñ")
+ ("и" "й")
+ ))
+ ;; Don't override global value by char-fold-update-table below
+ char-fold-table)
+ (char-fold-update-table)
+ (dolist (strings matches)
+ (dolist (permutation (char-fold--permutation strings))
+ (apply 'char-fold--test-match-exactly permutation)))
+ (dolist (strings no-matches)
+ (dolist (permutation (char-fold--permutation strings))
+ (apply 'char-fold--test-no-match-exactly permutation)))))
+
(provide 'char-fold-tests)
;;; char-fold-tests.el ends here
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el
b/test/lisp/emacs-lisp/let-alist-tests.el
index 31db4a9..9c3f2a5 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -95,4 +95,9 @@ See Bug#24641."
(should (equal (let-alist--deep-dot-search '(foo .bar (let-alist .qux .baz)))
'((.bar . bar) (.qux . qux))))) ; no .baz
+(ert-deftest let-alist--vectors ()
+ (should (equal (let-alist '((a . 1) (b . 2))
+ `[,(+ .a) ,(+ .a .b .b)])
+ [1 5])))
+
;;; let-alist.el ends here
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el
b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index 571e9ab..d5b4f53 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -483,7 +483,6 @@ regarding the odd-looking coverage result for the quoted
form."
;; ==== coverage-of-the-unknown-symbol-bug-25471 ====
"Testcover correctly records coverage of code which uses `unknown'"
-:expected-result :failed
;; ====
(defun testcover-testcase-how-do-i-know-you (name)
(let ((val 'unknown))
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 4396a69..7c8c195 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -93,6 +93,7 @@
(defvar file-notify--test-desc2 nil)
(defvar file-notify--test-results nil)
(defvar file-notify--test-event nil)
+(defvar file-notify--test-file nil)
(defvar file-notify--test-events nil)
(defvar file-notify--test-monitors nil)
@@ -204,6 +205,11 @@ Return nil when any other file notification watch is still
active."
(when (getenv "EMACS_HYDRA_CI")
(add-to-list 'tramp-remote-path 'tramp-own-remote-path))
+(defun file-notify--test-add-watch (file flags callback)
+ "Like `file-notify-add-watch', but also passing FILE to CALLBACK."
+ (file-notify-add-watch file flags
+ (lambda (event) (funcall callback event file))))
+
;; We do not want to try and fail `file-notify-add-watch'.
(defun file-notify--test-local-enabled ()
"Whether local file notification is enabled.
@@ -487,35 +493,40 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(file-notify--deftest-remote file-notify-test02-rm-watch
"Check `file-notify-rm-watch' for remote files.")
+;; Accessors for the callback argument.
+(defun file-notify--test-event-file (event) (nth 2 event))
+(defun file-notify--test-event-file1 (event) (nth 3 event))
+
(defun file-notify--test-event-test ()
"Ert test function to be called by `file-notify--test-event-handler'.
We cannot pass arguments, so we assume that `file-notify--test-event'
-is bound somewhere."
+and `file-notify--test-file' are bound somewhere."
;; Check the descriptor.
(should (equal (car file-notify--test-event) file-notify--test-desc))
;; Check the file name.
(should
(string-prefix-p
- (file-notify--event-watched-file file-notify--test-event)
- (file-notify--event-file-name file-notify--test-event)))
+ file-notify--test-file
+ (file-notify--test-event-file file-notify--test-event)))
;; Check the second file name if exists.
(when (eq (nth 1 file-notify--test-event) 'renamed)
(should
(string-prefix-p
- (file-notify--event-watched-file file-notify--test-event)
- (file-notify--event-file1-name file-notify--test-event)))))
+ file-notify--test-file
+ (file-notify--test-event-file1 file-notify--test-event)))))
-(defun file-notify--test-event-handler (event)
+(defun file-notify--test-event-handler (event file)
"Run a test over FILE-NOTIFY--TEST-EVENT.
For later analysis, append the test result to `file-notify--test-results'
and the event to `file-notify--test-events'."
(let* ((file-notify--test-event event)
+ (file-notify--test-file file)
(result
(ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
;; Do not add lock files, this would confuse the checks.
(unless (string-match
(regexp-quote ".#")
- (file-notify--event-file-name file-notify--test-event))
+ (file-notify--test-event-file file-notify--test-event))
(when file-notify-debug
(message "file-notify--test-event-handler result: %s event: %S"
(null (ert-test-failed-p result)) file-notify--test-event))
@@ -599,7 +610,7 @@ delivered."
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(should
(setq file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-events
@@ -633,7 +644,7 @@ delivered."
(write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
(should
(setq file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-events
@@ -667,7 +678,7 @@ delivered."
(should
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-events
@@ -714,7 +725,7 @@ delivered."
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-events
@@ -771,7 +782,7 @@ delivered."
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-events
@@ -822,7 +833,7 @@ delivered."
"any text" nil file-notify--test-tmpfile nil 'no-message)
(should
(setq file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(attribute-change) #'file-notify--test-event-handler)))
(file-notify--test-with-events
@@ -987,7 +998,7 @@ delivered."
(write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
(should
(setq file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
@@ -1024,7 +1035,7 @@ delivered."
(should
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
@@ -1142,7 +1153,7 @@ delivered."
(make-temp-file "file-notify-test-parent" t)))
(should
(setq file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(unwind-protect
@@ -1218,7 +1229,7 @@ delivered."
(write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
(should
(setq file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
@@ -1254,7 +1265,7 @@ delivered."
"any text" nil file-notify--test-tmpfile nil 'no-message)
(should
(setq file-notify--test-desc
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
@@ -1310,23 +1321,23 @@ the file watch."
(write-region "any text" nil file-notify--test-tmpfile1 nil 'no-message)
(unwind-protect
(cl-flet (;; Directory monitor.
- (dir-callback (event)
+ (dir-callback (event file)
(let ((file-notify--test-desc file-notify--test-desc1))
- (file-notify--test-event-handler event)))
+ (file-notify--test-event-handler event file)))
;; File monitor.
- (file-callback (event)
+ (file-callback (event file)
(let ((file-notify--test-desc file-notify--test-desc2))
- (file-notify--test-event-handler event))))
+ (file-notify--test-event-handler event file))))
(should
(setq file-notify--test-desc1
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'dir-callback)
;; This is needed for `file-notify--test-monitor'.
file-notify--test-desc file-notify--test-desc1))
(should
(setq file-notify--test-desc2
- (file-notify-add-watch
+ (file-notify--test-add-watch
file-notify--test-tmpfile1
'(change) #'file-callback)))
(should (file-notify-valid-p file-notify--test-desc1))
diff --git a/test/lisp/progmodes/flymake-tests.el
b/test/lisp/progmodes/flymake-tests.el
index af97290..f1d8b3a 100644
--- a/test/lisp/progmodes/flymake-tests.el
+++ b/test/lisp/progmodes/flymake-tests.el
@@ -52,7 +52,7 @@
(flymake-reporting-backends))
while notdone
unless noninteractive do (read-event "" nil 0.1)
- do (sleep-for (+ 0.5 flymake-no-changes-timeout))
+ do (sleep-for (+ 0.5 (or flymake-no-changes-timeout 0)))
finally (when notdone (ert-skip
(format "Some backends not reporting yet %s"
notdone)))))
@@ -111,7 +111,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest perl-backend ()
"Test the perl backend"
(skip-unless (executable-find "perl"))
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(flymake-tests--with-flymake ("test.pl")
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
@@ -123,7 +122,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest ruby-backend ()
"Test the ruby backend"
(skip-unless (executable-find "ruby"))
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
;; Some versions of ruby fail if HOME doesn't exist (bug#29187).
(let* ((tempdir (make-temp-file "flymake-tests-ruby" t))
(process-environment (cons (format "HOME=%s" tempdir)
@@ -169,7 +167,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest included-c-header-files ()
"Test inclusion of .h header files."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(let ((flymake-wrap-around nil))
(flymake-tests--with-flymake
("some-problems.h")
@@ -295,7 +292,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest recurrent-backend ()
"Test a backend that calls REPORT-FN multiple times"
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(with-temp-buffer
(let (tick)
(cl-letf
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index efbe012..83fcdd8 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -369,7 +369,11 @@ VALUES-PLIST is a list with alternating index and value
elements."
(ruby-with-temp-buffer "foo {|b|\n}"
(beginning-of-line)
(ruby-toggle-block)
- (should (string= "foo do |b|\nend" (buffer-string)))))
+ (should (string= "foo do |b|\nend" (buffer-string))))
+ (ruby-with-temp-buffer "foo {|b| b }"
+ (beginning-of-line)
+ (ruby-toggle-block)
+ (should (string= "foo do |b|\n b\nend" (buffer-string)))))
(ert-deftest ruby-toggle-block-to-brace ()
(let ((pairs '((17 . "foo { |b| b + 2 }")
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 06db8f5..0023680 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -400,5 +400,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(should (equal subr-tests--hook '(f5 f10 f9 f6 f2 f1 f4 f3 f7 f8)))
)
+(ert-deftest ignore-error-tests ()
+ (should (equal (ignore-error (end-of-file)
+ (read ""))
+ nil))
+ (should (equal (ignore-error end-of-file
+ (read ""))
+ nil))
+ (should-error (ignore-error foo
+ (read ""))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/term/tty-colors-tests.el
b/test/lisp/term/tty-colors-tests.el
new file mode 100644
index 0000000..0570d1b
--- /dev/null
+++ b/test/lisp/term/tty-colors-tests.el
@@ -0,0 +1,38 @@
+;;; tty-colors-tests.el --- tests for tty-colors.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+
+;;; Code:
+(require 'ert)
+(require 'term/tty-colors)
+
+(ert-deftest tty-colors-test-standard-colors ()
+ (should (equal (tty-color-standard-values "white") '(65535 65535 65535)))
+ (should (equal (tty-color-standard-values "#F00") '(65535 0 0)))
+ (should (equal (tty-color-standard-values "#00FF00") '(0 65535 0)))
+ (should (equal (tty-color-standard-values "#00000000FFFF") '(0 0 65535)))
+ (should (equal (tty-color-standard-values "rgb:0/0/7") '(0 0 30583)))
+ (should (equal (tty-color-standard-values "rgb:0/ff/0") '(0 65535 0)))
+ (should (equal (tty-color-standard-values "rgb:ffFF/0000/0000") '(65535 0
0))))
+
+(provide 'term-tests)
+
+;;; term-tests.el ends here
diff --git a/test/manual/indent/opascal.pas b/test/manual/indent/opascal.pas
new file mode 100644
index 0000000..ac4beb3
--- /dev/null
+++ b/test/manual/indent/opascal.pas
@@ -0,0 +1,12 @@
+{ -*- opascal -*- }
+
+procedure Toto ();
+begin
+ for i := 0 to 1 do
+ Write (str.Chars[i]);
+
+ // bug#36348
+ for var i := 0 to 1 do
+ Write (str.Chars[i]);
+
+end;
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 69cca5d..a106080 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -165,13 +165,9 @@
(should (string-equal (format "%d" -18446744073709551616.0)
"-18446744073709551616")))
-;; Perhaps Emacs will be improved someday to return the correct
-;; answer for positive numbers instead of overflowing; in
-;; that case these tests will need to be changed. In the meantime make
-;; sure Emacs is reporting the overflow correctly.
(ert-deftest format-%x-large-float ()
- (should-error (format "%x" 18446744073709551616.0)
- :type 'overflow-error))
+ (should (string-equal (format "%x" 18446744073709551616.0)
+ "10000000000000000")))
(ert-deftest read-large-integer ()
(should (eq (type-of (read (format "%d0" most-negative-fixnum))) 'integer))
(should (eq (type-of (read (format "%+d" (* -8.0 most-negative-fixnum))))
@@ -188,11 +184,16 @@
(dolist (val (list most-negative-fixnum (1+ most-negative-fixnum)
-1 0 1
(1- most-positive-fixnum) most-positive-fixnum))
- (should (eq val (read (format fmt val)))))))
-
-(ert-deftest format-%o-invalid-float ()
- (should-error (format "%o" -1e-37)
- :type 'overflow-error))
+ (should (eq val (read (format fmt val)))))
+ (dolist (val (list (1+ most-positive-fixnum)
+ (* 2 (1+ most-positive-fixnum))
+ (* 4 (1+ most-positive-fixnum))
+ (* 8 (1+ most-positive-fixnum))
+ 18446744073709551616.0))
+ (should (= val (read (format fmt val)))))))
+
+(ert-deftest format-%o-negative-float ()
+ (should (string-equal (format "%o" -1e-37) "0")))
;; Bug#31938
(ert-deftest format-%d-float ()
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 813ee5f..98d3d6b 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -136,3 +136,14 @@ Also check that an encoding error can appear in a symlink."
(name (expand-file-name "bar")))
(should (and (file-name-absolute-p name)
(not (eq (aref name 0) ?~))))))
+
+(ert-deftest fileio-tests--file-name-absolute-p ()
+ "Test file-name-absolute-p."
+ (dolist (suffix '("" "/" "//" "/foo" "/foo/" "/foo//" "/foo/bar"))
+ (unless (string-equal suffix "")
+ (should (file-name-absolute-p suffix)))
+ (should (file-name-absolute-p (concat "~" suffix)))
+ (when (user-full-name user-login-name)
+ (should (file-name-absolute-p (concat "~" user-login-name suffix))))
+ (unless (user-full-name "nosuchuser")
+ (should (not (file-name-absolute-p (concat "~nosuchuser" suffix)))))))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 0173962 2/2: Merge commit '9b480db6732c6d2e886838f112d9bd46fc8989bf',
Stephen Leake <=