[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/tramp-thread-safe 25f77f9: Merge remote-tracking b
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] feature/tramp-thread-safe 25f77f9: Merge remote-tracking branch 'origin/master' into feature/tramp-thread-safe |
|
Date: |
Fri, 12 Oct 2018 09:09:29 -0400 (EDT) |
branch: feature/tramp-thread-safe
commit 25f77f90855dd1add341ef58e044d375b7d8dfab
Merge: c8ca97a 9c231a4
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Merge remote-tracking branch 'origin/master' into feature/tramp-thread-safe
---
Makefile.in | 10 +-
admin/MAINTAINERS | 8 +
admin/merge-gnulib | 2 +-
configure.ac | 3 +-
doc/emacs/help.texi | 10 +-
doc/emacs/mark.texi | 2 +
doc/lispref/abbrevs.texi | 7 +-
doc/lispref/buffers.texi | 12 +-
doc/lispref/functions.texi | 4 +-
doc/lispref/minibuf.texi | 1 +
doc/lispref/os.texi | 157 ++--
doc/lispref/processes.texi | 19 +-
doc/lispref/text.texi | 5 +-
doc/misc/emacs-mime.texi | 69 +-
doc/misc/org.texi | 293 +++----
doc/misc/texinfo.tex | 3 +-
doc/misc/tramp.texi | 40 +-
doc/misc/trampver.texi | 22 +-
etc/NEWS | 57 +-
etc/NEWS.26 | 10 +
lib/acl-internal.c | 12 +-
lib/acl-internal.h | 16 +-
lib/acl_entries.c | 6 +-
lib/explicit_bzero.c | 4 +-
lib/fcntl.c | 380 +++++----
lib/get-permissions.c | 10 +-
lib/gettime.c | 2 -
lib/gnulib.mk.in | 1 +
lib/mktime.c | 4 +-
lib/set-permissions.c | 14 +-
lib/stdlib.in.h | 3 +-
lisp/abbrev.el | 52 +-
lisp/auth-source.el | 27 +-
lisp/bindings.el | 5 +-
lisp/calendar/cal-dst.el | 55 +-
lisp/calendar/parse-time.el | 5 +-
lisp/calendar/time-date.el | 10 +-
lisp/calendar/timeclock.el | 347 ++++----
lisp/cedet/ede/project-am.el | 2 +-
lisp/cedet/semantic/db-ref.el | 2 +-
lisp/cedet/semantic/scope.el | 2 +-
lisp/cus-start.el | 7 +-
lisp/emacs-lisp/autoload.el | 26 +-
lisp/emacs-lisp/cl-macs.el | 39 +-
lisp/emacs-lisp/lisp-mnt.el | 36 +-
lisp/emacs-lisp/timer.el | 42 +-
lisp/follow.el | 35 +-
lisp/gnus/nneething.el | 2 +-
lisp/international/mule-cmds.el | 52 +-
lisp/ldefs-boot.el | 107 ++-
lisp/net/ntlm.el | 171 ++--
lisp/net/tramp-archive.el | 8 +-
lisp/net/tramp-sh.el | 2 +-
lisp/net/tramp.el | 66 +-
lisp/net/trampver.el | 11 +-
lisp/obsolete/vc-arch.el | 3 +-
lisp/org/org-id.el | 4 +-
lisp/progmodes/sql.el | 37 +-
lisp/replace.el | 220 +++--
lisp/savehist.el | 23 +-
lisp/simple.el | 8 +-
lisp/subr.el | 2 +-
lisp/tar-mode.el | 28 +-
lisp/vc/vc.el | 13 +-
lisp/window.el | 2 +-
m4/acl.m4 | 5 +-
m4/gettime.m4 | 4 +-
src/Makefile.in | 2 +-
src/bignum.c | 103 ++-
src/bignum.h | 11 +
src/data.c | 4 +-
src/editfns.c | 1289 +---------------------------
src/emacs.c | 25 +-
src/eval.c | 5 +-
src/keyboard.c | 14 +-
src/lisp.h | 19 +-
src/lread.c | 100 +--
src/minibuf.c | 7 +-
src/nsterm.m | 781 +++++++++--------
src/print.c | 49 +-
src/process.c | 7 +-
src/scroll.c | 10 +-
src/sysdep.c | 127 +--
src/systime.h | 23 +-
src/term.c | 1 +
src/termhooks.h | 1 +
src/terminal.c | 9 +-
src/timefns.c | 1757 +++++++++++++++++++++++++++++++++++++++
src/w32.c | 2 -
src/w32.h | 1 +
src/xdisp.c | 69 +-
test/lisp/abbrev-tests.el | 8 +
test/lisp/net/tramp-tests.el | 2 +-
test/lisp/replace-tests.el | 47 +-
test/src/editfns-tests.el | 59 --
test/src/print-tests.el | 16 +-
test/src/timefns-tests.el | 144 ++++
97 files changed, 4152 insertions(+), 3186 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index c6b2cfa..f0b2b66 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -151,6 +151,9 @@ address@hidden@
# Currently only used for the systemd service file.
address@hidden@
+# Where to install emacs-module.h.
address@hidden@
+
# Where to install Emacs's man pages.
# Note they contain cross-references that expect them to be in section 1.
address@hidden@
@@ -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"
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index 10633a8..6db1d88 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -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
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index abb1929..575e3fa 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -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
diff --git a/configure.ac b/configure.ac
index 6f3d733..df91028 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 94d27a2..66673eb 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -523,13 +523,17 @@ currently in use. @xref{Coding Systems}.
@section Other Help Commands
@kindex C-h i
address@hidden C-h 4 i
@findex info
address@hidden 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
address@hidden 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
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index 0ffa9f7..1050587 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -17,11 +17,13 @@ one comes earlier in the text; each time you move point,
the region
changes.
@cindex active region
address@hidden 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}).
address@hidden 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
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi
index 4c9e653..1e9471b 100644
--- a/doc/lispref/abbrevs.texi
+++ b/doc/lispref/abbrevs.texi
@@ -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
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 1acf4ba..b2a4b0e 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -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}
address@hidden @var{picosec})}. (This is the same format that
address@hidden 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
address@hidden returns a list for some non-file buffers
address@hidden 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
address@hidden(@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
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 05bc8c7..3be52d8 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -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},
address@hidden:filter-args}, and @code{filter-return}, where @var{function}.
address@hidden:filter-args}, and @code{:filter-return}, where @var{function}
+receives different arguments than the original function stored in
address@hidden
@end defmac
@defmac remove-function place function
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 55fde74..5c66055 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -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}.
address@hidden 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
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 8ce5a5e..64c327c 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1233,11 +1233,44 @@ return value is @code{nil}.
This section explains how to determine the current time and time
zone.
address@hidden Lisp timestamp
address@hidden 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
address@hidden(@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:
+
address@hidden @bullet
address@hidden
+An integer. Although this is the simplest form, it cannot represent
+subsecond timestamps.
+
address@hidden
+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
address@hidden is 1000000000, for a nanosecond-resolution
address@hidden @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.}
+
address@hidden
+A list of four integers @code{(@var{high} @var{low} @var{micro}
address@hidden)}, 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} * address@hidden +
@var{pico} * address@hidden
@@ -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.
address@hidden 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
address@hidden 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
address@hidden(@var{high} @var{low} @var{micro})} or @code{(@var{high}
address@hidden)} 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
address@hidden 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.
address@hidden 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
address@hidden 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
address@hidden
address@hidden 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}
address@hidden @var{micro} @var{pico})}, or @code{nil} (the default) for
+the current time (@pxref{Time of Day}). It can also be a list
address@hidden(@var{second} @var{minute} @var{hour} @var{day} @var{month}
address@hidden @var{ignored} @var{dst} @var{zone})} that specifies a
+decoded time in the style of @code{decode-time}, so that
address@hidden(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})address@hidden 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
address@hidden, 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
address@hidden, this function returns an integer list @code{(@var{high}
address@hidden @var{micro} @var{pico})}. Although an omitted or @code{nil}
address@hidden 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},
address@hidden, @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
address@hidden 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.
address@hidden 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
address@hidden as the arguments to @code{encode-time}, like this:
+The @code{encode-time} function acts as a rough inverse to
address@hidden 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.
address@hidden, @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}
address@hidden)}, 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
address@hidden 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
address@hidden
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
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 89ad1cf..e1113e3 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -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
address@hidden@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
address@hidden is in the same format as for @code{utime}.
address@hidden 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
address@hidden(@var{high} @var{low} @var{microsec} @var{picosec})} format used
by
address@hidden 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}
address@hidden @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.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 8258270..6c38d8e 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -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
address@hidden(@var{sec-high} @var{sec-low} @var{microsec}
address@hidden)} 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;
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 9280311..f46b2a7 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -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")
address@hidden (13818 19266)
+(encode-time (date-to-time "Sat Sep 12 12:21:54 1998 +0200")
+ 1000000)
address@hidden (905595714000000 . 1000000)
-(parse-iso8601-time-string "1998-09-12T12:21:54+0200")
address@hidden (13818 19266)
+(encode-time (parse-iso8601-time-string "1998-09-12T12:21:54+0200")
+ 1000000)
address@hidden (905595714000000 . 1000000)
-(float-time '(13818 19266))
+(float-time '(905595714000000 . 1000000))
@result{} 905595714.0
-(seconds-to-time 905595714.0)
address@hidden (13818 19266 0 0)
+(encode-time 905595714.0 1000000)
address@hidden (905595714000000 . 1000000)
-(time-to-days '(13818 19266))
+(time-to-days '(905595714000000 . 1000000))
@result{} 729644
-(days-to-time 729644)
address@hidden (961933 512)
+(encode-time (days-to-time 729644) 1000000)
address@hidden (63041241600000000 . 1000000)
-(time-since '(13818 19266))
address@hidden (6797 9607 984839 247000)
+(encode-time (time-since '(905595714000000 . 1000000))
+ 1000000)
address@hidden (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))
address@hidden nil
+(time-equal-p '(905595593000000000 . 1000000000)
+ '(905595593000000 . 1000000 ))
address@hidden t
-(time-subtract '(13818 19266) '(13818 19145))
address@hidden (0 121)
+(time-subtract '(905595714000000 . 1000000)
+ '(905595593000000000 . 1000000000))
address@hidden (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")))
address@hidden 4314.095589286675
address@hidden 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:
address@hidden, @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
address@hidden 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.)
address@hidden seconds-to-time
-Take seconds and return a time.
address@hidden 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
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index ccb5f88..9ea78f5 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -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.
address@hidden Org Mobile
address@hidden Org Mobile
+
address@hidden 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
address@hidden exclusive} tags (see @ref{Setting tags}) only for those set in
+these variables.
+
address@hidden
+* 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
address@hidden menu
+
address@hidden Setting up the staging area
address@hidden Setting up the staging area
+
address@hidden org-mobile-directory
+The mobile application needs access to a file directory on
+a address@hidden 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:
+
address@hidden
+(setq org-mobile-directory "~/orgmobile/")
address@hidden lisp
+
address@hidden
+Alternatively, by using TRAMP (see @ref{Top,TRAMP User Manual,,tramp,}),
address@hidden may point to a remote directory accessible
+through, for example, SSH and SCP:
+
address@hidden
+(setq org-mobile-directory "/scpc:user@@remote.host:org/webdav/")
address@hidden lisp
+
address@hidden 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
address@hidden@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.
+
address@hidden Pushing to the mobile application
address@hidden Pushing to the mobile application
+
address@hidden org-mobile-push
address@hidden org-mobile-files
+The command @code{org-mobile-push} copies files listed in
address@hidden 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
address@hidden, so all files should be inside this address@hidden 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 address@hidden 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
address@hidden 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 address@hidden are stored
automatically in the file
address@hidden
+have changed.
+
address@hidden Pulling from the mobile application
address@hidden Pulling from the mobile application
+
address@hidden 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:
+
address@hidden
address@hidden
address@hidden org-mobile-inbox-for-pull
+Org moves all entries found in @address@hidden file will be empty after this
operation.} and appends
+them to the file pointed to by the variable
address@hidden 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.
+
address@hidden
address@hidden @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.
+
address@hidden
+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.
+
address@hidden @asis
address@hidden @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.
address@hidden table
address@hidden enumerate
+
address@hidden ? @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
address@hidden MobileOrg
address@hidden MobileOrg
address@hidden iPhone
address@hidden 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
address@hidden/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
address@hidden 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
address@hidden (@pxref{Per-file keywords}) and @emph{mutually exclusive} tags
-(@pxref{Setting tags}) only for those set in these variables.
-
address@hidden
-* 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
address@hidden menu
-
address@hidden Setting up the staging area
address@hidden 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
address@hidden installed on the local computer. To turn on encryption, set
-the same password in MobileOrg and in Emacs. Set the password in the
-variable @address@hidden Emacs is configured for
-safe storing of passwords, then configure the variable,
address@hidden; 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
address@hidden://dropbox.com,Dropbox.com} address@hidden alternative is to
-use webdav server. MobileOrg documentation has details of webdav server
-configuration. Additional help is at
address@hidden://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:
-
address@hidden
-(setq org-mobile-directory "~/Dropbox/MobileOrg")
address@hidden lisp
-
-Org copies files to the above directory for MobileOrg. Org also uses the
-same directory for sharing notes between Org and MobileOrg.
-
address@hidden Pushing to MobileOrg
address@hidden Pushing to MobileOrg
-
-Org pushes files listed in @code{org-mobile-files} to
address@hidden Files include agenda files (as listed in
address@hidden). Customize @code{org-mobile-files} to add other
-files. File names will be staged with paths relative to
address@hidden, so all files should be inside this
address@hidden 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 address@hidden 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
address@hidden 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 address@hidden are stored automatically in
-the file @file{checksums.dat}.} have changed.
-
address@hidden Pulling from MobileOrg
address@hidden 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.
-
address@hidden
address@hidden
-Org moves all entries found in
address@hidden@address@hidden will be empty after this
-operation.} and appends them to the file pointed to by the variable
address@hidden Each captured entry and each editing event
-is a top-level entry in the inbox file.
address@hidden
-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.
address@hidden
-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.
-
address@hidden @kbd
address@hidden ?
address@hidden ?
-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
address@hidden 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.
address@hidden table
address@hidden enumerate
-
address@hidden C-c a ?
address@hidden 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
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index d7f7f53..5840aff 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -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 @@ end
\gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
\gdef\magicamp{\let&=\amprm}
}
+\let\ampchar\&
\newcount\parencount
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 55cb232..ff5c0be 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -12,16 +12,6 @@
@c This is *so* much nicer :)
@footnotestyle end
address@hidden Macro for formatting a file name according to the respective
address@hidden syntax. Macro arguments should not have any leading or trailing
address@hidden whitespace. Not very elegant, but I don't know it better.
-
address@hidden trampfn {method, userhost, localname}
address@hidden@c
address@hidden@c
address@hidden
address@hidden 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
address@hidden@@gnu.org}, and archived at
address@hidden://lists.gnu.org/r/tramp-devel/, the
address@hidden Mail Archive}.
address@hidden@value{tramp-bug-report-address}}, and archived at
address@hidden://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
address@hidden/.authinfo.gpg}, but this can be changed via the variable
address@hidden/.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.
address@hidden sets the @env{INSIDE_EMACS} variable in the startup
-script file @file{~/.emacs_SHELLNAME}.
address@hidden 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.
address@hidden@@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.
address@hidden@value{tramp-bug-report-address}} is the mailing list.
+Messages sent to this address go to all the subscribers. This is
address@hidden 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
address@hidden @env{HISTSIZE} are set to 0.
address@hidden 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
address@hidden How file names, directories and localnames are mangled and
managed.
address@hidden 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.
address@hidden 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
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 807330b..aac7243 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -5,12 +5,12 @@
@c Copyright (C) 2003-2018 Free Software Foundation, Inc.
@c See file doclicense.texi for copying conditions.
address@hidden In the Tramp GIT, the version number is auto-frobbed from
address@hidden configure.ac, so you should edit that file and run
address@hidden "autoconf && ./configure" to change the version number.
address@hidden In the Tramp GIT, the version number is auto-frobbed from
tramp.el,
address@hidden and the bug report address is auto-frobbed from configure.ac.
@set trampver 2.4.1-pre
address@hidden tramp-bug-report-address tramp-devel@@gnu.org
address@hidden Other flags from configuration
address@hidden 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
+
address@hidden Macro for formatting a file name according to the respective
address@hidden syntax. trampver.texi is included several times in tramp.texi
and
address@hidden trampinst.texi. Redefining the macro is reported as warning for
address@hidden creating the dvi and pdf files, so we declare the macro only the
address@hidden first time this file is included.
address@hidden trampfndefined
address@hidden trampfndefined
address@hidden trampfn {method, userhost, localname}
address@hidden@c
address@hidden@c
address@hidden
address@hidden macro
address@hidden ifclear
diff --git a/etc/NEWS b/etc/NEWS
index a33296c..d15f909 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
---
@@ -976,6 +1010,21 @@ 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
floating-point operators do.
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index 19dd433..94bb45c 100644
--- a/etc/NEWS.26
+++ b/etc/NEWS.26
@@ -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
diff --git a/lib/acl-internal.c b/lib/acl-internal.c
index c62adb0..92e7b9b 100644
--- a/lib/acl-internal.c
+++ b/lib/acl-internal.c
@@ -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);
diff --git a/lib/acl-internal.h b/lib/acl-internal.h
index 0669d83..2da7c5a 100644
--- a/lib/acl-internal.h
+++ b/lib/acl-internal.h
@@ -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
diff --git a/lib/acl_entries.c b/lib/acl_entries.c
index 59dd420..ce730d4 100644
--- a/lib/acl_entries.c
+++ b/lib/acl_entries.c
@@ -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;
diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c
index 78ec747..79b7fd6 100644
--- a/lib/explicit_bzero.c
+++ b/lib/explicit_bzero.c
@@ -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. */
diff --git a/lib/fcntl.c b/lib/fcntl.c
index 8e97617..74e0f5d 100644
--- a/lib/fcntl.c
+++ b/lib/fcntl.c
@@ -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
diff --git a/lib/get-permissions.c b/lib/get-permissions.c
index 83ba263..3b98451 100644
--- a/lib/get-permissions.c
+++ b/lib/get-permissions.c
@@ -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)
diff --git a/lib/gettime.c b/lib/gettime.c
index 171f224..bb59c44 100644
--- a/lib/gettime.c
+++ b/lib/gettime.c
@@ -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);
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 2e265b3..431d0c0 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -44,6 +44,7 @@
# --avoid=malloc-posix \
# --avoid=mbrtowc \
# --avoid=mbsinit \
+# --avoid=mkdir \
# --avoid=msvc-inval \
# --avoid=msvc-nothrow \
# --avoid=nl_langinfo \
diff --git a/lib/mktime.c b/lib/mktime.c
index 6953e98..557712f 100644
--- a/lib/mktime.c
+++ b/lib/mktime.c
@@ -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
diff --git a/lib/set-permissions.c b/lib/set-permissions.c
index d42335a..a415e13 100644
--- a/lib/set-permissions.c
+++ b/lib/set-permissions.c
@@ -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 */
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index 3bf35bf..441c018 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -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>
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index e1fd366..20a967d 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -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)
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index eb262a1..fd529b3 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -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
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 9797052..76383ad 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -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
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 00a8e74..25264bd 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -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")
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index d6c1e9e..9443fde 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -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)
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 74c607c..c3898e0 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -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))
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index b46e773..646f529 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -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
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index d3f0648..e0fb111 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -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
diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el
index 7713a3c..c689e31 100644
--- a/lisp/cedet/semantic/db-ref.el
+++ b/lisp/cedet/semantic/db-ref.el
@@ -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)))
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index e653d0a..0f171e2 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -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."
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 88a6175..e33fe6e 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -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
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 3d73351..c9ee532 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -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)))))))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d0d1c3b..29ddd49 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -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))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 127d71a..5c623a3 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -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.
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 74d37b0..927e640 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -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
diff --git a/lisp/follow.el b/lisp/follow.el
index 7aa7b51..e2d3a11 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -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))))
-;;; Post Command Hook
+;;; 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)))
-;; The magic little box. This function is called after every command.
+;;; Post Command Hook
+;; 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)))
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 10ac702..ced75c8 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -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
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 817a26b..b755ae0 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -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
("address@hidden" . "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
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index bdf4c31..5ff0898 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -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.
-
-If FILE-LIST-FORM is non-nil, it is a form to evaluate to
-produce the list of files to search.
+For non-interactive use, superceded by `multifile-initialize-replace'.
-See also the documentation of the variable `tags-file-name'.
+\(fn FROM TO &optional DELIMITED FILES)" t nil)
-\(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-")))
@@ -22269,6 +22266,41 @@ QUALITY can be:
;;;***
+;;;### (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))
;;; Generated autoloads from mwheel.el
@@ -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))
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 217f0b8..142c375 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -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))
-
- (setq i 0)
- (while (< i 16)
+ (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))
+
+ (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)
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 5d7562f..bb87a83 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -332,13 +332,17 @@ pass to the OPERATION."
(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
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index cf5a704..e86971b 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 962549a..755ca21 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 1956ab6..de76788 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -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 ()
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index 9860c9d..e4c52d5 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -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))))
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index 26b203f..ad9b7d1 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -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)))
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index ba180c2..1cdae35 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -213,7 +213,7 @@
;; Drew Adams <address@hidden> -- Emacs 20 support
;; Harald Maier <address@hidden> -- sql-send-string
;; Stefan Monnier <address@hidden> -- font-lock corrections;
-;; code polish
+;; code polish; on-going guidance and mentorship
;; Paul Sleigh <address@hidden> -- MySQL keyword enhancement
;; Andrew Schein <address@hidden> -- sql-port bug
;; Ian Bjorhovde <address@hidden> -- db2 escape newlines
@@ -222,6 +222,7 @@
;; Mark Wilkinson <address@hidden> -- file-local variables ignored
;; Simen Heggestøyl <address@hidden> -- Postgres database completion
;; Robert Cochran <address@hidden> -- MariaDB support
+;; Alex Harsanyi <address@hidden> -- 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'.
diff --git a/lisp/replace.el b/lisp/replace.el
index 00b2cee..ecb4793 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -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"
diff --git a/lisp/savehist.el b/lisp/savehist.el
index e555450..329929b 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -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
diff --git a/lisp/simple.el b/lisp/simple.el
index 9b40a55..17bcb06 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -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].
diff --git a/lisp/subr.el b/lisp/subr.el
index 755cd29..b36d952 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 19e5159..cf4e53a 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -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.
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index d3d66d6..57bc3c2 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -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"))))
diff --git a/lisp/window.el b/lisp/window.el
index 0a42dae..8ff8497 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -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.
diff --git a/m4/acl.m4 b/m4/acl.m4
index 485cf9a..b64aa84 100644
--- a/m4/acl.m4
+++ b/m4/acl.m4
@@ -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
diff --git a/m4/gettime.m4 b/m4/gettime.m4
index ad35546..671b70d 100644
--- a/m4/gettime.m4
+++ b/m4/gettime.m4
@@ -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])
])
diff --git a/src/Makefile.in b/src/Makefile.in
index 72f5689..2dba102 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -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 \
diff --git a/src/bignum.c b/src/bignum.c
index 1e78d98..e3db037 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -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;
+ }
+ if (bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative
+ && mpz_scan1 (z, 0) == INTMAX_WIDTH - 1)
+ {
+ *pi = INTMAX_MIN;
+ return true;
}
- return ((bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative
- && mpz_scan1 (XBIGNUM (x)->value, 0) == INTMAX_WIDTH - 1)
- ? INTMAX_MIN : 0);
+ return false;
}
-uintmax_t
-bignum_to_uintmax (Lisp_Object x)
+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;
- if (0 <= mpz_sgn (XBIGNUM (x)->value))
+ int i = 0, shift = 0;
+
+ do
{
- 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);
- }
+ uintmax_t limb = mpz_getlimbn (z, i++);
+ v += limb << shift;
+ shift += GMP_NUMB_BITS;
}
- return v;
+ 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 i;
+ return mpz_to_uintmax (XBIGNUM (x)->value, &i) ? i : 0;
}
/* Yield an upper bound on the buffer size needed to contain a C
diff --git a/src/bignum.h b/src/bignum.h
index e9cd5c0..fd035e6 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -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;
diff --git a/src/data.c b/src/data.c
index 750d494..538081e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -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;
}
diff --git a/src/editfns.c b/src/editfns.c
index 47509c2..e995b38 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -35,34 +35,13 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "lisp.h"
-/* systime.h includes <sys/time.h> which, on some systems, is required
- for <sys/resource.h>; thus systime.h must be included before
- <sys/resource.h> */
-#include "systime.h"
-
-#if defined HAVE_SYS_RESOURCE_H
-#include <sys/resource.h>
-#endif
-
-#include <errno.h>
#include <float.h>
#include <limits.h>
#include <math.h>
-#ifdef HAVE_TIMEZONE_T
-# include <sys/param.h>
-# if defined __NetBSD_Version__ && __NetBSD_Version__ < 700000000
-# define HAVE_TZALLOC_BUG true
-# endif
-#endif
-#ifndef HAVE_TZALLOC_BUG
-# define HAVE_TZALLOC_BUG false
-#endif
-
#include <c-ctype.h>
#include <intprops.h>
#include <stdlib.h>
-#include <strftime.h>
#include <verify.h>
#include "composite.h"
@@ -70,34 +49,12 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "ptr-bounds.h"
#include "character.h"
#include "buffer.h"
-#include "coding.h"
#include "window.h"
#include "blockinput.h"
-#define TM_YEAR_BASE 1900
-
-#ifdef WINDOWSNT
-extern Lisp_Object w32_get_internal_run_time (void);
-#endif
-
-static struct lisp_time lisp_time_struct (Lisp_Object, int *);
-static Lisp_Object format_time_string (char const *, ptrdiff_t, struct
timespec,
- Lisp_Object, struct tm *);
-static long int tm_gmtoff (struct tm *);
-static int tm_diff (struct tm *, struct tm *);
static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
-#ifndef HAVE_TM_GMTOFF
-# define HAVE_TM_GMTOFF false
-#endif
-
-enum { tzeqlen = sizeof "TZ=" - 1 };
-
-/* Time zones equivalent to current local time and to UTC, respectively. */
-static timezone_t local_tz;
-static timezone_t const utc_tz = 0;
-
/* The cached value of Vsystem_name. This is used only to compare it
to Vsystem_name, so it need not be visible to the GC. */
static Lisp_Object cached_system_name;
@@ -109,153 +66,9 @@ init_and_cache_system_name (void)
cached_system_name = Vsystem_name;
}
-static struct tm *
-emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm)
-{
- tm = localtime_rz (tz, t, tm);
- if (!tm && errno == ENOMEM)
- memory_full (SIZE_MAX);
- return tm;
-}
-
-static time_t
-emacs_mktime_z (timezone_t tz, struct tm *tm)
-{
- errno = 0;
- time_t t = mktime_z (tz, tm);
- if (t == (time_t) -1 && errno == ENOMEM)
- memory_full (SIZE_MAX);
- return t;
-}
-
-static _Noreturn void
-invalid_time_zone_specification (Lisp_Object zone)
-{
- xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone);
-}
-
-/* Free a timezone, except do not free the time zone for local time.
- Freeing utc_tz is also a no-op. */
-static void
-xtzfree (timezone_t tz)
-{
- if (tz != local_tz)
- tzfree (tz);
-}
-
-/* Convert the Lisp time zone rule ZONE to a timezone_t object.
- The returned value either is 0, or is LOCAL_TZ, or is newly allocated.
- If SETTZ, set Emacs local time to the time zone rule; otherwise,
- the caller should eventually pass the returned value to xtzfree. */
-static timezone_t
-tzlookup (Lisp_Object zone, bool settz)
-{
- static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d";
- char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1;
- char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)];
- char const *zone_string;
- timezone_t new_tz;
-
- if (NILP (zone))
- return local_tz;
- else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0)))
- {
- zone_string = "UTC0";
- new_tz = utc_tz;
- }
- else
- {
- bool plain_integer = FIXNUMP (zone);
-
- if (EQ (zone, Qwall))
- zone_string = 0;
- else if (STRINGP (zone))
- zone_string = SSDATA (ENCODE_SYSTEM (zone));
- else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone))
- && CONSP (XCDR (zone))))
- {
- Lisp_Object abbr UNINIT;
- if (!plain_integer)
- {
- abbr = XCAR (XCDR (zone));
- zone = XCAR (zone);
- }
-
- EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60);
- int hour_remainder = abszone % (60 * 60);
- int min = hour_remainder / 60, sec = hour_remainder % 60;
-
- if (plain_integer)
- {
- int prec = 2;
- EMACS_INT numzone = hour;
- if (hour_remainder != 0)
- {
- prec += 2, numzone = 100 * numzone + min;
- if (sec != 0)
- prec += 2, numzone = 100 * numzone + sec;
- }
- sprintf (tzbuf, tzbuf_format, prec,
- XFIXNUM (zone) < 0 ? -numzone : numzone,
- &"-"[XFIXNUM (zone) < 0], hour, min, sec);
- zone_string = tzbuf;
- }
- else
- {
- AUTO_STRING (leading, "<");
- AUTO_STRING_WITH_LEN (trailing, tzbuf,
- sprintf (tzbuf, trailing_tzbuf_format,
- &"-"[XFIXNUM (zone) < 0],
- hour, min, sec));
- zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr),
- trailing));
- }
- }
- else
- invalid_time_zone_specification (zone);
-
- new_tz = tzalloc (zone_string);
-
- if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer
- && XFIXNUM (zone) % (60 * 60) == 0)
- {
- /* tzalloc mishandles POSIX strings; fall back on tzdb if
- possible (Bug#30738). */
- sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60)));
- new_tz = tzalloc (zone_string);
- }
-
- if (!new_tz)
- {
- if (errno == ENOMEM)
- memory_full (SIZE_MAX);
- invalid_time_zone_specification (zone);
- }
- }
-
- if (settz)
- {
- block_input ();
- emacs_setenv_TZ (zone_string);
- tzset ();
- timezone_t old_tz = local_tz;
- local_tz = new_tz;
- tzfree (old_tz);
- unblock_input ();
- }
-
- return new_tz;
-}
-
void
-init_editfns (bool dumping)
+init_editfns (void)
{
-#if !defined CANNOT_DUMP
- /* A valid but unlikely setting for the TZ environment variable.
- It is OK (though a bit slower) if the user chooses this value. */
- static char dump_tz_string[] = "TZ=UtC0";
-#endif
-
const char *user_name;
register char *p;
struct passwd *pw; /* password entry for the current user */
@@ -264,37 +77,6 @@ init_editfns (bool dumping)
/* Set up system_name even when dumping. */
init_and_cache_system_name ();
-#ifndef CANNOT_DUMP
- /* When just dumping out, set the time zone to a known unlikely value
- and skip the rest of this function. */
- if (dumping)
- {
- xputenv (dump_tz_string);
- tzset ();
- return;
- }
-#endif
-
- char *tz = getenv ("TZ");
-
-#if !defined CANNOT_DUMP
- /* If the execution TZ happens to be the same as the dump TZ,
- change it to some other value and then change it back,
- to force the underlying implementation to reload the TZ info.
- This is needed on implementations that load TZ info from files,
- since the TZ file contents may differ between dump and execution. */
- if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0)
- {
- ++*tz;
- tzset ();
- --*tz;
- }
-#endif
-
- /* Set the time zone rule now, so that the call to putenv is done
- before multiple threads are active. */
- tzlookup (tz ? build_string (tz) : Qwall, true);
-
pw = getpwuid (getuid ());
#ifdef MSDOS
/* We let the real user name default to "root" because that's quite
@@ -1349,7 +1131,7 @@ of the user with that uid, or nil if there is no such
user. */)
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
if (NILP (Vuser_login_name))
- init_editfns (false);
+ init_editfns ();
if (NILP (uid))
return Vuser_login_name;
@@ -1372,7 +1154,7 @@ This ignores the environment variables LOGNAME and USER,
so it differs from
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
if (NILP (Vuser_login_name))
- init_editfns (false);
+ init_editfns ();
return Vuser_real_login_name;
}
@@ -1494,1058 +1276,6 @@ Value is a fixnum, if it's small enough, otherwise a
bignum. */)
}
-
-#ifndef TIME_T_MIN
-# define TIME_T_MIN TYPE_MINIMUM (time_t)
-#endif
-#ifndef TIME_T_MAX
-# define TIME_T_MAX TYPE_MAXIMUM (time_t)
-#endif
-
-/* Report that a time value is out of range for Emacs. */
-void
-time_overflow (void)
-{
- error ("Specified time is not representable");
-}
-
-static _Noreturn void
-invalid_time (void)
-{
- error ("Invalid time specification");
-}
-
-/* Check a return value compatible with that of decode_time_components. */
-static void
-check_time_validity (int validity)
-{
- if (validity <= 0)
- {
- if (validity < 0)
- time_overflow ();
- else
- invalid_time ();
- }
-}
-
-/* Return the upper part of the time T (everything but the bottom 16 bits). */
-static EMACS_INT
-hi_time (time_t t)
-{
- time_t hi = t >> LO_TIME_BITS;
- if (FIXNUM_OVERFLOW_P (hi))
- time_overflow ();
- return hi;
-}
-
-/* Return the bottom bits of the time T. */
-static int
-lo_time (time_t t)
-{
- return t & ((1 << LO_TIME_BITS) - 1);
-}
-
-DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
- doc: /* Return the current time, as the number of seconds since
1970-01-01 00:00:00.
-The time is returned as a list of integers (HIGH LOW USEC PSEC).
-HIGH has the most significant bits of the seconds, while LOW has the
-least significant 16 bits. USEC and PSEC are the microsecond and
-picosecond counts. */)
- (void)
-{
- return make_lisp_time (current_timespec ());
-}
-
-static struct lisp_time
-time_add (struct lisp_time ta, struct lisp_time tb)
-{
- EMACS_INT hi = ta.hi + tb.hi;
- int lo = ta.lo + tb.lo;
- int us = ta.us + tb.us;
- int ps = ta.ps + tb.ps;
- us += (1000000 <= ps);
- ps -= (1000000 <= ps) * 1000000;
- lo += (1000000 <= us);
- us -= (1000000 <= us) * 1000000;
- hi += (1 << LO_TIME_BITS <= lo);
- lo -= (1 << LO_TIME_BITS <= lo) << LO_TIME_BITS;
- return (struct lisp_time) { hi, lo, us, ps };
-}
-
-static struct lisp_time
-time_subtract (struct lisp_time ta, struct lisp_time tb)
-{
- EMACS_INT hi = ta.hi - tb.hi;
- int lo = ta.lo - tb.lo;
- int us = ta.us - tb.us;
- int ps = ta.ps - tb.ps;
- us -= (ps < 0);
- ps += (ps < 0) * 1000000;
- lo -= (us < 0);
- us += (us < 0) * 1000000;
- hi -= (lo < 0);
- lo += (lo < 0) << LO_TIME_BITS;
- return (struct lisp_time) { hi, lo, us, ps };
-}
-
-static Lisp_Object
-time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
-{
- if (FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
- {
- double da = XFLOAT_DATA (a);
- double db = XFLOAT_DATA (Ffloat_time (b));
- return make_float (subtract ? da - db : da + db);
- }
- if (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))
- return subtract ? make_float (-XFLOAT_DATA (b)) : b;
-
- int alen, blen;
- struct lisp_time ta = lisp_time_struct (a, &alen);
- struct lisp_time tb = lisp_time_struct (b, &blen);
- struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb);
- if (FIXNUM_OVERFLOW_P (t.hi))
- time_overflow ();
- Lisp_Object val = Qnil;
-
- switch (max (alen, blen))
- {
- default:
- val = Fcons (make_fixnum (t.ps), val);
- FALLTHROUGH;
- case 3:
- val = Fcons (make_fixnum (t.us), val);
- FALLTHROUGH;
- case 2:
- val = Fcons (make_fixnum (t.lo), val);
- val = Fcons (make_fixnum (t.hi), val);
- break;
- }
-
- return val;
-}
-
-DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0,
- doc: /* Return the sum of two time values A and B, as a time value.
-A nil value for either argument stands for the current time.
-See `current-time-string' for the various forms of a time value. */)
- (Lisp_Object a, Lisp_Object b)
-{
- return time_arith (a, b, false);
-}
-
-DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0,
- doc: /* Return the difference between two time values A and B, as a
time value.
-Use `float-time' to convert the difference into elapsed seconds.
-A nil value for either argument stands for the current time.
-See `current-time-string' for the various forms of a time value. */)
- (Lisp_Object a, Lisp_Object b)
-{
- return time_arith (a, b, true);
-}
-
-/* Return negative, 0, positive if a < b, a == b, a > b respectively.
- Return positive if either a or b is a NaN; this is good enough
- for the current callers. */
-static int
-time_cmp (Lisp_Object a, Lisp_Object b)
-{
- if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
- || (FLOATP (b) && !isfinite (XFLOAT_DATA (b))))
- {
- double da = FLOATP (a) ? XFLOAT_DATA (a) : 0;
- double db = FLOATP (b) ? XFLOAT_DATA (b) : 0;
- return da < db ? -1 : da != db;
- }
-
- int alen, blen;
- struct lisp_time ta = lisp_time_struct (a, &alen);
- struct lisp_time tb = lisp_time_struct (b, &blen);
- return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1)
- : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1)
- : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1)
- : ta.ps < tb.ps ? -1 : ta.ps != tb.ps);
-}
-
-DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0,
- doc: /* Return non-nil if time value T1 is earlier than time value T2.
-A nil value for either argument stands for the current time.
-See `current-time-string' for the various forms of a time value. */)
- (Lisp_Object t1, Lisp_Object t2)
-{
- return time_cmp (t1, t2) < 0 ? Qt : Qnil;
-}
-
-DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0,
- doc: /* Return non-nil if T1 and T2 are equal time values.
-A nil value for either argument stands for the current time.
-See `current-time-string' for the various forms of a time value. */)
- (Lisp_Object t1, Lisp_Object t2)
-{
- return time_cmp (t1, t2) == 0 ? Qt : Qnil;
-}
-
-
-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 */
-}
-
-
-/* Make a Lisp list that represents the Emacs time T. T may be an
- invalid time, with a slightly negative tv_nsec value such as
- UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
- correspondingly negative picosecond count. */
-Lisp_Object
-make_lisp_time (struct timespec t)
-{
- time_t s = t.tv_sec;
- int ns = t.tv_nsec;
- return list4i (hi_time (s), lo_time (s), ns / 1000, ns % 1000 * 1000);
-}
-
-/* Decode a Lisp list SPECIFIED_TIME that represents a time.
- Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values.
- Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME
- if successful, 0 if unsuccessful. */
-static int
-disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
- Lisp_Object *plow, Lisp_Object *pusec,
- Lisp_Object *ppsec)
-{
- Lisp_Object high = make_fixnum (0);
- Lisp_Object low = specified_time;
- Lisp_Object usec = make_fixnum (0);
- Lisp_Object psec = make_fixnum (0);
- int len = 4;
-
- if (CONSP (specified_time))
- {
- high = XCAR (specified_time);
- low = XCDR (specified_time);
- if (CONSP (low))
- {
- Lisp_Object low_tail = XCDR (low);
- low = XCAR (low);
- if (CONSP (low_tail))
- {
- usec = XCAR (low_tail);
- low_tail = XCDR (low_tail);
- if (CONSP (low_tail))
- psec = XCAR (low_tail);
- else
- len = 3;
- }
- else if (!NILP (low_tail))
- {
- usec = low_tail;
- len = 3;
- }
- else
- len = 2;
- }
- else
- len = 2;
-
- /* When combining components, require LOW to be an integer,
- as otherwise it would be a pain to add up times. */
- if (! INTEGERP (low))
- return 0;
- }
- else if (INTEGERP (specified_time))
- len = 2;
-
- *phigh = high;
- *plow = low;
- *pusec = usec;
- *ppsec = psec;
- return len;
-}
-
-/* Convert T into an Emacs time *RESULT, truncating toward minus infinity.
- Return true if T is in range, false otherwise. */
-static bool
-decode_float_time (double t, struct lisp_time *result)
-{
- double lo_multiplier = 1 << LO_TIME_BITS;
- double emacs_time_min = MOST_NEGATIVE_FIXNUM * lo_multiplier;
- if (! (emacs_time_min <= t && t < -emacs_time_min))
- return false;
-
- double small_t = t / lo_multiplier;
- EMACS_INT hi = small_t;
- double t_sans_hi = t - hi * lo_multiplier;
- int lo = t_sans_hi;
- long double fracps = (t_sans_hi - lo) * 1e12L;
-#ifdef INT_FAST64_MAX
- int_fast64_t ifracps = fracps;
- int us = ifracps / 1000000;
- int ps = ifracps % 1000000;
-#else
- int us = fracps / 1e6L;
- int ps = fracps - us * 1e6L;
-#endif
- us -= (ps < 0);
- ps += (ps < 0) * 1000000;
- lo -= (us < 0);
- us += (us < 0) * 1000000;
- hi -= (lo < 0);
- lo += (lo < 0) << LO_TIME_BITS;
- result->hi = hi;
- result->lo = lo;
- result->us = us;
- result->ps = ps;
- return true;
-}
-
-/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp
- list, generate the corresponding time value.
- If LOW is floating point, the other components should be zero.
-
- If RESULT is not null, store into *RESULT the converted time.
- If *DRESULT is not null, store into *DRESULT the number of
- seconds since the start of the POSIX Epoch.
-
- Return 1 if successful, 0 if the components are of the
- wrong type, and -1 if the time is out of range. */
-int
-decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
- Lisp_Object psec,
- struct lisp_time *result, double *dresult)
-{
- EMACS_INT hi, us, ps;
- intmax_t lo;
- if (! (FIXNUMP (high)
- && FIXNUMP (usec) && FIXNUMP (psec)))
- return 0;
- if (! INTEGERP (low))
- {
- if (FLOATP (low))
- {
- double t = XFLOAT_DATA (low);
- if (result && ! decode_float_time (t, result))
- return -1;
- if (dresult)
- *dresult = t;
- return 1;
- }
- else if (NILP (low))
- {
- struct timespec now = current_timespec ();
- if (result)
- {
- result->hi = hi_time (now.tv_sec);
- result->lo = lo_time (now.tv_sec);
- result->us = now.tv_nsec / 1000;
- result->ps = now.tv_nsec % 1000 * 1000;
- }
- if (dresult)
- *dresult = now.tv_sec + now.tv_nsec / 1e9;
- return 1;
- }
- else
- return 0;
- }
-
- hi = XFIXNUM (high);
- if (! integer_to_intmax (low, &lo))
- return -1;
- us = XFIXNUM (usec);
- ps = XFIXNUM (psec);
-
- /* Normalize out-of-range lower-order components by carrying
- each overflow into the next higher-order component. */
- us += ps / 1000000 - (ps % 1000000 < 0);
- lo += us / 1000000 - (us % 1000000 < 0);
- if (INT_ADD_WRAPV (lo >> LO_TIME_BITS, hi, &hi))
- return -1;
- ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
- us = us % 1000000 + 1000000 * (us % 1000000 < 0);
- lo &= (1 << LO_TIME_BITS) - 1;
-
- if (result)
- {
- if (FIXNUM_OVERFLOW_P (hi))
- return -1;
- result->hi = hi;
- result->lo = lo;
- result->us = us;
- result->ps = ps;
- }
-
- if (dresult)
- {
- double dhi = hi;
- *dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS);
- }
-
- return 1;
-}
-
-struct timespec
-lisp_to_timespec (struct lisp_time t)
-{
- if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <=
t.hi)
- && t.hi <= TIME_T_MAX >> LO_TIME_BITS))
- return invalid_timespec ();
- time_t s = (t.hi << LO_TIME_BITS) + t.lo;
- int ns = t.us * 1000 + t.ps / 1000;
- return make_timespec (s, ns);
-}
-
-/* Decode a Lisp list SPECIFIED_TIME that represents a time.
- Store its effective length into *PLEN.
- If SPECIFIED_TIME is nil, use the current time.
- Signal an error if SPECIFIED_TIME does not represent a time. */
-static struct lisp_time
-lisp_time_struct (Lisp_Object specified_time, int *plen)
-{
- Lisp_Object high, low, usec, psec;
- struct lisp_time t;
- int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec);
- if (!len)
- invalid_time ();
- int val = decode_time_components (high, low, usec, psec, &t, 0);
- check_time_validity (val);
- *plen = len;
- return t;
-}
-
-/* Like lisp_time_struct, except return a struct timespec.
- Discard any low-order digits. */
-struct timespec
-lisp_time_argument (Lisp_Object specified_time)
-{
- int len;
- struct lisp_time lt = lisp_time_struct (specified_time, &len);
- struct timespec t = lisp_to_timespec (lt);
- if (! timespec_valid_p (t))
- time_overflow ();
- return t;
-}
-
-/* Like lisp_time_argument, except decode only the seconds part,
- and do not check the subseconds part. */
-static time_t
-lisp_seconds_argument (Lisp_Object specified_time)
-{
- Lisp_Object high, low, usec, psec;
- struct lisp_time t;
-
- int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec);
- if (val != 0)
- {
- val = decode_time_components (high, low, make_fixnum (0),
- make_fixnum (0), &t, 0);
- if (0 < val
- && ! ((TYPE_SIGNED (time_t)
- ? TIME_T_MIN >> LO_TIME_BITS <= t.hi
- : 0 <= t.hi)
- && t.hi <= TIME_T_MAX >> LO_TIME_BITS))
- val = -1;
- }
- check_time_validity (val);
- return (t.hi << LO_TIME_BITS) + t.lo;
-}
-
-DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
- doc: /* Return the current time, as a float number of seconds since the
epoch.
-If SPECIFIED-TIME is given, it is the time to convert to float
-instead of the current time. The argument should have the form
-\(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
-you can use times from `current-time' and from `file-attributes'.
-SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
-considered obsolete.
-
-WARNING: Since the result is floating point, it may not be exact.
-If precise time stamps are required, use either `current-time',
-or (if you need time as a string) `format-time-string'. */)
- (Lisp_Object specified_time)
-{
- double t;
- Lisp_Object high, low, usec, psec;
- if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
- && decode_time_components (high, low, usec, psec, 0, &t)))
- invalid_time ();
- return make_float (t);
-}
-
-/* Write information into buffer S of size MAXSIZE, according to the
- FORMAT of length FORMAT_LEN, using time information taken from *TP.
- Use the time zone specified by TZ.
- Use NS as the number of nanoseconds in the %N directive.
- Return the number of bytes written, not including the terminating
- '\0'. If S is NULL, nothing will be written anywhere; so to
- determine how many bytes would be written, use NULL for S and
- ((size_t) -1) for MAXSIZE.
-
- This function behaves like nstrftime, except it allows null
- bytes in FORMAT and it does not support nanoseconds. */
-static size_t
-emacs_nmemftime (char *s, size_t maxsize, const char *format,
- size_t format_len, const struct tm *tp, timezone_t tz, int ns)
-{
- size_t total = 0;
-
- /* Loop through all the null-terminated strings in the format
- argument. Normally there's just one null-terminated string, but
- there can be arbitrarily many, concatenated together, if the
- format contains '\0' bytes. nstrftime stops at the first
- '\0' byte so we must invoke it separately for each such string. */
- for (;;)
- {
- size_t len;
- size_t result;
-
- if (s)
- s[0] = '\1';
-
- result = nstrftime (s, maxsize, format, tp, tz, ns);
-
- if (s)
- {
- if (result == 0 && s[0] != '\0')
- return 0;
- s += result + 1;
- }
-
- maxsize -= result + 1;
- total += result;
- len = strlen (format);
- if (len == format_len)
- return total;
- total++;
- format += len + 1;
- format_len -= len + 1;
- }
-}
-
-DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
- doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted or
nil.
-TIME is specified as (HIGH LOW USEC PSEC), as returned by
-`current-time' or `file-attributes'. It can also be a single integer
-number of seconds since the epoch. The obsolete form (HIGH . LOW) is
-also still accepted.
-
-The optional ZONE is omitted or nil for Emacs local time, t for
-Universal Time, `wall' for system wall clock time, or a string as in
-the TZ environment variable. It can also be a list (as from
-`current-time-zone') or an integer (as from `decode-time') applied
-without consideration for daylight saving time.
-
-The value is a copy of FORMAT-STRING, but with certain constructs replaced
-by text that describes the specified date and time in TIME:
-
-%Y is the year, %y within the century, %C the century.
-%G is the year corresponding to the ISO week, %g within the century.
-%m is the numeric month.
-%b and %h are the locale's abbreviated month name, %B the full name.
- (%h is not supported on MS-Windows.)
-%d is the day of the month, zero-padded, %e is blank-padded.
-%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
-%a is the locale's abbreviated name of the day of week, %A the full name.
-%U is the week number starting on Sunday, %W starting on Monday,
- %V according to ISO 8601.
-%j is the day of the year.
-
-%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
- only blank-padded, %l is like %I blank-padded.
-%p is the locale's equivalent of either AM or PM.
-%q is the calendar quarter (1–4).
-%M is the minute (00-59).
-%S is the second (00-59; 00-60 on platforms with leap seconds)
-%s is the number of seconds since 1970-01-01 00:00:00 +0000.
-%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
-%Z is the time zone abbreviation, %z is the numeric form.
-
-%c is the locale's date and time format.
-%x is the locale's "preferred" date format.
-%D is like "%m/%d/%y".
-%F is the ISO 8601 date format (like "%Y-%m-%d").
-
-%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
-%X is the locale's "preferred" time format.
-
-Finally, %n is a newline, %t is a tab, %% is a literal %, and
-unrecognized %-sequences stand for themselves.
-
-Certain flags and modifiers are available with some format controls.
-The flags are `_', `-', `^' and `#'. For certain characters X,
-%_X is like %X, but padded with blanks; %-X is like %X,
-but without padding. %^X is like %X, but with all textual
-characters up-cased; %#X is like %X, but with letter-case of
-all textual characters reversed.
-%NX (where N stands for an integer) is like %X,
-but takes up at least N (a number) positions.
-The modifiers are `E' and `O'. For certain characters X,
-%EX is a locale's alternative version of %X;
-%OX is like %X, but uses the locale's number symbols.
-
-For example, to produce full ISO 8601 format, use "%FT%T%z".
-
-usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */)
- (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object zone)
-{
- struct timespec t = lisp_time_argument (timeval);
- struct tm tm;
-
- CHECK_STRING (format_string);
- format_string = code_convert_string_norecord (format_string,
- Vlocale_coding_system, 1);
- return format_time_string (SSDATA (format_string), SBYTES (format_string),
- t, zone, &tm);
-}
-
-static Lisp_Object
-format_time_string (char const *format, ptrdiff_t formatlen,
- struct timespec t, Lisp_Object zone, struct tm *tmp)
-{
- char buffer[4000];
- char *buf = buffer;
- ptrdiff_t size = sizeof buffer;
- size_t len;
- int ns = t.tv_nsec;
- USE_SAFE_ALLOCA;
-
- timezone_t tz = tzlookup (zone, false);
- /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is
- a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz
- expects a pointer to time_t value. */
- time_t tsec = t.tv_sec;
- tmp = emacs_localtime_rz (tz, &tsec, tmp);
- if (! tmp)
- {
- xtzfree (tz);
- time_overflow ();
- }
- synchronize_system_time_locale ();
-
- while (true)
- {
- buf[0] = '\1';
- len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns);
- if ((0 < len && len < size) || (len == 0 && buf[0] == '\0'))
- break;
-
- /* Buffer was too small, so make it bigger and try again. */
- len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns);
- if (STRING_BYTES_BOUND <= len)
- {
- xtzfree (tz);
- string_overflow ();
- }
- size = len + 1;
- buf = SAFE_ALLOCA (size);
- }
-
- xtzfree (tz);
- AUTO_STRING_WITH_LEN (bufstring, buf, len);
- Lisp_Object result = code_convert_string_norecord (bufstring,
- Vlocale_coding_system, 0);
- SAFE_FREE ();
- return result;
-}
-
-DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0,
- doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST
UTCOFF).
-The optional TIME should be a list of (HIGH LOW . IGNORED),
-as from `current-time' and `file-attributes', or nil to use the
-current time. It can also be a single integer number of seconds since
-the epoch. The obsolete form (HIGH . LOW) is also still accepted.
-
-The optional ZONE is omitted or nil for Emacs local time, t for
-Universal Time, `wall' for system wall clock time, or a string as in
-the TZ environment variable. It can also be a list (as from
-`current-time-zone') or an integer (the UTC offset in seconds) applied
-without consideration for daylight saving time.
-
-The list has the following nine members: SEC is an integer between 0
-and 60; SEC is 60 for a leap second, which only some operating systems
-support. MINUTE is an integer between 0 and 59. HOUR is an integer
-between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
-integer between 1 and 12. YEAR is an integer indicating the
-four-digit year. DOW is the day of week, an integer between 0 and 6,
-where 0 is Sunday. DST is t if daylight saving time is in effect,
-nil if it is not in effect, and -1 if this information is
-not available. UTCOFF is an integer indicating the UTC offset in
-seconds, i.e., the number of seconds east of Greenwich. (Note that
-Common Lisp has different meanings for DOW and UTCOFF.)
-
-usage: (decode-time &optional TIME ZONE) */)
- (Lisp_Object specified_time, Lisp_Object zone)
-{
- time_t time_spec = lisp_seconds_argument (specified_time);
- struct tm local_tm, gmt_tm;
- timezone_t tz = tzlookup (zone, false);
- struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm);
- xtzfree (tz);
-
- if (! (tm
- && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year
- && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
- time_overflow ();
-
- /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */
- EMACS_INT tm_year_base = TM_YEAR_BASE;
-
- return CALLN (Flist,
- make_fixnum (local_tm.tm_sec),
- make_fixnum (local_tm.tm_min),
- make_fixnum (local_tm.tm_hour),
- make_fixnum (local_tm.tm_mday),
- make_fixnum (local_tm.tm_mon + 1),
- make_fixnum (local_tm.tm_year + tm_year_base),
- make_fixnum (local_tm.tm_wday),
- (local_tm.tm_isdst < 0 ? make_fixnum (-1)
- : local_tm.tm_isdst == 0 ? Qnil : Qt),
- (HAVE_TM_GMTOFF
- ? make_fixnum (tm_gmtoff (&local_tm))
- : gmtime_r (&time_spec, &gmt_tm)
- ? make_fixnum (tm_diff (&local_tm, &gmt_tm))
- : Qnil));
-}
-
-/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
- the result is representable as an int. */
-static int
-check_tm_member (Lisp_Object obj, int offset)
-{
- CHECK_FIXNUM (obj);
- EMACS_INT n = XFIXNUM (obj);
- int result;
- if (INT_SUBTRACT_WRAPV (n, offset, &result))
- time_overflow ();
- return result;
-}
-
-DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0,
- doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to
internal time.
-This is the reverse operation of `decode-time', which see.
-
-The optional ZONE is omitted or nil for Emacs local time, t for
-Universal Time, `wall' for system wall clock time, or a string as in
-the TZ environment variable. It can also be a list (as from
-`current-time-zone') or an integer (as from `decode-time') applied
-without consideration for daylight saving time.
-
-You can pass more than 7 arguments; then the first six arguments
-are used as SECOND through YEAR, and the *last* argument is used as ZONE.
-The intervening arguments are ignored.
-This feature lets (apply \\='encode-time (decode-time ...)) work.
-
-Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
-for example, a DAY of 0 means the day preceding the given month.
-Year numbers less than 100 are treated just like other year numbers.
-If you want them to stand for years in this century, you must do that yourself.
-
-Years before 1970 are not guaranteed to work. On some systems,
-year values as low as 1901 do work.
-
-usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- time_t value;
- struct tm tm;
- Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil);
-
- tm.tm_sec = check_tm_member (args[0], 0);
- tm.tm_min = check_tm_member (args[1], 0);
- tm.tm_hour = check_tm_member (args[2], 0);
- tm.tm_mday = check_tm_member (args[3], 0);
- tm.tm_mon = check_tm_member (args[4], 1);
- tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE);
- tm.tm_isdst = -1;
-
- timezone_t tz = tzlookup (zone, false);
- value = emacs_mktime_z (tz, &tm);
- xtzfree (tz);
-
- if (value == (time_t) -1)
- time_overflow ();
-
- return list2i (hi_time (value), lo_time (value));
-}
-
-DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string,
- 0, 2, 0,
- doc: /* Return the current local time, as a human-readable string.
-Programs can use this function to decode a time,
-since the number of columns in each field is fixed
-if the year is in the range 1000-9999.
-The format is `Sun Sep 16 01:03:52 1973'.
-However, see also the functions `decode-time' and `format-time-string'
-which provide a much more powerful and general facility.
-
-If SPECIFIED-TIME is given, it is a time to format instead of the
-current time. The argument should have the form (HIGH LOW . IGNORED).
-Thus, you can use times obtained from `current-time' and from
-`file-attributes'. SPECIFIED-TIME can also be a single integer number
-of seconds since the epoch. The obsolete form (HIGH . LOW) is also
-still accepted.
-
-The optional ZONE is omitted or nil for Emacs local time, t for
-Universal Time, `wall' for system wall clock time, or a string as in
-the TZ environment variable. It can also be a list (as from
-`current-time-zone') or an integer (as from `decode-time') applied
-without consideration for daylight saving time. */)
- (Lisp_Object specified_time, Lisp_Object zone)
-{
- time_t value = lisp_seconds_argument (specified_time);
- timezone_t tz = tzlookup (zone, false);
-
- /* Convert to a string in ctime format, except without the trailing
- newline, and without the 4-digit year limit. Don't use asctime
- or ctime, as they might dump core if the year is outside the
- range -999 .. 9999. */
- struct tm tm;
- struct tm *tmp = emacs_localtime_rz (tz, &value, &tm);
- xtzfree (tz);
- if (! tmp)
- time_overflow ();
-
- static char const wday_name[][4] =
- { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
- static char const mon_name[][4] =
- { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
- "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
- printmax_t year_base = TM_YEAR_BASE;
- char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
- int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd,
- wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday,
- tm.tm_hour, tm.tm_min, tm.tm_sec,
- tm.tm_year + year_base);
-
- return make_unibyte_string (buf, len);
-}
-
-/* Yield A - B, measured in seconds.
- This function is copied from the GNU C Library. */
-static int
-tm_diff (struct tm *a, struct tm *b)
-{
- /* Compute intervening leap days correctly even if year is negative.
- Take care to avoid int overflow in leap day calculations,
- but it's OK to assume that A and B are close to each other. */
- int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3);
- int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3);
- int a100 = a4 / 25 - (a4 % 25 < 0);
- int b100 = b4 / 25 - (b4 % 25 < 0);
- int a400 = a100 >> 2;
- int b400 = b100 >> 2;
- int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
- int years = a->tm_year - b->tm_year;
- int days = (365 * years + intervening_leap_days
- + (a->tm_yday - b->tm_yday));
- return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
- + (a->tm_min - b->tm_min))
- + (a->tm_sec - b->tm_sec));
-}
-
-/* Yield A's UTC offset, or an unspecified value if unknown. */
-static long int
-tm_gmtoff (struct tm *a)
-{
-#if HAVE_TM_GMTOFF
- return a->tm_gmtoff;
-#else
- return 0;
-#endif
-}
-
-DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0,
- doc: /* Return the offset and name for the local time zone.
-This returns a list of the form (OFFSET NAME).
-OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
- A negative value means west of Greenwich.
-NAME is a string giving the name of the time zone.
-If SPECIFIED-TIME is given, the time zone offset is determined from it
-instead of using the current time. The argument should have the form
-\(HIGH LOW . IGNORED). Thus, you can use times obtained from
-`current-time' and from `file-attributes'. SPECIFIED-TIME can also be
-a single integer number of seconds since the epoch. The obsolete form
-(HIGH . LOW) is also still accepted.
-
-The optional ZONE is omitted or nil for Emacs local time, t for
-Universal Time, `wall' for system wall clock time, or a string as in
-the TZ environment variable. It can also be a list (as from
-`current-time-zone') or an integer (as from `decode-time') applied
-without consideration for daylight saving time.
-
-Some operating systems cannot provide all this information to Emacs;
-in this case, `current-time-zone' returns a list containing nil for
-the data it can't find. */)
- (Lisp_Object specified_time, Lisp_Object zone)
-{
- struct timespec value;
- struct tm local_tm, gmt_tm;
- Lisp_Object zone_offset, zone_name;
-
- zone_offset = Qnil;
- value = make_timespec (lisp_seconds_argument (specified_time), 0);
- zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value,
- zone, &local_tm);
-
- /* gmtime_r expects a pointer to time_t, but tv_sec of struct
- timespec on some systems (MinGW) is a 64-bit field. */
- time_t tsec = value.tv_sec;
- if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm))
- {
- long int offset = (HAVE_TM_GMTOFF
- ? tm_gmtoff (&local_tm)
- : tm_diff (&local_tm, &gmt_tm));
- zone_offset = make_fixnum (offset);
- if (SCHARS (zone_name) == 0)
- {
- /* No local time zone name is available; use numeric zone instead. */
- long int hour = offset / 3600;
- int min_sec = offset % 3600;
- int amin_sec = min_sec < 0 ? - min_sec : min_sec;
- int min = amin_sec / 60;
- int sec = amin_sec % 60;
- int min_prec = min_sec ? 2 : 0;
- int sec_prec = sec ? 2 : 0;
- char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
- zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d",
- (offset < 0 ? '-' : '+'),
- hour, min_prec, min, sec_prec,
sec);
- }
- }
-
- return list2 (zone_offset, zone_name);
-}
-
-DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
- doc: /* Set the Emacs local time zone using TZ, a string specifying a
time zone rule.
-If TZ is nil or `wall', use system wall clock time; this differs from
-the usual Emacs convention where nil means current local time. If TZ
-is t, use Universal Time. If TZ is a list (as from
-`current-time-zone') or an integer (as from `decode-time'), use the
-specified time zone without consideration for daylight saving time.
-
-Instead of calling this function, you typically want something else.
-To temporarily use a different time zone rule for just one invocation
-of `decode-time', `encode-time', or `format-time-string', pass the
-function a ZONE argument. To change local time consistently
-throughout Emacs, call (setenv "TZ" TZ): this changes both the
-environment of the Emacs process and the variable
-`process-environment', whereas `set-time-zone-rule' affects only the
-former. */)
- (Lisp_Object tz)
-{
- tzlookup (NILP (tz) ? Qwall : tz, true);
- return Qnil;
-}
-
-/* A buffer holding a string of the form "TZ=value", intended
- to be part of the environment. If TZ is supposed to be unset,
- the buffer string is "tZ=". */
- static char *tzvalbuf;
-
-/* Get the local time zone rule. */
-char *
-emacs_getenv_TZ (void)
-{
- return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0;
-}
-
-/* Set the local time zone rule to TZSTRING, which can be null to
- denote wall clock time. Do not record the setting in LOCAL_TZ.
-
- This function is not thread-safe, in theory because putenv is not,
- but mostly because of the static storage it updates. Other threads
- that invoke localtime etc. may be adversely affected while this
- function is executing. */
-
-int
-emacs_setenv_TZ (const char *tzstring)
-{
- static ptrdiff_t tzvalbufsize;
- ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0;
- char *tzval = tzvalbuf;
- bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen;
-
- if (new_tzvalbuf)
- {
- /* Do not attempt to free the old tzvalbuf, since another thread
- may be using it. In practice, the first allocation is large
- enough and memory does not leak. */
- tzval = xpalloc (NULL, &tzvalbufsize,
- tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1);
- tzvalbuf = tzval;
- tzval[1] = 'Z';
- tzval[2] = '=';
- }
-
- if (tzstring)
- {
- /* Modify TZVAL in place. Although this is dicey in a
- multithreaded environment, we know of no portable alternative.
- Calling putenv or setenv could crash some other thread. */
- tzval[0] = 'T';
- strcpy (tzval + tzeqlen, tzstring);
- }
- else
- {
- /* Turn 'TZ=whatever' into an empty environment variable 'tZ='.
- Although this is also dicey, calling unsetenv here can crash Emacs.
- See Bug#8705. */
- tzval[0] = 't';
- tzval[tzeqlen] = 0;
- }
-
-
-#ifndef WINDOWSNT
- /* Modifying *TZVAL merely requires calling tzset (which is the
- caller's responsibility). However, modifying TZVAL requires
- calling putenv; although this is not thread-safe, in practice this
- runs only on startup when there is only one thread. */
- bool need_putenv = new_tzvalbuf;
-#else
- /* MS-Windows 'putenv' copies the argument string into a block it
- allocates, so modifying *TZVAL will not change the environment.
- However, the other threads run by Emacs on MS-Windows never call
- 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
- dicey in-place modification technique doesn't exist there in the
- first place. */
- bool need_putenv = true;
-#endif
- if (need_putenv)
- xputenv (tzval);
-
- return 0;
-}
-
/* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
(if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
type of object is Lisp_String). INHERIT is passed to
@@ -5764,19 +4494,6 @@ it to be non-nil. */);
defsubr (&Sgroup_real_gid);
defsubr (&Suser_full_name);
defsubr (&Semacs_pid);
- defsubr (&Scurrent_time);
- defsubr (&Stime_add);
- defsubr (&Stime_subtract);
- defsubr (&Stime_equal_p);
- defsubr (&Stime_less_p);
- defsubr (&Sget_internal_run_time);
- defsubr (&Sformat_time_string);
- defsubr (&Sfloat_time);
- defsubr (&Sdecode_time);
- defsubr (&Sencode_time);
- defsubr (&Scurrent_time_string);
- defsubr (&Scurrent_time_zone);
- defsubr (&Sset_time_zone_rule);
defsubr (&Ssystem_name);
defsubr (&Smessage);
defsubr (&Smessage_box);
diff --git a/src/emacs.c b/src/emacs.c
index b1c96d1..07df191 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -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
diff --git a/src/eval.c b/src/eval.c
index 5e25caa..42c275d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -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);
}
diff --git a/src/keyboard.c b/src/keyboard.c
index 1c1f151..8ea15d3 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -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;
- 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)
+ if (! FIXNUMP (vec[2]))
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");
diff --git a/src/lisp.h b/src/lisp.h
index bb190b6..5ecc48b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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);
diff --git a/src/lread.c b/src/lread.c
index 73e38d8..62616cb 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -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;
+
+ /* 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);
+ }
- return make_float (negative ? -value : value);
+ /* 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;
}
diff --git a/src/minibuf.c b/src/minibuf.c
index 751d6bd..9395dc8 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -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);
diff --git a/src/nsterm.m b/src/nsterm.m
index 961271f..68ad646 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -278,12 +278,7 @@ struct ns_display_info *x_display_list; /* Chain of
existing displays */
long context_menu_value = 0;
/* display update */
-static struct frame *ns_updating_frame;
-static NSView *focus_view = NULL;
static int ns_window_num = 0;
-#ifdef NS_IMPL_GNUSTEP
-static NSRect uRect; // TODO: This is dead, remove it?
-#endif
static BOOL gsaved = NO;
static BOOL ns_fake_keydown = NO;
#ifdef NS_IMPL_COCOA
@@ -1093,12 +1088,13 @@ ns_update_begin (struct frame *f)
external (RIF) call; whole frame, called before update_window_begin
--------------------------------------------------------------------------
*/
{
+#ifdef NS_IMPL_COCOA
EmacsView *view = FRAME_NS_VIEW (f);
+
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin");
ns_update_auto_hide_menu_bar ();
-#ifdef NS_IMPL_COCOA
if ([view isFullscreen] && [view fsIsNative])
{
// Fix reappearing tool bar in fullscreen for Mac OS X 10.7
@@ -1107,36 +1103,29 @@ ns_update_begin (struct frame *f)
if (! tbar_visible != ! [toolbar isVisible])
[toolbar setVisible: tbar_visible];
}
-#endif
-
- ns_updating_frame = f;
- [view lockFocus];
/* drawRect may have been called for say the minibuffer, and then clip path
is for the minibuffer. But the display engine may draw more because
we have set the frame as garbaged. So reset clip path to the whole
view. */
-#ifdef NS_IMPL_COCOA
- {
- NSBezierPath *bp;
- NSRect r = [view frame];
- NSRect cr = [[view window] frame];
- /* If a large frame size is set, r may be larger than the window frame
- before constrained. In that case don't change the clip path, as we
- will clear in to the tool bar and title bar. */
- if (r.size.height
- + FRAME_NS_TITLEBAR_HEIGHT (f)
- + FRAME_TOOLBAR_HEIGHT (f) <= cr.size.height)
- {
- bp = [[NSBezierPath bezierPathWithRect: r] retain];
- [bp setClip];
- [bp release];
- }
- }
-#endif
-
-#ifdef NS_IMPL_GNUSTEP
- uRect = NSMakeRect (0, 0, 0, 0);
+ /* FIXME: I don't think we need to do this. */
+ if ([NSView focusView] == FRAME_NS_VIEW (f))
+ {
+ NSBezierPath *bp;
+ NSRect r = [view frame];
+ NSRect cr = [[view window] frame];
+ /* If a large frame size is set, r may be larger than the window frame
+ before constrained. In that case don't change the clip path, as we
+ will clear in to the tool bar and title bar. */
+ if (r.size.height
+ + FRAME_NS_TITLEBAR_HEIGHT (f)
+ + FRAME_TOOLBAR_HEIGHT (f) <= cr.size.height)
+ {
+ bp = [[NSBezierPath bezierPathWithRect: r] retain];
+ [bp setClip];
+ [bp release];
+ }
+ }
#endif
}
@@ -1218,99 +1207,66 @@ ns_update_end (struct frame *f)
external (RIF) call; for whole frame, called after update_window_end
--------------------------------------------------------------------------
*/
{
- EmacsView *view = FRAME_NS_VIEW (f);
-
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
-
- block_input ();
-
- [view unlockFocus];
- [[view window] flushWindow];
-
- unblock_input ();
- ns_updating_frame = NULL;
}
-static void
-ns_focus (struct frame *f, NSRect *r, int n)
+
+static BOOL
+ns_clip_to_rect (struct frame *f, NSRect *r, int n)
/* --------------------------------------------------------------------------
- Internal: Focus on given frame. During small local updates this is used to
- draw, however during large updates, ns_update_begin and ns_update_end are
- called to wrap the whole thing, in which case these calls are stubbed out.
- Except, on GNUstep, we accumulate the rectangle being drawn into, because
- the back end won't do this automatically, and will just end up flushing
- the entire window.
+ Clip the drawing area to rectangle r in frame f. If drawing is not
+ currently possible mark r as dirty and return NO, otherwise return
+ YES.
--------------------------------------------------------------------------
*/
{
- NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus");
- if (r != NULL)
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_clip_to_rect");
+ if (r)
{
NSTRACE_RECT ("r", *r);
- }
- if (f != ns_updating_frame)
- {
- NSView *view = FRAME_NS_VIEW (f);
- if (view != focus_view)
+ if ([NSView focusView] == FRAME_NS_VIEW (f))
{
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
-/* debug_lock--; */
- }
+ [[NSGraphicsContext currentContext] saveGraphicsState];
+ if (n == 2)
+ NSRectClipList (r, 2);
+ else
+ NSRectClip (*r);
+ gsaved = YES;
- if (view)
- [view lockFocus];
- focus_view = view;
-/* if (view) debug_lock++; */
+ return YES;
}
- }
-
- /* clipping */
- if (r)
- {
- [[NSGraphicsContext currentContext] saveGraphicsState];
- if (n == 2)
- NSRectClipList (r, 2);
else
- NSRectClip (*r);
- gsaved = YES;
+ {
+ NSView *view = FRAME_NS_VIEW (f);
+ int i;
+ for (i = 0 ; i < n ; i++)
+ [view setNeedsDisplayInRect:r[i]];
+ }
}
+
+ return NO;
}
static void
-ns_unfocus (struct frame *f)
-/* --------------------------------------------------------------------------
- Internal: Remove focus on given frame
- --------------------------------------------------------------------------
*/
+ns_reset_clipping (struct frame *f)
+/* Internal: Restore the previous graphics state, unsetting any
+ clipping areas. */
{
- NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping");
if (gsaved)
{
[[NSGraphicsContext currentContext] restoreGraphicsState];
gsaved = NO;
}
-
- if (f != ns_updating_frame)
- {
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- focus_view = NULL;
-/* debug_lock--; */
- }
- }
}
-static void
+static BOOL
ns_clip_to_row (struct window *w, struct glyph_row *row,
enum glyph_row_area area, BOOL gc)
/* --------------------------------------------------------------------------
@@ -1329,7 +1285,19 @@ ns_clip_to_row (struct window *w, struct glyph_row *row,
clip_rect.size.width = window_width;
clip_rect.size.height = row->visible_height;
- ns_focus (f, &clip_rect, 1);
+ return ns_clip_to_rect (f, &clip_rect, 1);
+}
+
+
+static void
+ns_flush_display (struct frame *f)
+/* Force the frame to redisplay. If areas have previously been marked
+ dirty by setNeedsDisplayInRect (in ns_clip_to_rect), then this will call
+ draw_rect: which will "expose" those areas. */
+{
+ block_input ();
+ [FRAME_NS_VIEW (f) displayIfNeeded];
+ unblock_input ();
}
@@ -2826,14 +2794,16 @@ ns_clear_frame (struct frame *f)
r = [view bounds];
block_input ();
- ns_focus (f, &r, 1);
- [ns_lookup_indexed_color (NS_FACE_BACKGROUND
- (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set];
- NSRectFill (r);
- ns_unfocus (f);
-
- /* as of 2006/11 or so this is now needed */
- ns_redraw_scroll_bars (f);
+ if (ns_clip_to_rect (f, &r, 1))
+ {
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND
+ (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set];
+ NSRectFill (r);
+ ns_reset_clipping (f);
+
+ /* as of 2006/11 or so this is now needed */
+ ns_redraw_scroll_bars (f);
+ }
unblock_input ();
}
@@ -2854,13 +2824,14 @@ ns_clear_frame_area (struct frame *f, int x, int y, int
width, int height)
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area");
r = NSIntersectionRect (r, [view frame]);
- ns_focus (f, &r, 1);
- [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
+ if (ns_clip_to_rect (f, &r, 1))
+ {
+ [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
- NSRectFill (r);
+ NSRectFill (r);
- ns_unfocus (f);
- return;
+ ns_reset_clipping (f);
+ }
}
static void
@@ -2872,11 +2843,11 @@ ns_copy_bits (struct frame *f, NSRect src, NSRect dest)
{
hide_bell(); // Ensure the bell image isn't scrolled.
- ns_focus (f, &dest, 1);
+ /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is
+ no obvious replacement so we may have to come up with our own. */
[FRAME_NS_VIEW (f) scrollRect: src
by: NSMakeSize (dest.origin.x - src.origin.x,
dest.origin.y -
src.origin.y)];
- ns_unfocus (f);
}
}
@@ -3087,85 +3058,86 @@ ns_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
}
/* Must clip because of partially visible lines. */
- ns_clip_to_row (w, row, ANY_AREA, YES);
-
- if (!p->overlay_p)
+ if (ns_clip_to_row (w, row, ANY_AREA, YES))
{
- int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny;
-
- if (bx >= 0 && nx > 0)
+ if (!p->overlay_p)
{
- NSRect r = NSMakeRect (bx, by, nx, ny);
- NSRectClip (r);
- [ns_lookup_indexed_color (face->background, f) set];
- NSRectFill (r);
- }
- }
+ int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny;
- if (p->which)
- {
- NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h);
- EmacsImage *img = bimgs[p->which - 1];
-
- if (!img)
- {
- // Note: For "periodic" images, allocate one EmacsImage for
- // the base image, and use it for all dh:s.
- unsigned short *bits = p->bits;
- int full_height = p->h + p->dh;
- int i;
- unsigned char *cbits = xmalloc (full_height);
-
- for (i = 0; i < full_height; i++)
- cbits[i] = bits[i];
- img = [[EmacsImage alloc] initFromXBM: cbits width: 8
- height: full_height
- fg: 0 bg: 0];
- bimgs[p->which - 1] = img;
- xfree (cbits);
+ if (bx >= 0 && nx > 0)
+ {
+ NSRect r = NSMakeRect (bx, by, nx, ny);
+ NSRectClip (r);
+ [ns_lookup_indexed_color (face->background, f) set];
+ NSRectFill (r);
+ }
}
- NSTRACE_RECT ("r", r);
+ if (p->which)
+ {
+ NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h);
+ EmacsImage *img = bimgs[p->which - 1];
- NSRectClip (r);
- /* Since we composite the bitmap instead of just blitting it, we need
- to erase the whole background. */
- [ns_lookup_indexed_color(face->background, f) set];
- NSRectFill (r);
+ if (!img)
+ {
+ // Note: For "periodic" images, allocate one EmacsImage for
+ // the base image, and use it for all dh:s.
+ unsigned short *bits = p->bits;
+ int full_height = p->h + p->dh;
+ int i;
+ unsigned char *cbits = xmalloc (full_height);
+
+ for (i = 0; i < full_height; i++)
+ cbits[i] = bits[i];
+ img = [[EmacsImage alloc] initFromXBM: cbits width: 8
+ height: full_height
+ fg: 0 bg: 0];
+ bimgs[p->which - 1] = img;
+ xfree (cbits);
+ }
- {
- NSColor *bm_color;
- if (!p->cursor_p)
- bm_color = ns_lookup_indexed_color(face->foreground, f);
- else if (p->overlay_p)
- bm_color = ns_lookup_indexed_color(face->background, f);
- else
- bm_color = f->output_data.ns->cursor_color;
- [img setXBMColor: bm_color];
- }
+ NSTRACE_RECT ("r", r);
-#ifdef NS_IMPL_COCOA
- // Note: For periodic images, the full image height is "h + hd".
- // By using the height h, a suitable part of the image is used.
- NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h);
+ NSRectClip (r);
+ /* Since we composite the bitmap instead of just blitting it, we need
+ to erase the whole background. */
+ [ns_lookup_indexed_color(face->background, f) set];
+ NSRectFill (r);
- NSTRACE_RECT ("fromRect", fromRect);
+ {
+ NSColor *bm_color;
+ if (!p->cursor_p)
+ bm_color = ns_lookup_indexed_color(face->foreground, f);
+ else if (p->overlay_p)
+ bm_color = ns_lookup_indexed_color(face->background, f);
+ else
+ bm_color = f->output_data.ns->cursor_color;
+ [img setXBMColor: bm_color];
+ }
- [img drawInRect: r
- fromRect: fromRect
- operation: NSCompositingOperationSourceOver
- fraction: 1.0
- respectFlipped: YES
- hints: nil];
+#ifdef NS_IMPL_COCOA
+ // Note: For periodic images, the full image height is "h + hd".
+ // By using the height h, a suitable part of the image is used.
+ NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h);
+
+ NSTRACE_RECT ("fromRect", fromRect);
+
+ [img drawInRect: r
+ fromRect: fromRect
+ operation: NSCompositingOperationSourceOver
+ fraction: 1.0
+ respectFlipped: YES
+ hints: nil];
#else
- {
- NSPoint pt = r.origin;
- pt.y += p->h;
- [img compositeToPoint: pt operation: NSCompositingOperationSourceOver];
- }
+ {
+ NSPoint pt = r.origin;
+ pt.y += p->h;
+ [img compositeToPoint: pt operation:
NSCompositingOperationSourceOver];
+ }
#endif
+ }
+ ns_reset_clipping (f);
}
- ns_unfocus (f);
}
@@ -3248,66 +3220,65 @@ ns_draw_window_cursor (struct window *w, struct
glyph_row *glyph_row,
r.size.width = w->phys_cursor_width;
/* Prevent the cursor from being drawn outside the text area. */
- ns_clip_to_row (w, glyph_row, TEXT_AREA, NO); /* do ns_focus(f, &r, 1); if
remove */
-
-
- face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id);
- if (face && NS_FACE_BACKGROUND (face)
- == ns_index_color (FRAME_CURSOR_COLOR (f), f))
+ if (ns_clip_to_row (w, glyph_row, TEXT_AREA, NO))
{
- [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set];
- hollow_color = FRAME_CURSOR_COLOR (f);
- }
- else
- [FRAME_CURSOR_COLOR (f) set];
+ face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id);
+ if (face && NS_FACE_BACKGROUND (face)
+ == ns_index_color (FRAME_CURSOR_COLOR (f), f))
+ {
+ [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set];
+ hollow_color = FRAME_CURSOR_COLOR (f);
+ }
+ else
+ [FRAME_CURSOR_COLOR (f) set];
#ifdef NS_IMPL_COCOA
- /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph
- atomic. Cleaner ways of doing this should be investigated.
- One way would be to set a global variable DRAWING_CURSOR
- when making the call to draw_phys..(), don't focus in that
- case, then move the ns_unfocus() here after that call. */
- NSDisableScreenUpdates ();
+ /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph
+ atomic. Cleaner ways of doing this should be investigated.
+ One way would be to set a global variable DRAWING_CURSOR
+ when making the call to draw_phys..(), don't focus in that
+ case, then move the ns_reset_clipping() here after that call. */
+ NSDisableScreenUpdates ();
#endif
- switch (cursor_type)
- {
- case DEFAULT_CURSOR:
- case NO_CURSOR:
- break;
- case FILLED_BOX_CURSOR:
- NSRectFill (r);
- break;
- case HOLLOW_BOX_CURSOR:
- NSRectFill (r);
- [hollow_color set];
- NSRectFill (NSInsetRect (r, 1, 1));
- [FRAME_CURSOR_COLOR (f) set];
- break;
- case HBAR_CURSOR:
- NSRectFill (r);
- break;
- case BAR_CURSOR:
- s = r;
- /* If the character under cursor is R2L, draw the bar cursor
- on the right of its glyph, rather than on the left. */
- cursor_glyph = get_phys_cursor_glyph (w);
- if ((cursor_glyph->resolved_level & 1) != 0)
- s.origin.x += cursor_glyph->pixel_width - s.size.width;
-
- NSRectFill (s);
- break;
- }
- ns_unfocus (f);
+ switch (cursor_type)
+ {
+ case DEFAULT_CURSOR:
+ case NO_CURSOR:
+ break;
+ case FILLED_BOX_CURSOR:
+ NSRectFill (r);
+ break;
+ case HOLLOW_BOX_CURSOR:
+ NSRectFill (r);
+ [hollow_color set];
+ NSRectFill (NSInsetRect (r, 1, 1));
+ [FRAME_CURSOR_COLOR (f) set];
+ break;
+ case HBAR_CURSOR:
+ NSRectFill (r);
+ break;
+ case BAR_CURSOR:
+ s = r;
+ /* If the character under cursor is R2L, draw the bar cursor
+ on the right of its glyph, rather than on the left. */
+ cursor_glyph = get_phys_cursor_glyph (w);
+ if ((cursor_glyph->resolved_level & 1) != 0)
+ s.origin.x += cursor_glyph->pixel_width - s.size.width;
+
+ NSRectFill (s);
+ break;
+ }
+ ns_reset_clipping (f);
- /* draw the character under the cursor */
- if (cursor_type != NO_CURSOR)
- draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
+ /* draw the character under the cursor */
+ if (cursor_type != NO_CURSOR)
+ draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
#ifdef NS_IMPL_COCOA
- NSEnableScreenUpdates ();
+ NSEnableScreenUpdates ();
#endif
-
+ }
}
@@ -3325,12 +3296,14 @@ ns_draw_vertical_window_border (struct window *w, int
x, int y0, int y1)
face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
- ns_focus (f, &r, 1);
- if (face)
- [ns_lookup_indexed_color(face->foreground, f) set];
+ if (ns_clip_to_rect (f, &r, 1))
+ {
+ if (face)
+ [ns_lookup_indexed_color(face->foreground, f) set];
- NSRectFill(r);
- ns_unfocus (f);
+ NSRectFill(r);
+ ns_reset_clipping (f);
+ }
}
@@ -3357,39 +3330,40 @@ ns_draw_window_divider (struct window *w, int x0, int
x1, int y0, int y1)
NSTRACE ("ns_draw_window_divider");
- ns_focus (f, ÷r, 1);
-
- if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
- /* A vertical divider, at least three pixels wide: Draw first and
- last pixels differently. */
- {
- [ns_lookup_indexed_color(color_first, f) set];
- NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0));
- [ns_lookup_indexed_color(color, f) set];
- NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0));
- [ns_lookup_indexed_color(color_last, f) set];
- NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0));
- }
- else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
- /* A horizontal divider, at least three pixels high: Draw first and
- last pixels differently. */
+ if (ns_clip_to_rect (f, ÷r, 1))
{
- [ns_lookup_indexed_color(color_first, f) set];
- NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1));
- [ns_lookup_indexed_color(color, f) set];
- NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2));
- [ns_lookup_indexed_color(color_last, f) set];
- NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1));
- }
- else
- {
- /* In any other case do not draw the first and last pixels
- differently. */
- [ns_lookup_indexed_color(color, f) set];
- NSRectFill(divider);
- }
+ if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
+ /* A vertical divider, at least three pixels wide: Draw first and
+ last pixels differently. */
+ {
+ [ns_lookup_indexed_color(color_first, f) set];
+ NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0));
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0));
+ [ns_lookup_indexed_color(color_last, f) set];
+ NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0));
+ }
+ else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
+ /* A horizontal divider, at least three pixels high: Draw first and
+ last pixels differently. */
+ {
+ [ns_lookup_indexed_color(color_first, f) set];
+ NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1));
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2));
+ [ns_lookup_indexed_color(color_last, f) set];
+ NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1));
+ }
+ else
+ {
+ /* In any other case do not draw the first and last pixels
+ differently. */
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(divider);
+ }
- ns_unfocus (f);
+ ns_reset_clipping (f);
+ }
}
static void
@@ -3988,83 +3962,84 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
n = ns_get_glyph_string_clip_rect (s, r);
*r = NSMakeRect (s->x, s->y, s->background_width, s->height);
- ns_focus (s->f, r, n);
-
- if (s->hl == DRAW_MOUSE_FACE)
- {
- face = FACE_FROM_ID_OR_NULL (s->f,
- MOUSE_HL_INFO (s->f)->mouse_face_face_id);
- if (!face)
- face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
- }
- else
- face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
-
- bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f);
- fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
-
- for (i = 0; i < n; ++i)
+ if (ns_clip_to_rect (s->f, r, n))
{
- if (!s->row->full_width_p)
+ if (s->hl == DRAW_MOUSE_FACE)
{
- int overrun, leftoverrun;
-
- /* truncate to avoid overwriting fringe and/or scrollbar */
- overrun = max (0, (s->x + s->background_width)
- - (WINDOW_BOX_RIGHT_EDGE_X (s->w)
- - WINDOW_RIGHT_FRINGE_WIDTH (s->w)));
- r[i].size.width -= overrun;
-
- /* truncate to avoid overwriting to left of the window box */
- leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w)
- + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x;
-
- if (leftoverrun > 0)
- {
- r[i].origin.x += leftoverrun;
- r[i].size.width -= leftoverrun;
- }
-
- /* XXX: Try to work between problem where a stretch glyph on
- a partially-visible bottom row will clear part of the
- modeline, and another where list-buffers headers and similar
- rows erroneously have visible_height set to 0. Not sure
- where this is coming from as other terms seem not to show. */
- r[i].size.height = min (s->height, s->row->visible_height);
+ face = FACE_FROM_ID_OR_NULL (s->f,
+ MOUSE_HL_INFO
(s->f)->mouse_face_face_id);
+ if (!face)
+ face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
}
+ else
+ face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
- [bgCol set];
+ bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f);
+ fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
- /* NOTE: under NS this is NOT used to draw cursors, but we must avoid
- overwriting cursor (usually when cursor on a tab). */
- if (s->hl == DRAW_CURSOR)
+ for (i = 0; i < n; ++i)
{
- CGFloat x, width;
+ if (!s->row->full_width_p)
+ {
+ int overrun, leftoverrun;
+
+ /* truncate to avoid overwriting fringe and/or scrollbar */
+ overrun = max (0, (s->x + s->background_width)
+ - (WINDOW_BOX_RIGHT_EDGE_X (s->w)
+ - WINDOW_RIGHT_FRINGE_WIDTH (s->w)));
+ r[i].size.width -= overrun;
+
+ /* truncate to avoid overwriting to left of the window box */
+ leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w)
+ + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x;
+
+ if (leftoverrun > 0)
+ {
+ r[i].origin.x += leftoverrun;
+ r[i].size.width -= leftoverrun;
+ }
+
+ /* XXX: Try to work between problem where a stretch glyph
on
+ a partially-visible bottom row will clear part of the
+ modeline, and another where list-buffers headers and
similar
+ rows erroneously have visible_height set to 0. Not sure
+ where this is coming from as other terms seem not to
show. */
+ r[i].size.height = min (s->height, s->row->visible_height);
+ }
+
+ [bgCol set];
- x = r[i].origin.x;
- width = s->w->phys_cursor_width;
- r[i].size.width -= width;
- r[i].origin.x += width;
+ /* NOTE: under NS this is NOT used to draw cursors, but we must
avoid
+ overwriting cursor (usually when cursor on a tab). */
+ if (s->hl == DRAW_CURSOR)
+ {
+ CGFloat x, width;
+
+ x = r[i].origin.x;
+ width = s->w->phys_cursor_width;
+ r[i].size.width -= width;
+ r[i].origin.x += width;
- NSRectFill (r[i]);
+ NSRectFill (r[i]);
- /* Draw overlining, etc. on the cursor. */
- if (s->w->phys_cursor_type == FILLED_BOX_CURSOR)
- ns_draw_text_decoration (s, face, bgCol, width, x);
+ /* Draw overlining, etc. on the cursor. */
+ if (s->w->phys_cursor_type == FILLED_BOX_CURSOR)
+ ns_draw_text_decoration (s, face, bgCol, width, x);
+ else
+ ns_draw_text_decoration (s, face, fgCol, width, x);
+ }
else
- ns_draw_text_decoration (s, face, fgCol, width, x);
- }
- else
- {
- NSRectFill (r[i]);
- }
+ {
+ NSRectFill (r[i]);
+ }
- /* Draw overlining, etc. on the stretch glyph (or the part
- of the stretch glyph after the cursor). */
- ns_draw_text_decoration (s, face, fgCol, r[i].size.width,
- r[i].origin.x);
+ /* Draw overlining, etc. on the stretch glyph (or the part
+ of the stretch glyph after the cursor). */
+ ns_draw_text_decoration (s, face, fgCol, r[i].size.width,
+ r[i].origin.x);
+ }
+ ns_reset_clipping (s->f);
}
- ns_unfocus (s->f);
s->background_filled_p = 1;
}
}
@@ -4214,9 +4189,11 @@ ns_draw_glyph_string (struct glyph_string *s)
if (next->first_glyph->type != STRETCH_GLYPH)
{
n = ns_get_glyph_string_clip_rect (s->next, r);
- ns_focus (s->f, r, n);
- ns_maybe_dumpglyphs_background (s->next, 1);
- ns_unfocus (s->f);
+ if (ns_clip_to_rect (s->f, r, n))
+ {
+ ns_maybe_dumpglyphs_background (s->next, 1);
+ ns_reset_clipping (s->f);
+ }
}
else
{
@@ -4231,10 +4208,12 @@ ns_draw_glyph_string (struct glyph_string *s)
|| s->first_glyph->type == COMPOSITE_GLYPH))
{
n = ns_get_glyph_string_clip_rect (s, r);
- ns_focus (s->f, r, n);
- ns_maybe_dumpglyphs_background (s, 1);
- ns_dumpglyphs_box_or_relief (s);
- ns_unfocus (s->f);
+ if (ns_clip_to_rect (s->f, r, n))
+ {
+ ns_maybe_dumpglyphs_background (s, 1);
+ ns_dumpglyphs_box_or_relief (s);
+ ns_reset_clipping (s->f);
+ }
box_drawn_p = 1;
}
@@ -4243,9 +4222,11 @@ ns_draw_glyph_string (struct glyph_string *s)
case IMAGE_GLYPH:
n = ns_get_glyph_string_clip_rect (s, r);
- ns_focus (s->f, r, n);
- ns_dumpglyphs_image (s, r[0]);
- ns_unfocus (s->f);
+ if (ns_clip_to_rect (s->f, r, n))
+ {
+ ns_dumpglyphs_image (s, r[0]);
+ ns_reset_clipping (s->f);
+ }
break;
case STRETCH_GLYPH:
@@ -4255,66 +4236,68 @@ ns_draw_glyph_string (struct glyph_string *s)
case CHAR_GLYPH:
case COMPOSITE_GLYPH:
n = ns_get_glyph_string_clip_rect (s, r);
- ns_focus (s->f, r, n);
+ if (ns_clip_to_rect (s->f, r, n))
+ {
+ if (s->for_overlaps || (s->cmp_from > 0
+ && ! s->first_glyph->u.cmp.automatic))
+ s->background_filled_p = 1;
+ else
+ ns_maybe_dumpglyphs_background
+ (s, s->first_glyph->type == COMPOSITE_GLYPH);
- if (s->for_overlaps || (s->cmp_from > 0
- && ! s->first_glyph->u.cmp.automatic))
- s->background_filled_p = 1;
- else
- ns_maybe_dumpglyphs_background
- (s, s->first_glyph->type == COMPOSITE_GLYPH);
+ if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type ==
FILLED_BOX_CURSOR)
+ {
+ unsigned long tmp = NS_FACE_BACKGROUND (s->face);
+ NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
+ NS_FACE_FOREGROUND (s->face) = tmp;
+ }
- if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
- {
- unsigned long tmp = NS_FACE_BACKGROUND (s->face);
- NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
- NS_FACE_FOREGROUND (s->face) = tmp;
- }
+ {
+ BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH;
- {
- BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH;
+ if (isComposite)
+ ns_draw_composite_glyph_string_foreground (s);
+ else
+ ns_draw_glyph_string_foreground (s);
+ }
- if (isComposite)
- ns_draw_composite_glyph_string_foreground (s);
- else
- ns_draw_glyph_string_foreground (s);
- }
+ {
+ NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0
+ ? ns_lookup_indexed_color (NS_FACE_FOREGROUND
(s->face),
+ s->f)
+ : FRAME_FOREGROUND_COLOR (s->f));
+ [col set];
+
+ /* Draw underline, overline, strike-through. */
+ ns_draw_text_decoration (s, s->face, col, s->width, s->x);
+ }
- {
- NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0
- ? ns_lookup_indexed_color (NS_FACE_FOREGROUND
(s->face),
- s->f)
- : FRAME_FOREGROUND_COLOR (s->f));
- [col set];
-
- /* Draw underline, overline, strike-through. */
- ns_draw_text_decoration (s, s->face, col, s->width, s->x);
- }
+ if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type ==
FILLED_BOX_CURSOR)
+ {
+ unsigned long tmp = NS_FACE_BACKGROUND (s->face);
+ NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
+ NS_FACE_FOREGROUND (s->face) = tmp;
+ }
- if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
- {
- unsigned long tmp = NS_FACE_BACKGROUND (s->face);
- NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
- NS_FACE_FOREGROUND (s->face) = tmp;
+ ns_reset_clipping (s->f);
}
-
- ns_unfocus (s->f);
break;
case GLYPHLESS_GLYPH:
n = ns_get_glyph_string_clip_rect (s, r);
- ns_focus (s->f, r, n);
-
- if (s->for_overlaps || (s->cmp_from > 0
- && ! s->first_glyph->u.cmp.automatic))
- s->background_filled_p = 1;
- else
- ns_maybe_dumpglyphs_background
- (s, s->first_glyph->type == COMPOSITE_GLYPH);
- /* ... */
- /* Not yet implemented. */
- /* ... */
- ns_unfocus (s->f);
+ if (ns_clip_to_rect (s->f, r, n))
+ {
+ if (s->for_overlaps || (s->cmp_from > 0
+ && ! s->first_glyph->u.cmp.automatic))
+ s->background_filled_p = 1;
+ else
+ ns_maybe_dumpglyphs_background
+ (s, s->first_glyph->type == COMPOSITE_GLYPH);
+ /* ... */
+ /* Not yet implemented. */
+ /* ... */
+ ns_reset_clipping (s->f);
+ }
break;
default:
@@ -4325,9 +4308,11 @@ ns_draw_glyph_string (struct glyph_string *s)
if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX)
{
n = ns_get_glyph_string_clip_rect (s, r);
- ns_focus (s->f, r, n);
- ns_dumpglyphs_box_or_relief (s);
- ns_unfocus (s->f);
+ if (ns_clip_to_rect (s->f, r, n))
+ {
+ ns_dumpglyphs_box_or_relief (s);
+ ns_reset_clipping (s->f);
+ }
}
s->num_clips = 0;
@@ -5133,7 +5118,7 @@ static struct redisplay_interface ns_redisplay_interface =
ns_after_update_window_line,
ns_update_window_begin,
ns_update_window_end,
- 0, /* flush_display */
+ ns_flush_display, /* flush_display */
x_clear_window_mouse_face,
x_get_glyph_overhangs,
x_fix_overlapping_area,
@@ -5350,7 +5335,21 @@ ns_term_init (Lisp_Object display_name)
alpha: 1.0]
forKey: [NSString stringWithUTF8String: name]];
}
- [cl writeToFile: nil];
+
+ /* FIXME: Report any errors writing the color file below. */
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101100
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100
+ if ([cl respondsToSelector:@selector(writeToURL:error:)])
+#endif
+ [cl writeToURL:nil error:nil];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100
+ else
+#endif
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101100 */
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 \
+ || defined (NS_IMPL_GNUSTEP)
+ [cl writeToFile: nil];
+#endif
}
}
diff --git a/src/print.c b/src/print.c
index c0c90bc..d15ff97 100644
--- a/src/print.c
+++ b/src/print.c
@@ -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;
-
- 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);
+ Lisp_Object name = SYMBOL_NAME (obj);
+ ptrdiff_t 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)))
{
diff --git a/src/process.c b/src/process.c
index a9638df..6cda4f2 100644
--- a/src/process.c
+++ b/src/process.c
@@ -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))
diff --git a/src/scroll.c b/src/scroll.c
index a29f2d3..5d0f320 100644
--- a/src/scroll.c
+++ b/src/scroll.c
@@ -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
diff --git a/src/sysdep.c b/src/sysdep.c
index 722d813..7a0c8a8 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -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);
+}
diff --git a/src/systime.h b/src/systime.h
index ad5ab85..0bc1e90 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -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
diff --git a/src/term.c b/src/term.c
index ce24f69..852dc23 100644
--- a/src/term.c
+++ b/src/term.c
@@ -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);
}
diff --git a/src/termhooks.h b/src/termhooks.h
index 2114291..4e34105 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -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. */
diff --git a/src/terminal.c b/src/terminal.c
index 18982fe..e480359 100644
--- a/src/terminal.c
+++ b/src/terminal.c
@@ -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 ();
diff --git a/src/timefns.c b/src/timefns.c
new file mode 100644
index 0000000..c94d97d
--- /dev/null
+++ b/src/timefns.c
@@ -0,0 +1,1757 @@
+/* Timestamp functions for Emacs
+
+Copyright (C) 1985-1987, 1989, 1993-2018 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "systime.h"
+
+#include "blockinput.h"
+#include "bignum.h"
+#include "coding.h"
+#include "lisp.h"
+
+#include <strftime.h>
+
+#include <errno.h>
+#include <limits.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef HAVE_TIMEZONE_T
+# include <sys/param.h>
+# if defined __NetBSD_Version__ && __NetBSD_Version__ < 700000000
+# define HAVE_TZALLOC_BUG true
+# endif
+#endif
+#ifndef HAVE_TZALLOC_BUG
+# define HAVE_TZALLOC_BUG false
+#endif
+
+#define TM_YEAR_BASE 1900
+
+#ifndef HAVE_TM_GMTOFF
+# define HAVE_TM_GMTOFF false
+#endif
+
+#ifndef TIME_T_MIN
+# define TIME_T_MIN TYPE_MINIMUM (time_t)
+#endif
+#ifndef TIME_T_MAX
+# define TIME_T_MAX TYPE_MAXIMUM (time_t)
+#endif
+
+/* Compile with -DFASTER_TIMEFNS=0 to disable common optimizations and
+ allow easier testing of some slow-path code. */
+#ifndef FASTER_TIMEFNS
+# define FASTER_TIMEFNS 1
+#endif
+
+/* Whether to warn about Lisp timestamps (TICKS . HZ) that may be
+ instances of obsolete-format timestamps (HI . LO) where HI is
+ the high-order bits and LO the low-order 16 bits. Currently this
+ is true, but it should change to false in a future version of
+ Emacs. Compile with -DWARN_OBSOLETE_TIMESTAMPS=0 to see what the
+ future will be like. */
+#ifndef WARN_OBSOLETE_TIMESTAMPS
+enum { WARN_OBSOLETE_TIMESTAMPS = true };
+#endif
+
+/* Although current-time etc. generate list-format timestamps
+ (HI LO US PS), the plan is to change these functions to generate
+ frequency-based timestamps (TICKS . HZ) in a future release.
+ To try this now, compile with -DCURRENT_TIME_LIST=0. */
+#ifndef CURRENT_TIME_LIST
+enum { CURRENT_TIME_LIST = true };
+#endif
+
+#if FIXNUM_OVERFLOW_P (1000000000)
+static Lisp_Object timespec_hz;
+#else
+# define timespec_hz make_fixnum (TIMESPEC_HZ)
+#endif
+
+#define TRILLION 1000000000000
+#if FIXNUM_OVERFLOW_P (TRILLION)
+static Lisp_Object trillion;
+# define ztrillion (XBIGNUM (trillion)->value)
+#else
+# define trillion make_fixnum (TRILLION)
+# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS
+mpz_t ztrillion;
+# endif
+#endif
+
+/* 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 < TIME_T_MAX)
+ {
+ tv.tv_sec++;
+ tv.tv_usec = 0;
+ }
+ }
+
+ return tv;
+}
+
+/* Yield A's UTC offset, or an unspecified value if unknown. */
+static long int
+tm_gmtoff (struct tm *a)
+{
+#if HAVE_TM_GMTOFF
+ return a->tm_gmtoff;
+#else
+ return 0;
+#endif
+}
+
+/* Yield A - B, measured in seconds.
+ This function is copied from the GNU C Library. */
+static int
+tm_diff (struct tm *a, struct tm *b)
+{
+ /* Compute intervening leap days correctly even if year is negative.
+ Take care to avoid int overflow in leap day calculations,
+ but it's OK to assume that A and B are close to each other. */
+ int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3);
+ int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3);
+ int a100 = a4 / 25 - (a4 % 25 < 0);
+ int b100 = b4 / 25 - (b4 % 25 < 0);
+ int a400 = a100 >> 2;
+ int b400 = b100 >> 2;
+ int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
+ int years = a->tm_year - b->tm_year;
+ int days = (365 * years + intervening_leap_days
+ + (a->tm_yday - b->tm_yday));
+ return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
+ + (a->tm_min - b->tm_min))
+ + (a->tm_sec - b->tm_sec));
+}
+
+enum { tzeqlen = sizeof "TZ=" - 1 };
+
+/* Time zones equivalent to current local time and to UTC, respectively. */
+static timezone_t local_tz;
+static timezone_t const utc_tz = 0;
+
+static struct tm *
+emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm)
+{
+ tm = localtime_rz (tz, t, tm);
+ if (!tm && errno == ENOMEM)
+ memory_full (SIZE_MAX);
+ return tm;
+}
+
+static time_t
+emacs_mktime_z (timezone_t tz, struct tm *tm)
+{
+ errno = 0;
+ time_t t = mktime_z (tz, tm);
+ if (t == (time_t) -1 && errno == ENOMEM)
+ memory_full (SIZE_MAX);
+ return t;
+}
+
+static _Noreturn void
+invalid_time_zone_specification (Lisp_Object zone)
+{
+ xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone);
+}
+
+/* Free a timezone, except do not free the time zone for local time.
+ Freeing utc_tz is also a no-op. */
+static void
+xtzfree (timezone_t tz)
+{
+ if (tz != local_tz)
+ tzfree (tz);
+}
+
+/* Convert the Lisp time zone rule ZONE to a timezone_t object.
+ The returned value either is 0, or is LOCAL_TZ, or is newly allocated.
+ If SETTZ, set Emacs local time to the time zone rule; otherwise,
+ the caller should eventually pass the returned value to xtzfree. */
+static timezone_t
+tzlookup (Lisp_Object zone, bool settz)
+{
+ static char const tzbuf_format[] = "<%+.*"pI"d>%s%"pI"d:%02d:%02d";
+ char const *trailing_tzbuf_format = tzbuf_format + sizeof "<%+.*"pI"d" - 1;
+ char tzbuf[sizeof tzbuf_format + 2 * INT_STRLEN_BOUND (EMACS_INT)];
+ char const *zone_string;
+ timezone_t new_tz;
+
+ if (NILP (zone))
+ return local_tz;
+ else if (EQ (zone, Qt) || EQ (zone, make_fixnum (0)))
+ {
+ zone_string = "UTC0";
+ new_tz = utc_tz;
+ }
+ else
+ {
+ bool plain_integer = FIXNUMP (zone);
+
+ if (EQ (zone, Qwall))
+ zone_string = 0;
+ else if (STRINGP (zone))
+ zone_string = SSDATA (ENCODE_SYSTEM (zone));
+ else if (plain_integer || (CONSP (zone) && FIXNUMP (XCAR (zone))
+ && CONSP (XCDR (zone))))
+ {
+ Lisp_Object abbr UNINIT;
+ if (!plain_integer)
+ {
+ abbr = XCAR (XCDR (zone));
+ zone = XCAR (zone);
+ }
+
+ EMACS_INT abszone = eabs (XFIXNUM (zone)), hour = abszone / (60 * 60);
+ int hour_remainder = abszone % (60 * 60);
+ int min = hour_remainder / 60, sec = hour_remainder % 60;
+
+ if (plain_integer)
+ {
+ int prec = 2;
+ EMACS_INT numzone = hour;
+ if (hour_remainder != 0)
+ {
+ prec += 2, numzone = 100 * numzone + min;
+ if (sec != 0)
+ prec += 2, numzone = 100 * numzone + sec;
+ }
+ sprintf (tzbuf, tzbuf_format, prec,
+ XFIXNUM (zone) < 0 ? -numzone : numzone,
+ &"-"[XFIXNUM (zone) < 0], hour, min, sec);
+ zone_string = tzbuf;
+ }
+ else
+ {
+ AUTO_STRING (leading, "<");
+ AUTO_STRING_WITH_LEN (trailing, tzbuf,
+ sprintf (tzbuf, trailing_tzbuf_format,
+ &"-"[XFIXNUM (zone) < 0],
+ hour, min, sec));
+ zone_string = SSDATA (concat3 (leading, ENCODE_SYSTEM (abbr),
+ trailing));
+ }
+ }
+ else
+ invalid_time_zone_specification (zone);
+
+ new_tz = tzalloc (zone_string);
+
+ if (HAVE_TZALLOC_BUG && !new_tz && errno != ENOMEM && plain_integer
+ && XFIXNUM (zone) % (60 * 60) == 0)
+ {
+ /* tzalloc mishandles POSIX strings; fall back on tzdb if
+ possible (Bug#30738). */
+ sprintf (tzbuf, "Etc/GMT%+"pI"d", - (XFIXNUM (zone) / (60 * 60)));
+ new_tz = tzalloc (zone_string);
+ }
+
+ if (!new_tz)
+ {
+ if (errno == ENOMEM)
+ memory_full (SIZE_MAX);
+ invalid_time_zone_specification (zone);
+ }
+ }
+
+ if (settz)
+ {
+ block_input ();
+ emacs_setenv_TZ (zone_string);
+ tzset ();
+ timezone_t old_tz = local_tz;
+ local_tz = new_tz;
+ tzfree (old_tz);
+ unblock_input ();
+ }
+
+ return new_tz;
+}
+
+void
+init_timefns (bool dumping)
+{
+#ifndef CANNOT_DUMP
+ /* A valid but unlikely setting for the TZ environment variable.
+ It is OK (though a bit slower) if the user chooses this value. */
+ static char dump_tz_string[] = "TZ=UtC0";
+
+ /* When just dumping out, set the time zone to a known unlikely value
+ and skip the rest of this function. */
+ if (dumping)
+ {
+ xputenv (dump_tz_string);
+ tzset ();
+ return;
+ }
+#endif
+
+ char *tz = getenv ("TZ");
+
+#if !defined CANNOT_DUMP
+ /* If the execution TZ happens to be the same as the dump TZ,
+ change it to some other value and then change it back,
+ to force the underlying implementation to reload the TZ info.
+ This is needed on implementations that load TZ info from files,
+ since the TZ file contents may differ between dump and execution. */
+ if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0)
+ {
+ ++*tz;
+ tzset ();
+ --*tz;
+ }
+#endif
+
+ /* Set the time zone rule now, so that the call to putenv is done
+ before multiple threads are active. */
+ tzlookup (tz ? build_string (tz) : Qwall, true);
+}
+
+/* Report that a time value is out of range for Emacs. */
+void
+time_overflow (void)
+{
+ error ("Specified time is not representable");
+}
+
+static _Noreturn void
+invalid_time (void)
+{
+ error ("Invalid time specification");
+}
+
+static _Noreturn void
+invalid_hz (Lisp_Object hz)
+{
+ xsignal2 (Qerror, build_string ("Invalid time frequency"), hz);
+}
+
+/* Return the upper part of the time T (everything but the bottom 16 bits). */
+static Lisp_Object
+hi_time (time_t t)
+{
+ return INT_TO_INTEGER (t >> LO_TIME_BITS);
+}
+
+/* Return the bottom bits of the time T. */
+static Lisp_Object
+lo_time (time_t t)
+{
+ return make_fixnum (t & ((1 << LO_TIME_BITS) - 1));
+}
+
+/* Convert T into an Emacs time *RESULT, truncating toward minus infinity.
+ Return true if T is in range, false otherwise. */
+static bool
+decode_float_time (double t, struct lisp_time *result)
+{
+ if (!isfinite (t))
+ return false;
+ /* Actual hz unknown; guess TIMESPEC_HZ. */
+ mpz_set_d (mpz[1], t);
+ mpz_set_si (mpz[0], floor ((t - trunc (t)) * TIMESPEC_HZ));
+ mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ);
+ result->ticks = make_integer_mpz ();
+ result->hz = timespec_hz;
+ return true;
+}
+
+/* Compute S + NS/TIMESPEC_HZ as a double.
+ Calls to this function suffer from double-rounding;
+ work around some of the problem by using long double. */
+static double
+s_ns_to_double (long double s, long double ns)
+{
+ return s + ns / TIMESPEC_HZ;
+}
+
+/* Make a 4-element timestamp (HI LO US PS) from TICKS and HZ.
+ Drop any excess precision. */
+static Lisp_Object
+ticks_hz_list4 (Lisp_Object ticks, Lisp_Object hz)
+{
+ mpz_t *zticks = bignum_integer (&mpz[0], ticks);
+#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
+ mpz_mul_ui (mpz[0], *zticks, TRILLION);
+#else
+ mpz_mul (mpz[0], *zticks, ztrillion);
+#endif
+ mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz));
+#if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
+ unsigned long int fullps = mpz_fdiv_q_ui (mpz[0], mpz[0], TRILLION);
+ int us = fullps / 1000000;
+ int ps = fullps % 1000000;
+#else
+ mpz_fdiv_qr (mpz[0], mpz[1], mpz[0], ztrillion);
+ int ps = mpz_fdiv_q_ui (mpz[1], mpz[1], 1000000);
+ int us = mpz_get_ui (mpz[1]);
+#endif
+ unsigned long ulo = mpz_get_ui (mpz[0]);
+ if (mpz_sgn (mpz[0]) < 0)
+ ulo = -ulo;
+ int lo = ulo & ((1 << LO_TIME_BITS) - 1);
+ mpz_fdiv_q_2exp (mpz[0], mpz[0], LO_TIME_BITS);
+ return list4 (make_integer_mpz (), make_fixnum (lo),
+ make_fixnum (us), make_fixnum (ps));
+}
+
+/* Set ROP to T. */
+static void
+mpz_set_time (mpz_t rop, time_t t)
+{
+ if (EXPR_SIGNED (t))
+ mpz_set_intmax (rop, t);
+ else
+ mpz_set_uintmax (rop, t);
+}
+
+/* Store into mpz[0] a clock tick count for T, assuming a
+ TIMESPEC_HZ-frequency clock. Use mpz[1] as a temp. */
+static void
+timespec_mpz (struct timespec t)
+{
+ mpz_set_ui (mpz[0], t.tv_nsec);
+ mpz_set_time (mpz[1], t.tv_sec);
+ mpz_addmul_ui (mpz[0], mpz[1], TIMESPEC_HZ);
+}
+
+/* Convert T to a Lisp integer counting TIMESPEC_HZ ticks. */
+static Lisp_Object
+timespec_ticks (struct timespec t)
+{
+ intmax_t accum;
+ if (FASTER_TIMEFNS
+ && !INT_MULTIPLY_WRAPV (t.tv_sec, TIMESPEC_HZ, &accum)
+ && !INT_ADD_WRAPV (t.tv_nsec, accum, &accum))
+ return make_int (accum);
+ timespec_mpz (t);
+ return make_integer_mpz ();
+}
+
+/* Convert T to a Lisp integer counting HZ ticks, taking the floor.
+ Assume T is valid, but check HZ. */
+static Lisp_Object
+time_hz_ticks (time_t t, Lisp_Object hz)
+{
+ if (FIXNUMP (hz))
+ {
+ if (XFIXNUM (hz) <= 0)
+ invalid_hz (hz);
+ intmax_t ticks;
+ if (FASTER_TIMEFNS && !INT_MULTIPLY_WRAPV (t, XFIXNUM (hz), &ticks))
+ return make_int (ticks);
+ }
+ else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value)))
+ invalid_hz (hz);
+
+ mpz_set_time (mpz[0], t);
+ mpz_mul (mpz[0], mpz[0], *bignum_integer (&mpz[1], hz));
+ return make_integer_mpz ();
+}
+static Lisp_Object
+lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz)
+{
+ if (FASTER_TIMEFNS && EQ (t.hz, hz))
+ return t.ticks;
+ if (FIXNUMP (hz))
+ {
+ if (XFIXNUM (hz) <= 0)
+ invalid_hz (hz);
+ intmax_t ticks;
+ if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz)
+ && !INT_MULTIPLY_WRAPV (XFIXNUM (t.ticks), XFIXNUM (hz), &ticks))
+ return make_int (ticks / XFIXNUM (t.hz)
+ - (ticks % XFIXNUM (t.hz) < 0));
+ }
+ else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value)))
+ invalid_hz (hz);
+
+ mpz_mul (mpz[0],
+ *bignum_integer (&mpz[0], t.ticks),
+ *bignum_integer (&mpz[1], hz));
+ mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], t.hz));
+ return make_integer_mpz ();
+}
+
+/* Convert T to a Lisp integer counting seconds, taking the floor. */
+static Lisp_Object
+lisp_time_seconds (struct lisp_time t)
+{
+ if (!FASTER_TIMEFNS)
+ return lisp_time_hz_ticks (t, make_fixnum (1));
+ if (FIXNUMP (t.ticks) && FIXNUMP (t.hz))
+ return make_fixnum (XFIXNUM (t.ticks) / XFIXNUM (t.hz)
+ - (XFIXNUM (t.ticks) % XFIXNUM (t.hz) < 0));
+ mpz_fdiv_q (mpz[0],
+ *bignum_integer (&mpz[0], t.ticks),
+ *bignum_integer (&mpz[1], t.hz));
+ return make_integer_mpz ();
+}
+
+/* Convert T to a Lisp timestamp. */
+Lisp_Object
+make_lisp_time (struct timespec t)
+{
+ if (CURRENT_TIME_LIST)
+ {
+ time_t s = t.tv_sec;
+ int ns = t.tv_nsec;
+ return list4 (hi_time (s), lo_time (s),
+ make_fixnum (ns / 1000), make_fixnum (ns % 1000 * 1000));
+ }
+ else
+ return Fcons (timespec_ticks (t), timespec_hz);
+}
+
+/* Convert T to a Lisp timestamp. FORM specifies the timestamp format. */
+static Lisp_Object
+time_form_stamp (time_t t, Lisp_Object form)
+{
+ if (NILP (form))
+ form = CURRENT_TIME_LIST ? Qlist : Qt;
+ if (EQ (form, Qlist))
+ return list2 (hi_time (t), lo_time (t));
+ if (EQ (form, Qt) || EQ (form, Qinteger))
+ return INT_TO_INTEGER (t);
+ return Fcons (time_hz_ticks (t, form), form);
+}
+static Lisp_Object
+lisp_time_form_stamp (struct lisp_time t, Lisp_Object form)
+{
+ if (NILP (form))
+ form = CURRENT_TIME_LIST ? Qlist : Qt;
+ if (EQ (form, Qlist))
+ return ticks_hz_list4 (t.ticks, t.hz);
+ if (EQ (form, Qinteger))
+ return lisp_time_seconds (t);
+ if (EQ (form, Qt))
+ form = t.hz;
+ return Fcons (lisp_time_hz_ticks (t, form), form);
+}
+
+/* From what should be a valid timestamp (TICKS . HZ), generate the
+ corresponding time values.
+
+ If RESULT is not null, store into *RESULT the converted time.
+ Otherwise, store into *DRESULT the number of seconds since the
+ start of the POSIX Epoch. Unsuccessful calls may or may not store
+ results.
+
+ Return true if successful, false if (TICKS . HZ) would not
+ be a valid new-format timestamp. */
+static bool
+decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz,
+ struct lisp_time *result, double *dresult)
+{
+ int ns;
+ mpz_t *q = &mpz[0];
+
+ if (! (INTEGERP (ticks)
+ && ((FIXNUMP (hz) && 0 < XFIXNUM (hz))
+ || (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value)))))
+ return false;
+
+ if (result)
+ {
+ result->ticks = ticks;
+ result->hz = hz;
+ }
+ else
+ {
+ if (FASTER_TIMEFNS && EQ (hz, timespec_hz))
+ {
+ if (FIXNUMP (ticks))
+ {
+ verify (1 < TIMESPEC_HZ);
+ EMACS_INT s = XFIXNUM (ticks) / TIMESPEC_HZ;
+ ns = XFIXNUM (ticks) % TIMESPEC_HZ;
+ if (ns < 0)
+ s--, ns += TIMESPEC_HZ;
+ *dresult = s_ns_to_double (s, ns);
+ return true;
+ }
+ ns = mpz_fdiv_q_ui (*q, XBIGNUM (ticks)->value, TIMESPEC_HZ);
+ }
+ else if (FASTER_TIMEFNS && EQ (hz, make_fixnum (1)))
+ {
+ ns = 0;
+ if (FIXNUMP (ticks))
+ {
+ *dresult = XFIXNUM (ticks);
+ return true;
+ }
+ q = &XBIGNUM (ticks)->value;
+ }
+ else
+ {
+ mpz_mul_ui (*q, *bignum_integer (&mpz[1], ticks), TIMESPEC_HZ);
+ mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], hz));
+ ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ);
+ }
+
+ *dresult = s_ns_to_double (mpz_get_d (*q), ns);
+ }
+
+ return true;
+}
+
+/* Lisp timestamp classification. */
+enum timeform
+ {
+ TIMEFORM_INVALID = 0,
+ TIMEFORM_HI_LO, /* seconds in the form (HI << LO_TIME_BITS) + LO. */
+ TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */
+ TIMEFORM_NIL, /* current time in nanoseconds */
+ TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */
+ TIMEFORM_FLOAT, /* time as a float */
+ TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
+ };
+
+/* From the valid form FORM and the time components HIGH, LOW, USEC
+ and PSEC, generate the corresponding time value. If LOW is
+ floating point, the other components should be zero and FORM should
+ not be TIMEFORM_TICKS_HZ.
+
+ If RESULT is not null, store into *RESULT the converted time.
+ Otherwise, store into *DRESULT the number of seconds since the
+ start of the POSIX Epoch. Unsuccessful calls may or may not store
+ results.
+
+ Return true if successful, false if the components are of the wrong
+ type. */
+static bool
+decode_time_components (enum timeform form,
+ Lisp_Object high, Lisp_Object low,
+ Lisp_Object usec, Lisp_Object psec,
+ struct lisp_time *result, double *dresult)
+{
+ switch (form)
+ {
+ case TIMEFORM_INVALID:
+ return false;
+
+ case TIMEFORM_TICKS_HZ:
+ return decode_ticks_hz (high, low, result, dresult);
+
+ case TIMEFORM_FLOAT:
+ {
+ double t = XFLOAT_DATA (low);
+ if (result)
+ return decode_float_time (t, result);
+ else
+ {
+ *dresult = t;
+ return true;
+ }
+ }
+
+ case TIMEFORM_NIL:
+ {
+ struct timespec now = current_timespec ();
+ if (result)
+ {
+ result->ticks = timespec_ticks (now);
+ result->hz = timespec_hz;
+ }
+ else
+ *dresult = s_ns_to_double (now.tv_sec, now.tv_nsec);
+ return true;
+ }
+
+ default:
+ break;
+ }
+
+ if (! (INTEGERP (high) && INTEGERP (low)
+ && FIXNUMP (usec) && FIXNUMP (psec)))
+ return false;
+ EMACS_INT us = XFIXNUM (usec);
+ EMACS_INT ps = XFIXNUM (psec);
+
+ /* Normalize out-of-range lower-order components by carrying
+ each overflow into the next higher-order component. */
+ us += ps / 1000000 - (ps % 1000000 < 0);
+ mpz_set_intmax (mpz[0], us / 1000000 - (us % 1000000 < 0));
+ mpz_add (mpz[0], mpz[0], *bignum_integer (&mpz[1], low));
+ mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], high), 1 << LO_TIME_BITS);
+ ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
+ us = us % 1000000 + 1000000 * (us % 1000000 < 0);
+
+ if (result)
+ {
+ switch (form)
+ {
+ case TIMEFORM_HI_LO:
+ /* Floats and nil were handled above, so it was an integer. */
+ result->hz = make_fixnum (1);
+ break;
+
+ case TIMEFORM_HI_LO_US:
+ mpz_mul_ui (mpz[0], mpz[0], 1000000);
+ mpz_add_ui (mpz[0], mpz[0], us);
+ result->hz = make_fixnum (1000000);
+ break;
+
+ case TIMEFORM_HI_LO_US_PS:
+ mpz_mul_ui (mpz[0], mpz[0], 1000000);
+ mpz_add_ui (mpz[0], mpz[0], us);
+ mpz_mul_ui (mpz[0], mpz[0], 1000000);
+ mpz_add_ui (mpz[0], mpz[0], ps);
+ result->hz = trillion;
+ break;
+
+ default:
+ eassume (false);
+ }
+ result->ticks = make_integer_mpz ();
+ }
+ else
+ *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L;
+
+ return true;
+}
+
+enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 };
+
+/* Decode a Lisp timestamp SPECIFIED_TIME that represents a time.
+
+ FLAGS specifies conversion flags. If FLAGS & DECODE_SECS_ONLY,
+ ignore and do not validate any sub-second components of an
+ old-format SPECIFIED_TIME. If FLAGS & WARN_OBSOLETE_TIMESTAMPS,
+ diagnose what could be obsolete (HIGH . LOW) timestamps.
+
+ If PFORM is not null, store into *PFORM the form of SPECIFIED-TIME.
+ If RESULT is not null, store into *RESULT the converted time;
+ otherwise, store into *DRESULT the number of seconds since the
+ start of the POSIX Epoch. Unsuccessful calls may or may not store
+ results.
+
+ Return true if successful, false if SPECIFIED_TIME is
+ not a valid Lisp timestamp. */
+static bool
+decode_lisp_time (Lisp_Object specified_time, int flags,
+ enum timeform *pform,
+ struct lisp_time *result, double *dresult)
+{
+ Lisp_Object high = make_fixnum (0);
+ Lisp_Object low = specified_time;
+ Lisp_Object usec = make_fixnum (0);
+ Lisp_Object psec = make_fixnum (0);
+ enum timeform form = TIMEFORM_HI_LO;
+
+ if (NILP (specified_time))
+ form = TIMEFORM_NIL;
+ else if (FLOATP (specified_time))
+ form = TIMEFORM_FLOAT;
+ else if (CONSP (specified_time))
+ {
+ high = XCAR (specified_time);
+ low = XCDR (specified_time);
+ if (CONSP (low))
+ {
+ Lisp_Object low_tail = XCDR (low);
+ low = XCAR (low);
+ if (! (flags & DECODE_SECS_ONLY))
+ {
+ if (CONSP (low_tail))
+ {
+ usec = XCAR (low_tail);
+ low_tail = XCDR (low_tail);
+ if (CONSP (low_tail))
+ {
+ psec = XCAR (low_tail);
+ form = TIMEFORM_HI_LO_US_PS;
+ }
+ else
+ form = TIMEFORM_HI_LO_US;
+ }
+ else if (!NILP (low_tail))
+ {
+ usec = low_tail;
+ form = TIMEFORM_HI_LO_US;
+ }
+ }
+ }
+ else
+ {
+ if (flags & WARN_OBSOLETE_TIMESTAMPS
+ && RANGED_FIXNUMP (0, low, (1 << LO_TIME_BITS) - 1))
+ message ("obsolete timestamp with cdr %"pI"d", XFIXNUM (low));
+ form = TIMEFORM_TICKS_HZ;
+ }
+
+ /* Require LOW to be an integer, as otherwise the computation
+ would be considerably trickier. */
+ if (! INTEGERP (low))
+ form = TIMEFORM_INVALID;
+ }
+
+ if (pform)
+ *pform = form;
+ return decode_time_components (form, high, low, usec, psec, result, dresult);
+}
+
+/* Convert Z to time_t, returning true if it fits. */
+static bool
+mpz_time (mpz_t const z, time_t *t)
+{
+ if (TYPE_SIGNED (time_t))
+ {
+ intmax_t i;
+ if (! (mpz_to_intmax (z, &i) && TIME_T_MIN <= i && i <= TIME_T_MAX))
+ return false;
+ *t = i;
+ }
+ else
+ {
+ uintmax_t i;
+ if (! (mpz_to_uintmax (z, &i) && i <= TIME_T_MAX))
+ return false;
+ *t = i;
+ }
+ return true;
+}
+
+/* Convert T to struct timespec, returning an invalid timespec
+ if T does not fit. */
+static struct timespec
+lisp_to_timespec (struct lisp_time t)
+{
+ struct timespec result = invalid_timespec ();
+ int ns;
+ mpz_t *q = &mpz[0];
+
+ if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz))
+ {
+ if (FIXNUMP (t.ticks))
+ {
+ EMACS_INT s = XFIXNUM (t.ticks) / TIMESPEC_HZ;
+ ns = XFIXNUM (t.ticks) % TIMESPEC_HZ;
+ if (ns < 0)
+ s--, ns += TIMESPEC_HZ;
+ if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s)
+ && s <= TIME_T_MAX)
+ {
+ result.tv_sec = s;
+ result.tv_nsec = ns;
+ }
+ return result;
+ }
+ else
+ ns = mpz_fdiv_q_ui (*q, XBIGNUM (t.ticks)->value, TIMESPEC_HZ);
+ }
+ else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1)))
+ {
+ ns = 0;
+ if (FIXNUMP (t.ticks))
+ {
+ EMACS_INT s = XFIXNUM (t.ticks);
+ if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s)
+ && s <= TIME_T_MAX)
+ {
+ result.tv_sec = s;
+ result.tv_nsec = ns;
+ }
+ return result;
+ }
+ else
+ q = &XBIGNUM (t.ticks)->value;
+ }
+ else
+ {
+ mpz_mul_ui (*q, *bignum_integer (q, t.ticks), TIMESPEC_HZ);
+ mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], t.hz));
+ ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ);
+ }
+
+ /* With some versions of MinGW, tv_sec is a 64-bit type, whereas
+ time_t is a 32-bit type. */
+ time_t sec;
+ if (mpz_time (*q, &sec))
+ {
+ result.tv_sec = sec;
+ result.tv_nsec = ns;
+ }
+ return result;
+}
+
+/* Convert (HIGH LOW USEC PSEC) to struct timespec.
+ Return true if successful. */
+bool
+list4_to_timespec (Lisp_Object high, Lisp_Object low,
+ Lisp_Object usec, Lisp_Object psec,
+ struct timespec *result)
+{
+ struct lisp_time t;
+ if (! decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec,
+ &t, 0))
+ return false;
+ *result = lisp_to_timespec (t);
+ return timespec_valid_p (*result);
+}
+
+/* Decode a Lisp list SPECIFIED_TIME that represents a time.
+ If SPECIFIED_TIME is nil, use the current time.
+ Signal an error if SPECIFIED_TIME does not represent a time. */
+static struct lisp_time
+lisp_time_struct (Lisp_Object specified_time, enum timeform *pform)
+{
+ int flags = WARN_OBSOLETE_TIMESTAMPS;
+ struct lisp_time t;
+ if (! decode_lisp_time (specified_time, flags, pform, &t, 0))
+ invalid_time ();
+ return t;
+}
+
+/* Decode a Lisp list SPECIFIED_TIME that represents a time.
+ Discard any low-order (sub-ns) resolution.
+ If SPECIFIED_TIME is nil, use the current time.
+ Signal an error if SPECIFIED_TIME does not represent a timespec. */
+struct timespec
+lisp_time_argument (Lisp_Object specified_time)
+{
+ struct lisp_time lt = lisp_time_struct (specified_time, 0);
+ struct timespec t = lisp_to_timespec (lt);
+ if (! timespec_valid_p (t))
+ time_overflow ();
+ return t;
+}
+
+/* Like lisp_time_argument, except decode only the seconds part, and
+ do not check the subseconds part. */
+static time_t
+lisp_seconds_argument (Lisp_Object specified_time)
+{
+ int flags = WARN_OBSOLETE_TIMESTAMPS | DECODE_SECS_ONLY;
+ struct lisp_time lt;
+ if (! decode_lisp_time (specified_time, flags, 0, <, 0))
+ invalid_time ();
+ struct timespec t = lisp_to_timespec (lt);
+ if (! timespec_valid_p (t))
+ time_overflow ();
+ return t.tv_sec;
+}
+
+/* Given Lisp operands A and B, add their values, and return the
+ result as a Lisp timestamp that is in (TICKS . HZ) form if either A
+ or B are in that form, (HI LO US PS) form otherwise. Subtract
+ instead of adding if SUBTRACT. */
+static Lisp_Object
+time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
+{
+ if (FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
+ {
+ double da = XFLOAT_DATA (a);
+ double db = XFLOAT_DATA (Ffloat_time (b));
+ return make_float (subtract ? da - db : da + db);
+ }
+ if (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))
+ return subtract ? make_float (-XFLOAT_DATA (b)) : b;
+
+ enum timeform aform, bform;
+ struct lisp_time ta = lisp_time_struct (a, &aform);
+ struct lisp_time tb = lisp_time_struct (b, &bform);
+ Lisp_Object ticks, hz;
+
+ if (FASTER_TIMEFNS && EQ (ta.hz, tb.hz))
+ {
+ hz = ta.hz;
+ if (FIXNUMP (ta.ticks) && FIXNUMP (tb.ticks))
+ ticks = make_int (subtract
+ ? XFIXNUM (ta.ticks) - XFIXNUM (tb.ticks)
+ : XFIXNUM (ta.ticks) + XFIXNUM (tb.ticks));
+ else
+ {
+ (subtract ? mpz_sub : mpz_add)
+ (mpz[0],
+ *bignum_integer (&mpz[0], ta.ticks),
+ *bignum_integer (&mpz[1], tb.ticks));
+ ticks = make_integer_mpz ();
+ }
+ }
+ else
+ {
+ /* The plan is to decompose ta into na/da and tb into nb/db.
+ Start by computing da and db. */
+ mpz_t *da = bignum_integer (&mpz[1], ta.hz);
+ mpz_t *db = bignum_integer (&mpz[2], tb.hz);
+
+ /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
+ where g = gcd (da, db). Start by computing g. */
+ mpz_t *g = &mpz[3];
+ mpz_gcd (*g, *da, *db);
+
+ /* fa = da/g, fb = db/g. */
+ mpz_t *fa = &mpz[1], *fb = &mpz[3];
+ mpz_tdiv_q (*fa, *da, *g);
+ mpz_tdiv_q (*fb, *db, *g);
+
+ /* FIXME: Maybe omit need for extra temp by computing fa * db here? */
+
+ /* hz = fa * db. This is equal to lcm (da, db). */
+ mpz_mul (mpz[0], *fa, *db);
+ hz = make_integer_mpz ();
+
+ /* ticks = (fb * na) OPER (fa * nb), where OPER is + or -.
+ OP is the multiply-add or multiply-sub form of OPER. */
+ mpz_t *na = bignum_integer (&mpz[0], ta.ticks);
+ mpz_mul (mpz[0], *fb, *na);
+ mpz_t *nb = bignum_integer (&mpz[3], tb.ticks);
+ (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb);
+ ticks = make_integer_mpz ();
+ }
+
+ /* Return the (TICKS . HZ) form if either argument is that way,
+ otherwise the (HI LO US PS) form for backward compatibility. */
+ return (aform == TIMEFORM_TICKS_HZ || bform == TIMEFORM_TICKS_HZ
+ ? Fcons (ticks, hz)
+ : ticks_hz_list4 (ticks, hz));
+}
+
+DEFUN ("time-add", Ftime_add, Stime_add, 2, 2, 0,
+ doc: /* Return the sum of two time values A and B, as a time value.
+See `format-time-string' for the various forms of a time value.
+For example, nil stands for the current time. */)
+ (Lisp_Object a, Lisp_Object b)
+{
+ return time_arith (a, b, false);
+}
+
+DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0,
+ doc: /* Return the difference between two time values A and B, as a
time value.
+You can use `float-time' to convert the difference into elapsed seconds.
+See `format-time-string' for the various forms of a time value.
+For example, nil stands for the current time. */)
+ (Lisp_Object a, Lisp_Object b)
+{
+ return time_arith (a, b, true);
+}
+
+/* Return negative, 0, positive if a < b, a == b, a > b respectively.
+ Return positive if either a or b is a NaN; this is good enough
+ for the current callers. */
+static int
+time_cmp (Lisp_Object a, Lisp_Object b)
+{
+ if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
+ || (FLOATP (b) && !isfinite (XFLOAT_DATA (b))))
+ {
+ double da = FLOATP (a) ? XFLOAT_DATA (a) : 0;
+ double db = FLOATP (b) ? XFLOAT_DATA (b) : 0;
+ return da < db ? -1 : da != db;
+ }
+
+ struct lisp_time ta = lisp_time_struct (a, 0);
+
+ /* Compare nil to nil correctly, and other eq values while we're at it.
+ Compare here rather than earlier, to handle NaNs and check formats. */
+ if (EQ (a, b))
+ return 0;
+
+ struct lisp_time tb = lisp_time_struct (b, 0);
+ mpz_t *za = bignum_integer (&mpz[0], ta.ticks);
+ mpz_t *zb = bignum_integer (&mpz[1], tb.ticks);
+ if (! (FASTER_TIMEFNS && EQ (ta.hz, tb.hz)))
+ {
+ /* This could be sped up by looking at the signs, sizes, and
+ number of bits of the two sides; see how GMP does mpq_cmp.
+ It may not be worth the trouble here, though. */
+ mpz_mul (mpz[0], *za, *bignum_integer (&mpz[2], tb.hz));
+ mpz_mul (mpz[1], *zb, *bignum_integer (&mpz[2], ta.hz));
+ za = &mpz[0];
+ zb = &mpz[1];
+ }
+ return mpz_cmp (*za, *zb);
+}
+
+DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0,
+ doc: /* Return non-nil if time value A is less than time value B.
+See `format-time-string' for the various forms of a time value.
+For example, nil stands for the current time. */)
+ (Lisp_Object a, Lisp_Object b)
+{
+ return time_cmp (a, b) < 0 ? Qt : Qnil;
+}
+
+DEFUN ("time-equal-p", Ftime_equal_p, Stime_equal_p, 2, 2, 0,
+ doc: /* Return non-nil if A and B are equal time values.
+See `format-time-string' for the various forms of a time value. */)
+ (Lisp_Object a, Lisp_Object b)
+{
+ return time_cmp (a, b) == 0 ? Qt : Qnil;
+}
+
+
+DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
+ doc: /* Return the current time, as a float number of seconds since the
epoch.
+If SPECIFIED-TIME is given, it is a time value to convert to float
+instead of the current time. See `format-time-string' for the various
+forms of a time value.
+
+WARNING: Since the result is floating point, it may not be exact.
+If precise time stamps are required, use either `encode-time',
+or (if you need time as a string) `format-time-string'. */)
+ (Lisp_Object specified_time)
+{
+ double t;
+ if (! decode_lisp_time (specified_time, 0, 0, 0, &t))
+ invalid_time ();
+ return make_float (t);
+}
+
+/* Write information into buffer S of size MAXSIZE, according to the
+ FORMAT of length FORMAT_LEN, using time information taken from *TP.
+ Use the time zone specified by TZ.
+ Use NS as the number of nanoseconds in the %N directive.
+ Return the number of bytes written, not including the terminating
+ '\0'. If S is NULL, nothing will be written anywhere; so to
+ determine how many bytes would be written, use NULL for S and
+ ((size_t) -1) for MAXSIZE.
+
+ This function behaves like nstrftime, except it allows null
+ bytes in FORMAT and it does not support nanoseconds. */
+static size_t
+emacs_nmemftime (char *s, size_t maxsize, const char *format,
+ size_t format_len, const struct tm *tp, timezone_t tz, int ns)
+{
+ size_t total = 0;
+
+ /* Loop through all the null-terminated strings in the format
+ argument. Normally there's just one null-terminated string, but
+ there can be arbitrarily many, concatenated together, if the
+ format contains '\0' bytes. nstrftime stops at the first
+ '\0' byte so we must invoke it separately for each such string. */
+ for (;;)
+ {
+ size_t len;
+ size_t result;
+
+ if (s)
+ s[0] = '\1';
+
+ result = nstrftime (s, maxsize, format, tp, tz, ns);
+
+ if (s)
+ {
+ if (result == 0 && s[0] != '\0')
+ return 0;
+ s += result + 1;
+ }
+
+ maxsize -= result + 1;
+ total += result;
+ len = strlen (format);
+ if (len == format_len)
+ return total;
+ total++;
+ format += len + 1;
+ format_len -= len + 1;
+ }
+}
+
+static Lisp_Object
+format_time_string (char const *format, ptrdiff_t formatlen,
+ struct timespec t, Lisp_Object zone, struct tm *tmp)
+{
+ char buffer[4000];
+ char *buf = buffer;
+ ptrdiff_t size = sizeof buffer;
+ size_t len;
+ int ns = t.tv_nsec;
+ USE_SAFE_ALLOCA;
+
+ timezone_t tz = tzlookup (zone, false);
+ /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is
+ a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz
+ expects a pointer to time_t value. */
+ time_t tsec = t.tv_sec;
+ tmp = emacs_localtime_rz (tz, &tsec, tmp);
+ if (! tmp)
+ {
+ xtzfree (tz);
+ time_overflow ();
+ }
+ synchronize_system_time_locale ();
+
+ while (true)
+ {
+ buf[0] = '\1';
+ len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns);
+ if ((0 < len && len < size) || (len == 0 && buf[0] == '\0'))
+ break;
+
+ /* Buffer was too small, so make it bigger and try again. */
+ len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns);
+ if (STRING_BYTES_BOUND <= len)
+ {
+ xtzfree (tz);
+ string_overflow ();
+ }
+ size = len + 1;
+ buf = SAFE_ALLOCA (size);
+ }
+
+ xtzfree (tz);
+ AUTO_STRING_WITH_LEN (bufstring, buf, len);
+ Lisp_Object result = code_convert_string_norecord (bufstring,
+ Vlocale_coding_system, 0);
+ SAFE_FREE ();
+ return result;
+}
+
+DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
+ doc: /* Use FORMAT-STRING to format the time value TIME.
+A time value that is omitted or nil stands for the current time,
+a number stands for that many seconds, an integer pair (TICKS . HZ)
+stands for TICKS/HZ seconds, and an integer list (HI LO US PS) stands
+for HI*2**16 + LO + US/10**6 + PS/10**12 seconds. This function
+treats seconds as time since the epoch of 1970-01-01 00:00:00 UTC.
+
+The optional ZONE is omitted or nil for Emacs local time, t for
+Universal Time, `wall' for system wall clock time, or a string as in
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
+
+The value is a copy of FORMAT-STRING, but with certain constructs replaced
+by text that describes the specified date and time in TIME:
+
+%Y is the year, %y within the century, %C the century.
+%G is the year corresponding to the ISO week, %g within the century.
+%m is the numeric month.
+%b and %h are the locale's abbreviated month name, %B the full name.
+ (%h is not supported on MS-Windows.)
+%d is the day of the month, zero-padded, %e is blank-padded.
+%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
+%a is the locale's abbreviated name of the day of week, %A the full name.
+%U is the week number starting on Sunday, %W starting on Monday,
+ %V according to ISO 8601.
+%j is the day of the year.
+
+%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
+ only blank-padded, %l is like %I blank-padded.
+%p is the locale's equivalent of either AM or PM.
+%q is the calendar quarter (1–4).
+%M is the minute (00-59).
+%S is the second (00-59; 00-60 on platforms with leap seconds)
+%s is the number of seconds since 1970-01-01 00:00:00 +0000.
+%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
+%Z is the time zone abbreviation, %z is the numeric form.
+
+%c is the locale's date and time format.
+%x is the locale's "preferred" date format.
+%D is like "%m/%d/%y".
+%F is the ISO 8601 date format (like "%Y-%m-%d").
+
+%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
+%X is the locale's "preferred" time format.
+
+Finally, %n is a newline, %t is a tab, %% is a literal %, and
+unrecognized %-sequences stand for themselves.
+
+Certain flags and modifiers are available with some format controls.
+The flags are `_', `-', `^' and `#'. For certain characters X,
+%_X is like %X, but padded with blanks; %-X is like %X,
+but without padding. %^X is like %X, but with all textual
+characters up-cased; %#X is like %X, but with letter-case of
+all textual characters reversed.
+%NX (where N stands for an integer) is like %X,
+but takes up at least N (a number) positions.
+The modifiers are `E' and `O'. For certain characters X,
+%EX is a locale's alternative version of %X;
+%OX is like %X, but uses the locale's number symbols.
+
+For example, to produce full ISO 8601 format, use "%FT%T%z".
+
+usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */)
+ (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object zone)
+{
+ struct timespec t = lisp_time_argument (timeval);
+ struct tm tm;
+
+ CHECK_STRING (format_string);
+ format_string = code_convert_string_norecord (format_string,
+ Vlocale_coding_system, 1);
+ return format_time_string (SSDATA (format_string), SBYTES (format_string),
+ t, zone, &tm);
+}
+
+DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0,
+ doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST
UTCOFF).
+The optional TIME is the time value to convert. See
+`format-time-string' for the various forms of a time value.
+
+The optional ZONE is omitted or nil for Emacs local time, t for
+Universal Time, `wall' for system wall clock time, or a string as in
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (the UTC offset in seconds) applied
+without consideration for daylight saving time.
+
+The list has the following nine members: SEC is an integer between 0
+and 60; SEC is 60 for a leap second, which only some operating systems
+support. MINUTE is an integer between 0 and 59. HOUR is an integer
+between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
+integer between 1 and 12. YEAR is an integer indicating the
+four-digit year. DOW is the day of week, an integer between 0 and 6,
+where 0 is Sunday. DST is t if daylight saving time is in effect,
+nil if it is not in effect, and -1 if daylight saving information is
+not available. UTCOFF is an integer indicating the UTC offset in
+seconds, i.e., the number of seconds east of Greenwich. (Note that
+Common Lisp has different meanings for DOW and UTCOFF.)
+
+usage: (decode-time &optional TIME ZONE) */)
+ (Lisp_Object specified_time, Lisp_Object zone)
+{
+ time_t time_spec = lisp_seconds_argument (specified_time);
+ struct tm local_tm, gmt_tm;
+ timezone_t tz = tzlookup (zone, false);
+ struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm);
+ xtzfree (tz);
+
+ if (! (tm
+ && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= local_tm.tm_year
+ && local_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
+ time_overflow ();
+
+ /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */
+ EMACS_INT tm_year_base = TM_YEAR_BASE;
+
+ return CALLN (Flist,
+ make_fixnum (local_tm.tm_sec),
+ make_fixnum (local_tm.tm_min),
+ make_fixnum (local_tm.tm_hour),
+ make_fixnum (local_tm.tm_mday),
+ make_fixnum (local_tm.tm_mon + 1),
+ make_fixnum (local_tm.tm_year + tm_year_base),
+ make_fixnum (local_tm.tm_wday),
+ (local_tm.tm_isdst < 0 ? make_fixnum (-1)
+ : local_tm.tm_isdst == 0 ? Qnil : Qt),
+ (HAVE_TM_GMTOFF
+ ? make_fixnum (tm_gmtoff (&local_tm))
+ : gmtime_r (&time_spec, &gmt_tm)
+ ? make_fixnum (tm_diff (&local_tm, &gmt_tm))
+ : Qnil));
+}
+
+/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
+ the result is representable as an int. 0 <= OFFSET <= TM_YEAR_BASE. */
+static int
+check_tm_member (Lisp_Object obj, int offset)
+{
+ if (FASTER_TIMEFNS && INT_MAX <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)
+ {
+ CHECK_FIXNUM (obj);
+ EMACS_INT n = XFIXNUM (obj);
+ int i;
+ if (INT_SUBTRACT_WRAPV (n, offset, &i))
+ time_overflow ();
+ return i;
+ }
+ else
+ {
+ CHECK_INTEGER (obj);
+ mpz_sub_ui (mpz[0], *bignum_integer (&mpz[0], obj), offset);
+ intmax_t i;
+ if (! (mpz_to_intmax (mpz[0], &i) && INT_MIN <= i && i <= INT_MAX))
+ time_overflow ();
+ return i;
+ }
+}
+
+DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0,
+ doc: /* Convert optional TIME to a timestamp.
+Optional FORM specifies how the returned value should be encoded.
+This can act as the reverse operation of `decode-time', which see.
+
+If TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE)
+it is a decoded time in the style of `decode-time', so that (encode-time
+(decode-time ...)) works. TIME can also be a time value.
+See `format-time-string' for the various forms of a time value.
+For example, an omitted TIME stands for the current time.
+
+If FORM is a positive integer, the time is returned as a pair of
+integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM
+is the clock frequency in ticks per second. (Currently the positive
+integer should be at least 65536 if the returned value is expected to
+be given to standard functions expecting Lisp timestamps.) If FORM is
+t, the time is returned as (TICKS . PHZ), where PHZ is a platform dependent
+clock frequency in ticks per second. If FORM is `integer', the time is
+returned as an integer count of seconds. If FORM is `list', the time is
+returned as an integer list (HIGH LOW USEC PSEC), where HIGH has the
+most significant bits of the seconds, LOW has the least significant 16
+bits, and USEC and PSEC are the microsecond and picosecond counts.
+Returned values are rounded toward minus infinity. Although an
+omitted or nil FORM currently acts like `list', this is planned to
+change, so callers requiring list timestamps should specify `list'.
+
+As an obsolescent calling convention, if this function is called with
+6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR,
+DAY, MONTH, and YEAR, and specify the components of a decoded time,
+where DST assumed to be -1 and FORM is omitted. If there are more
+than 6 arguments the *last* argument is used as ZONE and any other
+extra arguments are ignored, so that (apply #\\='encode-time
+(decode-time ...)) works; otherwise ZONE is assumed to be nil.
+
+If the input is a decoded time, ZONE is nil for Emacs local time, t
+for Universal Time, `wall' for system wall clock time, or a string as
+in the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
+
+If the input is a decoded time and ZONE specifies a time zone with
+daylight-saving transitions, DST is t for daylight saving time and nil
+for standard time. If DST is -1, the daylight saving flag is guessed.
+
+Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
+for example, a DAY of 0 means the day preceding the given month.
+Year numbers less than 100 are treated just like other year numbers.
+If you want them to stand for years in this century, you must do that yourself.
+
+Years before 1970 are not guaranteed to work. On some systems,
+year values as low as 1901 do work.
+
+usage: (encode-time &optional TIME FORM &rest OBSOLESCENT-ARGUMENTS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ time_t value;
+ struct tm tm;
+ Lisp_Object form = Qnil, zone = Qnil;
+ Lisp_Object a = args[0];
+ tm.tm_isdst = -1;
+
+ if (nargs <= 2)
+ {
+ if (nargs == 2)
+ form = args[1];
+ Lisp_Object tail = a;
+ for (int i = 0; i < 9; i++, tail = XCDR (tail))
+ if (! CONSP (tail))
+ {
+ struct lisp_time t;
+ if (! decode_lisp_time (a, 0, 0, &t, 0))
+ invalid_time ();
+ return lisp_time_form_stamp (t, form);
+ }
+ tm.tm_sec = check_tm_member (XCAR (a), 0); a = XCDR (a);
+ tm.tm_min = check_tm_member (XCAR (a), 0); a = XCDR (a);
+ tm.tm_hour = check_tm_member (XCAR (a), 0); a = XCDR (a);
+ tm.tm_mday = check_tm_member (XCAR (a), 0); a = XCDR (a);
+ tm.tm_mon = check_tm_member (XCAR (a), 1); a = XCDR (a);
+ tm.tm_year = check_tm_member (XCAR (a), TM_YEAR_BASE); a = XCDR (a);
+ a = XCDR (a);
+ if (SYMBOLP (XCAR (a)))
+ tm.tm_isdst = !NILP (XCAR (a));
+ a = XCDR (a);
+ zone = XCAR (a);
+ }
+ else if (nargs < 6)
+ xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs));
+ else
+ {
+ if (6 < nargs)
+ zone = args[nargs - 1];
+ form = Qnil;
+ tm.tm_sec = check_tm_member (a, 0);
+ tm.tm_min = check_tm_member (args[1], 0);
+ tm.tm_hour = check_tm_member (args[2], 0);
+ tm.tm_mday = check_tm_member (args[3], 0);
+ tm.tm_mon = check_tm_member (args[4], 1);
+ tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE);
+ }
+
+ timezone_t tz = tzlookup (zone, false);
+ value = emacs_mktime_z (tz, &tm);
+ xtzfree (tz);
+
+ if (value == (time_t) -1)
+ time_overflow ();
+
+ return time_form_stamp (value, form);
+}
+
+DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
+ doc: /* Return the current time, as the number of seconds since
1970-01-01 00:00:00.
+The time is returned as a list of integers (HIGH LOW USEC PSEC).
+HIGH has the most significant bits of the seconds, while LOW has the
+least significant 16 bits. USEC and PSEC are the microsecond and
+picosecond counts. Use `encode-time' if you need a particular
+timestamp form; for example, (encode-time nil \\='integer) returns the
+current time in seconds. */)
+ (void)
+{
+ return make_lisp_time (current_timespec ());
+}
+
+DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string,
+ 0, 2, 0,
+ doc: /* Return the current local time, as a human-readable string.
+Programs can use this function to decode a time,
+since the number of columns in each field is fixed
+if the year is in the range 1000-9999.
+The format is `Sun Sep 16 01:03:52 1973'.
+However, see also the functions `decode-time' and `format-time-string'
+which provide a much more powerful and general facility.
+
+If SPECIFIED-TIME is given, it is the time value to format instead of
+the current time. See `format-time-string' for the various forms of a
+time value.
+
+The optional ZONE is omitted or nil for Emacs local time, t for
+Universal Time, `wall' for system wall clock time, or a string as in
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time. */)
+ (Lisp_Object specified_time, Lisp_Object zone)
+{
+ time_t value = lisp_seconds_argument (specified_time);
+ timezone_t tz = tzlookup (zone, false);
+
+ /* Convert to a string in ctime format, except without the trailing
+ newline, and without the 4-digit year limit. Don't use asctime
+ or ctime, as they might dump core if the year is outside the
+ range -999 .. 9999. */
+ struct tm tm;
+ struct tm *tmp = emacs_localtime_rz (tz, &value, &tm);
+ xtzfree (tz);
+ if (! tmp)
+ time_overflow ();
+
+ static char const wday_name[][4] =
+ { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
+ static char const mon_name[][4] =
+ { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
+ printmax_t year_base = TM_YEAR_BASE;
+ char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
+ int len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd,
+ wday_name[tm.tm_wday], mon_name[tm.tm_mon], tm.tm_mday,
+ tm.tm_hour, tm.tm_min, tm.tm_sec,
+ tm.tm_year + year_base);
+
+ return make_unibyte_string (buf, len);
+}
+
+DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 2, 0,
+ doc: /* Return the offset and name for the local time zone.
+This returns a list of the form (OFFSET NAME).
+OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
+ A negative value means west of Greenwich.
+NAME is a string giving the name of the time zone.
+If SPECIFIED-TIME is given, the time zone offset is determined from it
+instead of using the current time. The argument should be a Lisp
+time value; see `format-time-string' for the various forms of a time
+value.
+
+The optional ZONE is omitted or nil for Emacs local time, t for
+Universal Time, `wall' for system wall clock time, or a string as in
+the TZ environment variable. It can also be a list (as from
+`current-time-zone') or an integer (as from `decode-time') applied
+without consideration for daylight saving time.
+
+Some operating systems cannot provide all this information to Emacs;
+in this case, `current-time-zone' returns a list containing nil for
+the data it can't find. */)
+ (Lisp_Object specified_time, Lisp_Object zone)
+{
+ struct timespec value;
+ struct tm local_tm, gmt_tm;
+ Lisp_Object zone_offset, zone_name;
+
+ zone_offset = Qnil;
+ value = make_timespec (lisp_seconds_argument (specified_time), 0);
+ zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value,
+ zone, &local_tm);
+
+ /* gmtime_r expects a pointer to time_t, but tv_sec of struct
+ timespec on some systems (MinGW) is a 64-bit field. */
+ time_t tsec = value.tv_sec;
+ if (HAVE_TM_GMTOFF || gmtime_r (&tsec, &gmt_tm))
+ {
+ long int offset = (HAVE_TM_GMTOFF
+ ? tm_gmtoff (&local_tm)
+ : tm_diff (&local_tm, &gmt_tm));
+ zone_offset = make_fixnum (offset);
+ if (SCHARS (zone_name) == 0)
+ {
+ /* No local time zone name is available; use numeric zone instead. */
+ long int hour = offset / 3600;
+ int min_sec = offset % 3600;
+ int amin_sec = min_sec < 0 ? - min_sec : min_sec;
+ int min = amin_sec / 60;
+ int sec = amin_sec % 60;
+ int min_prec = min_sec ? 2 : 0;
+ int sec_prec = sec ? 2 : 0;
+ char buf[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
+ zone_name = make_formatted_string (buf, "%c%.2ld%.*d%.*d",
+ (offset < 0 ? '-' : '+'),
+ hour, min_prec, min, sec_prec,
sec);
+ }
+ }
+
+ return list2 (zone_offset, zone_name);
+}
+
+DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
+ doc: /* Set the Emacs local time zone using TZ, a string specifying a
time zone rule.
+If TZ is nil or `wall', use system wall clock time; this differs from
+the usual Emacs convention where nil means current local time. If TZ
+is t, use Universal Time. If TZ is a list (as from
+`current-time-zone') or an integer (as from `decode-time'), use the
+specified time zone without consideration for daylight saving time.
+
+Instead of calling this function, you typically want something else.
+To temporarily use a different time zone rule for just one invocation
+of `decode-time', `encode-time', or `format-time-string', pass the
+function a ZONE argument. To change local time consistently
+throughout Emacs, call (setenv "TZ" TZ): this changes both the
+environment of the Emacs process and the variable
+`process-environment', whereas `set-time-zone-rule' affects only the
+former. */)
+ (Lisp_Object tz)
+{
+ tzlookup (NILP (tz) ? Qwall : tz, true);
+ return Qnil;
+}
+
+/* A buffer holding a string of the form "TZ=value", intended
+ to be part of the environment. If TZ is supposed to be unset,
+ the buffer string is "tZ=". */
+ static char *tzvalbuf;
+
+/* Get the local time zone rule. */
+char *
+emacs_getenv_TZ (void)
+{
+ return tzvalbuf[0] == 'T' ? tzvalbuf + tzeqlen : 0;
+}
+
+/* Set the local time zone rule to TZSTRING, which can be null to
+ denote wall clock time. Do not record the setting in LOCAL_TZ.
+
+ This function is not thread-safe, in theory because putenv is not,
+ but mostly because of the static storage it updates. Other threads
+ that invoke localtime etc. may be adversely affected while this
+ function is executing. */
+
+int
+emacs_setenv_TZ (const char *tzstring)
+{
+ static ptrdiff_t tzvalbufsize;
+ ptrdiff_t tzstringlen = tzstring ? strlen (tzstring) : 0;
+ char *tzval = tzvalbuf;
+ bool new_tzvalbuf = tzvalbufsize <= tzeqlen + tzstringlen;
+
+ if (new_tzvalbuf)
+ {
+ /* Do not attempt to free the old tzvalbuf, since another thread
+ may be using it. In practice, the first allocation is large
+ enough and memory does not leak. */
+ tzval = xpalloc (NULL, &tzvalbufsize,
+ tzeqlen + tzstringlen - tzvalbufsize + 1, -1, 1);
+ tzvalbuf = tzval;
+ tzval[1] = 'Z';
+ tzval[2] = '=';
+ }
+
+ if (tzstring)
+ {
+ /* Modify TZVAL in place. Although this is dicey in a
+ multithreaded environment, we know of no portable alternative.
+ Calling putenv or setenv could crash some other thread. */
+ tzval[0] = 'T';
+ strcpy (tzval + tzeqlen, tzstring);
+ }
+ else
+ {
+ /* Turn 'TZ=whatever' into an empty environment variable 'tZ='.
+ Although this is also dicey, calling unsetenv here can crash Emacs.
+ See Bug#8705. */
+ tzval[0] = 't';
+ tzval[tzeqlen] = 0;
+ }
+
+
+#ifndef WINDOWSNT
+ /* Modifying *TZVAL merely requires calling tzset (which is the
+ caller's responsibility). However, modifying TZVAL requires
+ calling putenv; although this is not thread-safe, in practice this
+ runs only on startup when there is only one thread. */
+ bool need_putenv = new_tzvalbuf;
+#else
+ /* MS-Windows 'putenv' copies the argument string into a block it
+ allocates, so modifying *TZVAL will not change the environment.
+ However, the other threads run by Emacs on MS-Windows never call
+ 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
+ dicey in-place modification technique doesn't exist there in the
+ first place. */
+ bool need_putenv = true;
+#endif
+ if (need_putenv)
+ xputenv (tzval);
+
+ return 0;
+}
+
+void
+syms_of_timefns (void)
+{
+#ifndef timespec_hz
+ timespec_hz = make_int (TIMESPEC_HZ);
+ staticpro (×pec_hz);
+#endif
+#ifndef trillion
+ trillion = make_int (1000000000000);
+ staticpro (&trillion);
+#endif
+#if (ULONG_MAX < TRILLION || !FASTER_TIMEFNS) && !defined ztrillion
+ mpz_init_set_ui (ztrillion, 1000000);
+ mpz_mul_ui (ztrillion, ztrillion, 1000000);
+#endif
+
+ DEFSYM (Qencode_time, "encode-time");
+
+ defsubr (&Scurrent_time);
+ defsubr (&Stime_add);
+ defsubr (&Stime_subtract);
+ defsubr (&Stime_less_p);
+ defsubr (&Stime_equal_p);
+ defsubr (&Sformat_time_string);
+ defsubr (&Sfloat_time);
+ defsubr (&Sdecode_time);
+ defsubr (&Sencode_time);
+ defsubr (&Scurrent_time_string);
+ defsubr (&Scurrent_time_zone);
+ defsubr (&Sset_time_zone_rule);
+}
diff --git a/src/w32.c b/src/w32.c
index 4b57d91..e643c42 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -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)
{
diff --git a/src/w32.h b/src/w32.h
index 9c219cd..42b3d98 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -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);
diff --git a/src/xdisp.c b/src/xdisp.c
index 93cd54a..d61d421 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -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.
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index facf097..e50f931 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -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))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 1575d4f..0523d8b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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.
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index 3fcdce6..5a91a2c 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -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
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 4a840c8..17b2c51 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -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"))
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 091f1aa..78e769f 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -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")
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
new file mode 100644
index 0000000..ebeb43d
--- /dev/null
+++ b/test/src/timefns-tests.el
@@ -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))))))))