pestctrl/emacs
1
0
Fork 0
forked from Github/emacs
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge remote-tracking branch 'origin/master' into feature/tramp-thread-safe

Browse source
This commit is contained in:
Michael Albinus 2018-10-12 15:09:03 +02:00
commit 25f77f9085
97 changed files with 4161 additions and 3195 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
Makefile.in
View file

@ -151,6 +151,9 @@ libexecdir=@libexecdir@
# Currently only used for the systemd service file.
libdir=@libdir@
# Where to install emacs-module.h.
includedir=@includedir@
# Where to install Emacs's man pages.
# Note they contain cross-references that expect them to be in section 1.
mandir=@mandir@
@ -560,6 +563,8 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \
## See also these comments from 2004 about cp -r working fine:
## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html
install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA}
umask 022 && $(MKDIR_P) "$(DESTDIR)$(includedir)"
$(INSTALL_DATA) src/emacs-module.h "$(DESTDIR)$(includedir)/emacs-module.h"
-set ${COPYDESTS} ; \
unset CDPATH; \
$(set_installuser); \
@ -743,6 +748,7 @@ install-strip:
###
### Don't delete the lisp and etc directories if they're in the source tree.
uninstall: uninstall-$(NTDIR) uninstall-doc
rm -f "$(DESTDIR)$(includedir)/emacs-module.h"
$(MAKE) -C lib-src uninstall
-unset CDPATH; \
for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \
@ -780,7 +786,9 @@ uninstall: uninstall-$(NTDIR) uninstall-doc
(if cd "$(DESTDIR)${icondir}"; then \
rm -f hicolor/*x*/apps/"${EMACS_NAME}.png" \
"hicolor/scalable/apps/${EMACS_NAME}.svg" \
hicolor/scalable/mimetypes/`echo emacs-document | sed '$(TRANSFORM)'`.svg; \
"hicolor/scalable/apps/${EMACS_NAME}.ico" \
"hicolor/scalable/mimetypes/${EMACS_NAME}-document.svg" \
"hicolor/scalable/mimetypes/${EMACS_NAME}-document23.svg"; \
fi)
-rm -f "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"
-rm -f "$(DESTDIR)${appdatadir}/${EMACS_NAME}.appdata.xml"

8
admin/MAINTAINERS
View file

@ -240,6 +240,14 @@ Vibhav Pant
lisp/net/browse-url.el
lisp/erc/*
Alan Third
The NS port:
nextstep/*
src/ns*
src/*.m
lisp/term/ns-win.el
doc/emacs/macos.texi
;;; Local Variables:
;;; coding: utf-8

2
admin/merge-gnulib
View file

@ -47,7 +47,7 @@ GNULIB_MODULES='
AVOIDED_MODULES='
btowc close dup fchdir fstat langinfo lock
malloc-posix mbrtowc mbsinit msvc-inval msvc-nothrow nl_langinfo
malloc-posix mbrtowc mbsinit mkdir msvc-inval msvc-nothrow nl_langinfo
openat-die opendir raise
save-cwd select setenv sigprocmask stat stdarg stdbool
threadlib tzset unsetenv utime utime-h

3
configure.ac
View file

@ -1019,9 +1019,10 @@ AS_IF([test $gl_gcc_warnings = no],
gl_WARN_ADD([-Wno-unused-parameter]) # Too many warnings for now
gl_WARN_ADD([-Wno-format-nonliteral])
# clang is unduly picky about braces.
# clang is unduly picky about some things.
if test "$emacs_cv_clang" = yes; then
gl_WARN_ADD([-Wno-missing-braces])
gl_WARN_ADD([-Wno-null-pointer-arithmetic])
fi
# This causes too much noise in the MinGW build

10
doc/emacs/help.texi
View file

@ -523,13 +523,17 @@ currently in use. @xref{Coding Systems}.
@section Other Help Commands
@kindex C-h i
@kindex C-h 4 i
@findex info
@findex info-other-window
@cindex Info
@cindex manuals, included
@kbd{C-h i} (@code{info}) runs the Info program, which browses
structured documentation files. The entire Emacs manual is available
within Info, along with many other manuals for the GNU system. Type
@kbd{h} after entering Info to run a tutorial on using Info.
structured documentation files. @kbd{C-h 4 i}
(@code{info-other-window}) does the same, but shows the Info buffer in
another window. The entire Emacs manual is available within Info,
along with many other manuals for the GNU system. Type @kbd{h} after
entering Info to run a tutorial on using Info.
@cindex find Info manual by its file name
With a numeric argument @var{n}, @kbd{C-h i} selects the Info buffer

2
doc/emacs/mark.texi
View file

@ -17,11 +17,13 @@ one comes earlier in the text; each time you move point, the region
changes.
@cindex active region
@cindex activating the mark
Setting the mark at a position in the text also @dfn{activates} it.
When the mark is active, we say also that the region is active; Emacs
indicates its extent by highlighting the text within it, using the
@code{region} face (@pxref{Face Customization}).
@cindex deactivating the mark
After certain non-motion commands, including any command that
changes the text in the buffer, Emacs automatically @dfn{deactivates}
the mark; this turns off the highlighting. You can also explicitly

7
doc/lispref/abbrevs.texi
View file

@ -122,9 +122,7 @@ System abbrevs are listed and identified as such. Otherwise the
description is a Lisp expression---a call to @code{define-abbrev-table}
that would define @var{name} as it is currently defined, but without
the system abbrevs. (The mode or package using @var{name} is supposed
to add these to @var{name} separately.) If the Lisp expression would
not define any abbrevs (i.e.@: it defines an empty abbrev table), this
function inserts nothing.
to add these to @var{name} separately.)
@end defun
@node Defining Abbrevs
@ -234,7 +232,8 @@ Emacs commands to offer to save your abbrevs.
Save all abbrev definitions (except system abbrevs), for all abbrev
tables listed in @code{abbrev-table-name-list}, in the file
@var{filename}, in the form of a Lisp program that when loaded will
define the same abbrevs. If @var{filename} is @code{nil} or omitted,
define the same abbrevs. Tables that do not have any abbrevs to save
are omitted. If @var{filename} is @code{nil} or omitted,
@code{abbrev-file-name} is used. This function returns @code{nil}.
@end deffn

12
doc/lispref/buffers.texi
View file

@ -648,16 +648,13 @@ file should not be done.
@defun visited-file-modtime
This function returns the current buffer's recorded last file
modification time, as a list of the form @code{(@var{high} @var{low}
@var{microsec} @var{picosec})}. (This is the same format that
@code{file-attributes} uses to return time values; @pxref{File
Attributes}.)
modification time, as a Lisp timestamp (@pxref{Time of Day}).
If the buffer has no recorded last modification time, this function
returns zero. This case occurs, for instance, if the buffer is not
visiting a file or if the time has been explicitly cleared by
@code{clear-visited-file-modtime}. Note, however, that
@code{visited-file-modtime} returns a list for some non-file buffers
@code{visited-file-modtime} returns a timestamp for some non-file buffers
too. For instance, in a Dired buffer listing a directory, it returns
the last modification time of that directory, as recorded by Dired.
@ -671,9 +668,8 @@ is not @code{nil}, and otherwise to the last modification time of the
visited file.
If @var{time} is neither @code{nil} nor an integer flag returned
by @code{visited-file-modtime}, it should have the form
@code{(@var{high} @var{low} @var{microsec} @var{picosec})},
the format used by @code{current-time} (@pxref{Time of Day}).
by @code{visited-file-modtime}, it should be a Lisp time value
(@pxref{Time of Day}).
This function is useful if the buffer was not read from the file
normally, or if the file itself has been changed for some known benign

4
doc/lispref/functions.texi
View file

@ -1679,7 +1679,9 @@ Note: The interactive spec of @var{function} will apply to the combined
function and should hence obey the calling convention of the combined function
rather than that of @var{function}. In many cases, it makes no difference
since they are identical, but it does matter for @code{:around},
@code{:filter-args}, and @code{filter-return}, where @var{function}.
@code{:filter-args}, and @code{:filter-return}, where @var{function}
receives different arguments than the original function stored in
@var{place}.
@end defmac
@defmac remove-function place function

1
doc/lispref/minibuf.texi
View file

@ -2242,6 +2242,7 @@ Here is an example of using this function:
To read a password to pass to another program, you can use the
function @code{read-passwd}.
@vindex read-hide-char
@defun read-passwd prompt &optional confirm default
This function reads a password, prompting with @var{prompt}. It does
not echo the password as the user types it; instead, it echoes

157
doc/lispref/os.texi
View file

@ -1233,11 +1233,44 @@ return value is @code{nil}.
This section explains how to determine the current time and time
zone.
@cindex Lisp timestamp
@cindex timestamp, Lisp
Many functions like @code{current-time} and @code{file-attributes}
return @dfn{Lisp timestamp} values that count seconds, and that can
represent absolute time by counting seconds since the @dfn{epoch} of
1970-01-01 00:00:00 UTC.
Although traditionally Lisp timestamps were integer pairs, their
form has evolved and programs ordinarily should not depend on the
current default form. If your program needs a particular timestamp
form, you can use the @code{encode-time} function to convert it to the
needed form. @xref{Time Conversion}.
@cindex epoch
Most of these functions represent time as a list of four integers
@code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}.
This represents the number of seconds from the @dfn{epoch} (January
1, 1970 at 00:00 UTC), using the formula:
There are currently three forms of Lisp timestamps, each of
which represents a number of seconds:
@itemize @bullet
@item
An integer. Although this is the simplest form, it cannot represent
subsecond timestamps.
@item
A pair of integers @code{(@var{ticks} . @var{hz})}, where @var{hz} is
positive. This represents @var{ticks}/@var{hz} seconds, which is the
same time as plain @var{ticks} if @var{hz} is 1. A common value for
@var{hz} is 1000000000, for a nanosecond-resolution
clock.@footnote{Currently @var{hz} should be at least 65536 to avoid
compatibility warnings when the timestamp is passed to standard
functions, as previous versions of Emacs would interpret such a
timestamps differently due to backward-compatibility concerns. These
warnings are intended to be removed in a future Emacs version.}
@item
A list of four integers @code{(@var{high} @var{low} @var{micro}
@var{pico})}, where 0 @leq{} @var{low} < 65536, 0 @leq{} @var{micro} <
1000000, and 0 @leq{} @var{pico} < 1000000.
This represents the number of seconds using the formula:
@ifnottex
@var{high} * 2**16 + @var{low} + @var{micro} * 10**@minus{}6 +
@var{pico} * 10**@minus{}12.
@ -1245,21 +1278,23 @@ This represents the number of seconds from the @dfn{epoch} (January
@tex
$high*2^{16} + low + micro*10^{-6} + pico*10^{-12}$.
@end tex
The return value of @code{current-time} represents time using this
form, as do the timestamps in the return values of other functions
such as @code{file-attributes} (@pxref{Definition of
file-attributes}). In some cases, functions may return two- or
In some cases, functions may default to returning two- or
three-element lists, with omitted @var{microsec} and @var{picosec}
components defaulting to zero.
On all current machines @var{picosec} is a multiple of 1000, but this
may change as higher-resolution clocks become available.
@end itemize
@cindex time value
Function arguments, e.g., the @var{time} argument to
@code{current-time-string}, accept a more-general @dfn{time value}
format, which can be a list of integers as above, or a single number
for seconds since the epoch, or @code{nil} for the current time. You
can convert a time value into a human-readable string using
@code{current-time-string} and @code{format-time-string}, into a list
of integers using @code{seconds-to-time}, and into other forms using
format, which can be a Lisp timestamp, @code{nil} for the current
time, a single floating-point number for seconds, or a list
@code{(@var{high} @var{low} @var{micro})} or @code{(@var{high}
@var{low})} that is a truncated list timestamp with missing elements
taken to be zero. You can convert a time value into
a human-readable string using @code{format-time-string}, into a Lisp
timestamp using @code{encode-time}, and into other forms using
@code{decode-time} and @code{float-time}. These functions are
described in the following sections.
@ -1287,12 +1322,7 @@ defaults to the current time zone rule. @xref{Time Zone Rules}.
@end defun
@defun current-time
This function returns the current time, represented as a list of four
integers @code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}.
These integers have trailing zeros on systems that return time with
lower resolutions. On all current machines @var{picosec} is a
multiple of 1000, but this may change as higher-resolution clocks
become available.
This function returns the current time as a Lisp timestamp.
@end defun
@defun float-time &optional time
@ -1306,13 +1336,6 @@ exact. Do not use this function if precise time stamps are required.
@code{time-to-seconds} is an alias for this function.
@end defun
@defun seconds-to-time time
This function converts a time value to list-of-integer form.
For example, if @var{time} is a number, @code{(time-to-seconds
(seconds-to-time @var{time}))} equals the number unless overflow
or rounding errors occur.
@end defun
@node Time Zone Rules
@section Time Zone Rules
@cindex time zone rules
@ -1434,32 +1457,63 @@ seconds east of Greenwich.
@var{dow} and @var{utcoff}.
@end defun
@defun encode-time seconds minutes hour day month year &optional zone
This function is the inverse of @code{decode-time}. It converts seven
items of calendrical data into a list-of-integer time value. For the
meanings of the arguments, see the table above under
@code{decode-time}.
@defun encode-time &optional time form &rest obsolescent-arguments
This function converts @var{time} to a Lisp timestamp.
It can act as the inverse of @code{decode-time}.
The first argument can be a time value such as a number of seconds, a
pair @code{(@var{ticks} . @var{hz})}, a list @code{(@var{high}
@var{low} @var{micro} @var{pico})}, or @code{nil} (the default) for
the current time (@pxref{Time of Day}). It can also be a list
@code{(@var{second} @var{minute} @var{hour} @var{day} @var{month}
@var{year} @var{ignored} @var{dst} @var{zone})} that specifies a
decoded time in the style of @code{decode-time}, so that
@code{(encode-time (decode-time ...))} works. For the meanings of
these list members, see the table under @code{decode-time}.
The optional @var{form} argument specifies the desired timestamp form
to be returned. If @var{form} is the symbol @code{integer}, this
function returns an integer count of seconds. If @var{form} is a
positive integer, it specifies a clock frequency and this function
returns an integer-pair timestamp @code{(@var{ticks}
. @var{form})}.@footnote{Currently a positive integer @var{form}
should be at least 65536 if the returned value is intended to be given
to standard functions expecting Lisp timestamps.} If @var{form} is
@code{t}, this function treats it as a positive integer suitable for
representing the timestamp; for example, it is treated as 1000000000
if the platform timestamp has nanosecond resolution. If @var{form} is
@code{list}, this function returns an integer list @code{(@var{high}
@var{low} @var{micro} @var{pico})}. Although an omitted or @code{nil}
@var{form} currently acts like @code{list}, this is planned to change
in a future Emacs version, so callers requiring list timestamps should
pass @code{list} explicitly.
As an obsolescent calling convention, this function can be given six
or more arguments. The first six arguments @var{second},
@var{minute}, @var{hour}, @var{day}, @var{month}, and @var{year}
specify most of the components of a decoded time. If there are more
than six arguments the @emph{last} argument is used as @var{zone} and
any other extra arguments are ignored, so that @code{(apply
#\\='encode-time (decode-time ...))} works; otherwise @var{zone} defaults
to the current time zone rule (@pxref{Time Zone Rules}). The decoded
time's @var{dst} component is treated as if it was @minus{}1, and
@var{form} takes its default value.
Year numbers less than 100 are not treated specially. If you want them
to stand for years above 1900, or years above 2000, you must alter them
yourself before you call @code{encode-time}.
The optional argument @var{zone} defaults to the current time zone rule.
@xref{Time Zone Rules}.
If you pass more than seven arguments to @code{encode-time}, the first
six are used as @var{seconds} through @var{year}, the last argument is
used as @var{zone}, and the arguments in between are ignored. This
feature makes it possible to use the elements of a list returned by
@code{decode-time} as the arguments to @code{encode-time}, like this:
The @code{encode-time} function acts as a rough inverse to
@code{decode-time}. For example, you can pass the output of
the latter to the former as follows:
@example
(apply 'encode-time (decode-time @dots{}))
(encode-time (decode-time @dots{}))
@end example
You can perform simple date arithmetic by using out-of-range values for
the @var{seconds}, @var{minutes}, @var{hour}, @var{day}, and @var{month}
arguments; for example, day 0 means the day preceding the given month.
@var{seconds}, @var{minutes}, @var{hour}, @var{day}, and @var{month};
for example, day 0 means the day preceding the given month.
The operating system puts limits on the range of possible time values;
if you try to encode a time that is out of range, an error results.
@ -1474,12 +1528,12 @@ on others, years as early as 1901 do work.
@cindex formatting time values
These functions convert time values to text in a string, and vice versa.
Time values include @code{nil}, numbers, and lists of two to four
integers (@pxref{Time of Day}).
Time values include @code{nil}, numbers, and Lisp timestamps
(@pxref{Time of Day}).
@defun date-to-time string
This function parses the time-string @var{string} and returns the
corresponding time value.
corresponding Lisp timestamp.
@end defun
@defun format-time-string format-string &optional time zone
@ -1701,10 +1755,8 @@ When called interactively, it prints the uptime in the echo area.
@end deffn
@defun get-internal-run-time
This function returns the processor run time used by Emacs as a list
of four integers: @code{(@var{sec-high} @var{sec-low} @var{microsec}
@var{picosec})}, using the same format as @code{current-time}
(@pxref{Time of Day}).
This function returns the processor run time used by Emacs, as a Lisp
timestamp (@pxref{Time of Day}).
Note that the time returned by this function excludes the time Emacs
was not using the processor, and if the Emacs process has several
@ -1729,9 +1781,10 @@ interactively, it prints the duration in the echo area.
@cindex calendrical computations
These functions perform calendrical computations using time values
(@pxref{Time of Day}). A value of @code{nil} for any of their
(@pxref{Time of Day}). As with any time value, a value of
@code{nil} for any of their
time-value arguments stands for the current system time, and a single
integer number stands for the number of seconds since the epoch.
number stands for the number of seconds since the epoch.
@defun time-less-p t1 t2
This returns @code{t} if time value @var{t1} is less than time value
@ -1757,7 +1810,7 @@ float-time}) to convert the result into seconds.
This returns the sum of two time values, as a time value.
However, the result is a float if either argument is a float infinity or NaN@.
One argument should represent a time difference rather than a point in time,
either as a list or as a single number of elapsed seconds.
as a time value that is often just a single number of elapsed seconds.
Here is how to add a number of seconds to a time value:
@example

19
doc/lispref/processes.texi
View file

@ -2158,19 +2158,17 @@ faults for all the child processes of the given process.
@item utime
Time spent by the process in the user context, for running the
application's code. The corresponding @var{value} is in the
@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format, the same
format used by functions @code{current-time} (@pxref{Time of Day,
current-time}) and @code{file-attributes} (@pxref{File Attributes}).
application's code. The corresponding @var{value} is a Lisp
timestamp (@pxref{Time of Day}).
@item stime
Time spent by the process in the system (kernel) context, for
processing system calls. The corresponding @var{value} is in the same
format as for @code{utime}.
processing system calls. The corresponding @var{value} is a Lisp
timestamp.
@item time
The sum of @code{utime} and @code{stime}. The corresponding
@var{value} is in the same format as for @code{utime}.
@var{value} is a Lisp timestamp.
@item cutime
@itemx cstime
@ -2189,13 +2187,10 @@ nice values get scheduled more favorably.)
The number of threads in the process.
@item start
The time when the process was started, in the same
@code{(@var{high} @var{low} @var{microsec} @var{picosec})} format used by
@code{file-attributes} and @code{current-time}.
The time when the process was started, as a Lisp timestamp.
@item etime
The time elapsed since the process started, in the format @code{(@var{high}
@var{low} @var{microsec} @var{picosec})}.
The time elapsed since the process started, as a Lisp timestamp.
@item vsize
The virtual memory size of the process, measured in kilobytes.

5
doc/lispref/text.texi
View file

@ -1327,9 +1327,8 @@ elements follow immediately after this element.
@item (t . @var{time-flag})
This kind of element indicates that an unmodified buffer became
modified. A @var{time-flag} of the form
@code{(@var{sec-high} @var{sec-low} @var{microsec}
@var{picosec})} represents the visited file's modification time as of
modified. A @var{time-flag} that is a non-integer Lisp timestamp
represents the visited file's modification time as of
when it was previously visited or saved, using the same format as
@code{current-time}; see @ref{Time of Day}.
A @var{time-flag} of 0 means the buffer does not correspond to any file;

69
doc/misc/emacs-mime.texi
View file

@ -1524,12 +1524,12 @@ many mailers don't support it. @xref{rfc2231}.
@section time-date
While not really a part of the @acronym{MIME} library, it is convenient to
document this library here. It deals with parsing @code{Date} headers
document time conversion functions often used when parsing @code{Date} headers
and manipulating time. (Not by using tesseracts, though, I'm sorry to
say.)
These functions convert between five formats: A date string, an Emacs
time structure, a decoded time list, a second number, and a day number.
These functions convert between five formats: A date string, a Lisp
timestamp, a decoded time list, a second number, and a day number.
Here's a bunch of time/date/second/day examples:
@ -1537,35 +1537,41 @@ Here's a bunch of time/date/second/day examples:
(parse-time-string "Sat Sep 12 12:21:54 1998 +0200")
@result{} (54 21 12 12 9 1998 6 -1 7200)
(date-to-time "Sat Sep 12 12:21:54 1998 +0200")
@result{} (13818 19266)
(encode-time (date-to-time "Sat Sep 12 12:21:54 1998 +0200")
1000000)
@result{} (905595714000000 . 1000000)
(parse-iso8601-time-string "1998-09-12T12:21:54+0200")
@result{} (13818 19266)
(encode-time (parse-iso8601-time-string "1998-09-12T12:21:54+0200")
1000000)
@result{} (905595714000000 . 1000000)
(float-time '(13818 19266))
(float-time '(905595714000000 . 1000000))
@result{} 905595714.0
(seconds-to-time 905595714.0)
@result{} (13818 19266 0 0)
(encode-time 905595714.0 1000000)
@result{} (905595714000000 . 1000000)
(time-to-days '(13818 19266))
(time-to-days '(905595714000000 . 1000000))
@result{} 729644
(days-to-time 729644)
@result{} (961933 512)
(encode-time (days-to-time 729644) 1000000)
@result{} (63041241600000000 . 1000000)
(time-since '(13818 19266))
@result{} (6797 9607 984839 247000)
(encode-time (time-since '(905595714000000 . 1000000))
1000000)
@result{} (631963244775642171 . 1000000000)
(time-less-p '(13818 19266) '(13818 19145))
(time-less-p '(905595714000000 . 1000000)
'(905595593000000000 . 1000000000))
@result{} nil
(time-equal-p '(13818 19266) '(13818 19145))
@result{} nil
(time-equal-p '(905595593000000000 . 1000000000)
'(905595593000000 . 1000000 ))
@result{} t
(time-subtract '(13818 19266) '(13818 19145))
@result{} (0 121)
(time-subtract '(905595714000000 . 1000000)
'(905595593000000000 . 1000000000))
@result{} (121000000000 . 1000000000)
(days-between "Sat Sep 12 12:21:54 1998 +0200"
"Sat Sep 07 12:21:54 1998 +0200")
@ -1574,13 +1580,13 @@ Here's a bunch of time/date/second/day examples:
(date-leap-year-p 2000)
@result{} t
(time-to-day-in-year '(13818 19266))
(time-to-day-in-year '(905595714000000 . 1000000))
@result{} 255
(time-to-number-of-days
(time-since
(date-to-time "Mon, 01 Jan 2001 02:22:26 GMT")))
@result{} 4314.095589286675
@result{} 6472.722661506652
@end example
And finally, we have @code{safe-date-to-time}, which does the same as
@ -1595,22 +1601,24 @@ An RFC822 (or similar) date string. For instance: @code{"Sat Sep 12
12:21:54 1998 +0200"}.
@item time
An internal Emacs time. For instance: @code{(13818 26466 0 0)}.
A Lisp timestamp.
For instance: @code{(905595714000000 . 1000000)}.
@item seconds
A floating point representation of the internal Emacs time. For
instance: @code{905595714.0}.
An integer or floating point count of seconds. For instance:
@code{905595714.0}, @code{905595714}.
@item days
An integer number representing the number of days since 00000101. For
instance: @code{729644}.
@item decoded time
A list of decoded time. For instance: @code{(54 21 12 12 9 1998 6 t
A list of decoded time. For instance: @code{(54 21 12 12 9 1998 6 nil
7200)}.
@end table
All the examples above represent the same moment.
All the examples above represent the same moment, except that
@var{days} represents the day containing the moment.
These are the functions available:
@ -1621,8 +1629,9 @@ Take a date and return a time.
@item float-time
Take a time and return seconds. (This is a built-in function.)
@item seconds-to-time
Take seconds and return a time.
@item encode-time
Take seconds (and other ways to represent time, notably decoded time
lists), and return a time.
@item time-to-days
Take a time and return days.
@ -1645,7 +1654,7 @@ Take two times and say whether the first time is less (i.e., earlier)
than the second time. (This is a built-in function.)
@item time-equal-p
Check, whether two time values are equal. The time values must not be
Check whether two time values are equal. The time values need not be
in the same format. (This is a built-in function.)
@item time-since

293
doc/misc/org.texi
View file

@ -325,7 +325,6 @@ Jambunathan K, Dan Davison, Thomas Dye, David O'Toole, and Philip Rooke.
* Working with source code:: Export, evaluate, and tangle code blocks
* Miscellaneous:: All the rest which did not fit elsewhere
* Hacking:: How to hack your way around
* MobileOrg:: Viewing and capture on a mobile device
* History and acknowledgments:: How Org came into being
* GNU Free Documentation License:: The license for this documentation.
* Main Index:: An index of Org's concepts and features
@ -760,12 +759,19 @@ Miscellaneous
* TTY keys:: Using Org on a tty
* Interaction:: With other Emacs packages
* org-crypt:: Encrypting Org files
* Org Mobile:: Viewing and capture on a mobile device
Interaction with other packages
* Cooperation:: Packages Org cooperates with
* Conflicts:: Packages that lead to conflicts
Org Mobile
* Setting up the staging area:: For the mobile device
* Pushing to the mobile application:: Uploading Org files and agendas
* Pulling from the mobile application:: Integrating captured and flagged items
Hacking
* Hooks:: How to reach into Org's internals
@ -788,12 +794,6 @@ Tables and lists in arbitrary syntax
* Translator functions:: Copy and modify
* Radio lists:: Sending and receiving lists
MobileOrg
* Setting up the staging area:: For the mobile device
* Pushing to MobileOrg:: Uploading Org files and agendas
* Pulling from MobileOrg:: Integrating captured and flagged items
@end detailmenu
@end menu
@ -17251,6 +17251,7 @@ emacs -Q --batch --eval "
* TTY keys:: Using Org on a tty
* Interaction:: With other Emacs packages
* org-crypt:: Encrypting Org files
* Org Mobile:: Viewing and capture on a mobile device
@end menu
@ -18185,6 +18186,150 @@ Suggested Org crypt settings in Emacs init file:
Excluding the crypt tag from inheritance prevents encrypting previously
encrypted text.
@node Org Mobile
@section Org Mobile
@cindex smartphone
Org Mobile is a protocol for synchronizing Org files between Emacs and
other applications, e.g., on mobile devices. It enables offline-views
and capture support for an Org mode system that is rooted on a ``real''
computer. The external application can also record changes to
existing entries.
This appendix describes Org's support for agenda view formats
compatible with Org Mobile. It also describes synchronizing changes,
such as to notes, between the mobile application and the computer.
To change tags and TODO states in the mobile application, first
customize the variables @code{org-todo-keywords} and @code{org-tag-alist}.
These should cover all the important tags and TODO keywords, even if
Org files use only some of them. Though the mobile application is
expected to support in-buffer settings, it is required to understand
TODO states @emph{sets} (see @ref{Per-file keywords}) and
@emph{mutually exclusive} tags (see @ref{Setting tags}) only for those set in
these variables.
@menu
* Setting up the staging area:: For the mobile device
* Pushing to the mobile application:: Uploading Org files and agendas
* Pulling from the mobile application:: Integrating captured and flagged items
@end menu
@node Setting up the staging area
@subsection Setting up the staging area
@vindex org-mobile-directory
The mobile application needs access to a file directory on
a server@footnote{For a server to host files, consider using a WebDAV server,
such as @uref{https://nextcloud.com, Nextcloud}. Additional help is at this @uref{https://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.} to interact with Emacs. Pass its location through
the @code{org-mobile-directory} variable. If you can mount that directory
locally just set the variable to point to that directory:
@lisp
(setq org-mobile-directory "~/orgmobile/")
@end lisp
@noindent
Alternatively, by using TRAMP (see @ref{Top,TRAMP User Manual,,tramp,}),
@code{org-mobile-directory} may point to a remote directory accessible
through, for example, SSH and SCP:
@lisp
(setq org-mobile-directory "/scpc:user@@remote.host:org/webdav/")
@end lisp
@vindex org-mobile-encryption
With a public server, consider encrypting the files. Org also
requires OpenSSL installed on the local computer. To turn on
encryption, set the same password in the mobile application and in
Emacs. Set the password in the variable
@code{org-mobile-use-encryption}@footnote{If Emacs is configured for safe storing of passwords, then
configure the variable @code{org-mobile-encryption-password}; please read
the docstring of that variable.}. Note that even after the mobile
application encrypts the file contents, the file name remains visible
on the file systems of the local computer, the server, and the mobile
device.
@node Pushing to the mobile application
@subsection Pushing to the mobile application
@findex org-mobile-push
@vindex org-mobile-files
The command @code{org-mobile-push} copies files listed in
@code{org-mobile-files} into the staging area. Files include agenda files
(as listed in @code{org-agenda-files}). Customize @code{org-mobile-files} to
add other files. File names are staged with paths relative to
@code{org-directory}, so all files should be inside this directory@footnote{Symbolic links in @code{org-directory} need to have the same name
as their targets.}.
Push creates a special Org file @samp{agendas.org} with custom agenda views
defined by the user@footnote{While creating the agendas, Org mode forces ID properties on
all referenced entries, so that these entries can be uniquely
identified if Org Mobile flags them for further action. To avoid
setting properties configure the variable
@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode then relies
on outline paths, assuming they are unique.}.
Finally, Org writes the file @samp{index.org}, containing links to other
files. The mobile application reads this file first from the server
to determine what other files to download for agendas. For faster
downloads, it is expected to only read files whose checksums@footnote{Checksums are stored automatically in the file
@samp{checksums.dat}.}
have changed.
@node Pulling from the mobile application
@subsection Pulling from the mobile application
@findex org-mobile-pull
The command @code{org-mobile-pull} synchronizes changes with the server.
More specifically, it first pulls the Org files for viewing. It then
appends captured entries and pointers to flagged or changed entries to
the file @samp{mobileorg.org} on the server. Org ultimately integrates its
data in an inbox file format, through the following steps:
@enumerate
@item
@vindex org-mobile-inbox-for-pull
Org moves all entries found in @samp{mobileorg.org}@footnote{The file will be empty after this operation.} and appends
them to the file pointed to by the variable
@code{org-mobile-inbox-for-pull}. It should reside neither in the
staging area nor on the server. Each captured entry and each
editing event is a top-level entry in the inbox file.
@item
@cindex @samp{FLAGGED}, tag
After moving the entries, Org processes changes to the shared
files. Some of them are applied directly and without user
interaction. Examples include changes to tags, TODO state,
headline and body text. Entries requiring further action are
tagged as @samp{FLAGGED}. Org marks entries with problems with an error
message in the inbox. They have to be resolved manually.
@item
Org generates an agenda view for flagged entries for user
intervention to clean up. For notes stored in flagged entries, Org
displays them in the echo area when point is on the corresponding
agenda item.
@table @asis
@item @kbd{?}
Pressing @kbd{?} displays the entire flagged note in
another window. Org also pushes it to the kill ring. To
store flagged note as a normal note, use @kbd{? z C-y C-c C-c}. Pressing @kbd{?} twice does these things: first
it removes the @samp{FLAGGED} tag; second, it removes the flagged
note from the property drawer; third, it signals that manual
editing of the flagged entry is now finished.
@end table
@end enumerate
@kindex ? @r{(Agenda dispatcher)}
From the agenda dispatcher, @kbd{?} returns to the view to finish
processing flagged entries. Note that these entries may not be the
most recent since the mobile application searches files that were last
pulled. To get an updated agenda view with changes since the last
pull, pull again.
@node Hacking
@appendix Hacking
@cindex hacking
@ -19149,140 +19294,6 @@ The following example counts the number of entries with TODO keyword
(length (org-map-entries t "/+WAITING" 'agenda))
@end lisp
@node MobileOrg
@appendix MobileOrg
@cindex iPhone
@cindex MobileOrg
MobileOrg is a companion mobile app that runs on iOS and Android devices.
MobileOrg enables offline-views and capture support for an Org mode system
that is rooted on a ``real'' computer. MobileOrg can record changes to
existing entries.
The @uref{https://github.com/MobileOrg/, iOS implementation} for the
@emph{iPhone/iPod Touch/iPad} series of devices, was started by Richard
Moreland and is now in the hands Sean Escriva. Android users should check
out @uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg
Android} by Matt Jones. Though the two implementations are not identical,
they offer similar features.
This appendix describes Org's support for agenda view formats compatible with
MobileOrg. It also describes synchronizing changes, such as to notes,
between MobileOrg and the computer.
To change tags and TODO states in MobileOrg, first customize the variables
@code{org-todo-keywords} and @code{org-tag-alist}. These should cover all
the important tags and TODO keywords, even if Org files use only some of
them. Though MobileOrg has in-buffer settings, it understands TODO states
@emph{sets} (@pxref{Per-file keywords}) and @emph{mutually exclusive} tags
(@pxref{Setting tags}) only for those set in these variables.
@menu
* Setting up the staging area:: For the mobile device
* Pushing to MobileOrg:: Uploading Org files and agendas
* Pulling from MobileOrg:: Integrating captured and flagged items
@end menu
@node Setting up the staging area
@section Setting up the staging area
MobileOrg needs access to a file directory on a server to interact with
Emacs. With a public server, consider encrypting the files. MobileOrg
version 1.5 supports encryption for the iPhone. Org also requires
@file{openssl} installed on the local computer. To turn on encryption, set
the same password in MobileOrg and in Emacs. Set the password in the
variable @code{org-mobile-use-encryption}@footnote{If Emacs is configured for
safe storing of passwords, then configure the variable,
@code{org-mobile-encryption-password}; please read the docstring of that
variable.}. Note that even after MobileOrg encrypts the file contents, the
file names will remain visible on the file systems of the local computer, the
server, and the mobile device.
For a server to host files, consider options like
@uref{http://dropbox.com,Dropbox.com} account@footnote{An alternative is to
use webdav server. MobileOrg documentation has details of webdav server
configuration. Additional help is at
@uref{https://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.}.
On first connection, MobileOrg creates a directory @file{MobileOrg/} on
Dropbox. Pass its location to Emacs through an init file variable as
follows:
@lisp
(setq org-mobile-directory "~/Dropbox/MobileOrg")
@end lisp
Org copies files to the above directory for MobileOrg. Org also uses the
same directory for sharing notes between Org and MobileOrg.
@node Pushing to MobileOrg
@section Pushing to MobileOrg
Org pushes files listed in @code{org-mobile-files} to
@code{org-mobile-directory}. Files include agenda files (as listed in
@code{org-agenda-files}). Customize @code{org-mobile-files} to add other
files. File names will be staged with paths relative to
@code{org-directory}, so all files should be inside this
directory@footnote{Symbolic links in @code{org-directory} should have the
same name as their targets.}.
Push creates a special Org file @file{agendas.org} with custom agenda views
defined by the user@footnote{While creating the agendas, Org mode will force
ID properties on all referenced entries, so that these entries can be
uniquely identified if MobileOrg flags them for further action. To avoid
setting properties configure the variable
@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode will then
rely on outline paths, assuming they are unique.}.
Org writes the file @file{index.org}, containing links to other files.
MobileOrg reads this file first from the server to determine what other files
to download for agendas. For faster downloads, MobileOrg will read only
those files whose checksums@footnote{Checksums are stored automatically in
the file @file{checksums.dat}.} have changed.
@node Pulling from MobileOrg
@section Pulling from MobileOrg
When MobileOrg synchronizes with the server, it pulls the Org files for
viewing. It then appends to the file @file{mobileorg.org} on the server the
captured entries, pointers to flagged and changed entries. Org integrates
its data in an inbox file format.
@enumerate
@item
Org moves all entries found in
@file{mobileorg.org}@footnote{@file{mobileorg.org} will be empty after this
operation.} and appends them to the file pointed to by the variable
@code{org-mobile-inbox-for-pull}. Each captured entry and each editing event
is a top-level entry in the inbox file.
@item
After moving the entries, Org attempts changes to MobileOrg. Some changes
are applied directly and without user interaction. Examples include changes
to tags, TODO state, headline and body text. Entries for further action are
tagged as @code{:FLAGGED:}. Org marks entries with problems with an error
message in the inbox. They have to be resolved manually.
@item
Org generates an agenda view for flagged entries for user intervention to
clean up. For notes stored in flagged entries, MobileOrg displays them in
the echo area when the cursor is on the corresponding agenda item.
@table @kbd
@kindex ?
@item ?
Pressing @kbd{?} displays the entire flagged note in another window. Org
also pushes it to the kill ring. To store flagged note as a normal note, use
@kbd{? z C-y C-c C-c}. Pressing @kbd{?} twice does these things: first it
removes the @code{:FLAGGED:} tag; second, it removes the flagged note from
the property drawer; third, it signals that manual editing of the flagged
entry is now finished.
@end table
@end enumerate
@kindex C-c a ?
@kbd{C-c a ?} returns to the agenda view to finish processing flagged
entries. Note that these entries may not be the most recent since MobileOrg
searches files that were last pulled. To get an updated agenda view with
changes since the last pull, pull again.
@node History and acknowledgments
@appendix History and acknowledgments
@cindex acknowledgments

3
doc/misc/texinfo.tex
View file

@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
\def\texinfoversion{2018-06-02.09}
\def\texinfoversion{2018-09-21.20}
%
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@ -8004,6 +8004,7 @@
\gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
\gdef\magicamp{\let&=\amprm}
}
\let\ampchar\&
\newcount\parencount

40
doc/misc/tramp.texi
View file

@ -12,16 +12,6 @@
@c This is *so* much nicer :)
@footnotestyle end
@c Macro for formatting a file name according to the respective
@c syntax. Macro arguments should not have any leading or trailing
@c whitespace. Not very elegant, but I don't know it better.
@macro trampfn {method, userhost, localname}
@value{prefix}@c
\method\@value{postfixhop}@c
\userhost\@value{postfix}\localname\
@end macro
@copying
Copyright @copyright{} 1999--2018 Free Software Foundation, Inc.
@ -83,9 +73,9 @@ Savannah Project Page}.
@end ifhtml
There is a mailing list for @value{tramp}, available at
@email{tramp-devel@@gnu.org}, and archived at
@uref{https://lists.gnu.org/r/tramp-devel/, the
@value{tramp} Mail Archive}.
@email{@value{tramp-bug-report-address}}, and archived at
@uref{https://lists.gnu.org/r/tramp-devel/, the @value{tramp} Mail
Archive}.
@page
@insertcopying
@ -122,8 +112,11 @@ For the developer:
--- The Detailed Node Listing ---
@c
@ifset installchapter
Installing @value{tramp} with your Emacs
* System Requirements:: Prerequisites for :@value{tramp} installation.
* Basic Installation:: Installation steps.:
* Installation parameters:: Parameters in order to control installation.
* Testing:: A test suite for @value{tramp}.
* Load paths:: How to plug-in @value{tramp} into your environment.
@ -1646,7 +1639,7 @@ the need.
The package @file{auth-source.el}, originally developed for No Gnus,
reads passwords from different sources, @xref{Help for users, ,
auth-source, auth}. The default authentication file is
@file{~/.authinfo.gpg}, but this can be changed via the variable
@file{~/.authinfo.gpg}, but this can be changed via the user option
@code{auth-sources}.
@noindent
@ -1670,7 +1663,7 @@ If there doesn't exist a proper entry, the password is read
interactively. After successful login (verification of the password),
it is offered to save a corresponding entry for further use by
@code{auth-source} backends which support this. This could be changed
by setting the variable @code{auth-source-save-behavior} to @code{nil}.
by setting the user option @code{auth-source-save-behavior} to @code{nil}.
@vindex auth-source-debug
Set @code{auth-source-debug} to @code{t} to debug messages.
@ -2031,10 +2024,10 @@ shell-specific config files. For example, bash can use
parsing. This redefinition affects the looks of a prompt in an
interactive remote shell through commands, such as @kbd{M-x shell
@key{RET}}. Such prompts, however, can be reset to something more
readable and recognizable using these @value{tramp} variables.
readable and recognizable using these environment variables.
@value{tramp} sets the @env{INSIDE_EMACS} variable in the startup
script file @file{~/.emacs_SHELLNAME}.
@value{tramp} sets the @env{INSIDE_EMACS} environment variable in the
startup script file @file{~/.emacs_SHELLNAME}.
@env{SHELLNAME} is @code{bash} or equivalent shell names. Change it by
setting the environment variable @env{ESHELL} in the @file{.emacs} as
@ -3254,9 +3247,9 @@ discussing, and general discussions about @value{tramp}.
post for moderator approval. Sometimes this approval step may take as
long as 48 hours due to public holidays.
@email{tramp-devel@@gnu.org} is the mailing list. Messages sent to
this address go to all the subscribers. This is @emph{not} the
address to send subscription requests to.
@email{@value{tramp-bug-report-address}} is the mailing list.
Messages sent to this address go to all the subscribers. This is
@emph{not} the address to send subscription requests to.
To subscribe to the mailing list, visit:
@uref{https://lists.gnu.org/mailman/listinfo/tramp-devel/, the
@ -3671,7 +3664,7 @@ Due to the remote shell saving tilde expansions triggered by
@value{tramp} can suppress this behavior with the user option
@code{tramp-histfile-override}. When set to @code{t}, environment
variable @env{HISTFILE} is unset, and environment variables
@env{HISTFILESIZE} @env{HISTSIZE} are set to 0.
@env{HISTFILESIZE} and @env{HISTSIZE} are set to 0.
Alternatively, @code{tramp-histfile-override} could be a string.
Environment variable @env{HISTFILE} is set to this file name then. Be
@ -4107,7 +4100,7 @@ Unloading @value{tramp} resets Ange FTP plugins also.
@c For the developer
@node Files directories and localnames
@chapter How file names, directories and localnames are mangled and managed.
@chapter How file names, directories and localnames are mangled and managed
@menu
* Localname deconstruction:: Splitting a localname into its component parts.
@ -4133,6 +4126,7 @@ handlers.
@section Integrating with external Lisp packages
@subsection File name completion.
@vindex non-essential
Sometimes, it is not convenient to open a new connection to a remote
host, including entering the password and alike. For example, this is
nasty for packages providing file name completion. Such a package

22
doc/misc/trampver.texi
View file

@ -5,12 +5,12 @@
@c Copyright (C) 2003-2018 Free Software Foundation, Inc.
@c See file doclicense.texi for copying conditions.
@c In the Tramp GIT, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
@c In the Tramp GIT, the version number is auto-frobbed from tramp.el,
@c and the bug report address is auto-frobbed from configure.ac.
@set trampver 2.4.1-pre
@set tramp-bug-report-address tramp-devel@@gnu.org
@c Other flags from configuration
@c Other flags from configuration.
@set instprefix /usr/local
@set lispdir /usr/local/share/emacs/site-lisp
@set infodir /usr/local/share/info
@ -44,3 +44,17 @@
@set ipv6prefix
@set ipv6postfix
@end ifset
@c Macro for formatting a file name according to the respective
@c syntax. trampver.texi is included several times in tramp.texi and
@c trampinst.texi. Redefining the macro is reported as warning for
@c creating the dvi and pdf files, so we declare the macro only the
@c first time this file is included.
@ifclear trampfndefined
@set trampfndefined
@macro trampfn {method, userhost, localname}
@value{prefix}@c
\method\@value{postfixhop}@c
\userhost\@value{postfix}\localname\
@end macro
@end ifclear

57
etc/NEWS
View file

@ -220,6 +220,12 @@ This triggers to search the program on the remote host as indicated by
When set to t, no message will be shown when auto-saving (default
value: nil).
---
** The value of 'make-cursor-line-fully-visible' can now be a function.
In addition to nil or non-nil, the value can now be a predicate
function. Follow mode uses this to control scrolling of its windows
when the last screen line in a window is not fully visible.
* Editing Changes in Emacs 27.1
@ -252,10 +258,9 @@ case does not match.
for abbrevs that have them.
+++
** 'insert-abbrev-table-description' skips empty tables.
'insert-abbrev-table-description' skips inserting empty tables when
inserting non-readable tables. By extension, this makes
'write-abbrev-file' skip writing empty tables.
** 'write-abbrev-file' skips empty tables.
'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for
tables which do not have any non-system abbrevs to save.
+++
** The new functions and commands 'text-property-search-forward' and
@ -329,6 +334,12 @@ file.
This new variable allows customizing the default arguments passed to
git-grep when 'vc-git-grep' is used.
*** Command 'vc-git-stash' now respects marks in the '*vc-dir*' buffer.
When some files are marked, only those are stashed.
When no files are marked, all modified files are stashed, as before.
*** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag.
** diff-mode
*** Hunks are now automatically refined by default.
To disable it, set the new defcustom 'diff-font-lock-refine' to nil.
@ -365,6 +376,29 @@ better emulate 'M-.' in both Bash and zsh, since the former counts
from the beginning of the arguments, while the latter counts from the
end.
** SQL
*** Installation of 'sql-indent' from ELPA is strongly encouraged.
This package support sophisticated rules for properly indenting SQL
statements. SQL is not like other programming languages like C, Java,
or Python where code is sparse and rules for formatting are fairly
well established. Instead SQL is more like COBOL (from which it came)
and code tends to be very dense and line ending decisions driven by
syntax and line length considerations to make readable code.
Experienced SQL developers may prefer to rely upon existing Emacs
facilities for formatting code but the 'sql-indent' package provides
facilities to aid more casual SQL developers layout queries and
complex expressions.
*** 'sql-use-indent-support' (default t) enables SQL indention support.
The `sql-indent' package from ELPA must be installed to get the
indentation support in 'sql-mode' and 'sql-interactive-mode'.
*** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed.
Both hook variables have had 'sql-indent-enable' added to their
default values. If youhave existing customizations to these variables,
you should make sure that the new default entry is included.
** Term
---
@ -975,6 +1009,21 @@ like file-attributes that compute file sizes and other attributes,
functions like process-id that compute process IDs, and functions like
user-uid and group-gid that compute user and group IDs.
+++
** Although the default timestamp format is still (HI LO US PS),
it is planned to change in a future Emacs version, to exploit bignums.
The documentation has been updated to mention that the timestamp
format may change and that programs should use functions like
format-time-string, decode-time, and encode-time rather than probing
the innards of a timestamp directly, or creating a timestamp by hand.
+++
** encode-time supports a new API (encode-time TIME &optional FORM).
This can convert decoded times and Lisp time values to Lisp timestamps
of various forms, including a new timestamp form (TICKS . HZ), where
TICKS is an integer and HZ is a positive integer denoting a clock
frequency. The old encode-time API is still supported.
+++
** 'time-add', 'time-subtract', and 'time-less-p' now accept
infinities and NaNs too, and propagate them or return nil like

10
etc/NEWS.26
View file

@ -110,6 +110,16 @@ be removed prior using the changed 'shadow-*' commands.
The old name is an alias of the new name. Future Emacs version will
obsolete it.
---
** 'while-no-input' does not return due to input from subprocesses.
Input that arrived from subprocesses while some code executed inside
the 'while-no-input' form injected an internal buffer-switch event
that counted as input and would cause 'while-no-input' to return,
perhaps prematurely. These buffer-switch events are now by default
ignored by 'while-no-input'; if you need to get the old behavior,
remove 'buffer-switch' from the list of events in
'while-no-input-ignore-events'.
* Lisp Changes in Emacs 26.2

12
lib/acl-internal.c
View file

@ -23,7 +23,7 @@
#include "acl-internal.h"
#if USE_ACL && HAVE_ACL_GET_FILE
#if USE_ACL && HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
# if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */
@ -37,7 +37,7 @@ acl_extended_nontrivial (acl_t acl)
return (acl_entries (acl) > 0);
}
# else /* Linux, FreeBSD, IRIX, Tru64 */
# else /* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
/* ACL is an ACL, from a file, stored as type ACL_TYPE_ACCESS.
Return 1 if the given ACL is non-trivial.
@ -51,7 +51,7 @@ acl_access_nontrivial (acl_t acl)
at least, allowing us to write
return (3 < acl_entries (acl));
but the following code is more robust. */
# if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD */
# if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Cygwin >= 2.5 */
acl_entry_t ace;
int got_one;
@ -124,7 +124,7 @@ acl_default_nontrivial (acl_t acl)
# endif
#elif USE_ACL && HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */
#elif USE_ACL && HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */
/* Test an ACL retrieved with GETACL.
Return 1 if the given ACL, consisting of COUNT entries, is non-trivial.
@ -479,7 +479,7 @@ void
free_permission_context (struct permission_context *ctx)
{
#if USE_ACL
# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */
# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
if (ctx->acl)
acl_free (ctx->acl);
# if !HAVE_ACL_TYPE_EXTENDED
@ -487,7 +487,7 @@ free_permission_context (struct permission_context *ctx)
acl_free (ctx->default_acl);
# endif
# elif defined GETACL /* Solaris, Cygwin */
# elif defined GETACL /* Solaris, Cygwin < 2.5 */
free (ctx->entries);
# ifdef ACE_GETACL
free (ctx->ace_entries);

16
lib/acl-internal.h
View file

@ -30,7 +30,8 @@
# define GETACLCNT ACL_CNT
#endif
/* On Linux, additional ACL related API is available in <acl/libacl.h>. */
/* On Linux and Cygwin >= 2.5, additional ACL related API is available in
<acl/libacl.h>. */
#ifdef HAVE_ACL_LIBACL_H
# include <acl/libacl.h>
#endif
@ -72,7 +73,7 @@ _GL_INLINE_HEADER_BEGIN
# if HAVE_ACL_GET_FILE
/* POSIX 1003.1e (draft 17 -- abandoned) specific version. */
/* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */
/* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
# ifndef MIN_ACL_ENTRIES
# define MIN_ACL_ENTRIES 4
@ -122,7 +123,10 @@ rpl_acl_set_fd (int fd, acl_t acl)
# endif
/* Linux-specific */
# ifndef HAVE_ACL_EXTENDED_FILE
/* Cygwin >= 2.5 implements this function, but it returns 1 for all
directories, thus is unusable. */
# if !defined HAVE_ACL_EXTENDED_FILE || defined __CYGWIN__
# undef HAVE_ACL_EXTENDED_FILE
# define HAVE_ACL_EXTENDED_FILE false
# define acl_extended_file(name) (-1)
# endif
@ -163,7 +167,7 @@ extern int acl_access_nontrivial (acl_t);
extern int acl_default_nontrivial (acl_t);
# endif
# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */
# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */
/* Set to 0 if a file's mode is stored independently from the ACL. */
# if defined __CYGWIN__ /* Cygwin */
@ -256,14 +260,14 @@ extern int acl_nontrivial (int count, struct acl *entries);
struct permission_context {
mode_t mode;
#if USE_ACL
# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */
# if HAVE_ACL_GET_FILE /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
acl_t acl;
# if !HAVE_ACL_TYPE_EXTENDED
acl_t default_acl;
# endif
bool acls_not_supported;
# elif defined GETACL /* Solaris, Cygwin */
# elif defined GETACL /* Solaris, Cygwin < 2.5 */
int count;
aclent_t *entries;
# ifdef ACE_GETACL

6
lib/acl_entries.c
View file

@ -22,7 +22,7 @@
#include "acl-internal.h"
/* This file assumes POSIX-draft like ACLs
(Linux, FreeBSD, Mac OS X, IRIX, Tru64). */
(Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5). */
/* Return the number of entries in ACL.
Return -1 and set errno upon failure to determine it. */
@ -34,7 +34,7 @@ acl_entries (acl_t acl)
if (acl != NULL)
{
#if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Mac OS X */
#if HAVE_ACL_FIRST_ENTRY /* Linux, FreeBSD, Mac OS X, Cygwin >= 2.5 */
# if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */
/* acl_get_entry returns 0 when it successfully fetches an entry,
and -1/EINVAL at the end. */
@ -45,7 +45,7 @@ acl_entries (acl_t acl)
got_one >= 0;
got_one = acl_get_entry (acl, ACL_NEXT_ENTRY, &ace))
count++;
# else /* Linux, FreeBSD */
# else /* Linux, FreeBSD, Cygwin >= 2.5 */
/* acl_get_entry returns 1 when it successfully fetches an entry,
and 0 at the end. */
acl_entry_t ace;

4
lib/explicit_bzero.c
View file

@ -27,9 +27,11 @@
#include <string.h>
#if _LIBC
/* glibc-internal users use __explicit_bzero_chk, and explicit_bzero
redirects to that. */
#undef explicit_bzero
# undef explicit_bzero
#endif
/* Set LEN bytes of S to 0. The compiler will not delete a call to
this function, even if S is dead after the call. */

380
lib/fcntl.c
View file

@ -27,10 +27,10 @@
#include <stdarg.h>
#include <unistd.h>
#if !HAVE_FCNTL
# define rpl_fcntl fcntl
#ifdef __KLIBC__
# define INCL_DOS
# include <os2.h>
#endif
#undef fcntl
#if defined _WIN32 && ! defined __CYGWIN__
/* Get declarations of the native Windows API functions. */
@ -166,93 +166,18 @@ dupfd (int oldfd, int newfd, int flags)
}
#endif /* W32 */
/* Forward declarations, because we '#undef fcntl' in the middle of this
compilation unit. */
/* Our implementation of fcntl (fd, F_DUPFD, target). */
static int rpl_fcntl_DUPFD (int fd, int target);
/* Our implementation of fcntl (fd, F_DUPFD_CLOEXEC, target). */
static int rpl_fcntl_DUPFD_CLOEXEC (int fd, int target);
#ifdef __KLIBC__
# define INCL_DOS
# include <os2.h>
static int
klibc_fcntl (int fd, int action, /* arg */...)
{
va_list arg_ptr;
int arg;
struct stat sbuf;
int result = -1;
va_start (arg_ptr, action);
arg = va_arg (arg_ptr, int);
result = fcntl (fd, action, arg);
/* EPERM for F_DUPFD, ENOTSUP for others */
if (result == -1 && (errno == EPERM || errno == ENOTSUP)
&& !fstat (fd, &sbuf) && S_ISDIR (sbuf.st_mode))
{
ULONG ulMode;
switch (action)
{
case F_DUPFD:
/* Find available fd */
while (fcntl (arg, F_GETFL) != -1 || errno != EBADF)
arg++;
result = dup2 (fd, arg);
break;
/* Using underlying APIs is right ? */
case F_GETFD:
if (DosQueryFHState (fd, &ulMode))
break;
result = (ulMode & OPEN_FLAGS_NOINHERIT) ? FD_CLOEXEC : 0;
break;
case F_SETFD:
if (arg & ~FD_CLOEXEC)
break;
if (DosQueryFHState (fd, &ulMode))
break;
if (arg & FD_CLOEXEC)
ulMode |= OPEN_FLAGS_NOINHERIT;
else
ulMode &= ~OPEN_FLAGS_NOINHERIT;
/* Filter supported flags. */
ulMode &= (OPEN_FLAGS_WRITE_THROUGH | OPEN_FLAGS_FAIL_ON_ERROR
| OPEN_FLAGS_NO_CACHE | OPEN_FLAGS_NOINHERIT);
if (DosSetFHState (fd, ulMode))
break;
result = 0;
break;
case F_GETFL:
result = 0;
break;
case F_SETFL:
if (arg != 0)
break;
result = 0;
break;
default :
errno = EINVAL;
break;
}
}
va_end (arg_ptr);
return result;
}
# define fcntl klibc_fcntl
/* Adds support for fcntl on directories. */
static int klibc_fcntl (int fd, int action, /* arg */...);
#endif
/* Perform the specified ACTION on the file descriptor FD, possibly
using the argument ARG further described below. This replacement
handles the following actions, and forwards all others on to the
@ -273,112 +198,30 @@ klibc_fcntl (int fd, int action, /* arg */...)
return -1 and set errno. */
int
rpl_fcntl (int fd, int action, /* arg */...)
fcntl (int fd, int action, /* arg */...)
#undef fcntl
#ifdef __KLIBC__
# define fcntl klibc_fcntl
#endif
{
va_list arg;
int result = -1;
va_start (arg, action);
switch (action)
{
#if !HAVE_FCNTL
case F_DUPFD:
{
int target = va_arg (arg, int);
result = dupfd (fd, target, 0);
result = rpl_fcntl_DUPFD (fd, target);
break;
}
#elif FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR
case F_DUPFD:
{
int target = va_arg (arg, int);
/* Detect invalid target; needed for cygwin 1.5.x. */
if (target < 0 || getdtablesize () <= target)
errno = EINVAL;
else
{
/* Haiku alpha 2 loses fd flags on original. */
int flags = fcntl (fd, F_GETFD);
if (flags < 0)
{
result = -1;
break;
}
result = fcntl (fd, action, target);
if (0 <= result && fcntl (fd, F_SETFD, flags) == -1)
{
int saved_errno = errno;
close (result);
result = -1;
errno = saved_errno;
}
# if REPLACE_FCHDIR
if (0 <= result)
result = _gl_register_dup (fd, result);
# endif
}
break;
} /* F_DUPFD */
#endif /* FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR */
case F_DUPFD_CLOEXEC:
{
int target = va_arg (arg, int);
#if !HAVE_FCNTL
result = dupfd (fd, target, O_CLOEXEC);
result = rpl_fcntl_DUPFD_CLOEXEC (fd, target);
break;
#else /* HAVE_FCNTL */
# if defined __HAIKU__
/* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets
the FD_CLOEXEC flag on fd, not on target. Therefore avoid the
system fcntl in this case. */
# define have_dupfd_cloexec -1
# else
/* Try the system call first, if the headers claim it exists
(that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we
may be running with a glibc that has the macro but with an
older kernel that does not support it. Cache the
information on whether the system call really works, but
avoid caching failure if the corresponding F_DUPFD fails
for any reason. 0 = unknown, 1 = yes, -1 = no. */
static int have_dupfd_cloexec = GNULIB_defined_F_DUPFD_CLOEXEC ? -1 : 0;
if (0 <= have_dupfd_cloexec)
{
result = fcntl (fd, action, target);
if (0 <= result || errno != EINVAL)
{
have_dupfd_cloexec = 1;
# if REPLACE_FCHDIR
if (0 <= result)
result = _gl_register_dup (fd, result);
# endif
}
else
{
result = rpl_fcntl (fd, F_DUPFD, target);
if (result < 0)
break;
have_dupfd_cloexec = -1;
}
}
else
# endif
result = rpl_fcntl (fd, F_DUPFD, target);
if (0 <= result && have_dupfd_cloexec == -1)
{
int flags = fcntl (result, F_GETFD);
if (flags < 0 || fcntl (result, F_SETFD, flags | FD_CLOEXEC) == -1)
{
int saved_errno = errno;
close (result);
errno = saved_errno;
result = -1;
}
}
break;
#endif /* HAVE_FCNTL */
} /* F_DUPFD_CLOEXEC */
}
#if !HAVE_FCNTL
case F_GETFD:
@ -598,3 +441,186 @@ rpl_fcntl (int fd, int action, /* arg */...)
va_end (arg);
return result;
}
static int
rpl_fcntl_DUPFD (int fd, int target)
{
int result;
#if !HAVE_FCNTL
result = dupfd (fd, target, 0);
#elif FCNTL_DUPFD_BUGGY || REPLACE_FCHDIR
/* Detect invalid target; needed for cygwin 1.5.x. */
if (target < 0 || getdtablesize () <= target)
{
result = -1;
errno = EINVAL;
}
else
{
/* Haiku alpha 2 loses fd flags on original. */
int flags = fcntl (fd, F_GETFD);
if (flags < 0)
result = -1;
else
{
result = fcntl (fd, F_DUPFD, target);
if (0 <= result && fcntl (fd, F_SETFD, flags) == -1)
{
int saved_errno = errno;
close (result);
result = -1;
errno = saved_errno;
}
# if REPLACE_FCHDIR
if (0 <= result)
result = _gl_register_dup (fd, result);
# endif
}
}
#else
result = fcntl (fd, F_DUPFD, target);
#endif
return result;
}
static int
rpl_fcntl_DUPFD_CLOEXEC (int fd, int target)
{
int result;
#if !HAVE_FCNTL
result = dupfd (fd, target, O_CLOEXEC);
#else /* HAVE_FCNTL */
# if defined __HAIKU__
/* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets
the FD_CLOEXEC flag on fd, not on target. Therefore avoid the
system fcntl in this case. */
# define have_dupfd_cloexec -1
# else
/* Try the system call first, if the headers claim it exists
(that is, if GNULIB_defined_F_DUPFD_CLOEXEC is 0), since we
may be running with a glibc that has the macro but with an
older kernel that does not support it. Cache the
information on whether the system call really works, but
avoid caching failure if the corresponding F_DUPFD fails
for any reason. 0 = unknown, 1 = yes, -1 = no. */
static int have_dupfd_cloexec = GNULIB_defined_F_DUPFD_CLOEXEC ? -1 : 0;
if (0 <= have_dupfd_cloexec)
{
result = fcntl (fd, F_DUPFD_CLOEXEC, target);
if (0 <= result || errno != EINVAL)
{
have_dupfd_cloexec = 1;
# if REPLACE_FCHDIR
if (0 <= result)
result = _gl_register_dup (fd, result);
# endif
}
else
{
result = rpl_fcntl_DUPFD (fd, target);
if (result >= 0)
have_dupfd_cloexec = -1;
}
}
else
# endif
result = rpl_fcntl_DUPFD (fd, target);
if (0 <= result && have_dupfd_cloexec == -1)
{
int flags = fcntl (result, F_GETFD);
if (flags < 0 || fcntl (result, F_SETFD, flags | FD_CLOEXEC) == -1)
{
int saved_errno = errno;
close (result);
errno = saved_errno;
result = -1;
}
}
#endif /* HAVE_FCNTL */
return result;
}
#undef fcntl
#ifdef __KLIBC__
static int
klibc_fcntl (int fd, int action, /* arg */...);
{
va_list arg_ptr;
int arg;
struct stat sbuf;
int result;
va_start (arg_ptr, action);
arg = va_arg (arg_ptr, int);
result = fcntl (fd, action, arg);
/* EPERM for F_DUPFD, ENOTSUP for others */
if (result == -1 && (errno == EPERM || errno == ENOTSUP)
&& !fstat (fd, &sbuf) && S_ISDIR (sbuf.st_mode))
{
ULONG ulMode;
switch (action)
{
case F_DUPFD:
/* Find available fd */
while (fcntl (arg, F_GETFL) != -1 || errno != EBADF)
arg++;
result = dup2 (fd, arg);
break;
/* Using underlying APIs is right ? */
case F_GETFD:
if (DosQueryFHState (fd, &ulMode))
break;
result = (ulMode & OPEN_FLAGS_NOINHERIT) ? FD_CLOEXEC : 0;
break;
case F_SETFD:
if (arg & ~FD_CLOEXEC)
break;
if (DosQueryFHState (fd, &ulMode))
break;
if (arg & FD_CLOEXEC)
ulMode |= OPEN_FLAGS_NOINHERIT;
else
ulMode &= ~OPEN_FLAGS_NOINHERIT;
/* Filter supported flags. */
ulMode &= (OPEN_FLAGS_WRITE_THROUGH | OPEN_FLAGS_FAIL_ON_ERROR
| OPEN_FLAGS_NO_CACHE | OPEN_FLAGS_NOINHERIT);
if (DosSetFHState (fd, ulMode))
break;
result = 0;
break;
case F_GETFL:
result = 0;
break;
case F_SETFL:
if (arg != 0)
break;
result = 0;
break;
default:
errno = EINVAL;
break;
}
}
va_end (arg_ptr);
return result;
}
#endif

10
lib/get-permissions.c
View file

@ -38,9 +38,9 @@ get_permissions (const char *name, int desc, mode_t mode,
#if USE_ACL && HAVE_ACL_GET_FILE
/* POSIX 1003.1e (draft 17 -- abandoned) specific version. */
/* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */
/* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
# if !HAVE_ACL_TYPE_EXTENDED
/* Linux, FreeBSD, IRIX, Tru64 */
/* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
if (HAVE_ACL_GET_FD && desc != -1)
ctx->acl = acl_get_fd (desc);
@ -60,13 +60,13 @@ get_permissions (const char *name, int desc, mode_t mode,
return -1;
}
# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */
# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */
/* TODO (see set_permissions). */
# endif
# endif
# else /* HAVE_ACL_TYPE_EXTENDED */
# else /* HAVE_ACL_TYPE_EXTENDED */
/* Mac OS X */
/* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS)

2
lib/gettime.c
View file

@ -30,8 +30,6 @@ gettime (struct timespec *ts)
{
#if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME
clock_gettime (CLOCK_REALTIME, ts);
#elif HAVE_NANOTIME
nanotime (ts);
#else
struct timeval tv;
gettimeofday (&tv, NULL);

1
lib/gnulib.mk.in
View file

@ -44,6 +44,7 @@
# --avoid=malloc-posix \
# --avoid=mbrtowc \
# --avoid=mbsinit \
# --avoid=mkdir \
# --avoid=msvc-inval \
# --avoid=msvc-nothrow \
# --avoid=nl_langinfo \

4
lib/mktime.c
View file

@ -78,7 +78,7 @@
#include "mktime-internal.h"
#ifndef _LIBC
#if !defined _LIBC && (NEED_MKTIME_WORKING || NEED_MKTIME_WINDOWS)
static void
my_tzset (void)
{
@ -527,7 +527,7 @@ mktime (struct tm *tp)
be set as if the tzset() function had been called. */
__tzset ();
# if defined __LIBC || NEED_MKTIME_WORKING
# if defined _LIBC || NEED_MKTIME_WORKING
static mktime_offset_t localtime_offset;
return __mktime_internal (tp, __localtime_r, &localtime_offset);
# else

14
lib/set-permissions.c
View file

@ -24,7 +24,7 @@
#include "acl-internal.h"
#if USE_ACL
# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64 */
# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
# if HAVE_ACL_GET_FILE && !HAVE_ACL_TYPE_EXTENDED
static acl_t
@ -32,7 +32,7 @@ acl_from_mode (mode_t mode)
{
# if HAVE_ACL_FREE_TEXT /* Tru64 */
char acl_text[] = "u::---,g::---,o::---,";
# else /* FreeBSD, IRIX */
# else /* FreeBSD, IRIX, Cygwin >= 2.5 */
char acl_text[] = "u::---,g::---,o::---";
# endif
@ -51,7 +51,7 @@ acl_from_mode (mode_t mode)
# endif
# endif
# if HAVE_FACL && defined GETACL /* Solaris, Cygwin, not HP-UX */
# if HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */
static int
set_acls_from_mode (const char *name, int desc, mode_t mode, bool *must_chmod)
{
@ -489,9 +489,9 @@ set_acls (struct permission_context *ctx, const char *name, int desc,
# if HAVE_ACL_GET_FILE
/* POSIX 1003.1e (draft 17 -- abandoned) specific version. */
/* Linux, FreeBSD, Mac OS X, IRIX, Tru64 */
/* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
# if !HAVE_ACL_TYPE_EXTENDED
/* Linux, FreeBSD, IRIX, Tru64 */
/* Linux, FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
# ifndef HAVE_ACL_FROM_TEXT
# error Must have acl_from_text (see POSIX 1003.1e draft 17).
@ -542,14 +542,14 @@ set_acls (struct permission_context *ctx, const char *name, int desc,
}
}
# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */
# if HAVE_ACL_TYPE_NFS4 /* FreeBSD */
/* File systems either support POSIX ACLs (for example, ufs) or NFS4 ACLs
(for example, zfs). */
/* TODO: Implement setting ACLs once get_permissions() reads them. */
# endif
# endif
# else /* HAVE_ACL_TYPE_EXTENDED */
/* Mac OS X */

3
lib/stdlib.in.h
View file

@ -90,9 +90,10 @@ struct random_data
# endif
#endif
#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !(defined _WIN32 && ! defined __CYGWIN__)
#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_MKOSTEMP@ || @GNULIB_MKOSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !(defined _WIN32 && ! defined __CYGWIN__)
/* On Mac OS X 10.3, only <unistd.h> declares mkstemp. */
/* On Mac OS X 10.5, only <unistd.h> declares mkstemps. */
/* On Mac OS X 10.13, only <unistd.h> declares mkostemp and mkostemps. */
/* On Cygwin 1.7.1, only <unistd.h> declares getsubopt. */
/* But avoid namespace pollution on glibc systems and native Windows. */
# include <unistd.h>

52
lisp/abbrev.el
View file

@ -251,7 +251,8 @@ have been saved."
(lambda (s1 s2)
(string< (symbol-name s1)
(symbol-name s2)))))
(insert-abbrev-table-description table nil))
(if (abbrev--table-symbols table)
(insert-abbrev-table-description table nil)))
(when (unencodable-char-position (point-min) (point-max) 'utf-8)
(setq coding-system-for-write
(if (> emacs-major-version 24)
@ -937,33 +938,38 @@ is inserted.
If READABLE is nil, an expression is inserted. The expression is
a call to `define-abbrev-table' that when evaluated will define
the abbrev table NAME exactly as it is currently defined.
Abbrevs marked as \"system abbrevs\" are ignored. If the
resulting expression would not define any abbrevs, nothing is
inserted."
Abbrevs marked as \"system abbrevs\" are ignored."
(let ((table (symbol-value name))
(symbols (abbrev--table-symbols name readable)))
(setq symbols (sort symbols 'string-lessp))
(let ((standard-output (current-buffer)))
(if readable
(progn
(insert "(")
(prin1 name)
(insert ")\n\n")
(mapc 'abbrev--describe symbols)
(insert "\n\n"))
(insert "(define-abbrev-table '")
(prin1 name)
(if (null symbols)
(insert " '())\n\n")
(insert "\n '(\n")
(mapc 'abbrev--write symbols)
(insert " ))\n\n")))
nil)))
(defun abbrev--table-symbols (name &optional system)
"Return the user abbrev symbols in the abbrev table named NAME.
NAME is a symbol whose value is an abbrev table. System abbrevs
are omitted unless SYSTEM is non-nil."
(let ((table (symbol-value name))
(symbols ()))
(mapatoms (lambda (sym)
(if (and (symbol-value sym) (or readable (not (abbrev-get sym :system))))
(if (and (symbol-value sym) (or system (not (abbrev-get sym :system))))
(push sym symbols)))
table)
(when symbols
(setq symbols (sort symbols 'string-lessp))
(let ((standard-output (current-buffer)))
(if readable
(progn
(insert "(")
(prin1 name)
(insert ")\n\n")
(mapc 'abbrev--describe symbols)
(insert "\n\n"))
(insert "(define-abbrev-table '")
(prin1 name)
(if (null symbols)
(insert " '())\n\n")
(insert "\n '(\n")
(mapc 'abbrev--write symbols)
(insert " ))\n\n")))
nil))))
symbols))
(defun define-abbrev-table (tablename definitions
&optional docstring &rest props)

27
lisp/auth-source.el
View file

@ -83,7 +83,6 @@
expiring. Overrides `password-cache-expiry' through a
let-binding."
:version "24.1"
:group 'auth-source
:type '(choice (const :tag "Never" nil)
(const :tag "All Day" 86400)
(const :tag "2 Hours" 7200)
@ -139,7 +138,6 @@ let-binding."
(smtp "smtp" "25"))
"List of authentication protocols and their names"
:group 'auth-source
:version "23.2" ;; No Gnus
:type '(repeat :tag "Authentication Protocols"
(cons :tag "Protocol Entry"
@ -168,7 +166,6 @@ let-binding."
(defcustom auth-source-save-behavior 'ask
"If set, auth-source will respect it for save behavior."
:group 'auth-source
:version "23.2" ;; No Gnus
:type `(choice
:tag "auth-source new token save behavior"
@ -183,7 +180,6 @@ let-binding."
"Set this to tell auth-source when to create GPG password
tokens in netrc files. It's either an alist or `never'.
Note that if EPA/EPG is not available, this should NOT be used."
:group 'auth-source
:version "23.2" ;; No Gnus
:type `(choice
(const :tag "Always use GPG password tokens" (t gpg))
@ -203,7 +199,6 @@ Note that if EPA/EPG is not available, this should NOT be used."
(defcustom auth-source-do-cache t
"Whether auth-source should cache information with `password-cache'."
:group 'auth-source
:version "23.2" ;; No Gnus
:type `boolean)
@ -218,7 +213,6 @@ for passwords).
If the value is a function, debug messages are logged by calling
that function using the same arguments as `message'."
:group 'auth-source
:version "23.2" ;; No Gnus
:type `(choice
:tag "auth-source debugging mode"
@ -241,7 +235,6 @@ for details.
It's best to customize this with `\\[customize-variable]' because the choices
can get pretty complex."
:group 'auth-source
:version "26.1" ; neither new nor changed default
:type `(repeat :tag "Authentication Sources"
(choice
@ -311,7 +304,6 @@ can get pretty complex."
(defcustom auth-source-gpg-encrypt-to t
"List of recipient keys that `authinfo.gpg' encrypted to.
If the value is not a list, symmetric encryption will be used."
:group 'auth-source
:version "24.1" ;; No Gnus
:type '(choice (const :tag "Symmetric encryption" t)
(repeat :tag "Recipient public keys"
@ -363,10 +355,9 @@ soon as a function returns non-nil.")
(defun auth-source-backend-parse (entry)
"Create an auth-source-backend from an ENTRY in `auth-sources'."
(let (backend)
(cl-dolist (f auth-source-backend-parser-functions)
(when (setq backend (funcall f entry))
(cl-return)))
(let ((backend
(run-hook-with-args-until-success 'auth-source-backend-parser-functions
entry)))
(unless backend
;; none of the parsers worked
@ -416,7 +407,7 @@ soon as a function returns non-nil.")
:create-function #'auth-source-netrc-create))))))
;; Note this function should be last in the parser functions, so we add it first
(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-file)
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-file)
(defun auth-source-backends-parser-macos-keychain (entry)
;; take macos-keychain-{internet,generic}:XYZ and use it as macOS
@ -463,7 +454,7 @@ soon as a function returns non-nil.")
:search-function #'auth-source-macos-keychain-search
:create-function #'auth-source-macos-keychain-create)))))
(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-macos-keychain)
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-macos-keychain)
(defun auth-source-backends-parser-secrets (entry)
;; take secrets:XYZ and use it as Secrets API collection "XYZ"
@ -510,7 +501,7 @@ soon as a function returns non-nil.")
:source ""
:type 'ignore))))))
(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-secrets)
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-secrets)
(defun auth-source-backend-parse-parameters (entry backend)
"Fills in the extra auth-source-backend parameters of ENTRY.
@ -528,7 +519,7 @@ parameters."
(oset backend port val)))
backend)
;; (mapcar 'auth-source-backend-parse auth-sources)
;; (mapcar #'auth-source-backend-parse auth-sources)
(cl-defun auth-source-search (&rest spec
&key max require create delete
@ -2176,8 +2167,8 @@ entries for git.gnus.org:
(plstore-save (oref backend data)))))
;;; Backend specific parsing: JSON backend
;;; (auth-source-search :max 1 :machine "imap.gmail.com")
;;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret))
;; (auth-source-search :max 1 :machine "imap.gmail.com")
;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret))
(defun auth-source-json-check (host user port require item)
(and item

5
lisp/bindings.el
View file

@ -309,7 +309,10 @@ Normally nil in most modes, since there is no process to display.")
(make-variable-buffer-local 'mode-line-process)
(defun bindings--define-key (map key item)
"Make as much as possible of the menus pure."
"Define KEY in keymap MAP according to ITEM from a menu.
This is like `define-key', but it takes the definition from the
specified menu item, and makes pure copies of as much as possible
of the menu's data."
(declare (indent 2))
(define-key map key
(cond

55
lisp/calendar/cal-dst.el
View file

@ -97,62 +97,48 @@ If the locale never uses daylight saving time, set this to nil."
;;;###autoload
(put 'calendar-current-time-zone-cache 'risky-local-variable t)
(defvar calendar-system-time-basis
(defconst calendar-system-time-basis
(calendar-absolute-from-gregorian '(1 1 1970))
"Absolute date of starting date of system clock.")
(defun calendar-absolute-from-time (x utc-diff)
"Absolute local date of time X; local time is UTC-DIFF seconds from UTC.
X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the
high and low 16 bits, respectively, of the number of seconds since
1970-01-01 00:00:00 UTC, ignoring leap seconds.
X is the number of seconds since 1970-01-01 00:00:00 UTC,
ignoring leap seconds.
Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on
absolute date ABS-DATE is the equivalent moment to X."
(let* ((h (car x))
(xtail (cdr x))
(l (+ utc-diff (if (numberp xtail) xtail (car xtail))))
(u (+ (* 512 (mod h 675)) (floor l 128))))
;; Overflow is a terrible thing!
(cons (+ calendar-system-time-basis
;; floor((2^16 h +l) / (60*60*24))
(* 512 (floor h 675)) (floor u 675))
;; (2^16 h +l) mod (60*60*24)
(+ (* (mod u 675) 128) (mod l 128)))))
(let ((secsperday 86400)
(local (+ x utc-diff)))
(cons (+ calendar-system-time-basis (floor local secsperday))
(mod local secsperday))))
(defun calendar-time-from-absolute (abs-date s)
"Time of absolute date ABS-DATE, S seconds after midnight.
Returns the list (HIGH LOW) where HIGH and LOW are the high and low
16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC,
ignoring leap seconds, that is the equivalent moment to S seconds after
midnight UTC on absolute date ABS-DATE."
(let* ((a (- abs-date calendar-system-time-basis))
(u (+ (* 163 (mod a 512)) (floor s 128))))
;; Overflow is a terrible thing!
(list
;; floor((60*60*24*a + s) / 2^16)
(+ a (* 163 (floor a 512)) (floor u 512))
;; (60*60*24*a + s) mod 2^16
(+ (* 128 (mod u 512)) (mod s 128)))))
Return the number of seconds since 1970-01-01 00:00:00 UTC,
ignoring leap seconds, that is the equivalent moment to S seconds
after midnight UTC on absolute date ABS-DATE."
(let ((secsperday 86400))
(+ s (* secsperday (- abs-date calendar-system-time-basis)))))
(defun calendar-next-time-zone-transition (time)
"Return the time of the next time zone transition after TIME.
Both TIME and the result are acceptable arguments to `current-time-zone'.
Return nil if no such transition can be found."
(let* ((base 65536) ; 2^16 = base of current-time output
(quarter-multiple 120) ; approx = (seconds per quarter year) / base
(let* ((time (encode-time time 'integer))
(time-zone (current-time-zone time))
(time-utc-diff (car time-zone))
hi
hi-zone
(hi-utc-diff time-utc-diff)
(quarter-seconds 7889238) ; Average seconds per 1/4 Gregorian year.
(quarters '(2 1 3)))
;; Heuristic: probe the time zone offset in the next three calendar
;; quarters, looking for a time zone offset different from TIME.
(while (and quarters (eq time-utc-diff hi-utc-diff))
(setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0)
(setq hi (+ time (* (car quarters) quarter-seconds))
hi-zone (current-time-zone hi)
hi-utc-diff (car hi-zone)
quarters (cdr quarters)))
@ -163,23 +149,16 @@ Return nil if no such transition can be found."
;; Now HI is after the next time zone transition.
;; Set LO to TIME, and then binary search to increase LO and decrease HI
;; until LO is just before and HI is just after the time zone transition.
(let* ((tail (cdr time))
(lo (cons (car time) (if (numberp tail) tail (car tail))))
(let* ((lo time)
probe)
(while
;; Set PROBE to halfway between LO and HI, rounding down.
;; If PROBE equals LO, we are done.
(let* ((lsum (+ (cdr lo) (cdr hi)))
(hsum (+ (car lo) (car hi) (/ lsum base)))
(hsumodd (logand 1 hsum)))
(setq probe (cons (/ (- hsum hsumodd) 2)
(/ (+ (* hsumodd base) (% lsum base)) 2)))
(not (equal lo probe)))
(not (= lo (setq probe (/ (+ lo hi) 2))))
;; Set either LO or HI to PROBE, depending on probe results.
(if (eq (car (current-time-zone probe)) hi-utc-diff)
(setq hi probe)
(setq lo probe)))
(setcdr hi (list (cdr hi)))
hi))))
(autoload 'calendar-persian-to-absolute "cal-persia")

5
lisp/calendar/parse-time.el
View file

@ -227,7 +227,7 @@ If DATE-STRING cannot be parsed, it falls back to
(tz-re (nth 2 parse-time-iso8601-regexp))
re-start
time seconds minute hour
day month year day-of-week dst tz)
day month year day-of-week (dst -1) tz)
;; We need to populate 'time' with
;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
@ -243,6 +243,7 @@ If DATE-STRING cannot be parsed, it falls back to
seconds (string-to-number (match-string 3 date-string))
re-start (match-end 0))
(when (string-match tz-re date-string re-start)
(setq dst nil)
(if (string= "Z" (match-string 1 date-string))
(setq tz 0) ;; UTC timezone indicated by Z
(setq tz (+
@ -260,7 +261,7 @@ If DATE-STRING cannot be parsed, it falls back to
(setq time (parse-time-string date-string)))
(and time
(apply 'encode-time time))))
(encode-time time))))
(provide 'parse-time)

10
lisp/calendar/time-date.el
View file

@ -168,15 +168,15 @@ If DATE lacks timezone information, GMT is assumed."
(defalias 'time-to-seconds 'float-time)
;;;###autoload
(defun seconds-to-time (seconds)
"Convert SECONDS to a time value."
(time-add 0 seconds))
(defalias 'seconds-to-time 'encode-time)
;;;###autoload
(defun days-to-time (days)
"Convert DAYS into a time value."
(let ((time (seconds-to-time (* 86400 days))))
(if (integerp days)
(let ((time (encode-time (* 86400 days))))
;; Traditionally, this returned a two-element list if DAYS was an integer.
;; Keep that tradition if encode-time outputs timestamps in list form.
(if (and (integerp days) (consp (cdr time)))
(setcdr (cdr time) nil))
time))

347
lisp/calendar/timeclock.el
View file

@ -1,4 +1,4 @@
;;; timeclock.el --- mode for keeping track of how much you work
;;; timeclock.el --- mode for keeping track of how much you work -*- lexical-binding:t -*-
;; Copyright (C) 1999-2018 Free Software Foundation, Inc.
@ -62,7 +62,7 @@
;; `timeclock-ask-before-exiting' to t using M-x customize (this is
;; the default), or by adding the following to your init file:
;;
;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
;; (add-hook 'kill-emacs-query-functions #'timeclock-query-out)
;; NOTE: If you change your timelog file without using timeclock's
;; functions, or if you change the value of any of timeclock's
@ -75,6 +75,8 @@
;;; Code:
(require 'cl-lib)
(defgroup timeclock nil
"Keeping track of the time that gets spent."
:group 'data)
@ -84,13 +86,11 @@
(defcustom timeclock-file (locate-user-emacs-file "timelog" ".timelog")
"The file used to store timeclock data in."
:version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'timeclock)
:type 'file)
(defcustom timeclock-workday (* 8 60 60)
"The length of a work period in seconds."
:type 'integer
:group 'timeclock)
:type 'integer)
(defcustom timeclock-relative t
"Whether to make reported time relative to `timeclock-workday'.
@ -100,24 +100,21 @@ Tuesday is twelve hours -- relative to an averaged work period of
eight hours -- or eight hours, non-relative. So relative time takes
into account any discrepancy of time under-worked or over-worked on
previous days. This only affects the timeclock mode line display."
:type 'boolean
:group 'timeclock)
:type 'boolean)
(defcustom timeclock-get-project-function 'timeclock-ask-for-project
"The function used to determine the name of the current project.
When clocking in, and no project is specified, this function will be
called to determine what is the current project to be worked on.
If this variable is nil, no questions will be asked."
:type 'function
:group 'timeclock)
:type 'function)
(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
"A function used to determine the reason for clocking out.
When clocking out, and no reason is specified, this function will be
called to determine what is the reason.
If this variable is nil, no questions will be asked."
:type 'function
:group 'timeclock)
:type 'function)
(defcustom timeclock-get-workday-function nil
"A function used to determine the length of today's workday.
@ -127,19 +124,17 @@ the return value is nil, or equal to `timeclock-workday', nothing special
will be done. If it is a quantity different from `timeclock-workday',
however, a record will be output to the timelog file to note the fact that
that day has a length that is different from the norm."
:type '(choice (const nil) function)
:group 'timeclock)
:type '(choice (const nil) function))
(defcustom timeclock-ask-before-exiting t
"If non-nil, ask if the user wants to clock out before exiting Emacs.
This variable only has effect if set with \\[customize]."
:set (lambda (symbol value)
(if value
(add-hook 'kill-emacs-query-functions 'timeclock-query-out)
(remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
(add-hook 'kill-emacs-query-functions #'timeclock-query-out)
(remove-hook 'kill-emacs-query-functions #'timeclock-query-out))
(set symbol value))
:type 'boolean
:group 'timeclock)
:type 'boolean)
(defvar timeclock-update-timer nil
"The timer used to update `timeclock-mode-string'.")
@ -172,7 +167,7 @@ a positive argument to force an update."
(if (and currently-displaying
(or (and value
(boundp 'display-time-hook)
(memq 'timeclock-update-mode-line
(memq #'timeclock-update-mode-line
display-time-hook))
(and (not value)
timeclock-update-timer)))
@ -185,7 +180,6 @@ a positive argument to force an update."
;; FIXME: The return value isn't used, AFAIK!
value))
:type 'boolean
:group 'timeclock
:require 'time)
(defcustom timeclock-first-in-hook nil
@ -194,40 +188,33 @@ Note that this hook is run before recording any events. Thus the
value of `timeclock-hours-today', `timeclock-last-event' and the
return value of function `timeclock-last-period' are relative previous
to today."
:type 'hook
:group 'timeclock)
:type 'hook)
(defcustom timeclock-load-hook nil
"Hook that gets run after timeclock has been loaded."
:type 'hook
:group 'timeclock)
:type 'hook)
(defcustom timeclock-in-hook nil
"A hook run every time an \"in\" event is recorded."
:type 'hook
:group 'timeclock)
:type 'hook)
(defcustom timeclock-day-over-hook nil
"A hook that is run when the workday has been completed.
This hook is only run if the current time remaining is being displayed
in the mode line. See the variable `timeclock-mode-line-display'."
:type 'hook
:group 'timeclock)
:type 'hook)
(defcustom timeclock-out-hook nil
"A hook run every time an \"out\" event is recorded."
:type 'hook
:group 'timeclock)
:type 'hook)
(defcustom timeclock-done-hook nil
"A hook run every time a project is marked as completed."
:type 'hook
:group 'timeclock)
:type 'hook)
(defcustom timeclock-event-hook nil
"A hook run every time any event is recorded."
:type 'hook
:group 'timeclock)
:type 'hook)
(defvar timeclock-last-event nil
"A list containing the last event that was recorded.
@ -294,12 +281,12 @@ display (non-nil means on)."
(or (memq 'timeclock-mode-string global-mode-string)
(setq global-mode-string
(append global-mode-string '(timeclock-mode-string))))
(add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
(add-hook 'timeclock-event-hook #'timeclock-update-mode-line)
(when timeclock-update-timer
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil))
(if (boundp 'display-time-hook)
(remove-hook 'display-time-hook 'timeclock-update-mode-line))
(remove-hook 'display-time-hook #'timeclock-update-mode-line))
(if timeclock-use-display-time
(progn
;; Update immediately so there is a visible change
@ -308,15 +295,15 @@ display (non-nil means on)."
(timeclock-update-mode-line)
(message "Activate `display-time-mode' or turn off \
`timeclock-use-display-time' to see timeclock information"))
(add-hook 'display-time-hook 'timeclock-update-mode-line))
(add-hook 'display-time-hook #'timeclock-update-mode-line))
(setq timeclock-update-timer
(run-at-time nil 60 'timeclock-update-mode-line))))
(setq global-mode-string
(delq 'timeclock-mode-string global-mode-string))
(remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
(remove-hook 'timeclock-event-hook #'timeclock-update-mode-line)
(if (boundp 'display-time-hook)
(remove-hook 'display-time-hook
'timeclock-update-mode-line))
#'timeclock-update-mode-line))
(when timeclock-update-timer
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil))))
@ -365,7 +352,8 @@ discover the name of the project."
(if (not (= workday timeclock-workday))
(timeclock-log "h" (number-to-string
(/ workday (if (zerop (% workday (* 60 60)))
60 60.0) 60))))))
60 60.0)
60))))))
(timeclock-log "i" (or project
(and timeclock-get-project-function
(or find-project
@ -417,12 +405,11 @@ If SHOW-SECONDS is non-nil, display second resolution.
If TODAY-ONLY is non-nil, the display will be relative only to time
worked today, ignoring the time worked on previous days."
(interactive "P")
(let ((remainder (timeclock-workday-remaining
(or today-only
(not timeclock-relative))))
(last-in (equal (car timeclock-last-event) "i"))
status)
(setq status
(let* ((remainder (timeclock-workday-remaining
(or today-only
(not timeclock-relative))))
(last-in (equal (car timeclock-last-event) "i"))
(status
(format "Currently %s since %s (%s), %s %s, leave at %s"
(if last-in "IN" "OUT")
(if show-seconds
@ -435,7 +422,7 @@ worked today, ignoring the time worked on previous days."
(timeclock-seconds-to-string remainder show-seconds t)
(if (> remainder 0)
"remaining" "over")
(timeclock-when-to-leave-string show-seconds today-only)))
(timeclock-when-to-leave-string show-seconds today-only))))
(if (called-interactively-p 'interactive)
(message "%s" status)
status)))
@ -534,8 +521,7 @@ non-nil, the amount returned will be relative to past time worked."
string)))
(define-obsolete-function-alias 'timeclock-time-to-seconds 'float-time "26.1")
(define-obsolete-function-alias 'timeclock-seconds-to-time 'seconds-to-time
"26.1")
(define-obsolete-function-alias 'timeclock-seconds-to-time 'encode-time "26.1")
;; Should today-only be removed in favor of timeclock-relative? - gm
(defsubst timeclock-when-to-leave (&optional today-only)
@ -624,7 +610,7 @@ arguments of `completing-read'."
(format "Clock into which project (default %s): "
(or timeclock-last-project
(car timeclock-project-list)))
(mapcar 'list timeclock-project-list)
timeclock-project-list
(or timeclock-last-project
(car timeclock-project-list))))
@ -633,7 +619,7 @@ arguments of `completing-read'."
(defun timeclock-ask-for-reason ()
"Ask the user for the reason they are clocking out."
(timeclock-completing-read "Reason for clocking out: "
(mapcar 'list timeclock-reason-list)))
timeclock-reason-list))
(define-obsolete-function-alias 'timeclock-update-modeline
'timeclock-update-mode-line "24.3")
@ -701,7 +687,7 @@ being logged for. Normally only \"in\" events specify a project."
"\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+"
"\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)"))
(defsubst timeclock-read-moment ()
(defun timeclock-read-moment ()
"Read the moment under point from the timelog."
(if (looking-at timeclock-moment-regexp)
(let ((code (match-string 1))
@ -726,27 +712,19 @@ This is only provided for coherency when used by
(float-time (cadr timeclock-last-event)))
timeclock-last-period))
(cl-defstruct (timeclock-entry
(:constructor nil) (:copier nil)
(:type list))
begin end project comment
;; FIXME: Documented in docstring of timeclock-log-data, but I can't see
;; where it's used in the code.
final-p)
(defsubst timeclock-entry-length (entry)
"Return the length of ENTRY in seconds."
(- (float-time (cadr entry))
(float-time (car entry))))
(defsubst timeclock-entry-begin (entry)
"Return the start time of ENTRY."
(car entry))
(defsubst timeclock-entry-end (entry)
"Return the end time of ENTRY."
(cadr entry))
(defsubst timeclock-entry-project (entry)
"Return the project of ENTRY."
(nth 2 entry))
(defsubst timeclock-entry-comment (entry)
"Return the comment of ENTRY."
(nth 3 entry))
(defsubst timeclock-entry-list-length (entry-list)
"Return the total length of ENTRY-LIST in seconds."
(let ((length 0))
@ -772,14 +750,11 @@ This is only provided for coherency when used by
(- (timeclock-entry-list-span entry-list)
(timeclock-entry-list-length entry-list)))
(defsubst timeclock-entry-list-projects (entry-list)
(defun timeclock-entry-list-projects (entry-list)
"Return a list of all the projects in ENTRY-LIST."
(let (projects proj)
(let (projects)
(dolist (entry entry-list)
(setq proj (timeclock-entry-project entry))
(if projects
(add-to-list 'projects proj)
(setq projects (list proj))))
(cl-pushnew (timeclock-entry-project entry) projects :test #'equal))
projects))
(defsubst timeclock-day-required (day)
@ -855,9 +830,7 @@ This is only provided for coherency when used by
(let (projects)
(dolist (day day-list)
(dolist (proj (timeclock-day-projects day))
(if projects
(add-to-list 'projects proj)
(setq projects (list proj)))))
(cl-pushnew proj projects :test #'equal)))
projects))
(defsubst timeclock-current-debt (&optional log-data)
@ -872,7 +845,7 @@ This is only provided for coherency when used by
"Return a list of the cdrs of the date alist from LOG-DATA."
(let (day-list)
(dolist (date-list (timeclock-day-alist log-data))
(setq day-list (cons (cdr date-list) day-list)))
(push (cdr date-list) day-list))
day-list))
(defsubst timeclock-project-alist (&optional log-data)
@ -1023,54 +996,55 @@ See the documentation for the given function if more info is needed."
(and beg (not last)
(setq last t event (list "o" now))))
(setq line (1+ line))
(cond ((equal (car event) "b")
(setcar log-data (string-to-number (nth 2 event))))
((equal (car event) "h")
(setq last-date-limited (timeclock-time-to-date (cadr event))
last-date-seconds (* (string-to-number (nth 2 event))
3600.0)))
((equal (car event) "i")
(if beg
(error "Error in format of timelog file, line %d" line)
(setq beg t))
(setq entry (list (cadr event) nil
(and (> (length (nth 2 event)) 0)
(nth 2 event))))
(let ((date (timeclock-time-to-date (cadr event))))
(if (and last-date
(not (equal date last-date)))
(progn
(setcar (cdr log-data)
(cons (cons last-date day)
(cadr log-data)))
(setq day (list (and last-date-limited
last-date-seconds))))
(unless day
(setq day (list (and last-date-limited
last-date-seconds)))))
(setq last-date date
last-date-limited nil)))
((equal (downcase (car event)) "o")
(if (not beg)
(error "Error in format of timelog file, line %d" line)
(setq beg nil))
(setcar (cdr entry) (cadr event))
(let ((desc (and (> (length (nth 2 event)) 0)
(nth 2 event))))
(if desc
(nconc entry (list (nth 2 event))))
(if (equal (car event) "O")
(nconc entry (if desc
(list t)
(list nil t))))
(nconc day (list entry))
(setq desc (nth 2 entry))
(let ((proj (assoc desc (nth 2 log-data))))
(if (null proj)
(setcar (cddr log-data)
(cons (cons desc (list entry))
(nth 2 log-data)))
(nconc (cdr proj) (list entry)))))))
(pcase (car event)
("b"
(setcar log-data (string-to-number (nth 2 event))))
("h"
(setq last-date-limited (timeclock-time-to-date (cadr event))
last-date-seconds (* (string-to-number (nth 2 event))
3600.0)))
("i"
(if beg
(error "Error in format of timelog file, line %d" line)
(setq beg t))
(setq entry (list (cadr event) nil
(and (> (length (nth 2 event)) 0)
(nth 2 event))))
(let ((date (timeclock-time-to-date (cadr event))))
(if (and last-date
(not (equal date last-date)))
(progn
(setcar (cdr log-data)
(cons (cons last-date day)
(cadr log-data)))
(setq day (list (and last-date-limited
last-date-seconds))))
(unless day
(setq day (list (and last-date-limited
last-date-seconds)))))
(setq last-date date
last-date-limited nil)))
((or "o" "O")
(if (not beg)
(error "Error in format of timelog file, line %d" line)
(setq beg nil))
(setcar (cdr entry) (cadr event))
(let ((desc (and (> (length (nth 2 event)) 0)
(nth 2 event))))
(if desc
(nconc entry (list (nth 2 event))))
(if (equal (car event) "O")
(nconc entry (if desc
(list t)
(list nil t))))
(nconc day (list entry))
(setq desc (nth 2 entry))
(let ((proj (assoc desc (nth 2 log-data))))
(if (null proj)
(setcar (cddr log-data)
(cons (cons desc (list entry))
(nth 2 log-data)))
(nconc (cdr proj) (list entry)))))))
(forward-line))
(if day
(setcar (cdr log-data)
@ -1186,14 +1160,12 @@ If optional argument TIME is non-nil, use that instead of the current time."
(defun timeclock-mean (l)
"Compute the arithmetic mean of the values in the list L."
(let ((total 0)
(count 0))
(dolist (thisl l)
(setq total (+ total thisl)
count (1+ count)))
(if (zerop count)
0
(/ total count))))
(if (not (consp l))
0
(let ((total 0))
(dolist (thisl l)
(setq total (+ total thisl)))
(/ total (length l)))))
(defun timeclock-generate-report (&optional html-p)
"Generate a summary report based on the current timelog file.
@ -1297,81 +1269,69 @@ HTML-P is non-nil, HTML markup is added."
six-months-ago one-year-ago)))
;; collect statistics from complete timelog
(dolist (day day-list)
(let ((i 0) (l 5))
(while (< i l)
(unless (time-less-p
(timeclock-day-begin day)
(aref lengths i))
(let ((base (float-time
(timeclock-day-base
(timeclock-day-begin day)))))
(nconc (aref time-in i)
(list (- (float-time (timeclock-day-begin day))
base)))
(let ((span (timeclock-day-span day))
(len (timeclock-day-length day))
(req (timeclock-day-required day)))
;; If the day's actual work length is less than
;; 70% of its span, then likely the exit time
;; and break amount are not worthwhile adding to
;; the statistic
(when (and (> span 0)
(> (/ (float len) (float span)) 0.70))
(nconc (aref time-out i)
(list (- (float-time (timeclock-day-end day))
base)))
(nconc (aref breaks i) (list (- span len))))
(if req
(setq len (+ len (- timeclock-workday req))))
(nconc (aref workday i) (list len)))))
(setq i (1+ i)))))
(dotimes (i 5)
(unless (time-less-p
(timeclock-day-begin day)
(aref lengths i))
(let ((base (float-time
(timeclock-day-base
(timeclock-day-begin day)))))
(nconc (aref time-in i)
(list (- (float-time (timeclock-day-begin day))
base)))
(let ((span (timeclock-day-span day))
(len (timeclock-day-length day))
(req (timeclock-day-required day)))
;; If the day's actual work length is less than
;; 70% of its span, then likely the exit time
;; and break amount are not worthwhile adding to
;; the statistic
(when (and (> span 0)
(> (/ (float len) (float span)) 0.70))
(nconc (aref time-out i)
(list (- (float-time (timeclock-day-end day))
base)))
(nconc (aref breaks i) (list (- span len))))
(if req
(setq len (+ len (- timeclock-workday req))))
(nconc (aref workday i) (list len)))))))
;; average statistics
(let ((i 0) (l 5))
(while (< i l)
(aset time-in i (timeclock-mean (cdr (aref time-in i))))
(aset time-out i (timeclock-mean (cdr (aref time-out i))))
(aset breaks i (timeclock-mean (cdr (aref breaks i))))
(aset workday i (timeclock-mean (cdr (aref workday i))))
(setq i (1+ i))))
(dotimes (i 5)
(aset time-in i (timeclock-mean (cdr (aref time-in i))))
(aset time-out i (timeclock-mean (cdr (aref time-out i))))
(aset breaks i (timeclock-mean (cdr (aref breaks i))))
(aset workday i (timeclock-mean (cdr (aref workday i)))))
;; Output the HTML table
(insert "<tr>\n")
(insert "<td align=\"center\">Time in</td>\n")
(let ((i 0) (l 5))
(while (< i l)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref time-in i))
"</td>\n")
(setq i (1+ i))))
(dotimes (i 5)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref time-in i))
"</td>\n"))
(insert "</tr>\n")
(insert "<tr>\n")
(insert "<td align=\"center\">Time out</td>\n")
(let ((i 0) (l 5))
(while (< i l)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref time-out i))
"</td>\n")
(setq i (1+ i))))
(dotimes (i 5)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref time-out i))
"</td>\n"))
(insert "</tr>\n")
(insert "<tr>\n")
(insert "<td align=\"center\">Break</td>\n")
(let ((i 0) (l 5))
(while (< i l)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref breaks i))
"</td>\n")
(setq i (1+ i))))
(dotimes (i 5)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref breaks i))
"</td>\n"))
(insert "</tr>\n")
(insert "<tr>\n")
(insert "<td align=\"center\">Workday</td>\n")
(let ((i 0) (l 5))
(while (< i l)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref workday i))
"</td>\n")
(setq i (1+ i))))
(dotimes (i 5)
(insert "<td align=\"right\">"
(timeclock-seconds-to-string (aref workday i))
"</td>\n"))
(insert "</tr>\n"))
(insert "<tfoot>
<td colspan=\"6\" align=\"center\">
@ -1394,6 +1354,7 @@ HTML-P is non-nil, HTML markup is added."
;; make sure we know the list of reasons, projects, and have computed
;; the last event and current discrepancy.
(if (file-readable-p timeclock-file)
;; FIXME: Loading a file should not have these kinds of side-effects.
(timeclock-reread-log))
;;; timeclock.el ends here

2
lisp/cedet/ede/project-am.el
View file

@ -532,7 +532,7 @@ DIR is the directory to apply to new targets."
(project-rescan tmp)
(setq ntargets (cons tmp ntargets)))
(makefile-macro-file-list macro))
;; Non-indirect will have a target whos sources
;; Non-indirect will have a target whose sources
;; are actual files, not names of other targets.
(let ((files (makefile-macro-file-list macro)))
(when files

2
lisp/cedet/semantic/db-ref.el
View file

@ -80,7 +80,7 @@ Abstract tables would be difficult to reference."
(cl-defmethod semanticdb-check-references ((dbt semanticdb-table))
"Check and cleanup references in the database DBT.
Any reference to a file that cannot be found, or whos file no longer
Any reference to a file that cannot be found, or whose file no longer
refers to DBT will be removed."
(let ((refs (oref dbt db-refs))
(myexpr (concat "\\<" (oref dbt file)))

2
lisp/cedet/semantic/scope.el
View file

@ -140,7 +140,7 @@ Saves scoping information between runs of the analyzer.")
(cl-defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
types-in-scope)
"Set the :typescope property on CACHE to some types.
TYPES-IN-SCOPE is a list of type tags whos members are
TYPES-IN-SCOPE is a list of type tags whose members are
currently in scope. For each type in TYPES-IN-SCOPE,
add those members to the types list.
If nil, then the typescope is reset."

7
lisp/cus-start.el
View file

@ -547,7 +547,12 @@ since it could result in memory overflow and make Emacs crash."
(const :tag "Respect `truncate-lines'" nil)
(other :tag "Truncate if not full-width" t))
"23.1")
(make-cursor-line-fully-visible windows boolean)
(make-cursor-line-fully-visible
windows
(choice
(const :tag "Make cursor always fully visible" t)
(const :tag "Allow cursor to be partially-visible" nil)
(function :tag "User-defined function")))
(mode-line-in-non-selected-windows mode-line boolean "22.1")
(line-number-display-limit display
(choice integer

26
lisp/emacs-lisp/autoload.el
View file

@ -660,6 +660,21 @@ Don't try to split prefixes that are already longer than that.")
(defvar autoload-builtin-package-versions nil)
(defvar autoload-ignored-definitions
'("define-obsolete-function-alias"
"define-obsolete-variable-alias"
"define-category" "define-key"
"defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
"define-erc-module"
"define-erc-response-handler"
"defun-rcirc-command")
"List of strings naming definitions to ignore for prefixes.
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
;; When called from `generate-file-autoloads' we should ignore
;; `generated-autoload-file' altogether. When called from
;; `update-file-autoloads' we don't know `outbuf'. And when called from
@ -758,16 +773,7 @@ FILE's modification time."
(looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
(not (member
(match-string 1)
'("define-obsolete-function-alias"
"define-obsolete-variable-alias"
"define-category" "define-key"
"defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
"define-erc-module"
"define-erc-response-handler"
"defun-rcirc-command"))))
autoload-ignored-definitions)))
(push (match-string-no-properties 2) defs))
(forward-sexp 1)
(forward-line 1)))))))

39
lisp/emacs-lisp/cl-macs.el
View file

@ -1779,7 +1779,24 @@ such that COMBO is equivalent to (and . CLAUSES)."
;;;###autoload
(defmacro cl-do (steps endtest &rest body)
"The Common Lisp `do' loop.
"Bind variables and run BODY forms until END-TEST returns non-nil.
First, each VAR is bound to the associated INIT value as if by a `let' form.
Then, in each iteration of the loop, the END-TEST is evaluated; if true,
the loop is finished. Otherwise, the BODY forms are evaluated, then each
VAR is set to the associated STEP expression (as if by a `cl-psetq' form)
and the next iteration begins.
Once the END-TEST becomes true, the RESULT forms are evaluated (with
the VARs still bound to their values) to produce the result
returned by `cl-do'.
Note that the entire loop is enclosed in an implicit `nil' block, so
that you can use `cl-return' to exit at any time.
Also note that END-TEST is checked before evaluating BODY. If END-TEST
is initially non-nil, `cl-do' will exit without running BODY.
For more details, see `cl-do' description in Info node `(cl) Iteration'.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
(declare (indent 2)
@ -1791,7 +1808,25 @@ such that COMBO is equivalent to (and . CLAUSES)."
;;;###autoload
(defmacro cl-do* (steps endtest &rest body)
"The Common Lisp `do*' loop.
"Bind variables and run BODY forms until END-TEST returns non-nil.
First, each VAR is bound to the associated INIT value as if by a `let*' form.
Then, in each iteration of the loop, the END-TEST is evaluated; if true,
the loop is finished. Otherwise, the BODY forms are evaluated, then each
VAR is set to the associated STEP expression (as if by a `setq'
form) and the next iteration begins.
Once the END-TEST becomes true, the RESULT forms are evaluated (with
the VARs still bound to their values) to produce the result
returned by `cl-do*'.
Note that the entire loop is enclosed in an implicit `nil' block, so
that you can use `cl-return' to exit at any time.
Also note that END-TEST is checked before evaluating BODY. If END-TEST
is initially non-nil, `cl-do*' will exit without running BODY.
This is to `cl-do' what `let*' is to `let'.
For more details, see `cl-do*' description in Info node `(cl) Iteration'.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
(declare (indent 2) (debug cl-do))

36
lisp/emacs-lisp/lisp-mnt.el
View file

@ -1,4 +1,4 @@
;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers
;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers -*- lexical-binding:t -*-
;; Copyright (C) 1992, 1994, 1997, 2000-2018 Free Software Foundation,
;; Inc.
@ -137,34 +137,28 @@ in your Lisp package:
The @(#) construct is used by unix what(1) and
then $identifier: doc string $ is used by GNU ident(1)"
:type 'regexp
:group 'lisp-mnt)
:type 'regexp)
(defcustom lm-copyright-prefix "^\\(;+[ \t]\\)+Copyright (C) "
"Prefix that is ignored before the dates in a copyright.
Leading comment characters and whitespace should be in regexp group 1."
:type 'regexp
:group 'lisp-mnt)
:type 'regexp)
(defcustom lm-comment-column 16
"Column used for placing formatted output."
:type 'integer
:group 'lisp-mnt)
:type 'integer)
(defcustom lm-any-header ".*"
"Regexp which matches start of any section."
:type 'regexp
:group 'lisp-mnt)
:type 'regexp)
(defcustom lm-commentary-header "Commentary\\|Documentation"
"Regexp which matches start of documentation section."
:type 'regexp
:group 'lisp-mnt)
:type 'regexp)
(defcustom lm-history-header "Change ?Log\\|History"
"Regexp which matches the start of code log section."
:type 'regexp
:group 'lisp-mnt)
:type 'regexp)
;;; Functions:
@ -236,26 +230,26 @@ a section."
(while (forward-comment 1))
(point))))))))
(defsubst lm-code-start ()
(defun lm-code-start ()
"Return the buffer location of the `Code' start marker."
(lm-section-start "Code"))
(defalias 'lm-code-mark 'lm-code-start)
(defsubst lm-commentary-start ()
(defun lm-commentary-start ()
"Return the buffer location of the `Commentary' start marker."
(lm-section-start lm-commentary-header))
(defalias 'lm-commentary-mark 'lm-commentary-start)
(defsubst lm-commentary-end ()
(defun lm-commentary-end ()
"Return the buffer location of the `Commentary' section end."
(lm-section-end lm-commentary-header))
(defsubst lm-history-start ()
(defun lm-history-start ()
"Return the buffer location of the `History' start marker."
(lm-section-start lm-history-header))
(defalias 'lm-history-mark 'lm-history-start)
(defsubst lm-copyright-mark ()
(defun lm-copyright-mark ()
"Return the buffer location of the `Copyright' line."
(save-excursion
(let ((case-fold-search t))
@ -385,7 +379,7 @@ Each element of the list is a cons; the car is the full name,
the cdr is an email address."
(lm-with-file file
(let ((authorlist (lm-header-multiline "author")))
(mapcar 'lm-crack-address authorlist))))
(mapcar #'lm-crack-address authorlist))))
(defun lm-maintainer (&optional file)
"Return the maintainer of file FILE, or current buffer if FILE is nil.
@ -453,7 +447,7 @@ each line."
(lm-with-file file
(let ((keywords (lm-header-multiline "keywords")))
(and keywords
(mapconcat 'downcase keywords " ")))))
(mapconcat #'downcase keywords " ")))))
(defun lm-keywords-list (&optional file)
"Return list of keywords given in file FILE."
@ -507,7 +501,7 @@ absent, return nil."
"Insert, at column COL, list of STRINGS."
(if (> (current-column) col) (insert "\n"))
(move-to-column col t)
(apply 'insert strings))
(apply #'insert strings))
(defun lm-verify (&optional file showok verbose non-fsf-ok)
"Check that the current buffer (or FILE if given) is in proper format.

42
lisp/emacs-lisp/timer.el
View file

@ -57,17 +57,11 @@
(defun timer--time-setter (timer time)
(timer--check timer)
(setf (timer--high-seconds timer) (pop time))
(let ((low time) (usecs 0) (psecs 0))
(when (consp time)
(setq low (pop time))
(when time
(setq usecs (pop time))
(when time
(setq psecs (car time)))))
(setf (timer--low-seconds timer) low)
(setf (timer--usecs timer) usecs)
(setf (timer--psecs timer) psecs)
(let ((lt (encode-time time 'list)))
(setf (timer--high-seconds timer) (nth 0 lt))
(setf (timer--low-seconds timer) (nth 1 lt))
(setf (timer--usecs timer) (nth 2 lt))
(setf (timer--psecs timer) (nth 3 lt))
time))
;; Pseudo field `time'.
@ -102,24 +96,14 @@ fire each time Emacs is idle for that many seconds."
"Yield the next value after TIME that is an integral multiple of SECS.
More precisely, the next value, after TIME, that is an integral multiple
of SECS seconds since the epoch. SECS may be a fraction."
(let* ((trillion 1000000000000)
(time-sec (+ (nth 1 time)
(* 65536 (nth 0 time))))
(delta-sec (mod (- time-sec) secs))
(next-sec (+ time-sec (floor delta-sec)))
(next-sec-psec (floor (* trillion (mod delta-sec 1))))
(sub-time-psec (+ (or (nth 3 time) 0)
(* 1000000 (nth 2 time))))
(psec-diff (- sub-time-psec next-sec-psec)))
(if (and (<= next-sec time-sec) (< 0 psec-diff))
(setq next-sec-psec (+ sub-time-psec
(mod (- psec-diff) (* trillion secs)))))
(setq next-sec (+ next-sec (floor next-sec-psec trillion)))
(setq next-sec-psec (mod next-sec-psec trillion))
(list (floor next-sec 65536)
(floor (mod next-sec 65536))
(floor next-sec-psec 1000000)
(floor (mod next-sec-psec 1000000)))))
(let* ((ticks-hz (if (and (consp time) (integerp (car time))
(integerp (cdr time)) (< 0 (cdr time)))
time
(encode-time time 1000000000000)))
(hz (cdr ticks-hz))
(s-ticks (* secs hz))
(more-ticks (+ (car ticks-hz) s-ticks)))
(encode-time (cons (- more-ticks (% more-ticks s-ticks)) hz))))
(defun timer-relative-time (time secs &optional usecs psecs)
"Advance TIME by SECS seconds and optionally USECS microseconds

35
lisp/follow.el
View file

@ -187,8 +187,8 @@
;; Implementation:
;;
;; The main method by which Follow mode aligns windows is via the
;; function `follow-post-command-hook', which is run after each
;; command. This "fixes up" the alignment of other windows which are
;; function `follow-pre-redisplay-function', which is run before each
;; redisplay. This "fixes up" the alignment of other windows which are
;; showing the same Follow mode buffer, on the same frame as the
;; selected window. It does not try to deal with buffers other than
;; the buffer of the selected frame, or windows on other frames.
@ -418,7 +418,7 @@ Keys specific to Follow mode:
(if follow-mode
(progn
(add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t)
(add-hook 'post-command-hook 'follow-post-command-hook t)
(add-function :before pre-redisplay-function 'follow-pre-redisplay-function)
(add-hook 'window-size-change-functions 'follow-window-size-change t)
(add-hook 'after-change-functions 'follow-after-change nil t)
(add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t)
@ -445,7 +445,7 @@ Keys specific to Follow mode:
(setq following (buffer-local-value 'follow-mode (car buffers))
buffers (cdr buffers)))
(unless following
(remove-hook 'post-command-hook 'follow-post-command-hook)
(remove-function pre-redisplay-function 'follow-pre-redisplay-function)
(remove-hook 'window-size-change-functions 'follow-window-size-change)))
(kill-local-variable 'move-to-window-group-line-function)
@ -1260,10 +1260,27 @@ non-first windows in Follow mode."
(not (eq win top)))) ;; Loop while this is true.
(set-buffer orig-buffer))))
;;; Pre Display Function
;; This function is added to `pre-display-function' and is thus called
;; before each redisplay operation. It supersedes (2018-09) the
;; former use of the post command hook, and now does the right thing
;; when a program calls `redisplay' or `sit-for'.
(defun follow-pre-redisplay-function (wins)
(if (or (eq wins t)
(null wins)
(and (listp wins)
(memq (selected-window) wins)))
(follow-post-command-hook)))
;;; Post Command Hook
;; The magic little box. This function is called after every command.
;; The magic little box. This function was formerly called after every
;; command. It is now called before each redisplay operation (see
;; `follow-pre-redisplay-function' above), and at the end of several
;; search/replace commands. It retains its historical name.
;;
;; This is not as complicated as it seems. It is simply a list of common
;; display situations and the actions to take, plus commands for redrawing
;; the screen if it should be unaligned.
@ -1284,6 +1301,12 @@ non-first windows in Follow mode."
(setq follow-windows-start-end-cache nil))
(follow-adjust-window win)))))
;; NOTE: to debug follow-mode with edebug, it is helpful to add
;; `follow-post-command-hook' to `post-command-hook' temporarily. Do
;; this locally to the target buffer with, say,:
;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t)
;; .
(defun follow-adjust-window (win)
;; Adjust the window WIN and its followers.
(cl-assert (eq (window-buffer win) (current-buffer)))

2
lisp/gnus/nneething.el
View file

@ -123,7 +123,7 @@ included.")
(file-exists-p file) ; The file exists.
(not (file-directory-p file)) ; It's not a dir.
(save-excursion
(let ((nnmail-file-coding-system 'binary))
(let ((nnmail-file-coding-system 'raw-text))
(nnmail-find-file file)) ; Insert the file in the nntp buf.
(unless (nnheader-article-p) ; Either it's a real article...
(let ((type

52
lisp/international/mule-cmds.el
View file

@ -2213,7 +2213,7 @@ See `set-language-info-alist' for use in programs."
("bg" "Bulgarian" cp1251) ; Bulgarian
; bh Bihari
; bi Bislama
("bn" . "UTF-8") ; Bengali, Bangla
("bn" "Bengali" utf-8) ; Bengali, Bangla
("bo" . "Tibetan")
("br" . "Latin-1") ; Breton
("bs" . "Latin-2") ; Bosnian
@ -2226,6 +2226,7 @@ See `set-language-info-alist' for use in programs."
("de" "German" iso-8859-1)
; dv Divehi
; dz Bhutani
("ee" . "Latin-4") ; Ewe
("el" "Greek" iso-8859-7)
;; Users who specify "en" explicitly typically want Latin-1, not ASCII.
;; That's actually what the GNU locales define, modulo things like
@ -2234,10 +2235,10 @@ See `set-language-info-alist' for use in programs."
("en" "English" iso-8859-1) ; English
("eo" . "Esperanto") ; Esperanto
("es" "Spanish" iso-8859-1)
("et" . "Latin-1") ; Estonian
("et" . "Latin-9") ; Estonian
("eu" . "Latin-1") ; Basque
("fa" . "UTF-8") ; Persian
("fi" . "Latin-1") ; Finnish
("fa" "Persian" utf-8) ; Persian
("fi" . "Latin-9") ; Finnish
("fj" . "Latin-1") ; Fiji
("fo" . "Latin-1") ; Faroese
("fr" "French" iso-8859-1) ; French
@ -2247,11 +2248,12 @@ See `set-language-info-alist' for use in programs."
("gez" "Ethiopic" utf-8) ; Geez
("gl" . "Latin-1") ; Gallegan; Galician
; gn Guarani
("gu" . "UTF-8") ; Gujarati
("gu" "Gujarati" utf-8) ; Gujarati
("gv" . "Latin-1") ; Manx Gaelic
; ha Hausa
("he" "Hebrew" iso-8859-8)
("hi" "Devanagari" utf-8) ; Hindi
("hni_IN" . "UTF-8") ; Chhattisgarhi
("hr" "Croatian" iso-8859-2) ; Croatian
("hu" . "Latin-2") ; Hungarian
; hy Armenian
@ -2268,20 +2270,20 @@ See `set-language-info-alist' for use in programs."
("ka" "Georgian" georgian-ps) ; Georgian
; kk Kazakh
("kl" . "Latin-1") ; Greenlandic
; km Cambodian
("km" "Khmer" utf-8) ; Cambodian, Khmer
("kn" "Kannada" utf-8)
("ko" "Korean" euc-kr)
; ks Kashmiri
("ks" . "UTF-8") ; Kashmiri
; ku Kurdish
("kw" . "Latin-1") ; Cornish
; ky Kirghiz
("ky" . "UTF-8") ; Kirghiz
("la" . "Latin-1") ; Latin
("lb" . "Latin-1") ; Luxemburgish
("lg" . "Laint-6") ; Ganda
("lg" . "Latin-6") ; Ganda, a.k.a. Luganda
; ln Lingala
("lo" "Lao" utf-8) ; Laothian
("lt" "Lithuanian" iso-8859-13)
("lv" . "Latvian") ; Latvian, Lettish
("lv" "Latvian" iso-8859-13) ; Latvian, Lettish
; mg Malagasy
("mi" . "Latin-7") ; Maori
("mk" "Cyrillic-ISO" iso-8859-5) ; Macedonian
@ -2291,24 +2293,29 @@ See `set-language-info-alist' for use in programs."
("mr" "Devanagari" utf-8) ; Marathi
("ms" . "Latin-1") ; Malay
("mt" . "Latin-3") ; Maltese
; my Burmese
("my" "Burmese" utf-8) ; Burmese
; na Nauru
("nb" . "Latin-1") ; Norwegian
("ne" "Devanagari" utf-8) ; Nepali
("nl" "Dutch" iso-8859-1)
("nn" . "Latin-1") ; Norwegian Nynorsk
("no" . "Latin-1") ; Norwegian
("nr_ZA" . "UTF-8") ; South Ndebele
("nso_ZA" . "UTF-8") ; Pedi
("oc" . "Latin-1") ; Occitan
("om_ET" . "UTF-8") ; (Afan) Oromo
("om" . "Latin-1") ; (Afan) Oromo
; or Oriya
("pa" . "UTF-8") ; Punjabi
("pl" . "Latin-2") ; Polish
("or" "Oriya" utf-8)
("pa" "Punjabi" utf-8) ; Punjabi
("pl" "Polish" iso-8859-2) ; Polish
; ps Pashto, Pushto
("pt_BR" "Brazilian Portuguese" iso-8859-1) ; Brazilian Portuguese
("pt" . "Latin-1") ; Portuguese
; qu Quechua
("rm" . "Latin-1") ; Rhaeto-Romanic
; rn Kirundi
("ro" "Romanian" iso-8859-2)
("ru_RU.koi8r" "Cyrillic-KOI8" koi8-r)
("ru_RU" "Russian" iso-8859-5)
("ru_UA" "Russian" koi8-u)
; rw Kinyarwanda
@ -2317,7 +2324,7 @@ See `set-language-info-alist' for use in programs."
("se" . "UTF-8") ; Northern Sami
; sg Sangho
("sh" . "Latin-2") ; Serbo-Croatian
; si Sinhalese
("si" "Sinhala" utf-8) ; Sinhalese
("sid" . "UTF-8") ; Sidamo
("sk" "Slovak" iso-8859-2)
("sl" "Slovenian" iso-8859-2)
@ -2325,7 +2332,7 @@ See `set-language-info-alist' for use in programs."
; sn Shona
("so_ET" "UTF-8") ; Somali
("so" "Latin-1") ; Somali
("sq" . "Latin-1") ; Albanian
("sq" . "Latin-2") ; Albanian
("sr" . "Latin-2") ; Serbian (Latin alphabet)
; ss Siswati
("st" . "Latin-1") ; Sesotho
@ -2333,17 +2340,20 @@ See `set-language-info-alist' for use in programs."
("sv" "Swedish" iso-8859-1) ; Swedish
("sw" . "Latin-1") ; Swahili
("ta" "Tamil" utf-8)
("te" . "UTF-8") ; Telugu
("te" "Telugu" utf-8) ; Telugu
("tg" "Tajik" koi8-t)
("th" "Thai" tis-620)
("th_TH.tis620" "Thai" tis-620)
("th_TH.TIS-620" "Thai" tis-620)
("th_TH" "Thai" iso-8859-11)
("th" "Thai" iso-8859-11)
("ti" "Ethiopic" utf-8) ; Tigrinya
("tig_ER" . "UTF-8") ; Tigre
; tk Turkmen
("tl" . "Latin-1") ; Tagalog
; tn Setswana
("tn" . "Latin-9") ; Setswana, Tswana
; to Tonga
("tr" "Turkish" iso-8859-9)
; ts Tsonga
("ts" . "Latin-1") ; Tsonga
("tt" . "UTF-8") ; Tatar
; tw Twi
; ug Uighur
@ -2351,6 +2361,7 @@ See `set-language-info-alist' for use in programs."
("ur" . "UTF-8") ; Urdu
("uz_UZ@cyrillic" . "UTF-8"); Uzbek
("uz" . "Latin-1") ; Uzbek
("ve" . "UTF-8") ; Venda
("vi" "Vietnamese" utf-8)
; vo Volapuk
("wa" . "Latin-1") ; Walloon
@ -2380,7 +2391,6 @@ See `set-language-info-alist' for use in programs."
;; Nonstandard or obsolete language codes
("cz" . "Czech") ; e.g. Solaris 2.6
("ee" . "Latin-4") ; Estonian, e.g. X11R6.4
("iw" . "Hebrew") ; e.g. X11R6.4
("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4
("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6

107
lisp/ldefs-boot.el
View file

@ -6626,7 +6626,7 @@ buffers accepted by the function pointed out by variable
`dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers'
says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in
all the other buffers, subject to constraints specified
by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-regexps'.
by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-buffer-regexps'.
A positive prefix argument, N, says to take the Nth backward *distinct*
possibility. A negative argument says search forward.
@ -11451,7 +11451,9 @@ See documentation of variable `tags-file-name'.
(defalias 'pop-tag-mark 'xref-pop-marker-stack)
(autoload 'next-file "etags" "\
(defalias 'next-file 'tags-next-file)
(autoload 'tags-next-file "etags" "\
Select next file among files in current tags table.
A first argument of t (prefix arg, if interactive) initializes to the
@ -11471,40 +11473,32 @@ Continue last \\[tags-search] or \\[tags-query-replace] command.
Used noninteractively with non-nil argument to begin such a command (the
argument is passed to `next-file', which see).
Two variables control the processing we do on each file: the value of
`tags-loop-scan' is a form to be executed on each file to see if it is
interesting (it returns non-nil if so) and `tags-loop-operate' is a form to
evaluate to operate on an interesting file. If the latter evaluates to
nil, we exit; otherwise we scan the next file.
\(fn &optional FIRST-TIME)" t nil)
(make-obsolete 'tags-loop-continue 'multifile-continue '"27.1")
(autoload 'tags-search "etags" "\
Search through all files listed in tags table for match for REGEXP.
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].
If FILE-LIST-FORM is non-nil, it should be a form that, when
evaluated, will return a list of file names. The search will be
restricted to these files.
If FILES if non-nil should be a list or an iterator returning the files to search.
The search will be restricted to these files.
Also see the documentation of the `tags-file-name' variable.
\(fn REGEXP &optional FILE-LIST-FORM)" t nil)
\(fn REGEXP &optional FILES)" t nil)
(autoload 'tags-query-replace "etags" "\
Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue].
Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop.
For non-interactive use, superceded by `multifile-initialize-replace'.
If FILE-LIST-FORM is non-nil, it is a form to evaluate to
produce the list of files to search.
\(fn FROM TO &optional DELIMITED FILES)" t nil)
See also the documentation of the variable `tags-file-name'.
\(fn FROM TO &optional DELIMITED FILE-LIST-FORM)" t nil)
(set-advertised-calling-convention 'tags-query-replace '(from to &optional delimited) '"27.1")
(autoload 'list-tags "etags" "\
Display list of tags in file FILE.
@ -11541,7 +11535,7 @@ for \\[find-tag] (which see).
\(fn)" nil nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "next-file-list" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-")))
;;;***
@ -12631,7 +12625,7 @@ Execute BODY, and unwind connection-local variables.
(function-put 'with-connection-local-profiles 'lisp-indent-function '1)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "hack-connection-local-variables" "modify-" "read-file-local-variable")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable")))
;;;***
@ -16909,6 +16903,9 @@ Define a filter named NAME.
DOCUMENTATION is the documentation of the function.
READER is a form which should read a qualifier from the user.
DESCRIPTION is a short string describing the filter.
ACCEPT-LIST is a boolean; if non-nil, the filter accepts either
a single condition or a list of them; in the latter
case the filter is the `or' composition of the conditions.
BODY should contain forms which will be evaluated to test whether or
not a particular buffer should be displayed or not. The forms in BODY
@ -17152,7 +17149,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
\(Type \\[describe-mode] in the shell buffer for a list of commands.)
\(fn &optional ARG QUICK)" t nil)
\(fn &optional ARG)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-shell" '("idlwave-")))
@ -22267,6 +22264,41 @@ QUALITY can be:
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis")))
;;;***
;;;### (autoloads nil "multifile" "multifile.el" (0 0 0 0))
;;; Generated autoloads from multifile.el
(autoload 'multifile-initialize "multifile" "\
Initialize a new round of operation on several files.
FILES can be either a list of file names, or an iterator (used with `iter-next')
which returns a file name at each step.
SCAN-FUNCTION is a function called with no argument inside a buffer
and it should return non-nil if that buffer has something on which to operate.
OPERATE-FUNCTION is a function called with no argument; it is expected
to perform the operation on the current file buffer and when done
should return non-nil to mean that we should immediately continue
operating on the next file and nil otherwise.
\(fn FILES SCAN-FUNCTION OPERATE-FUNCTION)" nil nil)
(autoload 'multifile-initialize-search "multifile" "\
\(fn REGEXP FILES CASE-FOLD)" nil nil)
(autoload 'multifile-initialize-replace "multifile" "\
Initialize a new round of query&replace on several files.
FROM is a regexp and TO is the replacement to use.
FILES describes the file, as in `multifile-initialize'.
CASE-FOLD can be t, nil, or `default', the latter one meaning to obey
the default setting of `case-fold-search'.
DELIMITED if non-nil means replace only word-delimited matches.
\(fn FROM TO FILES CASE-FOLD &optional DELIMITED)" nil nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "multifile" '("multifile-")))
;;;***
;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0))
@ -24850,7 +24882,8 @@ STRING should be on something resembling an RFC2822 string, a la
somewhat liberal in what format it accepts, and will attempt to
return a \"likely\" value even for somewhat malformed strings.
The values returned are identical to those of `decode-time', but
any values that are unknown are returned as nil.
any unknown values other than DST are returned as nil, and an
unknown DST value is returned as -1.
\(fn STRING)" nil nil)
@ -26354,6 +26387,20 @@ recognized.
\(fn)" t nil)
(autoload 'project-search "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
To continue searching for next match, use command \\[multifile-continue].
\(fn REGEXP)" t nil)
(autoload 'project-query-replace "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
To continue searching for next match, use command \\[multifile-continue].
\(fn FROM TO)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "project" '("project-")))
;;;***
@ -33791,15 +33838,17 @@ Return the number at point, or nil if none is found.
(autoload 'list-at-point "thingatpt" "\
Return the Lisp list at point, or nil if none is found.
If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are
treated as white space.
\(fn)" nil nil)
\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point")))
;;;***
;;;### (autoloads nil "thread" "emacs-lisp/thread.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/thread.el
;;;### (autoloads nil "thread" "thread.el" (0 0 0 0))
;;; Generated autoloads from thread.el
(autoload 'thread-handle-event "thread" "\
Handle thread events, propagated by `thread-signal'.
@ -33808,6 +33857,14 @@ An EVENT has the format
\(fn EVENT)" t nil)
(autoload 'list-threads "thread" "\
Display a list of threads.
\(fn)" t nil)
(put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.")
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thread" '("thread-list-")))
;;;***
;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0))

169
lisp/net/ntlm.el
View file

@ -1,4 +1,4 @@
;;; ntlm.el --- NTLM (NT LanManager) authentication support
;;; ntlm.el --- NTLM (NT LanManager) authentication support -*- lexical-binding:t -*-
;; Copyright (C) 2001, 2007-2018 Free Software Foundation, Inc.
@ -106,7 +106,7 @@ is not given."
(request-flags (concat (make-string 1 7) (make-string 1 130)
(make-string 1 8) (make-string 1 0)))
;0x07 0x82 0x08 0x00
lu ld off-d off-u)
)
(when (and user (string-match "@" user))
(unless domain
(setq domain (substring user (1+ (match-beginning 0)))))
@ -115,10 +115,10 @@ is not given."
;; set "negotiate domain supplied" bit
(aset request-flags 1 (logior (aref request-flags 1) ?\x10)))
;; set fields offsets within the request struct
(setq lu (length user))
(setq ld (length domain))
(setq off-u 32) ;offset to the string 'user
(setq off-d (+ 32 lu)) ;offset to the string 'domain
(let* ((lu (length user))
(ld (length domain))
(off-u 32) ;offset to the string 'user
(off-d (+ 32 lu))) ;offset to the string 'domain
;; pack the request struct in a string
(concat request-ident ;8 bytes
request-msgType ;4 bytes
@ -131,39 +131,34 @@ is not given."
(md4-pack-int32 (cons 0 off-d)) ;domain field, offset field
user ;buffer field
domain ;buffer field
)))
(eval-when-compile
(defmacro ntlm-string-as-unibyte (string)
(if (fboundp 'string-as-unibyte)
`(string-as-unibyte ,string)
string)))
))))
(defun ntlm-compute-timestamp ()
"Compute an NTLMv2 timestamp.
Return a unibyte string representing the number of tenths of a
microsecond since January 1, 1601 as a 64-bit little-endian
signed integer."
;; FIXME: This can likely be significantly simplified using the new
;; bignums support!
(let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
(us-to-tenths-of-us "mul($3,10)")
(ps-to-tenths-of-us "idiv($4,100000)")
(tenths-of-us-since-jan-1-1601
(apply 'calc-eval (concat "add(add(add("
(apply #'calc-eval (concat "add(add(add("
s-to-tenths-of-us ","
us-to-tenths-of-us "),"
ps-to-tenths-of-us "),"
;; tenths of microseconds between
;; 1601-01-01 and 1970-01-01
"116444736000000000)")
;; add trailing zeros to support old current-time formats
'rawnum (append (current-time) '(0 0))))
'rawnum (encode-time nil 'list)))
result-bytes)
(dotimes (byte 8)
(dotimes (_byte 8)
(push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
result-bytes)
(setq tenths-of-us-since-jan-1-1601
(calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
(apply 'unibyte-string (nreverse result-bytes))))
(apply #'unibyte-string (nreverse result-bytes))))
(defun ntlm-generate-nonce ()
"Generate a random nonce, not to be used more than once.
@ -178,7 +173,13 @@ the NTLM based server for the user USER and the password hash list
PASSWORD-HASHES. NTLM uses two hash values which are represented
by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
(let* ((rchallenge (ntlm-string-as-unibyte challenge))
(let* ((rchallenge (if (multibyte-string-p challenge)
(progn
;; FIXME: Maybe it would be better to
;; signal an error.
(message "Incorrect challenge string type in ntlm-build-auth-response")
(encode-coding-string challenge 'binary))
challenge))
;; get fields within challenge struct
;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes
;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
@ -189,20 +190,16 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
;0x07 0x82 0x08 0x00
(flags (substring rchallenge 20 24)) ;flags, 4 bytes
(challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
uDomain-len uDomain-offs
;; response struct and its fields
;; Extract domain string from challenge string.
;;(uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
(uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
;; Response struct and its fields.
lmRespData ;lmRespData, 24 bytes
ntRespData ;ntRespData, variable length
domain ;ascii domain string
workstation ;ascii workstation string
ll ln lu ld lw off-lm off-nt off-u off-d off-w)
;; extract domain string from challenge string
(setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
(setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
;; match Mozilla behavior, which is to send an empty domain string
(setq domain "")
;; match Mozilla behavior, which is to send "WORKSTATION"
(setq workstation "WORKSTATION")
;; Match Mozilla behavior, which is to send an empty domain string
(domain "") ;ascii domain string
;; Match Mozilla behavior, which is to send "WORKSTATION".
(workstation "WORKSTATION")) ;ascii workstation string
;; overwrite domain in case user is given in <user>@<domain> format
(when (string-match "@" user)
(setq domain (substring user (1+ (match-beginning 0))))
@ -261,13 +258,11 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
;; so just treat it the same as levels 0 and 1
;; check if "negotiate NTLM2 key" flag is set in type 2 message
(if (not (zerop (logand (aref flags 2) 8)))
(let (randomString
sessionHash)
;; generate NTLM2 session response data
(setq randomString (ntlm-generate-nonce))
(setq sessionHash (secure-hash 'md5
;; generate NTLM2 session response data
(let* ((randomString (ntlm-generate-nonce))
(sessionHash (secure-hash 'md5
(concat challengeData randomString)
nil nil t))
nil nil t)))
(setq sessionHash (substring sessionHash 0 8))
(setq lmRespData (concat randomString (make-string 16 0)))
(setq ntRespData (ntlm-smb-owf-encrypt
@ -279,16 +274,16 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
;; get offsets to fields to pack the response struct in a string
(setq ll (length lmRespData))
(setq ln (length ntRespData))
(setq lu (length user))
(setq ld (length domain))
(setq lw (length workstation))
(setq off-u 64) ;offset to string 'uUser
(setq off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain
(setq off-w (+ off-d (* 2 ld))) ;offset to string 'uWks
(setq off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse
(setq off-nt (+ off-lm ll)) ;offset to string 'ntResponse
(let* ((ll (length lmRespData))
(ln (length ntRespData))
(lu (length user))
(ld (length domain))
(lw (length workstation))
(off-u 64) ;offset to string 'uUser
(off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain
(off-w (+ off-d (* 2 ld))) ;offset to string 'uWks
(off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse
(off-nt (+ off-lm ll))) ;offset to string 'ntResponse
;; pack the response struct in a string
(concat "NTLMSSP\0" ;response ident field, 8 bytes
(md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
@ -342,7 +337,7 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(ntlm-ascii2unicode workstation lw) ;Unicode workstation, 2*lw bytes
lmRespData ;lmResponse, 24 bytes
ntRespData ;ntResponse, ln bytes
)))
))))
(defun ntlm-get-password-hashes (password)
"Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD."
@ -352,7 +347,10 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(defun ntlm-ascii2unicode (str len)
"Convert an ASCII string into a NT Unicode string, which is
little-endian utf16."
(let ((utf (make-string (* 2 len) 0)) (i 0) val)
;; FIXME: Can't we use encode-coding-string with a `utf-16le' coding system?
(let ((utf (make-string (* 2 len) 0))
(i 0)
val)
(while (and (< i len)
(not (zerop (setq val (aref str i)))))
(aset utf (* 2 i) val)
@ -381,9 +379,9 @@ string PASSWD. PASSWD is truncated to 14 bytes if longer."
"Return the response string of 24 bytes long for the given password
string PASSWD based on the DES encryption. PASSWD is of at most 14
bytes long and the challenge string C8 of 8 bytes long."
(let ((len (min (length passwd) 16)) p22)
(setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
(make-string (- 22 len) 0)))
(let* ((len (min (length passwd) 16))
(p22 (concat (substring passwd 0 len) ;Fill top 16 bytes with passwd.
(make-string (- 22 len) 0))))
(ntlm-smb-des-e-p24 p22 c8)))
(defun ntlm-smb-des-e-p24 (p22 c8)
@ -405,26 +403,26 @@ string C8."
"Return the hash string of length 8 for a string IN of length 8 and
a string KEY of length 8. FORW is t or nil."
(let ((out (make-string 8 0))
outb ;string of length 64
(inb (make-string 64 0))
(keyb (make-string 64 0))
(key2 (ntlm-smb-str-to-key key))
(i 0) aa)
(i 0))
(while (< i 64)
(unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8)))))
(aset inb i 1))
(unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8)))))
(aset keyb i 1))
(setq i (1+ i)))
(setq outb (ntlm-smb-dohash inb keyb forw))
(setq i 0)
(while (< i 64)
(unless (zerop (aref outb i))
(setq aa (aref out (/ i 8)))
(aset out (/ i 8)
(logior aa (ash 1 (- 7 (% i 8))))))
(setq i (1+ i)))
out))
(let ((outb (ntlm-smb-dohash inb keyb forw))
aa)
(setq i 0)
(while (< i 64)
(unless (zerop (aref outb i))
(setq aa (aref out (/ i 8)))
(aset out (/ i 8)
(logior aa (ash 1 (- 7 (% i 8))))))
(setq i (1+ i)))
out)))
(defun ntlm-smb-str-to-key (str)
"Return a string of length 8 for the given string STR of length 7."
@ -571,27 +569,22 @@ length of STR is LEN."
"Return the hash value for a string IN and a string KEY.
Length of IN and KEY are 64. FORW non-nil means forward, nil means
backward."
(let (pk1 ;string of length 56
c ;string of length 28
d ;string of length 28
cd ;string of length 56
(ki (make-vector 16 0)) ;vector of string of length 48
pd1 ;string of length 64
l ;string of length 32
r ;string of length 32
rl ;string of length 64
(i 0) (j 0) (k 0))
(setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56))
(setq c (substring pk1 0 28))
(setq d (substring pk1 28 56))
(let* ((pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) ;string of length 56
(c (substring pk1 0 28)) ;string of length 28
(d (substring pk1 28 56)) ;string of length 28
cd ;string of length 56
(ki (make-vector 16 0)) ;vector of string of length 48
pd1 ;string of length 64
l ;string of length 32
r ;string of length 32
rl ;string of length 64
(i 0) (j 0) (k 0))
(setq i 0)
(while (< i 16)
(dotimes (i 16)
(setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28))
(setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28))
(setq cd (concat (substring c 0 28) (substring d 0 28)))
(aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))
(setq i (1+ i)))
(aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48)))
(setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64))
@ -650,16 +643,12 @@ backward."
(defun ntlm-md4hash (passwd)
"Return the 16 bytes MD4 hash of a string PASSWD after converting it
into a Unicode string. PASSWD is truncated to 128 bytes if longer."
(let (len wpwd)
;; Password cannot be longer than 128 characters
(setq len (length passwd))
(if (> len 128)
(setq len 128))
;; Password must be converted to NT Unicode
(setq wpwd (ntlm-ascii2unicode passwd len))
;; Calculate length in bytes
(setq len (* len 2))
(md4 wpwd len)))
(let* ((len (min (length passwd) 128)) ;Pwd can't be > than 128 characters.
;; Password must be converted to NT Unicode.
(wpwd (ntlm-ascii2unicode passwd len)))
(md4 wpwd
;; Calculate length in bytes.
(* len 2))))
(provide 'ntlm)

8
lisp/net/tramp-archive.el
View file

@ -331,14 +331,18 @@ pass to the OPERATION."
(save-match-data (apply (cdr fn) args))
(tramp-archive-run-real-handler operation args)))))))
;;;###autoload
(defalias
'tramp-archive-autoload-file-name-handler 'tramp-autoload-file-name-handler)
;;;###autoload
(progn (defun tramp-register-archive-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
(when tramp-archive-enabled
(add-to-list 'file-name-handler-alist
(cons (tramp-archive-autoload-file-name-regexp)
'tramp-autoload-file-name-handler))
(put 'tramp-archive-file-name-handler 'safe-magic t))))
'tramp-archive-autoload-file-name-handler))
(put 'tramp-archive-autoload-file-name-handler 'safe-magic t))))
;;;###autoload
(progn

2
lisp/net/tramp-sh.el
View file

@ -1448,7 +1448,7 @@ of."
;; recorded last modification time, or there is no established
;; connection.
(if (or (not f)
(zerop (visited-file-modtime))
(zerop (float-time (visited-file-modtime)))
(not (file-remote-p f nil 'connected)))
t
(with-parsed-tramp-file-name f nil

66
lisp/net/tramp.el
View file

@ -2017,21 +2017,20 @@ been set up by `rfn-eshadow-setup-minibuffer'."
(minibuffer-prompt-end)))
;; We do not want to send any remote command.
(non-essential t))
(when
(tramp-tramp-file-p
(buffer-substring-no-properties end (point-max)))
(save-restriction
(narrow-to-region
(1+ (or (string-match
(tramp-rfn-eshadow-update-overlay-regexp)
(buffer-string) end)
end))
(point-max))
(let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
(rfn-eshadow-update-overlay-hook nil)
file-name-handler-alist)
(move-overlay rfn-eshadow-overlay (point-max) (point-max))
(rfn-eshadow-update-overlay)))))))
(when (tramp-tramp-file-p (buffer-substring end (point-max)))
(save-excursion
(save-restriction
(narrow-to-region
(1+ (or (string-match
(tramp-rfn-eshadow-update-overlay-regexp)
(buffer-string) end)
end))
(point-max))
(let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
(rfn-eshadow-update-overlay-hook nil)
file-name-handler-alist)
(move-overlay rfn-eshadow-overlay (point-max) (point-max))
(rfn-eshadow-update-overlay))))))))
(add-hook 'rfn-eshadow-update-overlay-hook
'tramp-rfn-eshadow-update-overlay)
@ -2153,7 +2152,7 @@ ARGS are the arguments OPERATION has been called with."
default-directory))
;; FILE DIRECTORY resp FILE1 FILE2.
((member operation
'(add-name-to-file copy-directory copy-file expand-file-name
'(add-name-to-file copy-directory copy-file
file-equal-p file-in-directory-p
file-name-all-completions file-name-completion
;; Starting with Emacs 26.1, just the 2nd argument of
@ -2167,6 +2166,13 @@ ARGS are the arguments OPERATION has been called with."
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
(t default-directory))))
;; FILE DIRECTORY resp FILE1 FILE2.
((eq operation 'expand-file-name)
(save-match-data
(cond
((file-name-absolute-p (nth 0 args)) (nth 0 args))
((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
(t default-directory))))
;; START END FILE.
((eq operation 'write-region)
(if (file-name-absolute-p (nth 2 args))
@ -2290,7 +2296,8 @@ If Emacs is compiled --with-threads, the body is protected by a mutex."
;; the Tramp packages locally.
(when (autoloadp sf)
(let ((default-directory
(tramp-compat-temporary-file-directory)))
(tramp-compat-temporary-file-directory))
file-name-handler-alist)
(load (cadr sf) 'noerror 'nomessage)))
;; (tramp-message
;; v 4 "Running `%s'..." (cons operation args))
@ -2391,10 +2398,10 @@ Falls back to normal file name handler if no Tramp file name handler exists."
;;;###autoload
(progn (defun tramp-autoload-file-name-handler (operation &rest args)
"Load Tramp file name handler, and perform OPERATION."
(tramp-unload-file-name-handlers)
(if tramp-mode
(let ((default-directory temporary-file-directory))
(load "tramp" 'noerror 'nomessage))
(tramp-unload-file-name-handlers))
(load "tramp" 'noerror 'nomessage)))
(apply operation args)))
;; `tramp-autoload-file-name-handler' must be registered before
@ -2438,15 +2445,8 @@ remote file names."
(defun tramp-register-file-name-handlers ()
"Add Tramp file name handlers to `file-name-handler-alist'."
;; Remove autoloaded handlers from file name handler alist. Useful,
;; if `tramp-syntax' has been changed. We cannot call
;; `tramp-unload-file-name-handlers', this would result in recursive
;; loading of Tramp.
(dolist (fnh '(tramp-file-name-handler
tramp-completion-file-name-handler
tramp-archive-file-name-handler
tramp-autoload-file-name-handler))
(let ((a1 (rassq fnh file-name-handler-alist)))
(setq file-name-handler-alist (delq a1 file-name-handler-alist))))
;; if `tramp-syntax' has been changed.
(tramp-unload-file-name-handlers)
;; Add the handlers. We do not add anything to the `operations'
;; property of `tramp-file-name-handler' and
@ -2521,12 +2521,10 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
;;;###autoload
(progn (defun tramp-unload-file-name-handlers ()
"Unload Tramp file name handlers from `file-name-handler-alist'."
(dolist (fnh '(tramp-file-name-handler
tramp-completion-file-name-handler
tramp-archive-file-name-handler
tramp-autoload-file-name-handler))
(let ((a1 (rassq fnh file-name-handler-alist)))
(setq file-name-handler-alist (delq a1 file-name-handler-alist))))))
(dolist (fnh file-name-handler-alist)
(when (and (symbolp (cdr fnh))
(string-prefix-p "tramp-" (symbol-name (cdr fnh))))
(setq file-name-handler-alist (delq fnh file-name-handler-alist))))))
(add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)

11
lisp/net/trampver.el
View file

@ -25,11 +25,10 @@
;;; Code:
;; In the Tramp GIT repository, the version number and the bug report
;; address are auto-frobbed from configure.ac, so you should edit that
;; file and run "autoconf && ./configure" to change them. Emacs
;; version check is defined in macro AC_EMACS_INFO of aclocal.m4;
;; should be changed only there.
;; In the Tramp GIT, the version number is auto-frobbed from tramp.el,
;; and the bug report address is auto-frobbed from configure.ac.
;; Emacs version check is defined in macro AC_EMACS_INFO of
;; aclocal.m4; should be changed only there.
;;;###tramp-autoload
(defconst tramp-version "2.4.1-pre"
@ -68,7 +67,7 @@
("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5")
("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2")
("2.2.13.25.2" . "25.3")
("2.3.3.26.1" . "26.1") ("2.3.4.26.2" . "26.2")))
("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2")))
(add-hook 'tramp-unload-hook
(lambda ()

3
lisp/obsolete/vc-arch.el
View file

@ -133,7 +133,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(file-error (insert (format "%s <%s> %s"
(current-time-string)
user-mail-address
(+ (nth 2 (current-time))
(+ (% (car (encode-time nil 1000000))
1000000)
(buffer-size)))))))
(comment-region beg (point))))

4
lisp/org/org-id.el
View file

@ -357,7 +357,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
"Return string with random (version 4) UUID."
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
(random)
(current-time)
(encode-time nil 'list)
(user-uid)
(emacs-pid)
(user-full-name)
@ -416,7 +416,7 @@ The input I may be a character, or a single-letter string."
"Encode TIME as a 10-digit string.
This string holds the time to micro-second accuracy, and can be decoded
using `org-id-decode'."
(setq time (or time (current-time)))
(setq time (encode-time time 'list))
(concat (org-id-int-to-b36 (nth 0 time) 4)
(org-id-int-to-b36 (nth 1 time) 4)
(org-id-int-to-b36 (or (nth 2 time) 0) 4)))

37
lisp/progmodes/sql.el
View file

@ -213,7 +213,7 @@
;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
;; Harald Maier <maierh@myself.com> -- sql-send-string
;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
;; code polish
;; code polish; on-going guidance and mentorship
;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement
;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
@ -222,6 +222,7 @@
;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
;; Simen Heggestøyl <simenheg@gmail.com> -- Postgres database completion
;; Robert Cochran <robert-emacs@cochranmail.com> -- MariaDB support
;; Alex Harsanyi <alexharsanyi@gmail.com> -- sql-indent package and support
;;
@ -723,6 +724,30 @@ This allows highlighting buffers properly when you open them."
:group 'SQL
:safe 'symbolp)
;; SQL indent support
(defcustom sql-use-indent-support t
"If non-nil then use the SQL indent support features of sql-indent.
The `sql-indent' package in ELPA provides indentation support for
SQL statements with easy customizations to support varied layout
requirements.
The package must be available to be loaded and activated."
:group 'SQL
:link '(url-link "https://elpa.gnu.org/packages/sql-indent.html")
:type 'booleanp
:version "27.1")
(defun sql-is-indent-available ()
"Check if sql-indent module is available."
(when (locate-library "sql-indent")
(fboundp 'sqlind-minor-mode)))
(defun sql-indent-enable ()
"Enable `sqlind-minor-mode' if available and requested."
(when (sql-is-indent-available)
(sqlind-minor-mode (if sql-use-indent-support +1 -1))))
;; misc customization of sql.el behavior
(defcustom sql-electric-stuff nil
@ -850,15 +875,17 @@ commands when the input history is read, as if you had set
;; The usual hooks
(defcustom sql-interactive-mode-hook '()
(defcustom sql-interactive-mode-hook '(sql-indent-enable)
"Hook for customizing `sql-interactive-mode'."
:type 'hook
:group 'SQL)
:group 'SQL
:version "27.1")
(defcustom sql-mode-hook '()
(defcustom sql-mode-hook '(sql-indent-enable)
"Hook for customizing `sql-mode'."
:type 'hook
:group 'SQL)
:group 'SQL
:version "27.1")
(defcustom sql-set-sqli-hook '()
"Hook for reacting to changes of `sql-buffer'.

220
lisp/replace.el
View file

@ -1099,10 +1099,9 @@ a previously found match."
map)
"Keymap for `occur-mode'.")
(defvar occur-revert-arguments nil
(defvar-local occur-revert-arguments nil
"Arguments to pass to `occur-1' to revert an Occur mode buffer.
See `occur-revert-function'.")
(make-variable-buffer-local 'occur-revert-arguments)
(put 'occur-revert-arguments 'permanent-local t)
(defcustom occur-mode-hook '(turn-on-font-lock)
@ -1122,6 +1121,11 @@ for this is to reveal context in an outline-mode when the occurrence is hidden."
:type 'hook
:group 'matching)
(defun occur--garbage-collect-revert-args ()
(dolist (boo (nth 2 occur-revert-arguments))
(when (overlayp boo) (delete-overlay boo)))
(kill-local-variable 'occur-revert-arguments))
(put 'occur-mode 'mode-class 'special)
(define-derived-mode occur-mode special-mode "Occur"
"Major mode for output from \\[occur].
@ -1130,8 +1134,9 @@ for this is to reveal context in an outline-mode when the occurrence is hidden."
Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
\\{occur-mode-map}"
(set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
(setq next-error-function 'occur-next-error))
(setq-local revert-buffer-function #'occur-revert-function)
(add-hook 'kill-buffer-hook #'occur--garbage-collect-revert-args nil t)
(setq next-error-function #'occur-next-error))
;;; Occur Edit mode
@ -1154,7 +1159,7 @@ the originating buffer.
To return to ordinary Occur mode, use \\[occur-cease-edit]."
(setq buffer-read-only nil)
(add-hook 'after-change-functions 'occur-after-change-function nil t)
(add-hook 'after-change-functions #'occur-after-change-function nil t)
(message (substitute-command-keys
"Editing: Type \\[occur-cease-edit] to return to Occur mode.")))
@ -1206,34 +1211,9 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
(move-to-column col)))))))
(defun occur--parse-occur-buffer()
"Retrieve a list of the form (BEG END ORIG-LINE BUFFER).
BEG and END define the region.
ORIG-LINE and BUFFER are the line and the buffer from which
the user called `occur'."
(save-excursion
(goto-char (point-min))
(let ((buffer (get-text-property (point) 'occur-title))
(beg-pos (get-text-property (point) 'region-start))
(end-pos (get-text-property (point) 'region-end))
(orig-line (get-text-property (point) 'current-line)))
(list beg-pos end-pos orig-line buffer))))
(defun occur-revert-function (_ignore1 _ignore2)
"Handle `revert-buffer' for Occur mode buffers."
(if (cdr (nth 2 occur-revert-arguments)) ; multi-occur
(apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))
(pcase-let ((`(,region-start ,region-end ,orig-line ,buffer)
(occur--parse-occur-buffer))
(regexp (car occur-revert-arguments)))
(with-current-buffer buffer
(when (wholenump orig-line)
(goto-char (point-min))
(forward-line (1- orig-line)))
(save-excursion
(if (or region-start region-end)
(occur regexp nil (list (cons region-start region-end)))
(apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))))))))
(apply #'occur-1 (append occur-revert-arguments (list (buffer-name)))))
(defun occur-mode-find-occurrence ()
(let ((pos (get-text-property (point) 'occur-target)))
@ -1437,10 +1417,6 @@ invoke `occur'."
(or unique-p (not interactive-p)))))
;; Region limits when `occur' applies on a region.
(defvar occur--region-start nil)
(defvar occur--region-end nil)
(defvar occur--region-start-line nil)
(defvar occur--orig-line nil)
(defvar occur--final-pos nil)
(defun occur (regexp &optional nlines region)
@ -1487,23 +1463,14 @@ is not modified."
(and (use-region-p) (list (region-bounds)))))
(let* ((start (and (caar region) (max (caar region) (point-min))))
(end (and (cdar region) (min (cdar region) (point-max))))
(in-region-p (or start end)))
(when in-region-p
(or start (setq start (point-min)))
(or end (setq end (point-max))))
(let ((occur--region-start start)
(occur--region-end end)
(occur--region-start-line
(and in-region-p
(line-number-at-pos (min start end))))
(occur--orig-line
(line-number-at-pos (point))))
(save-excursion ; If no matches `occur-1' doesn't restore the point.
(and in-region-p (narrow-to-region
(save-excursion (goto-char start) (line-beginning-position))
(save-excursion (goto-char end) (line-end-position))))
(occur-1 regexp nlines (list (current-buffer)))
(and in-region-p (widen))))))
(in-region (or start end))
(bufs (if (not in-region) (list (current-buffer))
(let ((ol (make-overlay
(or start (point-min))
(or end (point-max)))))
(overlay-put ol 'occur--orig-point (point))
(list ol)))))
(occur-1 regexp nlines bufs)))
(defvar ido-ignore-item-temp-list)
@ -1574,17 +1541,27 @@ See also `multi-occur'."
(query-replace-descr regexp))))
(defun occur-1 (regexp nlines bufs &optional buf-name)
;; BUFS is a list of buffer-or-overlay!
(unless (and regexp (not (equal regexp "")))
(error "Occur doesn't work with the empty regexp"))
(unless buf-name
(setq buf-name "*Occur*"))
(let (occur-buf
(active-bufs (delq nil (mapcar #'(lambda (buf)
(when (buffer-live-p buf) buf))
bufs))))
(active-bufs
(delq nil (mapcar (lambda (boo)
(when (or (buffer-live-p boo)
(and (overlayp boo)
(overlay-buffer boo)))
boo))
bufs))))
;; Handle the case where one of the buffers we're searching is the
;; output buffer. Just rename it.
(when (member buf-name (mapcar 'buffer-name active-bufs))
(when (member buf-name
;; FIXME: Use cl-exists.
(mapcar
(lambda (boo)
(buffer-name (if (overlayp boo) (overlay-buffer boo) boo)))
active-bufs))
(with-current-buffer (get-buffer buf-name)
(rename-uniquely)))
@ -1604,22 +1581,24 @@ See also `multi-occur'."
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
(let ((bufs active-bufs)
(count 0))
(while bufs
(with-current-buffer (car bufs)
(let ((count 0))
(dolist (boo active-bufs)
(with-current-buffer
(if (overlayp boo) (overlay-buffer boo) boo)
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
;; Insert the replacement regexp.
(let ((str (match-substitute-replacement nlines)))
(if str
(with-current-buffer occur-buf
(insert str)
(setq count (1+ count))
(or (zerop (current-column))
(insert "\n"))))))))
(setq bufs (cdr bufs)))
(goto-char
(if (overlayp boo) (overlay-start boo) (point-min)))
(let ((end (if (overlayp boo) (overlay-end boo))))
(while (re-search-forward regexp end t)
;; Insert the replacement regexp.
(let ((str (match-substitute-replacement
nlines)))
(if str
(with-current-buffer occur-buf
(insert str)
(setq count (1+ count))
(or (zerop (current-column))
(insert "\n"))))))))))
count)
;; Perform normal occur.
(occur-engine
@ -1647,6 +1626,7 @@ See also `multi-occur'."
42)
(window-width))
"" (occur-regexp-descr regexp))))
(occur--garbage-collect-revert-args)
(setq occur-revert-arguments (list regexp nlines bufs))
(if (= count 0)
(kill-buffer occur-buf)
@ -1662,49 +1642,55 @@ See also `multi-occur'."
(defun occur-engine (regexp buffers out-buf nlines case-fold
title-face prefix-face match-face keep-props)
;; BUFFERS is a list of buffer-or-overlay!
(with-current-buffer out-buf
(let ((global-lines 0) ;; total count of matching lines
(global-matches 0) ;; total count of matches
(coding nil)
(case-fold-search case-fold)
(in-region-p (and occur--region-start occur--region-end))
(multi-occur-p (cdr buffers)))
;; Map over all the buffers
(dolist (buf buffers)
(when (buffer-live-p buf)
(let ((lines 0) ;; count of matching lines
(matches 0) ;; count of matches
(curr-line ;; line count
(or occur--region-start-line 1))
(orig-line (or occur--orig-line 1))
(orig-line-shown-p)
(prev-line nil) ;; line number of prev match endpt
(prev-after-lines nil) ;; context lines of prev match
(matchbeg 0)
(origpt nil)
(begpt nil)
(endpt nil)
(marker nil)
(curstring "")
(ret nil)
(inhibit-field-text-motion t)
(headerpt (with-current-buffer out-buf (point))))
(with-current-buffer buf
;; The following binding is for when case-fold-search
;; has a local binding in the original buffer, in which
;; case we cannot bind it globally and let that have
;; effect in every buffer we search.
(let ((case-fold-search case-fold))
(or coding
;; Set CODING only if the current buffer locally
;; binds buffer-file-coding-system.
(not (local-variable-p 'buffer-file-coding-system))
(setq coding buffer-file-coding-system))
(save-excursion
(goto-char (point-min)) ;; begin searching in the buffer
(while (not (eobp))
(dolist (boo buffers)
(when (if (overlayp boo) (overlay-buffer boo) (buffer-live-p boo))
(with-current-buffer (if (overlayp boo) (overlay-buffer boo) boo)
(let ((inhibit-field-text-motion t)
(lines 0) ; count of matching lines
(matches 0) ; count of matches
(headerpt (with-current-buffer out-buf (point)))
)
(save-excursion
;; begin searching in the buffer
(goto-char (if (overlayp boo) (overlay-start boo) (point-min)))
(forward-line 0)
(let* ((limit (if (overlayp boo) (overlay-end boo) (point-max)))
(start-line (line-number-at-pos))
(curr-line start-line) ; line count
(orig-line (if (not (overlayp boo)) 1
(line-number-at-pos
(overlay-get boo 'occur--orig-point))))
(orig-line-shown-p)
(prev-line nil) ; line number of prev match endpt
(prev-after-lines nil) ; context lines of prev match
(matchbeg 0)
(origpt nil)
(begpt nil)
(endpt nil)
(marker nil)
(curstring "")
(ret nil)
;; The following binding is for when case-fold-search
;; has a local binding in the original buffer, in which
;; case we cannot bind it globally and let that have
;; effect in every buffer we search.
(case-fold-search case-fold))
(or coding
;; Set CODING only if the current buffer locally
;; binds buffer-file-coding-system.
(not (local-variable-p 'buffer-file-coding-system))
(setq coding buffer-file-coding-system))
(while (< (point) limit)
(setq origpt (point))
(when (setq endpt (re-search-forward regexp nil t))
(when (setq endpt (re-search-forward regexp limit t))
(setq lines (1+ lines)) ;; increment matching lines count
(setq matchbeg (match-beginning 0))
;; Get beginning of first match line and end of the last.
@ -1810,7 +1796,7 @@ See also `multi-occur'."
(setq orig-line-shown-p t)
(save-excursion
(goto-char (point-min))
(forward-line (- orig-line (or occur--region-start-line 1)))
(forward-line (- orig-line start-line 1))
(occur-engine-line (line-beginning-position)
(line-end-position) keep-props)))))
;; Actually insert the match display data
@ -1848,7 +1834,7 @@ See also `multi-occur'."
(let ((orig-line-str
(save-excursion
(goto-char (point-min))
(forward-line (- orig-line (or occur--region-start-line 1)))
(forward-line (- orig-line start-line 1))
(occur-engine-line (line-beginning-position)
(line-end-position) keep-props))))
(add-face-text-property
@ -1878,17 +1864,14 @@ See also `multi-occur'."
;; Don't display regexp for multi-buffer.
(if (> (length buffers) 1)
"" (occur-regexp-descr regexp))
(buffer-name buf)
(if in-region-p
(buffer-name (if (overlayp boo) (overlay-buffer boo) boo))
(if (overlayp boo)
(format " within region: %d-%d"
occur--region-start
occur--region-end)
(overlay-start boo)
(overlay-end boo))
""))
'read-only t))
(setq end (point))
(add-text-properties beg end `(occur-title ,buf current-line ,orig-line
region-start ,occur--region-start
region-end ,occur--region-end))
(when title-face
(add-face-text-property beg end title-face))
(goto-char (if (and list-matching-lines-jump-to-current-line
@ -2425,7 +2408,7 @@ characters."
(message
(if query-flag
(apply 'propertize
(apply #'propertize
(concat "Query replacing "
(if backward "backward " "")
(if delimited-flag
@ -2880,10 +2863,11 @@ characters."
(if (= replace-count 1) "" "s")
(if (> (+ skip-read-only-count
skip-filtered-count
skip-invisible-count) 0)
skip-invisible-count)
0)
(format " (skipped %s)"
(mapconcat
'identity
#'identity
(delq nil (list
(if (> skip-read-only-count 0)
(format "%s read-only"

23
lisp/savehist.el
View file

@ -173,9 +173,26 @@ minibuffer history.")
"Toggle saving of minibuffer history (Savehist mode).
When Savehist mode is enabled, minibuffer history is saved
periodically and when exiting Emacs. When Savehist mode is
enabled for the first time in an Emacs session, it loads the
previous minibuffer history from `savehist-file'.
to `savehist-file' periodically and when exiting Emacs. When
Savehist mode is enabled for the first time in an Emacs session,
it loads the previous minibuffer histories from `savehist-file'.
The variable `savehist-autosave-interval' controls the
periodicity of saving minibuffer histories.
If `savehist-save-minibuffer-history' is non-nil (the default),
all recorded minibuffer histories will be saved. You can arrange
for additional history variables to be saved and restored by
customizing `savehist-additional-variables', which by default is
an empty list. For example, to save the history of commands
invoked via \\[execute-extended-command], add `command-history' to the list in
`savehist-additional-variables'.
Alternatively, you could customize `savehist-save-minibuffer-history'
to nil, and add to `savehist-additional-variables' only those
history variables you want to save.
To ignore some history variables, add their symbols to the list
in `savehist-ignored-variables'.
This mode should normally be turned on from your Emacs init file.
Calling it at any other time replaces your current minibuffer

8
lisp/simple.el
View file

@ -5870,10 +5870,10 @@ its earlier value."
Transient Mark mode is a global minor mode. When enabled, the
region is highlighted with the `region' face whenever the mark
is active. The mark is \"deactivated\" by changing the buffer,
and after certain other operations that set the mark but whose
main purpose is something else--for example, incremental search,
\\[beginning-of-buffer], and \\[end-of-buffer].
is active. The mark is \"deactivated\" after certain non-motion
commands, including those that change the text in the buffer, and
during shift or mouse selection by any unshifted cursor motion
command (see Info node `Shift Selection' for more details).
You can also deactivate the mark by typing \\[keyboard-quit] or
\\[keyboard-escape-quit].

2
lisp/subr.el
View file

@ -3575,7 +3575,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
;; Don't throw `throw-on-input' on those events by default.
(setq while-no-input-ignore-events
'(focus-in focus-out help-echo iconify-frame
make-frame-visible selection-request))
make-frame-visible selection-request buffer-switch))
(defmacro while-no-input (&rest body)
"Execute BODY only as long as there's no pending input.

28
lisp/tar-mode.el
View file

@ -304,7 +304,7 @@ write-date, checksum, link-type, and link-name."
(tar-parse-octal-integer string tar-uid-offset tar-gid-offset)
(tar-parse-octal-integer string tar-gid-offset tar-size-offset)
(tar-parse-octal-integer string tar-size-offset tar-time-offset)
(tar-parse-octal-long-integer string tar-time-offset tar-chk-offset)
(tar-parse-octal-integer string tar-time-offset tar-chk-offset)
(tar-parse-octal-integer string tar-chk-offset tar-linkp-offset)
link-p
linkname
@ -342,20 +342,8 @@ write-date, checksum, link-type, and link-name."
start (1+ start)))
n)))
(defun tar-parse-octal-long-integer (string &optional start end)
(if (null start) (setq start 0))
(if (null end) (setq end (length string)))
(if (= (aref string start) 0)
(list 0 0)
(let ((lo 0)
(hi 0))
(while (< start end)
(if (>= (aref string start) ?0)
(setq lo (+ (* lo 8) (- (aref string start) ?0))
hi (+ (* hi 8) (ash lo -16))
lo (logand lo 65535)))
(setq start (1+ start)))
(list hi lo))))
(define-obsolete-function-alias 'tar-parse-octal-long-integer
'tar-parse-octal-integer "27.1")
(defun tar-parse-octal-integer-safe (string)
(if (zerop (length string)) (error "empty string"))
@ -1276,14 +1264,8 @@ for this to be permanent."
(defun tar-octal-time (timeval)
;; Format a timestamp as 11 octal digits. Ghod, I hope this works...
(let ((hibits (car timeval)) (lobits (car (cdr timeval))))
(format "%05o%01o%05o"
(ash hibits -2)
(logior (ash (logand 3 hibits) 1)
(if (> (logand lobits 32768) 0) 1 0))
(logand 32767 lobits)
)))
;; Format a timestamp as 11 octal digits.
(format "%011o" (encode-time timeval 'integer)))
(defun tar-subfile-save-buffer ()
"In tar subfile mode, save this buffer into its parent tar-file buffer.

13
lisp/vc/vc.el
View file

@ -834,6 +834,12 @@ See `run-hooks'."
:type 'hook
:group 'vc)
(defcustom vc-retrieve-tag-hook nil
"Normal hook (list of functions) run after retrieving a tag."
:type 'hook
:group 'vc
:version "27.1")
(defcustom vc-revert-show-diff t
"If non-nil, `vc-revert' shows a `vc-diff' buffer before querying."
:type 'boolean
@ -1536,8 +1542,7 @@ The optional argument REV may be a string specifying the new revision
level (only supported for some older VCSes, like RCS and CVS).
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
(run-hooks 'vc-before-checkin-hook))
(run-hooks 'vc-before-checkin-hook)
(vc-start-logentry
files comment initial-contents
"Enter a change comment."
@ -2154,7 +2159,8 @@ otherwise use the repository root of the current buffer.
If NAME is empty, it refers to the latest revisions of the current branch.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped)."
allowed and simply skipped).
This function runs the hook `vc-retrieve-tag-hook' when finished."
(interactive
(let* ((granularity
(vc-call-backend (vc-responsible-backend default-directory)
@ -2181,6 +2187,7 @@ allowed and simply skipped)."
(vc-call-backend (vc-responsible-backend dir)
'retrieve-tag dir name update)
(vc-resynch-buffer dir t t t)
(run-hooks 'vc-retrieve-tag-hook)
(message "%s" (concat msg "done"))))

2
lisp/window.el
View file

@ -6833,7 +6833,7 @@ See `display-buffer' for details.")
(put 'display-buffer-overriding-action 'risky-local-variable t)
(defcustom display-buffer-alist nil
"Alist of uder-defined conditional actions for `display-buffer'.
"Alist of user-defined conditional actions for `display-buffer'.
Its value takes effect before `display-buffer-base-action'
and `display-buffer-fallback-action', but after
`display-buffer-overriding-action', which see.

5
m4/acl.m4
View file

@ -1,5 +1,5 @@
# acl.m4 - check for access control list (ACL) primitives
# serial 22
# serial 23
# Copyright (C) 2002, 2004-2018 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@ -30,7 +30,8 @@ AC_DEFUN([gl_FUNC_ACL],
ac_save_LIBS=$LIBS
dnl Test for POSIX-draft-like API (GNU/Linux, FreeBSD, Mac OS X,
dnl IRIX, Tru64). -lacl is needed on GNU/Linux, -lpacl on OSF/1.
dnl IRIX, Tru64, Cygwin >= 2.5).
dnl -lacl is needed on GNU/Linux, -lpacl on OSF/1.
if test $use_acl = 0; then
AC_SEARCH_LIBS([acl_get_file], [acl pacl],
[if test "$ac_cv_search_acl_get_file" != "none required"; then

4
m4/gettime.m4
View file

@ -1,4 +1,4 @@
# gettime.m4 serial 8
# gettime.m4 serial 9
dnl Copyright (C) 2002, 2004-2006, 2009-2018 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@ -9,5 +9,5 @@ AC_DEFUN([gl_GETTIME],
dnl Prerequisites of lib/gettime.c.
AC_REQUIRE([gl_CLOCK_TIME])
AC_REQUIRE([gl_TIMESPEC])
AC_CHECK_FUNCS_ONCE([gettimeofday nanotime])
AC_CHECK_FUNCS_ONCE([gettimeofday])
])

2
src/Makefile.in
View file

@ -399,7 +399,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \
syntax.o $(UNEXEC_OBJ) bytecode.o \
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
region-cache.o sound.o timefns.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
$(XWIDGETS_OBJ) \
profiler.o decompress.o \

105
src/bignum.c
View file

@ -31,7 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
storage is exhausted. Admittedly this is not ideal. An mpz value
in a temporary is made permanent by mpz_swapping it with a bignum's
value. Although typically at most two temporaries are needed,
rounding_driver and rounddiv_q need four altogther. */
time_arith, rounddiv_q and rounding_driver each need four. */
mpz_t mpz[4];
@ -101,18 +101,6 @@ make_bignum (void)
return make_bignum_bits (mpz_sizeinbase (mpz[0], 2));
}
static void mpz_set_uintmax_slow (mpz_t, uintmax_t);
/* Set RESULT to V. */
static void
mpz_set_uintmax (mpz_t result, uintmax_t v)
{
if (v <= ULONG_MAX)
mpz_set_ui (result, v);
else
mpz_set_uintmax_slow (result, v);
}
/* Return a Lisp integer equal to N, which must not be in fixnum range. */
Lisp_Object
make_bigint (intmax_t n)
@ -129,6 +117,16 @@ make_biguint (uintmax_t n)
return make_bignum ();
}
/* Return a Lisp integer equal to -N, which must not be in fixnum range. */
Lisp_Object
make_neg_biguint (uintmax_t n)
{
eassert (-MOST_NEGATIVE_FIXNUM < n);
mpz_set_uintmax (mpz[0], n);
mpz_neg (mpz[0], mpz[0]);
return make_bignum ();
}
/* Return a Lisp integer with value taken from mpz[0].
Set mpz[0] to a junk value. */
Lisp_Object
@ -183,7 +181,7 @@ mpz_set_intmax_slow (mpz_t result, intmax_t v)
mpz_limbs_finish (result, negative ? -n : n);
}
static void
void
mpz_set_uintmax_slow (mpz_t result, uintmax_t v)
{
int maxlimbs = (UINTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS;
@ -200,13 +198,13 @@ mpz_set_uintmax_slow (mpz_t result, uintmax_t v)
mpz_limbs_finish (result, n);
}
/* Return the value of the bignum X if it fits, 0 otherwise.
A bignum cannot be zero, so 0 indicates failure reliably. */
intmax_t
bignum_to_intmax (Lisp_Object x)
/* If Z fits into *PI, store its value there and return true.
Return false otherwise. */
bool
mpz_to_intmax (mpz_t const z, intmax_t *pi)
{
ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2);
bool negative = mpz_sgn (XBIGNUM (x)->value) < 0;
ptrdiff_t bits = mpz_sizeinbase (z, 2);
bool negative = mpz_sgn (z) < 0;
if (bits < INTMAX_WIDTH)
{
@ -215,39 +213,60 @@ bignum_to_intmax (Lisp_Object x)
do
{
intmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++);
intmax_t limb = mpz_getlimbn (z, i++);
v += limb << shift;
shift += GMP_NUMB_BITS;
}
while (shift < bits);
return negative ? -v : v;
*pi = negative ? -v : v;
return true;
}
return ((bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative
&& mpz_scan1 (XBIGNUM (x)->value, 0) == INTMAX_WIDTH - 1)
? INTMAX_MIN : 0);
if (bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative
&& mpz_scan1 (z, 0) == INTMAX_WIDTH - 1)
{
*pi = INTMAX_MIN;
return true;
}
return false;
}
bool
mpz_to_uintmax (mpz_t const z, uintmax_t *pi)
{
if (mpz_sgn (z) < 0)
return false;
ptrdiff_t bits = mpz_sizeinbase (z, 2);
if (UINTMAX_WIDTH < bits)
return false;
uintmax_t v = 0;
int i = 0, shift = 0;
do
{
uintmax_t limb = mpz_getlimbn (z, i++);
v += limb << shift;
shift += GMP_NUMB_BITS;
}
while (shift < bits);
*pi = v;
return true;
}
/* Return the value of the bignum X if it fits, 0 otherwise.
A bignum cannot be zero, so 0 indicates failure reliably. */
intmax_t
bignum_to_intmax (Lisp_Object x)
{
intmax_t i;
return mpz_to_intmax (XBIGNUM (x)->value, &i) ? i : 0;
}
uintmax_t
bignum_to_uintmax (Lisp_Object x)
{
uintmax_t v = 0;
if (0 <= mpz_sgn (XBIGNUM (x)->value))
{
ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2);
if (bits <= UINTMAX_WIDTH)
{
int i = 0, shift = 0;
do
{
uintmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++);
v += limb << shift;
shift += GMP_NUMB_BITS;
}
while (shift < bits);
}
}
return v;
uintmax_t i;
return mpz_to_uintmax (XBIGNUM (x)->value, &i) ? i : 0;
}
/* Yield an upper bound on the buffer size needed to contain a C

11
src/bignum.h
View file

@ -45,7 +45,10 @@ extern mpz_t mpz[4];
extern void init_bignum (void);
extern Lisp_Object make_integer_mpz (void);
extern bool mpz_to_intmax (mpz_t const, intmax_t *) ARG_NONNULL ((1, 2));
extern bool mpz_to_uintmax (mpz_t const, uintmax_t *) ARG_NONNULL ((1, 2));
extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1));
extern void mpz_set_uintmax_slow (mpz_t, uintmax_t) ARG_NONNULL ((1));
extern double mpz_get_d_rounded (mpz_t const);
INLINE_HEADER_BEGIN
@ -68,6 +71,14 @@ mpz_set_intmax (mpz_t result, intmax_t v)
else
mpz_set_intmax_slow (result, v);
}
INLINE void ARG_NONNULL ((1))
mpz_set_uintmax (mpz_t result, uintmax_t v)
{
if (v <= ULONG_MAX)
mpz_set_ui (result, v);
else
mpz_set_uintmax_slow (result, v);
}
/* Return a pointer to an mpz_t that is equal to the Lisp integer I.
If I is a bignum this returns a pointer to I's representation;

4
src/data.c
View file

@ -336,8 +336,6 @@ DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
return Qnil;
}
/* Define this in C to avoid unnecessarily consing up the symbol
name. */
DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
doc: /* Return t if OBJECT is a keyword.
This means that it is a symbol with a print name beginning with `:'
@ -2798,7 +2796,7 @@ If the base used is not 10, STRING is always parsed as an integer. */)
while (*p == ' ' || *p == '\t')
p++;
Lisp_Object val = string_to_number (p, b, S2N_IGNORE_TRAILING);
Lisp_Object val = string_to_number (p, b, 0);
return NILP (val) ? make_fixnum (0) : val;
}

1289
src/editfns.c
View file

File diff suppressed because it is too large Load diff

25
src/emacs.c
View file

@ -881,18 +881,21 @@ main (int argc, char **argv)
newlim = rlim.rlim_max;
newlim -= newlim % pagesize;
if (pagesize <= newlim - lim)
if (newlim > lim /* in case rlim_t is an unsigned type */
&& pagesize <= newlim - lim)
{
rlim.rlim_cur = newlim;
if (setrlimit (RLIMIT_STACK, &rlim) == 0)
lim = newlim;
}
}
/* If the stack is big enough, let regex-emacs.c more of it before
falling back to heap allocation. */
emacs_re_safe_alloca = max
(min (lim - extra, SIZE_MAX) * (min_ratio / ratio),
MAX_ALLOCA);
/* If the stack is big enough, let regex-emacs.c use more of it
before falling back to heap allocation. */
if (lim < extra)
lim = extra; /* avoid wrap-around in unsigned subtraction */
ptrdiff_t max_failures
= min (lim - extra, min (PTRDIFF_MAX, SIZE_MAX)) / ratio;
emacs_re_safe_alloca = max (max_failures * min_ratio, MAX_ALLOCA);
}
#endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */
@ -1512,6 +1515,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_minibuf ();
syms_of_process ();
syms_of_search ();
syms_of_sysdep ();
syms_of_timefns ();
syms_of_frame ();
syms_of_syntax ();
syms_of_terminal ();
@ -1653,9 +1658,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_charset ();
/* This calls putenv and so must precede init_process_emacs. Also,
it sets Voperating_system_release, which init_process_emacs uses. */
init_editfns (dumping);
/* This calls putenv and so must precede init_process_emacs. */
init_timefns (dumping);
/* This sets Voperating_system_release, which init_process_emacs uses. */
init_editfns ();
/* These two call putenv. */
#ifdef HAVE_DBUS

5
src/eval.c
View file

@ -1591,7 +1591,7 @@ DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
This function does not return.
An error symbol is a symbol with an `error-conditions' property
that is a list of condition names.
that is a list of condition names. The symbol should be non-nil.
A handler for any of those names will get to handle this signal.
The symbol `error' should normally be one of them.
@ -1603,6 +1603,9 @@ See also the function `condition-case'. */
attributes: noreturn)
(Lisp_Object error_symbol, Lisp_Object data)
{
/* If they call us with nonsensical arguments, produce "peculiar error". */
if (NILP (error_symbol) && NILP (data))
error_symbol = Qerror;
signal_or_quit (error_symbol, data, false);
eassume (false);
}

14
src/keyboard.c
View file

@ -3554,6 +3554,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
case ICONIFY_EVENT: ignore_event = Qiconify_frame; break;
case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break;
case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break;
case BUFFER_SWITCH_EVENT: ignore_event = Qbuffer_switch; break;
default: ignore_event = Qnil; break;
}
@ -4162,18 +4163,13 @@ decode_timer (Lisp_Object timer, struct timespec *result)
Lisp_Object *vec;
if (! (VECTORP (timer) && ASIZE (timer) == 9))
return 0;
return false;
vec = XVECTOR (timer)->contents;
if (! NILP (vec[0]))
return 0;
return false;
if (! FIXNUMP (vec[2]))
return false;
struct lisp_time t;
if (decode_time_components (vec[1], vec[2], vec[3], vec[8], &t, 0) <= 0)
return false;
*result = lisp_to_timespec (t);
return timespec_valid_p (*result);
return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result);
}
@ -11082,6 +11078,8 @@ syms_of_keyboard (void)
/* Menu and tool bar item parts. */
DEFSYM (Qmenu_enable, "menu-enable");
DEFSYM (Qbuffer_switch, "buffer-switch");
#ifdef HAVE_NTGUI
DEFSYM (Qlanguage_change, "language-change");
DEFSYM (Qend_session, "end-session");

19
src/lisp.h
View file

@ -236,13 +236,15 @@ enum Lisp_Bits
/* Number of bits in a Lisp_Object value, not counting the tag. */
VALBITS = EMACS_INT_WIDTH - GCTYPEBITS,
/* Number of bits in a Lisp fixnum tag. */
INTTYPEBITS = GCTYPEBITS - 1,
/* Number of bits in a Lisp fixnum value, not counting the tag. */
FIXNUM_BITS = VALBITS + 1
};
/* Number of bits in a Lisp fixnum tag; can be used in #if. */
DEFINE_GDB_SYMBOL_BEGIN (int, INTTYPEBITS)
#define INTTYPEBITS (GCTYPEBITS - 1)
DEFINE_GDB_SYMBOL_END (INTTYPEBITS)
/* The maximum value that can be stored in a EMACS_INT, assuming all
bits other than the type bits contribute to a nonnegative signed value.
This can be used in #if, e.g., '#if USE_LSB_TAG' below expands to an
@ -1034,7 +1036,7 @@ enum More_Lisp_Bits
that cons. */
/* Largest and smallest representable fixnum values. These are the C
values. They are macros for use in static initializers. */
values. They are macros for use in #if and static initializers. */
#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
@ -2504,7 +2506,7 @@ INTEGERP (Lisp_Object x)
return FIXNUMP (x) || BIGNUMP (x);
}
/* Return a Lisp integer with value taken from n. */
/* Return a Lisp integer with value taken from N. */
INLINE Lisp_Object
make_int (intmax_t n)
{
@ -3327,6 +3329,7 @@ extern ptrdiff_t bignum_bufsize (Lisp_Object, int);
extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int);
extern Lisp_Object bignum_to_string (Lisp_Object, int);
extern Lisp_Object make_bignum_str (char const *, int);
extern Lisp_Object make_neg_biguint (uintmax_t);
extern Lisp_Object double_to_integer (double);
/* Converthe integer NUM to *N. Return true if successful, false
@ -3837,7 +3840,7 @@ LOADHIST_ATTACH (Lisp_Object x)
extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object *, Lisp_Object, bool);
enum { S2N_IGNORE_TRAILING = 1 };
extern Lisp_Object string_to_number (char const *, int, int);
extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *);
extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
Lisp_Object);
extern void dir_warning (const char *, Lisp_Object);
@ -4014,11 +4017,10 @@ extern void save_excursion_save (union specbinding *);
extern void save_excursion_restore (Lisp_Object, Lisp_Object);
extern Lisp_Object save_restriction_save (void);
extern void save_restriction_restore (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, bool);
extern void init_editfns (bool);
extern void init_editfns (void);
extern void syms_of_editfns (void);
/* Defined in buffer.c. */
@ -4355,6 +4357,7 @@ extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
extern void emacs_perror (char const *);
extern int renameat_noreplace (int, char const *, int, char const *);
extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern void syms_of_sysdep (void);
/* Defined in filelock.c. */
extern void lock_file (Lisp_Object);

100
src/lread.c
View file

@ -2354,12 +2354,14 @@ character_name_to_code (char const *name, ptrdiff_t name_len)
{
/* For "U+XXXX", pass the leading '+' to string_to_number to reject
monstrosities like "U+-0000". */
ptrdiff_t len = name_len - 1;
Lisp_Object code
= (name[0] == 'U' && name[1] == '+'
? string_to_number (name + 1, 16, 0)
? string_to_number (name + 1, 16, &len)
: call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt));
if (! RANGED_FIXNUMP (0, code, MAX_UNICODE_CHAR)
|| len != name_len - 1
|| char_surrogate_p (XFIXNUM (code)))
{
AUTO_STRING (format, "\\N{%s}");
@ -3531,12 +3533,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
|| strchr ("\"';()[]#`,", c) == NULL));
*p = 0;
ptrdiff_t nbytes = p - read_buffer;
UNREAD (c);
if (!quoted && !uninterned_symbol)
{
Lisp_Object result = string_to_number (read_buffer, 10, 0);
if (! NILP (result))
ptrdiff_t len;
Lisp_Object result = string_to_number (read_buffer, 10, &len);
if (! NILP (result) && len == nbytes)
return unbind_to (count, result);
}
if (!quoted && multibyte)
@ -3548,7 +3552,6 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
}
{
Lisp_Object result;
ptrdiff_t nbytes = p - read_buffer;
ptrdiff_t nchars
= (multibyte
? multibyte_chars_in_text ((unsigned char *) read_buffer,
@ -3700,18 +3703,18 @@ substitute_in_interval (INTERVAL interval, void *arg)
}
/* Convert STRING to a number, assuming base BASE. When STRING has
floating point syntax and BASE is 10, return a nearest float. When
STRING has integer syntax, return a fixnum if the integer fits, or
else a bignum. Otherwise, return nil. If FLAGS &
S2N_IGNORE_TRAILING is nonzero, consider just the longest prefix of
STRING that has valid syntax. */
/* Convert the initial prefix of STRING to a number, assuming base BASE.
If the prefix has floating point syntax and BASE is 10, return a
nearest float; otherwise, if the prefix has integer syntax, return
the integer; otherwise, return nil. If PLEN, set *PLEN to the
length of the numeric prefix if there is one, otherwise *PLEN is
unspecified. */
Lisp_Object
string_to_number (char const *string, int base, int flags)
string_to_number (char const *string, int base, ptrdiff_t *plen)
{
char const *cp = string;
bool float_syntax = 0;
bool float_syntax = false;
double value = 0;
/* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
@ -3797,49 +3800,46 @@ string_to_number (char const *string, int base, int flags)
|| (state & ~INTOVERFLOW) == (LEAD_INT|E_EXP));
}
/* Return nil if the number uses invalid syntax. If FLAGS &
S2N_IGNORE_TRAILING, accept any prefix that matches. Otherwise,
the entire string must match. */
if (! (flags & S2N_IGNORE_TRAILING
? ((state & LEAD_INT) != 0 || float_syntax)
: (!*cp && ((state & ~(INTOVERFLOW | DOT_CHAR)) == LEAD_INT
|| float_syntax))))
return Qnil;
if (plen)
*plen = cp - string;
/* If the number uses integer and not float syntax, and is in C-language
range, use its value, preferably as a fixnum. */
if (leading_digit >= 0 && ! float_syntax)
/* Return a float if the number uses float syntax. */
if (float_syntax)
{
if ((state & INTOVERFLOW) == 0
&& n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM))
{
EMACS_INT signed_n = n;
return make_fixnum (negative ? -signed_n : signed_n);
}
/* Trim any leading "+" and trailing nondigits, then convert to
bignum. */
string += positive;
if (!*after_digits)
return make_bignum_str (string, base);
ptrdiff_t trimmed_len = after_digits - string;
USE_SAFE_ALLOCA;
char *trimmed = SAFE_ALLOCA (trimmed_len + 1);
memcpy (trimmed, string, trimmed_len);
trimmed[trimmed_len] = '\0';
Lisp_Object result = make_bignum_str (trimmed, base);
SAFE_FREE ();
return result;
/* Convert to floating point, unless the value is already known
because it is infinite or a NaN. */
if (! value)
value = atof (string + signedp);
return make_float (negative ? -value : value);
}
/* Either the number uses float syntax, or it does not fit into a fixnum.
Convert it from string to floating point, unless the value is already
known because it is an infinity, a NAN, or its absolute value fits in
uintmax_t. */
if (! value)
value = atof (string + signedp);
/* Return nil if the number uses invalid syntax. */
if (! (state & LEAD_INT))
return Qnil;
return make_float (negative ? -value : value);
/* Fast path if the integer (san sign) fits in uintmax_t. */
if (! (state & INTOVERFLOW))
{
if (!negative)
return make_uint (n);
if (-MOST_NEGATIVE_FIXNUM < n)
return make_neg_biguint (n);
EMACS_INT signed_n = n;
return make_fixnum (-signed_n);
}
/* Trim any leading "+" and trailing nondigits, then return a bignum. */
string += positive;
if (!*after_digits)
return make_bignum_str (string, base);
ptrdiff_t trimmed_len = after_digits - string;
USE_SAFE_ALLOCA;
char *trimmed = SAFE_ALLOCA (trimmed_len + 1);
memcpy (trimmed, string, trimmed_len);
trimmed[trimmed_len] = '\0';
Lisp_Object result = make_bignum_str (trimmed, base);
SAFE_FREE ();
return result;
}

7
src/minibuf.c
View file

@ -2058,8 +2058,11 @@ properties. */);
DEFVAR_LISP ("read-hide-char", Vread_hide_char,
doc: /* Whether to hide input characters in noninteractive mode.
It must be a character, which will be used to mask the input
characters. This variable should never be set globally. */);
If non-nil, it must be a character, which will be used to mask the
input characters. This variable should never be set globally.
This variable also overrides the default character that `read-passwd'
uses to hide passwords. */);
Vread_hide_char = Qnil;
defsubr (&Sactive_minibuffer_window);

801
src/nsterm.m
View file

File diff suppressed because it is too large Load diff

47
src/print.c
View file

@ -1993,39 +1993,17 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
case Lisp_Symbol:
{
bool confusing;
unsigned char *p = SDATA (SYMBOL_NAME (obj));
unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
int c;
ptrdiff_t i, i_byte;
ptrdiff_t size_byte;
Lisp_Object name;
Lisp_Object name = SYMBOL_NAME (obj);
ptrdiff_t size_byte = SBYTES (name);
name = SYMBOL_NAME (obj);
if (p != end && (*p == '-' || *p == '+')) p++;
if (p == end)
confusing = 0;
/* If symbol name begins with a digit, and ends with a digit,
and contains nothing but digits and `e', it could be treated
as a number. So set CONFUSING.
Symbols that contain periods could also be taken as numbers,
but periods are always escaped, so we don't have to worry
about them here. */
else if (*p >= '0' && *p <= '9'
&& end[-1] >= '0' && end[-1] <= '9')
{
while (p != end && ((*p >= '0' && *p <= '9')
/* Needed for \2e10. */
|| *p == 'e' || *p == 'E'))
p++;
confusing = (end == p);
}
else
confusing = 0;
size_byte = SBYTES (name);
/* Set CONFUSING if NAME looks like a number, calling
string_to_number for non-obvious cases. */
char *p = SSDATA (name);
bool signedp = *p == '-' || *p == '+';
ptrdiff_t len;
bool confusing = ((c_isdigit (p[signedp]) || p[signedp] == '.')
&& !NILP (string_to_number (p, 10, &len))
&& len == size_byte);
if (! NILP (Vprint_gensym)
&& !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj))
@ -2036,10 +2014,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
break;
}
for (i = 0, i_byte = 0; i_byte < size_byte;)
ptrdiff_t i = 0;
for (ptrdiff_t i_byte = 0; i_byte < size_byte; )
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
int c;
FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
maybe_quit ();
@ -2049,6 +2029,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
|| c == ';' || c == '#' || c == '(' || c == ')'
|| c == ',' || c == '.' || c == '`'
|| c == '[' || c == ']' || c == '?' || c <= 040
|| c == NO_BREAK_SPACE
|| confusing
|| (i == 1 && confusable_symbol_character_p (c)))
{

7
src/process.c
View file

@ -6852,7 +6852,12 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */)
{
Lisp_Object tem = Fget_process (process);
if (NILP (tem))
tem = string_to_number (SSDATA (process), 10, 0);
{
ptrdiff_t len;
tem = string_to_number (SSDATA (process), 10, &len);
if (NILP (tem) || len != SBYTES (process))
return Qnil;
}
process = tem;
}
else if (!NUMBERP (process))

10
src/scroll.c
View file

@ -41,13 +41,13 @@ struct matrix_elt
int deletecost;
/* Number of inserts so far in this run of inserts,
for the cost in insertcost. */
unsigned char insertcount;
int insertcount;
/* Number of deletes so far in this run of deletes,
for the cost in deletecost. */
unsigned char deletecount;
int deletecount;
/* Number of writes so far since the last insert
or delete for the cost in writecost. */
unsigned char writecount;
int writecount;
};
static void do_direct_scrolling (struct frame *,
@ -186,13 +186,13 @@ calculate_scrolling (struct frame *frame,
else
{
cost = p1->writecost + first_insert_cost[i];
if ((int) p1->insertcount > i)
if (p1->insertcount > i)
emacs_abort ();
cost1 = p1->insertcost + next_insert_cost[i - p1->insertcount];
}
p->insertcost = min (cost, cost1) + draw_cost[i] + extra_cost;
p->insertcount = (cost < cost1) ? 1 : p1->insertcount + 1;
if ((int) p->insertcount > i)
if (p->insertcount > i)
emacs_abort ();
/* Calculate the cost if we do a delete line after

127
src/sysdep.c
View file

@ -91,13 +91,19 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <sys/file.h>
#include <fcntl.h>
#include "syssignal.h"
#include "systime.h"
#include "systty.h"
#include "syswait.h"
#ifdef HAVE_SYS_RESOURCE_H
# include <sys/resource.h>
#endif
#ifdef HAVE_SYS_UTSNAME_H
#include <sys/utsname.h>
#include <memory.h>
#endif /* HAVE_SYS_UTSNAME_H */
# include <sys/utsname.h>
# include <memory.h>
#endif
#include "keyboard.h"
#include "frame.h"
@ -118,18 +124,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#endif
#ifdef WINDOWSNT
#include <direct.h>
# include <direct.h>
/* In process.h which conflicts with the local copy. */
#define _P_WAIT 0
# define _P_WAIT 0
int _cdecl _spawnlp (int, const char *, const char *, ...);
/* The following is needed for O_CLOEXEC, F_SETFD, FD_CLOEXEC, and
several prototypes of functions called below. */
#include <sys/socket.h>
# include <sys/socket.h>
#endif
#include "syssignal.h"
#include "systime.h"
/* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */
#ifndef ULLONG_MAX
#define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int)
@ -2704,30 +2707,6 @@ emacs_perror (char const *message)
errno = err;
}
/* Return a struct timeval that is roughly equivalent to T.
Use the least timeval not less than T.
Return an extremal value if the result would overflow. */
struct timeval
make_timeval (struct timespec t)
{
struct timeval tv;
tv.tv_sec = t.tv_sec;
tv.tv_usec = t.tv_nsec / 1000;
if (t.tv_nsec % 1000 != 0)
{
if (tv.tv_usec < 999999)
tv.tv_usec++;
else if (tv.tv_sec < TYPE_MAXIMUM (time_t))
{
tv.tv_sec++;
tv.tv_usec = 0;
}
}
return tv;
}
/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
ATIME and MTIME, respectively.
FD must be either negative -- in which case it is ignored --
@ -3068,6 +3047,22 @@ list_system_processes (void)
#endif /* !defined (WINDOWSNT) */
#if defined __FreeBSD__ || defined DARWIN_OS
static struct timespec
timeval_to_timespec (struct timeval t)
{
return make_timespec (t.tv_sec, t.tv_usec * 1000);
}
static Lisp_Object
make_lisp_timeval (struct timeval t)
{
return make_lisp_time (timeval_to_timespec (t));
}
#endif
#if defined GNU_LINUX && defined HAVE_LONG_LONG_INT
static struct timespec
time_from_jiffies (unsigned long long tval, long hz)
@ -3588,18 +3583,6 @@ system_process_attributes (Lisp_Object pid)
#elif defined __FreeBSD__
static struct timespec
timeval_to_timespec (struct timeval t)
{
return make_timespec (t.tv_sec, t.tv_usec * 1000);
}
static Lisp_Object
make_lisp_timeval (struct timeval t)
{
return make_lisp_time (timeval_to_timespec (t));
}
Lisp_Object
system_process_attributes (Lisp_Object pid)
{
@ -3769,18 +3752,6 @@ system_process_attributes (Lisp_Object pid)
#elif defined DARWIN_OS
static struct timespec
timeval_to_timespec (struct timeval t)
{
return make_timespec (t.tv_sec, t.tv_usec * 1000);
}
static Lisp_Object
make_lisp_timeval (struct timeval t)
{
return make_lisp_time (timeval_to_timespec (t));
}
Lisp_Object
system_process_attributes (Lisp_Object pid)
{
@ -3911,6 +3882,42 @@ system_process_attributes (Lisp_Object pid)
}
#endif /* !defined (WINDOWSNT) */
DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
0, 0, 0,
doc: /* Return the current run time used by Emacs.
The time is returned as in the style of `current-time'.
On systems that can't determine the run time, `get-internal-run-time'
does the same thing as `current-time'. */)
(void)
{
#ifdef HAVE_GETRUSAGE
struct rusage usage;
time_t secs;
int usecs;
if (getrusage (RUSAGE_SELF, &usage) < 0)
/* This shouldn't happen. What action is appropriate? */
xsignal0 (Qerror);
/* Sum up user time and system time. */
secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
if (usecs >= 1000000)
{
usecs -= 1000000;
secs++;
}
return make_lisp_time (make_timespec (secs, usecs * 1000));
#else /* ! HAVE_GETRUSAGE */
#ifdef WINDOWSNT
return w32_get_internal_run_time ();
#else /* ! WINDOWSNT */
return Fcurrent_time ();
#endif /* WINDOWSNT */
#endif /* HAVE_GETRUSAGE */
}
/* Wide character string collation. */
@ -4116,3 +4123,9 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
return res;
}
#endif /* WINDOWSNT */
void
syms_of_sysdep (void)
{
defsubr (&Sget_internal_run_time);
}

23
src/systime.h
View file

@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_SYSTIME_H
#define EMACS_SYSTIME_H
#include "lisp.h"
#include <timespec.h>
INLINE_HEADER_BEGIN
@ -66,7 +67,6 @@ timespec_valid_p (struct timespec t)
/* defined in sysdep.c */
extern int set_file_times (int, const char *, struct timespec, struct timespec);
extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST;
/* defined in keyboard.c */
extern void set_waiting_for_input (struct timespec *);
@ -75,19 +75,26 @@ extern void set_waiting_for_input (struct timespec *);
(HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */
enum { LO_TIME_BITS = 16 };
/* A Lisp time (HI LO US PS), sans the cons cells. */
/* Components of a new-format Lisp timestamp. */
struct lisp_time
{
EMACS_INT hi;
int lo, us, ps;
/* Clock count as a Lisp integer. */
Lisp_Object ticks;
/* Clock frequency (ticks per second) as a positive Lisp integer.
(TICKS . HZ) is a valid Lisp timestamp unless HZ < 65536. */
Lisp_Object hz;
};
/* defined in editfns.c */
/* defined in timefns.c */
extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST;
extern Lisp_Object make_lisp_time (struct timespec);
extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, struct lisp_time *, double *);
extern struct timespec lisp_to_timespec (struct lisp_time);
extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, struct timespec *);
extern struct timespec lisp_time_argument (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern void init_timefns (bool);
extern void syms_of_timefns (void);
INLINE_HEADER_END

1
src/term.c
View file

@ -4008,6 +4008,7 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
char const *diagnostic
= (fd < 0) ? "Could not open file: %s" : "Not a tty device: %s";
emacs_close (fd);
delete_terminal_internal (terminal);
maybe_fatal (must_succeed, terminal, diagnostic, diagnostic, name);
}

1
src/termhooks.h
View file

@ -733,6 +733,7 @@ extern struct terminal *get_named_terminal (const char *);
extern struct terminal *create_terminal (enum output_method,
struct redisplay_interface *);
extern void delete_terminal (struct terminal *);
extern void delete_terminal_internal (struct terminal *);
extern Lisp_Object terminal_glyph_code (struct terminal *, int);
/* The initial terminal device, created by initial_term_init. */

9
src/terminal.c
View file

@ -314,7 +314,6 @@ create_terminal (enum output_method type, struct redisplay_interface *rif)
void
delete_terminal (struct terminal *terminal)
{
struct terminal **tp;
Lisp_Object tail, frame;
/* Protect against recursive calls. delete_frame calls the
@ -335,6 +334,14 @@ delete_terminal (struct terminal *terminal)
}
}
delete_terminal_internal (terminal);
}
void
delete_terminal_internal (struct terminal *terminal)
{
struct terminal **tp;
for (tp = &terminal_list; *tp != terminal; tp = &(*tp)->next_terminal)
if (! *tp)
emacs_abort ();

1757
src/timefns.c Normal file
View file

File diff suppressed because it is too large Load diff

2
src/w32.c
View file

@ -535,8 +535,6 @@ static Lisp_Object ltime (ULONGLONG);
/* Get total user and system times for get-internal-run-time.
Returns a list of integers if the times are provided by the OS
(NT derivatives), otherwise it returns the result of current-time. */
Lisp_Object w32_get_internal_run_time (void);
Lisp_Object
w32_get_internal_run_time (void)
{

1
src/w32.h
View file

@ -195,6 +195,7 @@ extern int filename_from_ansi (const char *, char *);
extern int filename_to_ansi (const char *, char *);
extern int filename_from_utf16 (const wchar_t *, char *);
extern int filename_to_utf16 (const char *, wchar_t *);
extern Lisp_Object w32_get_internal_run_time (void);
extern void w32_init_file_name_codepage (void);
extern int codepage_for_filenames (CPINFO *);
extern Lisp_Object ansi_encode_filename (Lisp_Object);

69
src/xdisp.c
View file

@ -842,7 +842,7 @@ static Lisp_Object redisplay_window_1 (Lisp_Object);
static bool set_cursor_from_row (struct window *, struct glyph_row *,
struct glyph_matrix *, ptrdiff_t, ptrdiff_t,
int, int);
static bool cursor_row_fully_visible_p (struct window *, bool, bool);
static bool cursor_row_fully_visible_p (struct window *, bool, bool, bool);
static bool update_menu_bar (struct frame *, bool, bool);
static bool try_window_reusing_current_matrix (struct window *);
static int try_window_id (struct window *);
@ -14346,7 +14346,7 @@ redisplay_internal (void)
eassert (this_line_vpos == it.vpos);
eassert (this_line_y == it.current_y);
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
if (cursor_row_fully_visible_p (w, false, true))
if (cursor_row_fully_visible_p (w, false, true, false))
{
#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
@ -15628,19 +15628,46 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp)
window's current glyph matrix; otherwise use the desired glyph
matrix.
If JUST_TEST_USER_PREFERENCE_P, just test what the value of
make-cursor-row-fully-visible requires, don't test the actual
cursor position. The assumption is that in that case the caller
performs the necessary testing of the cursor position.
A value of false means the caller should do scrolling
as if point had gone off the screen. */
static bool
cursor_row_fully_visible_p (struct window *w, bool force_p,
bool current_matrix_p)
bool current_matrix_p,
bool just_test_user_preference_p)
{
struct glyph_matrix *matrix;
struct glyph_row *row;
int window_height;
Lisp_Object mclfv_p =
buffer_local_value (Qmake_cursor_line_fully_visible, w->contents);
if (!make_cursor_line_fully_visible_p)
/* If no local binding, use the global value. */
if (EQ (mclfv_p, Qunbound))
mclfv_p = Vmake_cursor_line_fully_visible;
/* Follow mode sets the variable to a Lisp function in buffers that
are under Follow mode. */
if (FUNCTIONP (mclfv_p))
{
Lisp_Object window;
XSETWINDOW (window, w);
/* Implementation note: if the function we call here signals an
error, we will NOT scroll when the cursor is partially-visible. */
Lisp_Object val = safe_call1 (mclfv_p, window);
if (NILP (val))
return true;
else if (just_test_user_preference_p)
return false;
}
else if (NILP (mclfv_p))
return true;
else if (just_test_user_preference_p)
return false;
/* It's not always possible to find the cursor, e.g, when a window
is full of overlay strings. Don't do anything in that case. */
@ -16002,7 +16029,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
/* If cursor ends up on a partially visible line,
treat that as being off the bottom of the screen. */
if (! cursor_row_fully_visible_p (w, extra_scroll_margin_lines <= 1,
false)
false, false)
/* It's possible that the cursor is on the first line of the
buffer, which is partially obscured due to a vscroll
(Bug#7537). In that case, avoid looping forever. */
@ -16367,7 +16394,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
/* Make sure this isn't a header line by any chance, since
then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield true. */
&& !row->mode_line_p
&& make_cursor_line_fully_visible_p)
&& !cursor_row_fully_visible_p (w, true, true, true))
{
if (PT == MATRIX_ROW_END_CHARPOS (row)
&& !row->ends_at_zv_p
@ -16385,7 +16412,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
else
{
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
if (!cursor_row_fully_visible_p (w, false, true))
if (!cursor_row_fully_visible_p (w, false, true, false))
rc = CURSOR_MOVEMENT_MUST_SCROLL;
else
rc = CURSOR_MOVEMENT_SUCCESS;
@ -16964,7 +16991,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
new_vpos = window_box_height (w) / 2;
}
if (!cursor_row_fully_visible_p (w, false, false))
if (!cursor_row_fully_visible_p (w, false, false, false))
{
/* Point does appear, but on a line partly visible at end of window.
Move it back to a fully-visible line. */
@ -17059,7 +17086,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
goto need_larger_matrices;
}
}
if (w->cursor.vpos < 0 || !cursor_row_fully_visible_p (w, false, false))
if (w->cursor.vpos < 0
|| !cursor_row_fully_visible_p (w, false, false, false))
{
clear_glyph_matrix (w->desired_matrix);
goto try_to_scroll;
@ -17206,7 +17234,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
/* Forget any recorded base line for line number display. */
w->base_line_number = 0;
if (!cursor_row_fully_visible_p (w, true, false))
if (!cursor_row_fully_visible_p (w, true, false, false))
{
clear_glyph_matrix (w->desired_matrix);
last_line_misfit = true;
@ -17502,7 +17530,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
set_cursor_from_row (w, row, matrix, 0, 0, 0, 0);
}
if (!cursor_row_fully_visible_p (w, false, false))
if (!cursor_row_fully_visible_p (w, false, false, false))
{
/* If vscroll is enabled, disable it and try again. */
if (w->vscroll)
@ -19068,9 +19096,10 @@ try_window_id (struct window *w)
&& CHARPOS (start) > BEGV)
/* Old redisplay didn't take scroll margin into account at the bottom,
but then global-hl-line-mode doesn't scroll. KFS 2004-06-14 */
|| (w->cursor.y + (make_cursor_line_fully_visible_p
? cursor_height + this_scroll_margin
: 1)) > it.last_visible_y)
|| (w->cursor.y
+ (cursor_row_fully_visible_p (w, false, true, true)
? 1
: cursor_height + this_scroll_margin)) > it.last_visible_y)
{
w->cursor.vpos = -1;
clear_glyph_matrix (w->desired_matrix);
@ -32903,9 +32932,15 @@ automatically; to decrease the tool-bar height, use \\[recenter]. */);
doc: /* Non-nil means raise tool-bar buttons when the mouse moves over them. */);
auto_raise_tool_bar_buttons_p = true;
DEFVAR_BOOL ("make-cursor-line-fully-visible", make_cursor_line_fully_visible_p,
doc: /* Non-nil means to scroll (recenter) cursor line if it is not fully visible. */);
make_cursor_line_fully_visible_p = true;
DEFVAR_LISP ("make-cursor-line-fully-visible", Vmake_cursor_line_fully_visible,
doc: /* Whether to scroll the window if the cursor line is not fully visible.
If the value is non-nil, Emacs scrolls or recenters the window to make
the cursor line fully visible. The value could also be a function, which
is called with a single argument, the window to be scrolled, and should
return non-nil if the partially-visible cursor requires scrolling the
window, nil if it's okay to leave the cursor partially-visible. */);
Vmake_cursor_line_fully_visible = Qt;
DEFSYM (Qmake_cursor_line_fully_visible, "make-cursor-line-fully-visible");
DEFVAR_LISP ("tool-bar-border", Vtool_bar_border,
doc: /* Border below tool-bar in pixels.

8
test/lisp/abbrev-tests.el
View file

@ -64,6 +64,14 @@
(should (= (length table) obarray-default-size))
(should (eq (abbrev-table-get table 'foo) 'bar))))
(ert-deftest abbrev--table-symbols-test ()
(let ((ert-test-abbrevs (setup-test-abbrev-table)))
(define-abbrev ert-test-abbrevs "sys" "system abbrev" nil :system t)
(should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs))
'("a-e-t")))
(should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs t))
'("a-e-t" "sys")))))
(ert-deftest abbrev-table-get-put-test ()
(let ((table (make-abbrev-table)))
(should-not (abbrev-table-get table 'foo))

2
test/lisp/net/tramp-tests.el
View file

@ -4884,7 +4884,7 @@ Use the `ls' command."
(numberp (nth 2 fsi))))))
(defun tramp--test-timeout-handler ()
(interactive)
"Timeout handler, reporting a failed test."
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
;; This test is inspired by Bug#16928.

47
test/lisp/replace-tests.el
View file

@ -359,6 +359,52 @@ Each element has the format:
(dotimes (i (length replace-occur-tests))
(replace-occur-test-create i))
(ert-deftest replace-occur-revert-bug32543 ()
"Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'."
(let ((temp-buffer (get-buffer-create " *test-occur*")))
(unwind-protect
(save-window-excursion
(with-current-buffer temp-buffer
(erase-buffer)
(setq list-matching-lines-jump-to-current-line t)
(insert
";; This buffer is for text that is not saved, and for Lisp evaluation.
;; To create a file, visit it with C-x C-f and enter text in its buffer.
")
(occur "and")
(with-current-buffer "*Occur*"
(revert-buffer)
(goto-char (point-min))
(should (string-match "\\`2 matches for \"and\" in buffer: "
(buffer-substring-no-properties
(point) (line-end-position)))))))
(and (buffer-name temp-buffer)
(kill-buffer temp-buffer)))))
(ert-deftest replace-occur-revert-bug32987 ()
"Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'."
(let ((temp-buffer (get-buffer-create " *test-occur*")))
(unwind-protect
(save-window-excursion
(with-current-buffer temp-buffer
(erase-buffer)
(setq list-matching-lines-jump-to-current-line nil)
(insert
";; This buffer is for text that is not saved, and for Lisp evaluation.
;; To create a file, visit it with C-x C-f and enter text in its buffer.
")
(occur "and")
(with-current-buffer "*Occur*"
(revert-buffer)
(goto-char (point-min))
(should (string-match "\\`2 matches for \"and\" in buffer: "
(buffer-substring-no-properties
(point) (line-end-position)))))))
(and (buffer-name temp-buffer)
(kill-buffer temp-buffer)))))
;;; Tests for `query-replace' undo feature.
@ -454,5 +500,4 @@ Return the last evalled form in BODY."
input "a" "B" ((?\s . (1 2 3)) (?E . (4)) (?U . (5))) ?q
(string= input (buffer-string))))))
;;; replace-tests.el ends here

59
test/src/editfns-tests.el
View file

@ -204,65 +204,6 @@
(should (string-equal (format "%d" 0.9) "0"))
(should (string-equal (format "%d" 1.1) "1")))
;;; Check format-time-string with various TZ settings.
;;; Use only POSIX-compatible TZ values, since the tests should work
;;; even if tzdb is not in use.
(ert-deftest format-time-string-with-zone ()
;; Don’t use (0 0 0 0) as the test case, as there are too many bugs
;; in MS-Windows (and presumably other) C libraries when formatting
;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this
;; test is for GNU Emacs, not for C runtimes. Instead, look before
;; you leap: "look" is the timestamp just before the first leap
;; second on 1972-06-30 23:59:60 UTC, so it should format to the
;; same string regardless of whether the underlying C library
;; ignores leap seconds, while avoiding circa-1970 glitches.
;;
;; Similarly, stick to the limited set of time zones that are
;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters
;; in the abbreviation, and no DST.
(let ((look '(1202 22527 999999 999999))
(format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)"))
;; UTC.
(should (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
"1972-06-30 23:59:59.999 +0000"))
;; "UTC0".
(should (string-equal
(format-time-string format look "UTC0")
"1972-06-30 23:59:59.999 +0000 (UTC)"))
;; Negative UTC offset, as a Lisp list.
(should (string-equal
(format-time-string format look '(-28800 "PST"))
"1972-06-30 15:59:59.999 -0800 (PST)"))
;; Negative UTC offset, as a Lisp integer.
(should (string-equal
(format-time-string format look -28800)
;; MS-Windows build replaces unrecognizable TZ values,
;; such as "-08", with "ZZZ".
(if (eq system-type 'windows-nt)
"1972-06-30 15:59:59.999 -0800 (ZZZ)"
"1972-06-30 15:59:59.999 -0800 (-08)")))
;; Positive UTC offset that is not an hour multiple, as a string.
(should (string-equal
(format-time-string format look "IST-5:30")
"1972-07-01 05:29:59.999 +0530 (IST)"))))
;;; This should not dump core.
(ert-deftest format-time-string-with-outlandish-zone ()
(should (stringp
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
(concat (make-string 2048 ?X) "0")))))
(defun editfns-tests--have-leap-seconds ()
(string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t)
"1972-06-30 23:59:60"))
(ert-deftest format-time-string-with-bignum-on-32-bit ()
(should (or (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t)
"2038-01-19 02:14:08")
(editfns-tests--have-leap-seconds))))
(ert-deftest format-with-field ()
(should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3)
"First argument 2, then 3, then 1"))

16
test/src/print-tests.el
View file

@ -95,8 +95,20 @@ otherwise, use a different charset."
"--------\n"))))
(ert-deftest print-read-roundtrip ()
(let ((sym '\’bar))
(should (eq (read (prin1-to-string sym)) sym))))
(let ((syms (list '## '& '* '+ '- '/ '0E '0e '< '= '> 'E 'E0 'NaN '\"
'\# '\#x0 '\' '\'\' '\( '\) '\+00 '\, '\-0 '\. '\.0
'\0 '\0.0 '\0E0 '\0e0 '\1E+ '\1E+NaN '\1e+ '\1e+NaN
'\; '\? '\[ '\\ '\] '\` '_ 'a 'e 'e0 'x
'{ '| '} '~ : '\’ '\’bar
(intern "\t") (intern "\n") (intern " ")
(intern "\N{NO-BREAK SPACE}")
(intern "\N{ZERO WIDTH SPACE}")
(intern "\0"))))
(dolist (sym syms)
(should (eq (read (prin1-to-string sym)) sym))
(dolist (sym1 syms)
(let ((sym2 (intern (concat (symbol-name sym) (symbol-name sym1)))))
(should (eq (read (prin1-to-string sym2)) sym2)))))))
(ert-deftest print-bignum ()
(let* ((str "999999999999999999999999999999999")

144
test/src/timefns-tests.el Normal file
View file

@ -0,0 +1,144 @@
;;; timefns-tests.el -- tests for timefns.c
;; Copyright (C) 2016-2018 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(require 'ert)
;;; Check format-time-string and decode-time with various TZ settings.
;;; Use only POSIX-compatible TZ values, since the tests should work
;;; even if tzdb is not in use.
(ert-deftest format-time-string-with-zone ()
;; Don’t use (0 0 0 0) as the test case, as there are too many bugs
;; in MS-Windows (and presumably other) C libraries when formatting
;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this
;; test is for GNU Emacs, not for C runtimes. Instead, look before
;; you leap: "look" is the timestamp just before the first leap
;; second on 1972-06-30 23:59:60 UTC, so it should format to the
;; same string regardless of whether the underlying C library
;; ignores leap seconds, while avoiding circa-1970 glitches.
;;
;; Similarly, stick to the limited set of time zones that are
;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters
;; in the abbreviation, and no DST.
(let ((format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)"))
(dolist (look '((1202 22527 999999 999999)
(7879679999900 . 100000)
(78796799999999999999 . 1000000000000)))
;; UTC.
(should (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
"1972-06-30 23:59:59.999 +0000"))
(should (equal (decode-time look t)
'(59 59 23 30 6 1972 5 nil 0)))
;; "UTC0".
(should (string-equal
(format-time-string format look "UTC0")
"1972-06-30 23:59:59.999 +0000 (UTC)"))
(should (equal (decode-time look "UTC0")
'(59 59 23 30 6 1972 5 nil 0)))
;; Negative UTC offset, as a Lisp list.
(should (string-equal
(format-time-string format look '(-28800 "PST"))
"1972-06-30 15:59:59.999 -0800 (PST)"))
(should (equal (decode-time look '(-28800 "PST"))
'(59 59 15 30 6 1972 5 nil -28800)))
;; Negative UTC offset, as a Lisp integer.
(should (string-equal
(format-time-string format look -28800)
;; MS-Windows build replaces unrecognizable TZ values,
;; such as "-08", with "ZZZ".
(if (eq system-type 'windows-nt)
"1972-06-30 15:59:59.999 -0800 (ZZZ)"
"1972-06-30 15:59:59.999 -0800 (-08)")))
(should (equal (decode-time look -28800)
'(59 59 15 30 6 1972 5 nil -28800)))
;; Positive UTC offset that is not an hour multiple, as a string.
(should (string-equal
(format-time-string format look "IST-5:30")
"1972-07-01 05:29:59.999 +0530 (IST)"))
(should (equal (decode-time look "IST-5:30")
'(59 29 5 1 7 1972 6 nil 19800))))))
(ert-deftest decode-then-encode-time ()
(let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0
most-negative-fixnum most-positive-fixnum
(1- most-negative-fixnum)
(1+ most-positive-fixnum)
1e+INF -1e+INF 1e+NaN -1e+NaN
'(0 1 0 0) '(1 0 0 0) '(-1 0 0 0)
'(123456789000000 . 1000000)
(cons (1+ most-positive-fixnum) 1000000000000)
(cons 1000000000000 (1+ most-positive-fixnum)))))
(dolist (a time-values)
(let* ((d (ignore-errors (decode-time a t)))
(e (encode-time d))
(diff (float-time (time-subtract a e))))
(should (or (not d)
(and (<= 0 diff) (< diff 1))))))))
;;; This should not dump core.
(ert-deftest format-time-string-with-outlandish-zone ()
(should (stringp
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
(concat (make-string 2048 ?X) "0")))))
(defun timefns-tests--have-leap-seconds ()
(string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t)
"1972-06-30 23:59:60"))
(ert-deftest format-time-string-with-bignum-on-32-bit ()
(should (or (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t)
"2038-01-19 02:14:08")
(timefns-tests--have-leap-seconds))))
(ert-deftest time-equal-p-nil-nil ()
(should (time-equal-p nil nil)))
(ert-deftest time-arith-tests ()
(let ((time-values (list 0 -1 1 0.0 -0.0 -1.0 1.0
most-negative-fixnum most-positive-fixnum
(1- most-negative-fixnum)
(1+ most-positive-fixnum)
1e+INF -1e+INF 1e+NaN -1e+NaN
'(0 0 0 1) '(0 0 1 0) '(0 1 0 0) '(1 0 0 0)
'(-1 0 0 0) '(1 2 3 4) '(-1 2 3 4)
'(-123456789 . 100000) '(123456789 . 1000000)
(cons (1+ most-positive-fixnum) 1000000000000)
(cons 1000000000000 (1+ most-positive-fixnum)))))
(dolist (a time-values)
(dolist (b time-values)
(let ((aa (time-subtract (time-add a b) b)))
(should (or (time-equal-p a aa) (and (floatp aa) (isnan aa)))))
(should (= 1 (+ (if (time-less-p a b) 1 0)
(if (time-equal-p a b) 1 0)
(if (time-less-p b a) 1 0)
(if (or (and (floatp a) (isnan a))
(and (floatp b) (isnan b)))
1 0))))
(should (or (not (time-less-p 0 b))
(time-less-p a (time-add a b))
(time-equal-p a (time-add a b))
(and (floatp (time-add a b)) (isnan (time-add a b)))))
(let ((x (float-time (time-add a b)))
(y (+ (float-time a) (float-time b))))
(should (or (and (isnan x) (isnan y))
(= x y)
(< 0.99 (/ x y) 1.01)
(< 0.99 (/ (- (float-time a)) (float-time b))
1.01))))))))