[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 3d44231 2/2: Merge commit '74e9799bd89484b8d15bdd65
|
From: |
Stephen Leake |
|
Subject: |
[Emacs-diffs] master 3d44231 2/2: Merge commit '74e9799bd89484b8d15bdd6597c68fc00d07e7f7' |
|
Date: |
Tue, 10 Sep 2019 06:38:29 -0400 (EDT) |
branch: master
commit 3d442312889ef2d14c07282d0aff6199d00cc165
Merge: ac1a2e2 74e9799
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
Merge commit '74e9799bd89484b8d15bdd6597c68fc00d07e7f7'
---
.gitattributes | 3 -
ChangeLog.3 | 551 +++++++++++++++-
GNUmakefile | 33 +
INSTALL | 3 +
admin/admin.el | 4 +
build-aux/install-sh | 13 +-
configure.ac | 23 +-
doc/emacs/building.texi | 11 +-
doc/emacs/custom.texi | 78 ++-
doc/emacs/maintaining.texi | 10 +-
doc/emacs/misc.texi | 12 +-
doc/lispref/customize.texi | 2 +-
doc/lispref/errors.texi | 6 +-
doc/lispref/files.texi | 6 +-
doc/lispref/hooks.texi | 3 +
doc/lispref/modes.texi | 8 +-
doc/lispref/os.texi | 41 +-
doc/lispref/processes.texi | 15 +
doc/lispref/windows.texi | 8 +-
doc/misc/efaq.texi | 22 +-
doc/misc/emacs-mime.texi | 2 +-
doc/misc/ido.texi | 56 +-
doc/misc/info.texi | 11 +-
doc/misc/texinfo.tex | 220 +++----
doc/misc/tramp.texi | 110 ++--
doc/misc/url.texi | 3 +-
etc/HISTORY | 2 +
etc/NEWS | 94 ++-
etc/NEWS.26 | 29 +-
etc/tutorials/TUTORIAL.ru | 3 +-
lib-src/emacsclient.c | 47 +-
lib-src/etags.c | 4 -
lib-src/pop.c | 10 +-
lib/intprops.h | 91 ++-
lib/regex_internal.c | 11 +-
lib/verify.h | 28 +-
lisp/battery.el | 23 +-
lisp/bookmark.el | 39 +-
lisp/calendar/icalendar.el | 7 +-
lisp/calendar/time-date.el | 32 +-
lisp/cedet/ede/proj.el | 2 +-
lisp/composite.el | 4 +-
lisp/custom.el | 1 +
lisp/dframe.el | 21 +-
lisp/dired-aux.el | 1 +
lisp/emacs-lisp/bytecomp.el | 2 +-
lisp/emacs-lisp/cl-lib.el | 10 +-
lisp/emacs-lisp/cl-macs.el | 38 +-
lisp/emacs-lisp/easy-mmode.el | 38 +-
lisp/emacs-lisp/eldoc.el | 19 +-
lisp/emacs-lisp/find-func.el | 17 +-
lisp/emacs-lisp/package.el | 25 +-
lisp/emacs-lisp/rmc.el | 2 +-
lisp/emacs-lisp/subr-x.el | 4 +-
lisp/epa-file.el | 64 +-
lisp/epa.el | 4 +-
lisp/epg-config.el | 15 +-
lisp/epg.el | 10 +-
lisp/erc/erc.el | 19 +-
lisp/files.el | 4 +-
lisp/gnus/gnus-art.el | 7 +-
lisp/gnus/gnus-start.el | 3 -
lisp/gnus/mml-sec.el | 8 +-
lisp/hi-lock.el | 2 +-
lisp/ibuf-ext.el | 3 +-
lisp/image-mode.el | 10 +-
lisp/info.el | 57 +-
lisp/international/quail.el | 3 +-
lisp/ldefs-boot.el | 201 +++---
lisp/ls-lisp.el | 3 +-
lisp/macros.el | 14 +-
lisp/mail/flow-fill.el | 3 +-
lisp/net/browse-url.el | 4 +-
lisp/net/gnutls.el | 37 +-
lisp/net/net-utils.el | 75 ++-
lisp/net/nsm.el | 1133 ++++++++++++++++++++++++---------
lisp/net/shr.el | 9 +-
lisp/net/tramp-sh.el | 14 +-
lisp/net/tramp.el | 7 +-
lisp/play/gamegrid.el | 3 +-
lisp/progmodes/compile.el | 111 +++-
lisp/progmodes/flymake-proc.el | 14 +-
lisp/progmodes/gud.el | 4 +-
lisp/progmodes/hideif.el | 18 +-
lisp/progmodes/prog-mode.el | 3 +-
lisp/progmodes/xref.el | 25 +-
lisp/ps-print.el | 11 -
lisp/recentf.el | 3 -
lisp/server.el | 3 +-
lisp/shadowfile.el | 17 +-
lisp/shell.el | 9 +-
lisp/simple.el | 23 +-
lisp/skeleton.el | 4 +-
lisp/sort.el | 16 +-
lisp/startup.el | 78 ++-
lisp/subr.el | 8 +-
lisp/tar-mode.el | 5 +-
lisp/textmodes/ispell.el | 7 +-
lisp/tmm.el | 18 +-
lisp/vc/vc-hg.el | 18 +-
lisp/wid-edit.el | 32 +-
lisp/window.el | 12 +-
src/alloc.c | 146 +++--
src/bignum.c | 15 +-
src/bignum.h | 19 +-
src/buffer.c | 10 +-
src/buffer.h | 671 +++++++++++--------
src/coding.c | 5 +-
src/composite.c | 7 +-
src/conf_post.h | 43 +-
src/data.c | 139 ++--
src/dbusbind.c | 37 +-
src/emacs.c | 3 +-
src/floatfns.c | 14 +-
src/fns.c | 82 +--
src/font.c | 7 +
src/frame.c | 16 +-
src/ftfont.c | 2 +-
src/ftfont.h | 1 -
src/gnutls.c | 215 ++++++-
src/image.c | 35 +-
src/keyboard.c | 4 +
src/keymap.c | 4 +-
src/lisp.h | 10 +-
src/lread.c | 71 ++-
src/mini-gmp.c | 10 +-
src/minibuf.c | 3 +-
src/pdumper.c | 219 ++++---
src/pdumper.h | 16 +-
src/process.c | 104 ++-
src/sound.c | 6 +-
src/sysdep.c | 6 -
src/sysstdio.h | 1 -
src/systime.h | 2 +
src/timefns.c | 163 +++--
src/w32.c | 2 +-
src/xdisp.c | 20 +-
src/xterm.c | 1 -
test/Makefile.in | 1 +
test/README | 3 +
test/lisp/autorevert-tests.el | 3 +
test/lisp/calendar/icalendar-tests.el | 18 +
test/lisp/net/nsm-tests.el | 69 ++
test/lisp/net/tramp-tests.el | 44 +-
test/lisp/shadowfile-tests.el | 272 ++++----
test/src/data-tests.el | 7 +
test/src/lread-tests.el | 3 +
test/src/process-tests.el | 63 +-
test/src/timefns-tests.el | 50 +-
149 files changed, 4594 insertions(+), 2057 deletions(-)
diff --git a/.gitattributes b/.gitattributes
index 65a943f..e1fd4b1 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -31,9 +31,6 @@ test/manual/etags/html-src/algrthms.html whitespace=cr-at-eol
# The todo-mode file format includes trailing whitespace.
*.tod[aorty] -whitespace=blank-at-eol
-# The upstream maintainer does not want to remove trailing whitespace.
-doc/misc/texinfo.tex -whitespace=blank-at-eol
-
# Some files should not be treated as text when diffing or merging.
*.cur binary
*.gpg binary
diff --git a/ChangeLog.3 b/ChangeLog.3
index c049402..747fd56 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,552 @@
+2019-08-29 Nicolas Petton <address@hidden>
+
+ * etc/AUTHORS: Update.
+
+2019-08-29 Nicolas Petton <address@hidden>
+2019-08-29 Nicolas Petton <address@hidden>
+
+ * etc/NEWS: Delete temporary markup.
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Fix process filter documentation (Bug#13400)
+
+ * doc/lispref/processes.texi (Asynchronous Processes): Note that input
+ may read when sending data as well.
+ (Output from Processes): Note that functions which send data may also
+ trigger reading from processes.
+ (Input to Processes, Filter Functions): Note that filter functions may
+ be called recursively.
+
+2019-08-29 Tino Calancha <address@hidden>
+
+ Fix query-replace-regexp undo feature
+
+ Ensure that non-regexp strings used with `looking-at' are quoted.
+ * lisp/replace.el (perform-replace): Quote regexp (Bug#37073).
+ * test/lisp/replace-tests.el
(replace-tests-perform-replace-regexp-flag):
+ New variable.
+ (replace-tests-with-undo): Use it.
+ (query-replace-undo-bug37073): Add tests.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Support the new Japanese era name
+
+ * admin/unidata/NormalizationTest.txt:
+ * admin/unidata/UnicodeData.txt: Add U+32FF SQUARE ERA NAME REIWA.
+ Do not merge to master.
+
+ * test/lisp/international/ucs-normalize-tests.el
+ (ucs-normalize-tests--failing-lines-part1)
+ (ucs-normalize-tests--failing-lines-part2): Update. Do not
+ merge to master.
+
+ * etc/NEWS: Mention the change.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Fix a typo in char-width-table
+
+ * lisp/international/characters.el (char-width-table): Fix a
+ typo in zero-width characters.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Minor update in admin/notes/unicode
+
+ * admin/notes/unicode: Mention changes to be done in
+ setup-default-fontset in fontset.el. (Bug#14461)
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Fix lisp indent infloop on unfinished strings (Bug#37045)
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-indent-calc-next): Stop trying to
+ skip over strings if we've hit the end of buffer.
+ * test/lisp/emacs-lisp/lisp-mode-tests.el
+ (lisp-indent-unfinished-string): New test.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve commentary in composite.el
+
+ * lisp/composite.el (compose-gstring-for-graphic)
+ (compose-gstring-for-terminal): Add comments that explain
+ Unicode General Category mnemonics in human-readable terms.
+ (Bug#14461)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Fix markup in dired-x.texi
+
+ * doc/misc/dired-x.texi (Omitting Variables)
+ (Local Variables, Shell Command Guessing)
+ (Advanced Cleaning Variables, Special Marking Function): Fix
+ markup and indexing. (Bug#14212)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ * src/callproc.c (Fcall_process): Doc fix.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve documentation of features that use the fringes
+
+ * doc/emacs/display.texi (Fringes): Add cross-reference to
+ where indicate-empty-lines is described.
+ (Useless Whitespace): Add an @anchor for a more accurate
+ cross-reference in "Fringes".
+
+2019-08-29 Mauro Aranda <address@hidden>
+
+ Fix docstrings in pong
+
+ * lisp/play/pong.el (pong-move-left pong-move-right): Refer to the
+ right bats and directions of movement. (Bug#36959)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve doc strings of 'append-to-buffer' and friends
+
+ * lisp/simple.el (append-to-buffer, prepend-to-buffer)
+ (copy-to-buffer): Doc fixes.
+
+2019-08-29 Mauro Aranda <address@hidden>
+
+ Fix octave-mode ElDoc support
+
+ * lisp/progmodes/octave.el (octave-eldoc-function-signatures): Fix the
+ regexp used, so no match happens when there is no defined function FN.
+ Also, tweak the regexp to support GNU Octave 4.2.x and newer.
(Bug#36459)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Avoid Groff hanging on MS-Windows when invoked by "M-x man"
+
+ * lisp/man.el (Man-build-man-command): On MS-Windows, redirect
+ stdin of 'man' to the null device, to make sure Groff exits
+ immediately after formatting the man page.
+
+2019-08-29 Philipp Stephani <address@hidden>
+
+ Ignore pending_signals when checking for quits.
+
+ pending_signals is often set if no quit is pending. This results in
+ bugs in module code if the module returns but no quit is actually
+ pending.
+
+ * src/emacs-module.c (module_should_quit): Use QUITP macro to check
+ whether the caller should quit.
+
+ * src/eval.c: Remove obsolete comment.
+
+2019-08-29 Basil L. Contovounesios <address@hidden>
+
+ Fix nnmail-expiry-wait docs and custom :types
+
+ * doc/misc/gnus.texi (Group Parameters, Expiring Mail):
+ * lisp/gnus/gnus-cus.el (gnus-group-parameters): Clarify
+ descriptions of nnmail-expiry, nnmail-expiry-wait, and
+ nnmail-expiry-wait-function.
+ * lisp/gnus/nnmail.el (nnmail-expiry-wait)
+ (nnmail-expiry-wait-function): Clarify docstrings and fix custom
+ :types (bug#36850).
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ * lisp/simple.el (kill-do-not-save-duplicates): Doc fix. (Bug#36827)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve documentation of debugging Lisp syntax error
+
+ * doc/lispref/debugging.texi (Syntax Errors, Excess Open)
+ (Excess Close): Name the commands invoked by the key
+ sequences. Add cross-references to appropriate sections of
+ the Emacs manual. (Bug#21385)
+
+ (cherry picked from commit faafd467a374c9398ee4668cdc173611d35693ed)
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Add index for "\( in strings" (Bug#25195)
+
+ * doc/emacs/programs.texi (Left Margin Paren): Add index for "\( in
+ strings".
+ * doc/lispref/positions.texi (List Motion): Add index, and cross
+ reference.
+
+2019-08-29 Martin Rudalics <address@hidden>
+
+ Fix doc-string of 'fit-window-to-buffer' (Bug#36848)
+
+ * lisp/window.el (fit-window-to-buffer): Fix doc-string.
+
+ Suggested by Drew Adams <address@hidden>
+
+2019-08-29 Tino Calancha <address@hidden>
+
+ Update view-mode docstring
+
+ Not all the kill commands save the text in the kill ring
+ by default (e.g. `kill-rectangle').
+ It is more precise to just say that the kill commands save
+ the text and do not change the buffer (Bug#36741).
+ * lisp/view.el (view-mode): Update docstring.
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Fix subproc listening when setting filter to non-t (Bug#36591)
+
+ * src/process.c (Fset_process_filter): Call add_process_read_fd
+ according to the state of process filter before it's updated. This
+ restores the correct functioning as it was before 2016-02-16 "Allow
+ setting the filter masks later". Inline the set_process_filter_masks
+ call instead of fixing it that function, because it is also called
+ from connect_network_socket, and we don't want to change the behavior
+ of that function so close to release.
+ * test/src/process-tests.el (set-process-filter-t): New test.
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ * etc/NEWS.25: Belatedly announce rcirc-reconnect-delay.
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Mention term.el's \032 dir tracking in commentary (Bug#19524)
+
+ * lisp/term.el: Mention both forms of directory tracking in
+ commentary. Remove obsolete ChangeLog comments. Move more relevant
+ summary comments to the top.
+
+2019-08-29 Stefan Kangas <address@hidden>
+
+ Remove upload functionality of package-x from the elisp manual
+
+ Suggested by Stefan Monnier.
+ Ref: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19537#8
+
+ * doc/lispref/package.texi (Package Archives): Don't document
+ package-x upload functions in the elisp manual, since they are not
+ very commonly used. (Bug#19537)
+ * lisp/emacs-lisp/package-x.el (package-archive-upload-base)
+ (package-upload-buffer, package-upload-file): Add to the doc strings
+ any details removed from the elisp manual that would otherwise be
+ missing.
+
+2019-08-29 Nicolas Petton <address@hidden>
+
+ * etc/AUTHORS: Update.
+
+2019-08-29 Basil L. Contovounesios <address@hidden>
+
+ Clarify Gravatar docs
+
+ For discussion, see the following thread:
+ https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html
+ * doc/misc/gnus.texi (X-Face): Fix cross-reference.
+ (Gravatars):
+ * lisp/gnus/gnus-gravatar.el (gnus-gravatar-too-ugly):
+ * lisp/image/gravatar.el (gravatar-cache-ttl, gravatar-rating)
+ (gravatar-size): Clarify user option descriptions.
+ (gravatar-retrieve, gravatar-retrieve-synchronously): Document
+ return value.
+
+2019-08-29 Alan Mackenzie <address@hidden>
+
+ * doc/lispref/display.texi (Defining Faces): Say a face can't be
undefined.
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Handle completely undecoded input in term (Bug#29918)
+
+ * lisp/term.el (term-emulate-terminal): Avoid errors if the whole
+ decoded string is eight-bit characters. Don't attempt to save the
+ string for next iteration in that case.
+ * test/lisp/term-tests.el (term-decode-partial)
+ (term-undecodable-input): New tests.
+
+2019-08-29 N. Jackson <address@hidden> (tiny change)
+
+ * doc/misc/forms.texi (Control File Format): Fix a doc error.
+
+ (Bug#36693)
+
+2019-08-29 Basil L. Contovounesios <address@hidden>
+
+ Fix typo in package-alist docstring
+
+ Pointed out by Michael Heerdegen <address@hidden>.
+ * lisp/emacs-lisp/package.el (package-alist): Fix docstring
+ grammar (bug#17403).
+
+2019-08-29 Markus Triska <address@hidden>
+
+ * doc/lispref/text.texi (Mode-Specific Indent): Fix a typo (bug#36646).
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve doc string of 'bidi-display-reordering'
+
+ * src/buffer.c (syms_of_buffer) <bidi-display-reordering>:
+ Further doc fix.
+
+2019-08-29 Stefan Kangas <address@hidden>
+
+ Add warning to bidi-display-reordering doc string
+
+ This explanation was given by Eli Zaretskii on emacs-devel.
+ For discussion, see:
+ https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00294.html
+
+ * src/buffer.c (syms_of_buffer): Add warning to doc string of
+ bidi-display-reordering to explain that it should only be used for
+ debugging.
+
+2019-08-29 YAMAMOTO Mitsuharu <address@hidden>
+
+ Raise required librsvg version so as to match the current use
+
+ * configure.ac: Set RSVG_REQUIRED to 2.14.0 as
rsvg_handle_get_dimensions
+ needs it.
+
+2019-08-29 Michael Albinus <address@hidden>
+
+ * lisp/net/tramp-sh.el (tramp-inline-compress-start-size): Set nil on
w32.
+
+2019-08-29 Stefan Monnier <address@hidden>
+
+ * lisp/progmodes/verilog-mode.el: One more ELPA Version:
+
+2019-08-29 Stefan Monnier <address@hidden>
+
+ * lisp/svg.el, lisp/progmodes/ada-mode.el: Fix bug#36360.
+
+ Tell package.el their version number, for better behavior w.r.t the
+ versions available in GNU ELPA
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Minor copyedit of "Font Lock" in user manual
+
+ * doc/emacs/display.texi (Font Lock): Make the wording about
+ "enabling Font Lock" crystal clear. (Bug#36529)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve description of image descriptors
+
+ * doc/lispref/display.texi (Image Descriptors): More accurate
+ description of where image files are looked up. (Bug#36523)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve documentation of secondary selections
+
+ * doc/emacs/killing.texi (Secondary Selection): Improve
+ wording. Mention that 'M-mouse-1' can be used to cancel
+ secondary selections. (Bug#36365)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ * src/fns.c (Fmapconcat): Doc fix. (Bug#36418)
+
+2019-08-29 YAMAMOTO Mitsuharu <address@hidden>
+
+ Avoid crash inside CFCharacterSetIsLongCharacterMember (Bug#36507)
+
+ * src/macfont.m (macfont_supports_charset_and_languages_p)
+ (macfont_has_char): Don't pass integers outside the Unicode codespace to
+ CFCharacterSetIsLongCharacterMember. Do not merge to master.
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Fix python.el docstring (Bug#36458)
+
+ * lisp/progmodes/python.el
(python-shell--prompt-calculated-output-regexp):
+ python-shell-set-prompt-regexp doesn't exist, presumably
+ python-shell-prompt-set-calculated-regexps was meant.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ * lisp/hi-lock.el (hi-lock-line-face-buffer): Doc fix. (Bug36448)
+
+2019-08-29 Stefan Kangas <address@hidden>
+
+ Fix typo in doc string of file-exists-p (bug#36408)
+
+ * src/fileio.c (Ffile_exists_p): Fix typo in doc string.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ * test/lisp/url/url-file-tests.el (url-file): Fix for POSIX filenames.
+
+2019-08-29 Stefan Kangas <address@hidden>
+
+ Fix typo in windows.texi
+
+ * doc/lispref/windows.texi (Window History): Fix typo. (Bug#36412)
+
+2019-08-29 Basil L. Contovounesios <address@hidden>
+
+ Clarify & update (elisp) Writing Emacs Primitives
+
+ * doc/lispref/internals.texi (Writing Emacs Primitives): Update some
+ of the sample code listings, fixing argument lists and parentheses.
+ Replace ... with @dots{}. Describe UNEVALLED special forms as
+ taking a single argument. (bug#36392)
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Clarify a subtle issue in the Internals chapter of lispref
+
+ * doc/lispref/internals.texi (Writing Emacs Primitives):
+ Clarify the issue with relocation of buffer or string text as
+ side effect of Lisp evaluation. (Bug#36392)
+
+2019-08-29 Noam Postavsky <address@hidden>
+
+ Fix sgml-mode handling of quotes within parens (Bug#36347)
+
+ * lisp/textmodes/sgml-mode.el (sgml-syntax-propertize): Use
+ syntax-ppss-table if set. This is only needed on the release branch,
+ on master the caller (syntax-propertize) already does this.
+ (sgml-mode): Set syntax-ppss-table to sgml-tag-syntax-table. This
+ correctly classifies parens as punctuation, so they won't confuse the
+ parser.
+ * test/lisp/textmodes/sgml-mode-tests.el (sgml-tests--quotes-syntax):
+ New test copied from master, with two cases added for this bug.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ Rename 'make-symbolic-link' argument NEWNAME to LINKNAME
+
+ * src/fileio.c (Fmake_symbolic_link): Fix docstring.
+ * doc/lispref/files.texi (Changing Files): Doc fix.
+
+2019-08-29 Robert Pluim <address@hidden>
+
+ Check that length of data returned by sysctl is non-zero
+
+ The length of the data returned by sysctl can be zero, which was not
+ checked for. This could cause crashes, e.g. when querying
+ non-existent processes. (Bug#36279)
+
+ * src/sysdep.c (list_system_processes) [DARWIN_OS || __FreeBSD__]:
+ (system_process_attributes) [__FreeBSD__]:
+ (system_process_attributes) [DARWIN_OS]:
+ * src/filelock.c (get_boot_time) [CTL_KERN && KERN_BOOTTIME]: Check
+ for zero length data returned by sysctl.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ * test/lisp/progmodes/python-tests.el (python-virt-bin): Doc fix.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ Fix Python tests depending on system-type
+
+ * test/lisp/progmodes/python-tests.el (python-virt-bin): New function.
+ (python-shell-calculate-exec-path-2)
+ (python-shell-calculate-exec-path-3)
+ (python-shell-calculate-exec-path-4)
+ (python-shell-with-environment-1, python-shell-with-environment-2):
+ Use it.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ Fix problem with wdired test when symlinks cannot be created.
+
+ * test/lisp/wdired-tests.el (wdired-test-symlink-name):
+ Skip test if 'make-symbolic-link' fails for whatever reason;
+ that's not what's being tested.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Improve wording of documentation of click events
+
+ * doc/lispref/commands.texi (Click Events, Accessing Mouse):
+ Improve and clarify wording. (Bug#36232)
+
+2019-08-29 Mattias Engdegård <address@hidden>
+
+ Backport: Fix typo in regexp-opt example code
+
+ * doc/lispref/searching.texi (Regexp Functions):
+ Fix typo in example code (Bug#34596).
+
+2019-08-29 Stefan Kangas <address@hidden>
+
+ Remove outdated comment in winner.el (Bug#36185)
+
+ * lisp/winner.el: Remove outdated comment.
+
+2019-08-29 Michael Albinus <address@hidden>
+
+ Fix accidential change in tramp-tests; do not merge with master
+
+ * lisp/net/trampver.el: Change version to "2.3.5.26.3".
+ (customize-package-emacs-version-alist): Add Tramp version
+ integrated in Emacs 26.3.
+
+ * test/lisp/net/tramp-tests.el (tramp-test42-auto-load):
+ Add skip for w32.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ tramp-test42-auto-load: Add expected-result.
+
+ * test/lisp/net/tramp-tests.el (tramp-test42-auto-load):
+ Expect a failed result if remote file access is not enabled,
+ as it happens while doing the test on Windows.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ * test/lisp/url/url-file-tests.el (url-file): Use file:///, not file://.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ Fix doc of srecompile-compile-split-code (Bug#36200)
+
+ * lisp/cedet/srecode/compile.el (srecode-compile-split-code):
+ Remove leftover text from docstring.
+
+2019-08-29 Eric Abrahamsen <address@hidden>
+
+ Make sure Gnus imap group names are decoded before searching
+
+ do not merge (fix unnecessary in Emacs 27)
+
+ * lisp/gnus/nnir.el (nnir-run-imap): Ensure that non-ascii group names
+ have been fully decoded before passing them to imap search.
+
+2019-08-29 Eli Zaretskii <address@hidden>
+
+ Remove failing test erroneously added in backport
+
+ * test/src/thread-tests.el (threads-test-bug33073): Remove
+ test which cannot work on the emacs-26 branch. Do not merge
+ to master. Reported by Juanma Barranquero <address@hidden>.
+
+2019-08-29 Juanma Barranquero <address@hidden>
+
+ * lisp/net/sieve-manage.el (sieve-manage-parse-capability): Doc fix.
+
+2019-08-29 Nicolas Petton <address@hidden>
+
+ Bump Emacs version to 26.2.90
+
+ * README:
+ * configure.ac:
+ * msdos/sed2v2.inp:
+ * nt/README.W32: Bump Emacs version.
+
+2019-08-29 Nicolas Petton <address@hidden>
+
+ * etc/AUTHORS: Update.
+
+2019-08-29 Martin Rudalics <address@hidden>
2019-06-15 Martin Rudalics <address@hidden>
Fix description of 'display-buffer-in-previous-window' again (Bug#36161)
@@ -65974,7 +66523,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
-commit eca2677b1db94a126b6d2871526a1d6fce98353d (inclusive).
+commit a6d0172e8330a5683517eba78356d4c70ad979d7 (inclusive).
See ChangeLog.1 for earlier changes.
;; Local Variables:
diff --git a/GNUmakefile b/GNUmakefile
index a67624e..274109c 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -32,6 +32,38 @@
# But run 'autogen.sh' first, if the source was checked out directly
# from the repository.
+# Display help.
+
+ifeq (help,$(filter help,$(MAKECMDGOALS)))
+help:
+ @echo "NOTE: This is a brief summary of some common make targets."
+ @echo "For more detailed information, please read the files INSTALL,"
+ @echo "INSTALL.REPO, Makefile or visit this URL:"
+ @echo
"http://www.gnu.org/prep/standards/html_node/Standard-Targets.html";
+ @echo ""
+ @echo "make all -- compile and build Emacs"
+ @echo "make install -- install Emacs"
+ @echo "make TAGS -- update tags tables"
+ @echo "make clean -- delete built files but preserve
configuration"
+ @echo "make mostlyclean -- like 'make clean', but leave those
files that"
+ @echo " usually do not need to be recompiled"
+ @echo "make distclean -- delete all build and configuration
files,"
+ @echo " leave only files included in source
distribution"
+ @echo "make maintainer-clean -- delete almost everything that can be
regenerated"
+ @echo "make bootstrap -- delete all compiled files to force a
new bootstrap"
+ @echo " from a clean slate, then build in the
normal way"
+ @echo "make uninstall -- remove files installed by 'make
install'"
+ @echo "make check -- run the Emacs test suite"
+ @echo "make docs -- generate Emacs documentation in info
format"
+ @echo "make html -- generate documentation in html format"
+ @echo "make ps -- generate documentation in ps format"
+ @echo "make pdf -- generate documentation in pdf format "
+ @exit
+
+.PHONY: help
+
+else
+
# If a Makefile already exists, just use it.
ifeq ($(wildcard Makefile),Makefile)
@@ -82,3 +114,4 @@ bootstrap: Makefile
endif
endif
+endif
diff --git a/INSTALL b/INSTALL
index 6934022..86f9e00 100644
--- a/INSTALL
+++ b/INSTALL
@@ -109,6 +109,9 @@ sections if you need to.
(provided you have the 'gzip' program) those installed Lisp source (.el)
files that have corresponding .elc versions, as well as the Info files.
+ You can read a brief summary about common make targets:
+
+ make help
ADDITIONAL DISTRIBUTION FILES
diff --git a/admin/admin.el b/admin/admin.el
index d3a477f..5968e32 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -147,6 +147,10 @@ Root must be the root of an Emacs source tree."
(unless (> (length newversion) 2) ; pretest or release candidate?
(with-temp-buffer
(insert-file-contents newsfile)
+ (when (re-search-forward "^\\* [^\n]*\n+ " nil t)
+ (display-warning 'admin
+ "NEWS file contains empty sections - remove them?"))
+ (goto-char (point-min))
(if (re-search-forward "^\\(\\+\\+\\+ *\\|--- *\\)$" nil t)
(display-warning 'admin
"NEWS file still contains temporary markup.
diff --git a/build-aux/install-sh b/build-aux/install-sh
index 8175c64..20d8b2e 100755
--- a/build-aux/install-sh
+++ b/build-aux/install-sh
@@ -451,7 +451,18 @@ do
trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
# Copy the file name to the temp name.
- (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+ (umask $cp_umask &&
+ { test -z "$stripcmd" || {
+ # Create $dsttmp read-write so that cp doesn't create it read-only,
+ # which would cause strip to fail.
+ if test -z "$doit"; then
+ : >"$dsttmp" # No need to fork-exec 'touch'.
+ else
+ $doit touch "$dsttmp"
+ fi
+ }
+ } &&
+ $doit_exec $cpprog "$src" "$dsttmp") &&
# and set any options; do chmod last to preserve setuid bits.
#
diff --git a/configure.ac b/configure.ac
index 6c83d61..e822b0b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1731,26 +1731,6 @@ if test "${with_sound}" != "no"; then
ALSA_MODULES="alsa >= $ALSA_REQUIRED"
EMACS_CHECK_MODULES([ALSA], [$ALSA_MODULES])
if test $HAVE_ALSA = yes; then
- SAVE_CFLAGS="$CFLAGS"
- SAVE_LIBS="$LIBS"
- CFLAGS="$ALSA_CFLAGS $CFLAGS"
- LIBS="$ALSA_LIBS $LIBS"
- AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <asoundlib.h>]],
[[snd_lib_error_set_handler (0);]])],
- emacs_alsa_normal=yes,
- emacs_alsa_normal=no)
- if test "$emacs_alsa_normal" != yes; then
- AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <alsa/asoundlib.h>]],
- [[snd_lib_error_set_handler (0);]])],
- emacs_alsa_subdir=yes,
- emacs_alsa_subdir=no)
- if test "$emacs_alsa_subdir" != yes; then
- AC_MSG_ERROR([pkg-config found alsa, but it does not compile. See
config.log for error messages.])
- fi
- ALSA_CFLAGS="$ALSA_CFLAGS -DALSA_SUBDIR_INCLUDE"
- fi
-
- CFLAGS="$SAVE_CFLAGS"
- LIBS="$SAVE_LIBS"
LIBSOUND="$LIBSOUND $ALSA_LIBS"
CFLAGS_SOUND="$CFLAGS_SOUND $ALSA_CFLAGS"
AC_DEFINE(HAVE_ALSA, 1, [Define to 1 if ALSA is available.])
@@ -3308,7 +3288,8 @@ fi
# Check for XRender
HAVE_XRENDER=no
if test "${HAVE_X11}" = "yes"; then
- AC_CHECK_LIB(Xrender, XRenderQueryExtension, HAVE_XRENDER=yes)
+ AC_CHECK_HEADER([X11/extensions/Xrender.h],
+ [AC_CHECK_LIB([Xrender], [XRenderQueryExtension], [HAVE_XRENDER=yes])])
if test $HAVE_XRENDER = yes; then
XRENDER_LIBS="-lXrender"
AC_SUBST(XRENDER_LIBS)
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 990b82d..f7809d4 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -266,11 +266,12 @@ fringe (@pxref{Fringes}), the locus-visiting commands put
an arrow in
the fringe, pointing to the current error message. If the window has
no left fringe, such as on a text terminal, these commands scroll the
window so that the current message is at the top of the window. If
-you change the variable @code{compilation-context-lines} to an integer
-value @var{n}, these commands scroll the window so that the current
-error message is @var{n} lines from the top, whether or not there is a
-fringe; the default value, @code{nil}, gives the behavior described
-above.
+you change the variable @code{compilation-context-lines} to @code{t},
+a visible arrow is inserted before column zero instead. If you change
+the variable to an integer value @var{n}, these commands scroll the
+window so that the current error message is @var{n} lines from the
+top, whether or not there is a fringe; the default value, @code{nil},
+gives the behavior described above.
@vindex compilation-error-regexp-alist
@vindex grep-regexp-alist
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 8fbc6c1..0c2509e 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2220,28 +2220,18 @@ as a function from Lisp programs.
@cindex init file
@cindex .emacs file
@cindex ~/.emacs file
-@cindex ~/.config/emacs file
+@cindex ~/.config/emacs/init.el file
@cindex Emacs initialization file
@cindex startup (init file)
+@cindex XDG_CONFIG_HOME
When Emacs is started, it normally tries to load a Lisp program from
an @dfn{initialization file}, or @dfn{init file} for short. This
-file, if it exists, specifies how to initialize Emacs for you. Emacs
-looks for your init file using the filenames
-@file{~/.config/emacs},. @file{~/.emacs}, @file{~/.config/emacs.el},
-@file{~/.emacs.el}, @file{~/.config/emacs.d/init.el} or
-@file{~/.emacs.d/init.el}; you can choose to use any one of these
-names (@pxref{Find Init}). Here, @file{~/} stands for your home
-directory.
-
- While the @file{~/.emacs} and @file{~/.emacs.d/init.el} locations
-are backward-compatible to older Emacs versions, and the rest of this
-chapter will use them to name your initialization file, it is better practice
-to group all of your dotfiles under @file{.config} so that if you have
-to troubleshoot a problem that might be due to a bad init file, or
-archive a collection of them, it can be done by renaming or
-copying that directory. Note that the @file{.config} versions
-don't have a leading dot on the basename part of the file.
+file, if it exists, specifies how to initialize Emacs for you.
+If the file @file{~/.config/emacs/init.el} exists, it is used as the
+init file; otherwise Emacs may look at @file{~/.emacs.el},
+@file{~/.emacs}, @file{~/.emacs.d/init.el}, or other locations.
+@xref{Find Init}.
You can use the command line switch @samp{-q} to prevent loading
your init file, and @samp{-u} (or @samp{--user}) to specify a
@@ -2313,17 +2303,17 @@ function @code{setq} to set the variable
@code{fill-column}
You can set any Lisp variable with @code{setq}, but with certain
variables @code{setq} won't do what you probably want in the
-@file{.emacs} file. Some variables automatically become buffer-local
-when set with @code{setq}; what you want in @file{.emacs} is to set
+init file. Some variables automatically become buffer-local
+when set with @code{setq}; what you want in the init file is to set
the default value, using @code{setq-default}. Some customizable minor
mode variables do special things to enable the mode when you set them
with Customize, but ordinary @code{setq} won't do that; to enable the
-mode in your @file{.emacs} file, call the minor mode command. The
+mode in your init file, call the minor mode command. The
following section has examples of both of these methods.
The second argument to @code{setq} is an expression for the new
value of the variable. This can be a constant, a variable, or a
-function call expression. In @file{.emacs}, constants are used most
+function call expression. In the init file, constants are used most
of the time. They can be:
@table @asis
@@ -2646,25 +2636,49 @@ library. @xref{Hooks}.
@node Find Init
@subsection How Emacs Finds Your Init File
- Normally Emacs uses your home directory to find
-@file{~/.config/emacs} or @file{~/.emacs}; that's what @samp{~} means
-in a file name. @xref{General Variables, HOME}. If none of
-@file{~/.config/emacs}, @file{~/.emacs}, @file{~/.config/emacs.el} nor
-@file{~/.emacs.el} is found, Emacs looks for
-@file{~/.config/emacs.d/init.el} or @file{~/.emacs.d/init.el} (these,
-like @file{~/.emacs.el}, can be byte-compiled).
+ Emacs normally finds your init file in a location under your home
+directory. @xref{Init File}. By default this location is
+@file{~/.config/emacs/init.el} where @file{~/} stands for your home directory.
+This default can be overridden as described below.
+
+ If @env{XDG_CONFIG_HOME} is set in your environment, its
+value replaces @file{~/.config} in the name of the default
+init file.
+
+ If the default init file's parent directory does not exist but the
+directory @file{~/.emacs.d} does exist, Emacs looks for your init file
+using the filenames @file{~/.emacs.el}, @file{~/.emacs}, or
+@file{~/.emacs.d/init.el}; you can choose to use any one of these
+names. (Note that only the locations directly in your home directory
+have a leading dot in the location's basename.) Although this is
+backward-compatible with older Emacs versions, modern POSIX platforms
+prefer putting your initialization files under @file{~/.config} so
+that troubleshooting a problem that might be due to a bad init file,
+or archiving a collection of init files, can be done by renaming that
+directory. To help older Emacs versions find configuration files in
+their current default locations, you can execute the following
+Emacs Lisp code:
+
+@example
+(make-symbolic-link ".config/emacs" "~/.emacs.d")
+@end example
- However, if you run Emacs from a shell started by @code{su}, Emacs
+ However, if you run Emacs from a shell started by @code{su} and
+@env{XDG_CONFIG_HOME} is not set in your environment, Emacs
tries to find your own initialization files, not that of the user you are
currently pretending to be. The idea is that you should get your own
editor customizations even if you are running as the super user.
More precisely, Emacs first determines which user's init file to use.
It gets your user name from the environment variables @env{LOGNAME} and
-@env{USER}; if neither of those exists, it uses effective user-ID@.
+@env{USER}; if neither of those exists, it uses the effective user-ID@.
If that user name matches the real user-ID, then Emacs uses @env{HOME};
otherwise, it looks up the home directory corresponding to that user
name in the system's data base of users.
+
+ For brevity the rest of the Emacs documentation generally uses just
+the current default location @file{~/.config/emacs/init.el} for the
+init file.
@c LocalWords: backtab
@node Init Non-ASCII
@@ -2705,8 +2719,8 @@ Type @kbd{C-q}, followed by the key you want to bind, to
insert @var{char}.
@subsection The Early Init File
@cindex early init file
- Most customizations for Emacs should be put in the normal init file,
-@file{.config/emacs} or @file{~/.config/emacs.d/init.el}. However, it is
sometimes desirable
+ Most customizations for Emacs should be put in the normal init file.
+@xref{Init File}. However, it is sometimes desirable
to have customizations that take effect during Emacs startup earlier than the
normal init file is processed. Such customizations can be put in the early
init file, @file{~/.config/emacs.d/early-init.el} or
@file{~/.emacs.d/early-init.el}. This file is loaded before the
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index c6fe29e..e92a959 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -679,12 +679,12 @@ started editing (@pxref{Old Revisions}), type @kbd{C-c
C-d}
(@code{log-edit-show-diff}).
@kindex C-c C-w @r{(Log Edit mode)}
-@findex log-edit-generate-changelog
+@findex log-edit-generate-changelog-from-diff
To help generate ChangeLog entries, type @kbd{C-c C-w}
-(@code{log-edit-generate-changelog}), to generate skeleton ChangeLog
-entries, listing all changed file and function names based on the diff
-of the VC fileset. Consecutive entries left empty will be combined by
-@kbd{C-q} (@code{fill-paragraph}).
+(@code{log-edit-generate-changelog-from-diff}), to generate skeleton
+ChangeLog entries, listing all changed file and function names based
+on the diff of the VC fileset. Consecutive entries left empty will be
+combined by @kbd{C-q} (@code{fill-paragraph}).
@kindex C-c C-a @r{(Log Edit mode)}
@findex log-edit-insert-changelog
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 5877c4b..83fb8ac 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -302,7 +302,10 @@ the Transport Layer Security (@acronym{TLS}) features.
@vindex network-security-level
The @code{network-security-level} variable determines the security
level that @acronym{NSM} enforces. If its value is @code{low}, no
-security checks are performed.
+security checks are performed. This is not recommended, and will
+basically mean that your network connections can't be trusted.
+However, the setting can be useful in limited circumstances, as when
+testing network issues.
If this variable is @code{medium} (which is the default), a number of
checks will be performed. If as result @acronym{NSM} determines that
@@ -325,13 +328,12 @@ The protocol network checks is controlled via the
@code{network-security-protocol-checks} variable.
It's an alist where the first element of each association is the name
-of the check, the second element is the security level where the check
-should be used, and the optional third element is a parameter supplied
-to the check.
+of the check, and the second element is the security level where the
+check should be used.
An element like @code{(rc4 medium)} will result in the function
@code{nsm-protocol-check--rc4} being called like thus:
-@w{@code{(nsm-protocol-check--rc4 host port status optional-parameter)}}.
+@w{@code{(nsm-protocol-check--rc4 host port status settings)}}.
The function should return non-@code{nil} if the connection should
proceed and @code{nil} otherwise.
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index e4a500b..822066f 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -418,7 +418,7 @@ already set or has been customized; otherwise, just use
@code{set-default}.
@item custom-initialize-delay
-This functions behaves like @code{custom-initialize-set}, but it
+This function behaves like @code{custom-initialize-set}, but it
delays the actual initialization to the next Emacs start. This should
be used in files that are preloaded (or for autoloaded variables), so
that the initialization is done in the run-time context rather than
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index aa99b2b..b25fb99 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -140,8 +140,10 @@ emacs, The GNU Emacs Manual}.
The message is @samp{Invalid function}. @xref{Function Indirection}.
@item invalid-read-syntax
-The message is @samp{Invalid read syntax}. @xref{Printed
-Representation}.
+The message is usually @samp{Invalid read syntax}. @xref{Printed
+Representation}. This error can also be raised by commands like
+@code{eval-expression} when there's text following an expression. In
+that case, the message is @samp{Trailing garbage following expression}.
@item invalid-regexp
The message is @samp{Invalid regexp}. @xref{Regular Expressions}.
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 6be5a52..18a1f49 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2822,8 +2822,10 @@ filter out a directory named @file{foo.elc}.
name for a particular use---typically, to hold configuration data
specified by the current user. Usually, such files should be located
in the directory specified by @code{user-emacs-directory}, which is
-@file{~/.emacs.d} by default (@pxref{Init File}). For example, abbrev
-definitions are stored by default in @file{~/.emacs.d/abbrev_defs}.
+typically @file{~/.config/emacs/} or @file{~/.emacs.d/} by default (@pxref{Find
+Init,,How Emacs Finds Your Init File, emacs, The GNU Emacs Manual}).
+For example, abbrev definitions are stored by default in
+@file{~/.config/emacs/abbrev_defs} or @file{~/.emacs.d/abbrev_defs}.
The easiest way to specify such a file name is to use the function
@code{locate-user-emacs-file}.
diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi
index f775aa4..4542db9 100644
--- a/doc/lispref/hooks.texi
+++ b/doc/lispref/hooks.texi
@@ -160,6 +160,9 @@ The command loop runs this soon after
@code{post-command-hook} (q.v.).
@item frame-auto-hide-function
@xref{Quitting Windows}.
+@item quit-window-hook
+@xref{Quitting Windows}.
+
@item kill-buffer-hook
@itemx kill-buffer-query-functions
@xref{Killing Buffers}.
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 764a67e..7185c24 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1783,12 +1783,12 @@ don't need any.
(hungry-electric-delete t)))))
@end smallexample
-@defmac define-globalized-minor-mode global-mode mode turn-on
keyword-args@dots{}
+@defmac define-globalized-minor-mode global-mode mode turn-on
keyword-args@dots{} body@dots{}
This defines a global toggle named @var{global-mode} whose meaning is
to enable or disable the buffer-local minor mode @var{mode} in all
-buffers. To turn on the minor mode in a buffer, it uses the function
-@var{turn-on}; to turn off the minor mode, it calls @var{mode} with
-@minus{}1 as argument.
+buffers. It also executes the @var{body} forms. To turn on the minor
+mode in a buffer, it uses the function @var{turn-on}; to turn off the
+minor mode, it calls @var{mode} with @minus{}1 as argument.
Globally enabling the mode also affects buffers subsequently created
by visiting files, and buffers that use a major mode other than
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 49c0738..c94e96b 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -473,8 +473,14 @@ the value refers to the corresponding source file.
@end defvar
@defvar user-emacs-directory
-This variable holds the name of the @file{.emacs.d} directory. It is
-@file{~/.emacs.d} on all platforms but MS-DOS.
+This variable holds the name of the Emacs default directory.
+It defaults to @file{$@{XDG_CONFIG_HOME-'~/.config'@}/emacs/}
+if that directory exists and @file{~/.emacs.d/} does not exist,
+otherwise to @file{~/.emacs.d/} on all platforms but MS-DOS@.
+Here, @file{$@{XDG_CONFIG_HOME-'~/.config'@}}
+stands for the value of the environment variable @env{XDG_CONFIG_HOME}
+if that variable is set, and for @file{~/.config} otherwise.
+@xref{Find Init,,How Emacs Finds Your Init File, emacs, The GNU Emacs Manual}.
@end defvar
@node Terminal-Specific
@@ -1346,6 +1352,8 @@ given, specifies a time to convert instead of the current
time.
@emph{Warning}: Since the result is floating point, it may not be
exact. Do not use this function if precise time stamps are required.
+For example, on typical systems @code{(float-time '(1 . 10))} displays
+as @samp{0.1} but is slightly greater than 1/10.
@code{time-to-seconds} is an alias for this function.
@end defun
@@ -1432,8 +1440,6 @@ as traditional Gregorian years do; for example, the year
number
@defun time-convert time &optional form
This function converts a time value into a Lisp timestamp.
-If the time cannot be represented exactly, it is truncated
-toward minus infinity.
The optional @var{form} argument specifies the timestamp form to be
returned. If @var{form} is the symbol @code{integer}, this function
@@ -1452,8 +1458,17 @@ Although an omitted or @code{nil} @var{form} currently
acts like
@code{list}, this is planned to change in a future Emacs version, so
callers requiring list timestamps should pass @code{list} explicitly.
-If @var{time} already has the proper form, this function might yield
-@var{time} rather than a copy.
+If @var{time} is infinite or a NaN, this function signals an error.
+Otherwise, if @var{time} cannot be represented exactly, conversion
+truncates it toward minus infinity. When @var{form} is @code{t},
+conversion is always exact so no truncation occurs, and the returned
+clock resolution is no less than that of @var{time}. By way of
+contrast, @code{float-time} can convert any Lisp time value without
+signaling an error, although the result might not be exact.
+@xref{Time of Day}.
+
+For efficiency this function might return a value that is @code{eq} to
+@var{time}, or that otherwise shares structure with @var{time}.
Although @code{(time-convert nil nil)} is equivalent to
@code{(current-time)}, the latter may be a bit faster.
@@ -1950,16 +1965,18 @@ The result is @code{nil} if either argument is a NaN.
@defun time-subtract t1 t2
This returns the time difference @var{t1} @minus{} @var{t2} between
-two time values, as a time value. However, the result is a float
-if either argument is a float infinity or NaN@.
+two time values, normally as a Lisp timestamp but as a float
+if either argument is infinite or a NaN@.
+When the result is a timestamp, it is exact and its clock
+resolution is no worse than the worse of its two arguments' resolutions.
If you need the difference in units
-of elapsed seconds, use @code{float-time} (@pxref{Time of Day,
-float-time}) to convert the result into seconds.
+of elapsed seconds, you can convert it with @code{time-convert} or
+@code{float-time}. @xref{Time Conversion}.
@end defun
@defun time-add t1 t2
-This returns the sum of two time values, as a time value.
-However, the result is a float if either argument is a float infinity or NaN@.
+This returns the sum of two time values,
+using the same conversion rules as @code{time-subtract}.
One argument should represent a time difference rather than a point in time,
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:
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 21bc32e..61de77d 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3005,6 +3005,21 @@ If the vector does not include the port number, @var{p},
or if
@code{:@var{p}} suffix.
@end defun
+@defun network-lookup-address-info name &optional family
+This function is used to perform hostname lookups on @var{name}, which
+is expected to be an ASCII-only string, otherwise an error is
+signaled. Call @code{puny-encode-domain} on @var{name}
+first if you wish to lookup internationalized hostnames.
+
+If successful it returns a list of Lisp representations of network
+addresses, otherwise it returns @code{nil}.
+
+By default both IPv4 and IPv6 lookups are attempted. The optional
+argument @var{family} controls this behavior, specifying the symbol
+@code{ipv4} or @code{ipv6} restricts lookups to IPv4 and IPv6
+respectively.
+@end defun
+
@node Serial Ports
@section Communicating with Serial Ports
@cindex @file{/dev/tty}
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 157f004..39d3960 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -4034,6 +4034,10 @@ This command quits @var{window} and buries its buffer.
The argument
With prefix argument @var{kill} non-@code{nil}, it kills the buffer
instead of burying it. It calls the function @code{quit-restore-window}
described next to deal with the window and its buffer.
+
+@vindex quit-window-hook
+The functions in @code{quit-window-hook} are run before doing anything
+else.
@end deffn
@defun quit-restore-window &optional window bury-or-kill
@@ -4043,10 +4047,6 @@ the selected one. The function's behavior is determined
by the four
elements of the list specified by @var{window}'s @code{quit-restore}
parameter (@pxref{Window Parameters}).
-@vindex quit-window-hook
-The functions in @code{quit-window-hook} are run before doing anything
-else.
-
The first element of the @code{quit-restore} parameter is one of the
symbols @code{window}, meaning that the window has been specially
created by @code{display-buffer}; @code{frame}, a separate frame has
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 8fd3bf3..e5673da 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -34,7 +34,7 @@ the FAQ may not be embedded in a larger literary work unless
that work
itself allows free copying and redistribution.
[This version has been heavily edited since it was included in the Emacs
-distribution.]
+distribution in 1999.]
@end quotation
@end copying
@@ -1687,11 +1687,21 @@ mode-line-format @key{RET}}) for more information on
how to set and use
this variable.
@cindex Set number capability in @code{vi} emulators
-The @samp{linum} package (distributed with Emacs since version 23.1)
-displays line numbers in the left margin, like the ``set number''
-capability of @code{vi}. The packages @samp{setnu} and
-@samp{wb-line-number} (not distributed with Emacs) also implement this
-feature.
+The @samp{display-line-numbers} package (added to Emacs in version
+26.1) displays line numbers in the text area, before each line, like
+the ``set number'' capability of @samp{vi}. Customize the
+buffer-local variable @code{display-line-numbers} to activate this
+optional display. Alternatively, you can use the
+@code{display-line-numbers-mode} minor mode or the global
+@code{global-display-line-numbers-mode}. When using these modes,
+customize @code{display-line-numbers-type} with the same value as you
+would use with @code{display-line-numbers}.
+
+There is also the @samp{linum} package (distributed with Emacs since
+version 23.1) which will henceforth become obsolete. Users and
+developers are encouraged to use @samp{display-line-numbers} instead.
+The packages @samp{setnu} and @samp{wb-line-number} (not distributed
+with Emacs) also implement this feature.
@node Displaying the current file name in the titlebar
@section How can I modify the titlebar to contain the current file name?
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index eb829b0..131a358 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -1568,7 +1568,7 @@ Here's a bunch of time/date/second/day examples:
(time-subtract '(905595714000000 . 1000000)
'(905595593000000000 . 1000000000))
-@result{} (121000000000 . 1000000000)
+@result{} (121000000 . 1000000)
(days-between "Sat Sep 12 12:21:54 1998 +0200"
"Sat Sep 07 12:21:54 1998 +0200")
diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi
index 29a204c..a787b74 100644
--- a/doc/misc/ido.texi
+++ b/doc/misc/ido.texi
@@ -108,7 +108,7 @@ This document describes a set of features that can
interactively do
things with buffers and files. All the features are described here
in detail.
-The @dfn{Ido} package can let you switch between buffers and visit
+The @dfn{Ido} package lets you switch between buffers and visit
files and directories with a minimum of keystrokes. It is a superset
of Iswitchb, the interactive buffer switching package by Stephen
Eglen.
@@ -211,7 +211,7 @@ do with various kinds of @emph{matching}: among buffers,
files, and directories.
@noindent
As you type in a substring, the list of buffers or files currently
-matching the substring are displayed as you type. The list is
+matching the substring is displayed as you type. The list is
ordered so that the most recent buffers or files visited come at
the start of the list.
@@ -240,13 +240,13 @@ If you then press @kbd{2}:
Buffer: 2[3]@{123456 | 123@}
@end example
-The list in @{...@} are the matching buffers, most recent first
-(buffers visible in the current frame are put at the end of the list
-by default). At any time you can select the item at the head of the
-list by pressing @key{RET}. You can also put the first element at the
-end of the list by pressing @kbd{C-s} or @kbd{<right>}, or bring the
-last element to the head of the list by pressing @kbd{C-r} or
-@kbd{<left>}.
+The items listed in @{...@} are the matching buffers, most recent
+first (buffers visible in the current frame are put at the end of the
+list by default). At any time you can select the item at the head of
+the list by pressing @key{RET}. You can also put the first element at
+the end of the list by pressing @kbd{C-s} or @key{RIGHT}, or bring
+the last element to the head of the list by pressing @kbd{C-r} or
+@key{LEFT}.
@findex ido-complete
The item in [...] indicates what can be added to your input by
@@ -287,7 +287,7 @@ Buffer: 234a [No match]
There are no matching buffers. If you press @key{RET} or @key{TAB},
you can be prompted to create a new buffer called @file{234a}.
-Of course, where this function comes in really useful is when you can
+Of course, where this function really comes in handy is when you can
specify the buffer using only a few keystrokes. In the above example,
the quickest way to get to the @file{123456} file would be just to
type @kbd{4} and then @key{RET} (assuming there isn't any newer buffer
@@ -305,7 +305,7 @@ In addition to scrolling through the list using
@kbd{<right>} and
@kbd{<left>}, you can use @kbd{<up>} and @kbd{<down>} to quickly
scroll the list to the next or previous subdirectory.
-To go down into a subdirectory, and continue the file selection on
+To go down into a subdirectory and continue the file selection on
the files in that directory, simply move the directory to the head
of the list and hit @key{RET}.
@@ -366,9 +366,9 @@ If for some reason you cannot specify the proper file using
@noindent
The standard way of completion with *nix shells and Emacs is to insert
a @dfn{prefix} and then hitting @key{TAB} (or another completion key).
-Cause of this behavior has become second nature to a lot of Emacs
-users Ido offers in addition to the default substring matching method
-(look above) also the prefix matching method. The kind of matching is
+Because this behavior has become second nature to a lot of Emacs
+users, Ido offers, in addition to the default substring matching method
+(see above), also the prefix matching method. The kind of matching is
the only difference to the description of the substring matching
above.
@@ -425,7 +425,7 @@ matching. The value of this user option can be toggled
within
ido-mode using @code{ido-toggle-regexp}.
@end defopt
-@strong{Please notice:} Ido-style completion is inhibited when you
+@strong{Please note:} Ido-style completion is inhibited when you
enable regexp matching.
@node Highlighting
@@ -438,21 +438,21 @@ The highlighting of matching items is controlled via
@code{ido-use-faces}. The faces used are @code{ido-first-match},
@code{ido-only-match} and @code{ido-subdir}.
-Coloring of the matching item was suggested by Carsten Dominik.
+Coloring of the matching items was suggested by Carsten Dominik.
@node Hidden Buffers and Files
@chapter Hidden Buffers and Files
@cindex hidden buffers and files
-Normally, Ido does not include hidden buffers (whose name starts with
-a space) and hidden files and directories (whose name starts with
-@samp{.}) in the list of possible completions. However, if the
+Normally, Ido does not include hidden buffers (whose names start with
+a space) and hidden files and directories (whose names start with
+@file{.}) in the list of possible completions. However, if the
substring you enter does not match any of the visible buffers or
files, Ido will automatically look for completions among the hidden
buffers or files.
@findex ido-toggle-ignore
-You can toggle display of the hidden buffers and files with @kbd{C-a}
+You can toggle the display of hidden buffers and files with @kbd{C-a}
(@code{ido-toggle-ignore}).
@c @deffn Command ido-toggle-ignore
@@ -525,7 +525,7 @@ deleting or rearranging elements.)
@noindent
Find File At Point, also known generally as ``ffap'', is an
-intelligent system for opening files, and URLs.
+intelligent system for opening files and URLs.
The following expression will make Ido guess the context:
@@ -552,7 +552,7 @@ a URL at point. If found, call @code{find-file-at-point}
to visit it.
@noindent
Ido is capable of ignoring buffers, directories, files and extensions
-using regular expression.
+using regular expressions.
@defopt ido-ignore-buffers
This variable takes a list of regular expressions for buffers to
@@ -590,7 +590,7 @@ Now you can customize @code{completion-ignored-extensions}
as well.
Go ahead and add all the useless object files, backup files, shared
library files and other computing flotsam you don't want Ido to show.
-@strong{Please notice:} Ido will still complete the ignored elements
+@strong{Note:} Ido will still complete the ignored elements
if it would otherwise not show any other matches. So if you type out
the name of an ignored file, Ido will still let you open it just fine.
@@ -718,7 +718,7 @@ packages.
After @kbd{C-x b} (@code{ido-switch-buffer}), the buffer at the head
of the list can be killed by pressing @kbd{C-k}. If the buffer needs
saving, you will be queried before the buffer is killed. @kbd{C-S-b}
-buries the buffer at the head of the list.
+buries the buffer at the end of the list.
Likewise, after @kbd{C-x C-f}, you can delete (i.e., physically
remove) the file at the head of the list with @kbd{C-k}. You will
@@ -726,8 +726,8 @@ always be asked for confirmation before deleting the file.
If you enter @kbd{C-x b} to switch to a buffer visiting a given file,
and you find that the file you are after is not in any buffer, you can
-press @kbd{C-f} to immediately drop into @code{ido-find-file}. And
-you can switch back to buffer selection with @kbd{C-b}.
+press @kbd{C-f} to immediately drop into @code{ido-find-file}. You
+can switch back to buffer selection with @kbd{C-b}.
@c @deffn Command ido-magic-forward-char
@c @deffn Command ido-magic-backward-char
@@ -759,7 +759,7 @@ want Ido to behave differently from the default minibuffer
resizing
behavior, set the variable @code{ido-max-window-height}.
Also, to improve the responsiveness of Ido, the maximum number of
-matching items is limited to 12, but you can increase or removed this
+matching items is limited to 12, but you can increase or remove this
limit via the @code{ido-max-prospects} user option.
@c @defopt ido-max-prospects
@@ -774,7 +774,7 @@ this separate buffer.
@noindent
@code{ido-read-buffer} and @code{ido-read-file-name} have been written
-to be drop in replacements for the normal buffer and file name reading
+to be drop-in replacements for the normal buffer and file name reading
functions @code{read-buffer} and @code{read-file-name}.
To use ido for all buffer and file selections in Emacs, customize the
diff --git a/doc/misc/info.texi b/doc/misc/info.texi
index e69779a..077e83e 100644
--- a/doc/misc/info.texi
+++ b/doc/misc/info.texi
@@ -886,6 +886,14 @@ which the header says is the @samp{Previous} node (from
this node, the
to revisit nodes in the history list in the forward direction, so that
@kbd{r} will return you to the node you came from by typing @kbd{l}.
+@cindex using tool-bar to navigate history
+ Clicking the mouse on the left arrow icon in the tool-bar while
+holding down the @key{CTRL} key in Emacs opens a menu of previously
+visited nodes: the same nodes that you can revisit by
+@code{Info-history-back}. Selecting a node after clicking on the
+right arrow icon revisits the same nodes as available by
+@code{Info-history-forward}.
+
@kindex L @r{(Info mode)}
@findex Info-history
@cindex history list of visited nodes
@@ -929,10 +937,9 @@ is @code{Info-top-node}.
@section Quitting Info
@kindex q @r{(Info mode)}
-@findex Info-exit
@cindex quitting Info mode
To get out of Info, back to what you were doing before, type @kbd{q}
-for @dfn{Quit}. This runs @code{Info-exit} in Emacs.
+for @dfn{Quit}. This runs @code{quit-window} in Emacs.
This is the end of the basic course on using Info. You have learned
how to move in an Info document, and how to follow menus and cross
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index ed3f0ee..d2e895f 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -1,9 +1,9 @@
% texinfo.tex -- TeX macros to handle Texinfo files.
-%
+%
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2019-06-01.23}
+\def\texinfoversion{2019-08-18.20}
%
% Copyright 1985, 1986, 1988, 1990-2019 Free Software Foundation, Inc.
%
@@ -218,7 +218,7 @@
% @errormsg{MSG}. Do the index-like expansions on MSG, but if things
% aren't perfect, it's not the end of the world, being an error message,
% after all.
-%
+%
\def\errormsg{\begingroup \indexnofonts \doerrormsg}
\def\doerrormsg#1{\errmessage{#1}}
@@ -323,9 +323,9 @@
% the output routine. The saved contents are valid until we actually
% \shipout a page.
%
-% (We used to run a short output routine to actually set \topmark and
-% \firstmark to the right values, but if this was called with an empty page
-% containing whatsits for writing index entries, the whatsits would be thrown
+% (We used to run a short output routine to actually set \topmark and
+% \firstmark to the right values, but if this was called with an empty page
+% containing whatsits for writing index entries, the whatsits would be thrown
% away and the index auxiliary file would remain empty.)
%
\newtoks\savedtopmark
@@ -365,7 +365,7 @@
\let\thischapterheading\thischapter
\else
% \thischapterheading is the same as \thischapter except it is blank
- % for the first page of a chapter. This is to prevent the chapter name
+ % for the first page of a chapter. This is to prevent the chapter name
% being shown twice.
\def\thischapterheading{}%
\fi
@@ -448,7 +448,7 @@
}%
}
-% First remove any @comment, then any @c comment. Pass the result on to
+% First remove any @comment, then any @c comment. Pass the result on to
% \argcheckspaces.
\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm}
\def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm}
@@ -1137,7 +1137,7 @@ where each line of input produces a line of output.}
% for display in the outlines, and in other places. Thus, we have to
% double any backslashes. Otherwise, a name like "\node" will be
% interpreted as a newline (\n), followed by o, d, e. Not good.
-%
+%
% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and
% related messages. The final outcome is that it is up to the TeX user
% to double the backslashes and otherwise make the string valid, so
@@ -1442,7 +1442,7 @@ output) for that.)}
% their "best" equivalent, based on the @documentencoding. Too
% much work for too little return. Just use the ASCII equivalents
% we use for the index sort strings.
- %
+ %
\indexnofonts
\setupdatafile
% We can have normal brace characters in the PDF outlines, unlike
@@ -2726,7 +2726,7 @@ end
}
% Commands to set the quote options.
-%
+%
\parseargdef\codequoteundirected{%
\def\temp{#1}%
\ifx\temp\onword
@@ -2767,7 +2767,7 @@ end
% If we are in a monospaced environment, however, 1) always use \ttsl,
% and 2) do not add an italic correction.
\def\dosmartslant#1#2{%
- \ifusingtt
+ \ifusingtt
{{\ttsl #2}\let\next=\relax}%
{\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}%
\next
@@ -2914,14 +2914,14 @@ end
\gdef\codedash{\futurelet\next\codedashfinish}
\gdef\codedashfinish{%
\normaldash % always output the dash character itself.
- %
+ %
% Now, output a discretionary to allow a line break, unless
% (a) the next character is a -, or
% (b) the preceding character is a -.
% E.g., given --posix, we do not want to allow a break after either -.
% Given --foo-bar, we do want to allow a break between the - and the b.
\ifx\next\codedash \else
- \ifx\codedashprev\codedash
+ \ifx\codedashprev\codedash
\else \discretionary{}{}{}\fi
\fi
% we need the space after the = for the case when \next itself is a
@@ -3003,7 +3003,7 @@ end
% For pdfTeX and LuaTeX
\ifurefurlonlylink
% PDF plus option to not display url, show just arg
- \unhbox0
+ \unhbox0
\else
% PDF, normally display both arg and url for consistency,
% visibility, if the pdf is eventually used to print, etc.
@@ -3016,7 +3016,7 @@ end
% For XeTeX
\ifurefurlonlylink
% PDF plus option to not display url, show just arg
- \unhbox0
+ \unhbox0
\else
% PDF, normally display both arg and url for consistency,
% visibility, if the pdf is eventually used to print, etc.
@@ -3074,10 +3074,10 @@ end
}
}
-% By default we'll break after the special characters, but some people like to
-% break before the special chars, so allow that. Also allow no breaking at
+% By default we'll break after the special characters, but some people like to
+% break before the special chars, so allow that. Also allow no breaking at
% all, for manual control.
-%
+%
\parseargdef\urefbreakstyle{%
\def\txiarg{#1}%
\ifx\txiarg\wordnone
@@ -3095,7 +3095,7 @@ end
\def\wordbefore{before}
\def\wordnone{none}
-% Allow a ragged right output to aid breaking long URL's. Putting stretch in
+% Allow a ragged right output to aid breaking long URL's. Putting stretch in
% between characters of the URL doesn't look good.
\def\urefallowbreak{%
\hskip 0pt plus 4 em\relax
@@ -3299,7 +3299,7 @@ end
% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}.
% Ignore unless FMTNAME == tex; then it is like @iftex and @tex,
% except specified as a normal braced arg, so no newlines to worry about.
-%
+%
\def\outfmtnametex{tex}
%
\long\def\inlinefmt#1{\doinlinefmt #1,\finish}
@@ -3307,7 +3307,7 @@ end
\def\inlinefmtname{#1}%
\ifx\inlinefmtname\outfmtnametex \ignorespaces #2\fi
}
-%
+%
% @inlinefmtifelse{FMTNAME,THEN-TEXT,ELSE-TEXT} expands THEN-TEXT if
% FMTNAME is tex, else ELSE-TEXT.
\long\def\inlinefmtifelse#1{\doinlinefmtifelse #1,,,\finish}
@@ -3323,7 +3323,7 @@ end
% *right* brace they would have to use a command anyway, so they may as
% well use a command to get a left brace too. We could re-use the
% delimiter character idea from \verb, but it seems like overkill.
-%
+%
\long\def\inlineraw{\tex \doinlineraw}
\long\def\doinlineraw#1{\doinlinerawtwo #1,\finish}
\def\doinlinerawtwo#1,#2,\finish{%
@@ -3600,7 +3600,7 @@ end
% for non-CM glyphs. That is ec* for regular text and tc* for the text
% companion symbols (LaTeX TS1 encoding). Both are part of the ec
% package and follow the same conventions.
-%
+%
\def\ecfont{\etcfont{e}}
\def\tcfont{\etcfont{t}}
%
@@ -3672,7 +3672,7 @@ end
after the title page.}}%
\def\setshortcontentsaftertitlepage{%
\errmessage{@setshortcontentsaftertitlepage has been removed as a Texinfo
- command; move your @shortcontents and @contents commands if you
+ command; move your @shortcontents and @contents commands if you
want the contents after the title page.}}%
\parseargdef\shorttitlepage{%
@@ -3727,7 +3727,7 @@ end
% don't worry much about spacing, ragged right. This should be used
% inside a \vbox, and fonts need to be set appropriately first. \par should
% be specified before the end of the \vbox, since a vbox is a group.
-%
+%
\def\raggedtitlesettings{%
\rm
\hyphenpenalty=10000
@@ -4350,7 +4350,7 @@ end
}
% multitable-only commands.
-%
+%
% @headitem starts a heading row, which we typeset in bold. Assignments
% have to be global since we are inside the implicit group of an
% alignment entry. \everycr below resets \everytab so we don't have to
@@ -4669,13 +4669,13 @@ end
% Like \expandablevalue, but completely expandable (the \message in the
% definition above operates at the execution level of TeX). Used when
% writing to auxiliary files, due to the expansion that \write does.
-% If flag is undefined, pass through an unexpanded @value command: maybe it
+% If flag is undefined, pass through an unexpanded @value command: maybe it
% will be set by the time it is read back in.
%
% NB flag names containing - or _ may not work here.
\def\dummyvalue#1{%
\expandafter\ifx\csname SET#1\endcsname\relax
- \noexpand\value{#1}%
+ \string\value{#1}%
\else
\csname SET#1\endcsname
\fi
@@ -4693,7 +4693,7 @@ end
% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined
% with @set.
-%
+%
% To get the special treatment we need for `@end ifset,' we call
% \makecond and then redefine.
%
@@ -4726,7 +4726,7 @@ end
% without the @) is in fact defined. We can only feasibly check at the
% TeX level, so something like `mathcode' is going to considered
% defined even though it is not a Texinfo command.
-%
+%
\makecond{ifcommanddefined}
\def\ifcommanddefined{\parsearg{\doifcmddefined{\let\next=\ifcmddefinedfail}}}
%
@@ -4834,8 +4834,8 @@ end
\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx}
\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}}
-
-% Used for the aux, toc and index files to prevent expansion of Texinfo
+
+% Used for the aux, toc and index files to prevent expansion of Texinfo
% commands.
%
\def\atdummies{%
@@ -5180,7 +5180,7 @@ end
}
\def\defglyph#1#2{\def#1##1{#2}} % see above
-
+
% #1 is the index name, #2 is the entry text.
@@ -5207,7 +5207,7 @@ end
\ifx\suffix\indexisfl\def\suffix{f1}\fi
% Open the file
\immediate\openout\csname#1indfile\endcsname \jobname.\suffix
- % Using \immediate above here prevents an object entering into the current
+ % Using \immediate above here prevents an object entering into the current
% box, which could confound checks such as those in \safewhatsit for
% preceding skips.
\typeout{Writing index file \jobname.\suffix}%
@@ -5259,7 +5259,7 @@ end
\ifx\segment\isfinish
\else
%
- % Fully expand the segment, throwing away any @sortas directives, and
+ % Fully expand the segment, throwing away any @sortas directives, and
% trim spaces.
\edef\trimmed{\segment}%
\edef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}%
@@ -5317,12 +5317,12 @@ end
% the current value of \escapechar.
\def\escapeisbackslash{\escapechar=`\\}
-% Use \ in index files by default. texi2dvi didn't support @ as the escape
-% character (as it checked for "\entry" in the files, and not "@entry"). When
-% the new version of texi2dvi has had a chance to become more prevalent, then
-% the escape character can change back to @ again. This should be an easy
-% change to make now because both @ and \ are only used as escape characters
in
-% index files, never standing for themselves.
+% Use \ in index files by default. texi2dvi didn't support @ as the escape
+% character (as it checked for "\entry" in the files, and not "@entry"). When
+% the new version of texi2dvi has had a chance to become more prevalent, then
+% the escape character can change back to @ again. This should be an easy
+% change to make now because both @ and \ are only used as escape characters in
+% index files, never standing for themselves.
%
\set txiindexescapeisbackslash
@@ -5342,7 +5342,7 @@ end
\def\}{\rbracechar{}}%
\uccode`\~=`\\ \uppercase{\def~{\backslashchar{}}}%
%
- % Split the entry into primary entry and any subentries, and get the index
+ % Split the entry into primary entry and any subentries, and get the index
% sort key.
\splitindexentry\indextext
%
@@ -5523,18 +5523,18 @@ end
\uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1
\expandafter\ifx\csname SETtxiskipindexfileswithbackslash\endcsname\relax
\errmessage{%
-ERROR: A sorted index file in an obsolete format was skipped.
+ERROR: A sorted index file in an obsolete format was skipped.
To fix this problem, please upgrade your version of 'texi2dvi'
or 'texi2pdf' to that at <https://ftp.gnu.org/gnu/texinfo>.
-If you are using an old version of 'texindex' (part of the Texinfo
+If you are using an old version of 'texindex' (part of the Texinfo
distribution), you may also need to upgrade to a newer version (at least 6.0).
You may be able to typeset the index if you run
'texindex \jobname.\indexname' yourself.
-You could also try setting the 'txiindexescapeisbackslash' flag by
+You could also try setting the 'txiindexescapeisbackslash' flag by
running a command like
-'texi2dvi -t "@set txiindexescapeisbackslash" \jobname.texi'. If you do
+'texi2dvi -t "@set txiindexescapeisbackslash" \jobname.texi'. If you do
this, Texinfo will try to use index files in the old format.
-If you continue to have problems, deleting the index files and starting again
+If you continue to have problems, deleting the index files and starting again
might help (with 'rm \jobname.?? \jobname.??s')%
}%
\else
@@ -5603,7 +5603,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% bottom of a column to reduce an increase in inter-line spacing.
\nobreak
\vskip 0pt plus 5\baselineskip
- \penalty -300
+ \penalty -300
\vskip 0pt plus -5\baselineskip
%
% Typeset the initial. Making this add up to a whole number of
@@ -5719,7 +5719,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\advance\dimen@ii by 1\dimen@i
\ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line
\ifdim\dimen@ > 0.8\dimen@ii % due to long index text
- % Try to split the text roughly evenly. \dimen@ will be the length of
+ % Try to split the text roughly evenly. \dimen@ will be the length of
% the first line.
\dimen@ = 0.7\dimen@
\dimen@ii = \hsize
@@ -5927,7 +5927,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\newbox\balancedcolumns
\setbox\balancedcolumns=\vbox{shouldnt see this}%
%
-% Only called for the last of the double column material. \doublecolumnout
+% Only called for the last of the double column material. \doublecolumnout
% does the others.
\def\balancecolumns{%
\setbox0 = \vbox{\unvbox\PAGE}% like \box255 but more efficient, see p.120.
@@ -5955,7 +5955,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}%
% Now the left column is in box 1, and the right column in box 3.
%
- % Check whether the left column has come out higher than the page itself.
+ % Check whether the left column has come out higher than the page itself.
% (Note that we have doubled \vsize for the double columns, so
% the actual height of the page is 0.5\vsize).
\ifdim2\ht1>\vsize
@@ -6252,7 +6252,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\let\top\unnumbered
% Sections.
-%
+%
\outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz
\def\seczzz#1{%
\global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1
@@ -6275,7 +6275,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
% Subsections.
-%
+%
% normally calls numberedsubseczzz:
\outer\parseargdef\numberedsubsec{\numhead2{#1}}
\def\numberedsubseczzz#1{%
@@ -6300,7 +6300,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
% Subsubsections.
-%
+%
% normally numberedsubsubseczzz:
\outer\parseargdef\numberedsubsubsec{\numhead3{#1}}
\def\numberedsubsubseczzz#1{%
@@ -7358,7 +7358,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% @indentedblock is like @quotation, but indents only on the left and
% has no optional argument.
-%
+%
\makedispenvdef{indentedblock}{\indentedblockstart}
%
\def\indentedblockstart{%
@@ -7658,7 +7658,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% @deftypefnnewline on|off says whether the return type of typed functions
% are printed on their own line. This affects @deftypefn, @deftypefun,
% @deftypeop, and @deftypemethod.
-%
+%
\parseargdef\deftypefnnewline{%
\def\temp{#1}%
\ifx\temp\onword
@@ -7677,8 +7677,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% \dosubind {index}{topic}{subtopic}
%
% If SUBTOPIC is present, precede it with a space, and call \doind.
-% (At some time during the 20th century, this made a two-level entry in an
-% index such as the operation index. Nobody seemed to notice the change in
+% (At some time during the 20th century, this made a two-level entry in an
+% index such as the operation index. Nobody seemed to notice the change in
% behaviour though.)
\def\dosubind#1#2#3{%
\def\thirdarg{#3}%
@@ -7853,7 +7853,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\tclose{\temp}% typeset the return type
\ifrettypeownline
% put return type on its own line; prohibit line break following:
- \hfil\vadjust{\nobreak}\break
+ \hfil\vadjust{\nobreak}\break
\else
\space % type on same line, so just followed by a space
\fi
@@ -8000,7 +8000,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\scantokens{#1@comment}%
%
% The \comment is to remove the \newlinechar added by \scantokens, and
- % can be noticed by \parsearg. Note \c isn't used because this means
cedilla
+ % can be noticed by \parsearg. Note \c isn't used because this means cedilla
% in math mode.
}
@@ -8201,7 +8201,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% list to some hook where the argument is to be expanded. If there are
% less than 10 arguments that hook is to be replaced by ##N where N
% is the position in that list, that is to say the macro arguments are to be
-% defined `a la TeX in the macro body.
+% defined `a la TeX in the macro body.
%
% That gets used by \mbodybackslash (above).
%
@@ -8232,8 +8232,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
% Read recursive and nonrecursive macro bodies. (They're different since
% rec and nonrec macros end differently.)
-%
-% We are in \macrobodyctxt, and the \xdef causes backslashshes in the macro
+%
+% We are in \macrobodyctxt, and the \xdef causes backslashshes in the macro
% body to be transformed.
% Set \macrobody to the body of the macro, and call \defmacro.
%
@@ -8267,7 +8267,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% twice the \macarg.BLAH macros does not cost too much processing power.
\def\parsemmanyargdef@@#1,{%
\if#1;\let\next=\relax
- \else
+ \else
\let\next=\parsemmanyargdef@@
\edef\tempb{\eatspaces{#1}}%
\expandafter\def\expandafter\tempa
@@ -8352,7 +8352,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% Replace arguments by their values in the macro body, and place the result
% in macro \@tempa.
-%
+%
\def\macvalstoargs@{%
% To do this we use the property that token registers that are \the'ed
% within an \edef expand only once. So we are going to place all argument
@@ -8376,9 +8376,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\expandafter\def\expandafter\@tempa\expandafter{\@tempc}%
}
-% Define the named-macro outside of this group and then close this group.
-%
-\def\macargexpandinbody@{%
+% Define the named-macro outside of this group and then close this group.
+%
+\def\macargexpandinbody@{%
\expandafter
\endgroup
\macargdeflist@
@@ -8416,7 +8416,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
% Trailing missing arguments are set to empty.
-%
+%
\def\setemptyargvalues@{%
\ifx\paramlist\nilm@
\let\next\macargexpandinbody@
@@ -8493,7 +8493,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\else % at most 9
\ifnum\paramno<10\relax
% @MACNAME sets the context for reading the macro argument
- % @MACNAME@@ gets the argument, processes backslashes and appends a
+ % @MACNAME@@ gets the argument, processes backslashes and appends a
% comma.
% @MACNAME@@@ removes braces surrounding the argument list.
% @MACNAME@@@@ scans the macro body with arguments substituted.
@@ -8537,11 +8537,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% Call #1 with a list of tokens #2, with any doubled backslashes in #2
% compressed to one.
%
-% This implementation works by expansion, and not execution (so we cannot use
-% \def or similar). This reduces the risk of this failing in contexts where
-% complete expansion is done with no execution (for example, in writing out to
+% This implementation works by expansion, and not execution (so we cannot use
+% \def or similar). This reduces the risk of this failing in contexts where
+% complete expansion is done with no execution (for example, in writing out to
% an auxiliary file for an index entry).
-%
+%
% State is kept in the input stream: the argument passed to
% @look_ahead, @gobble_and_check_finish and @add_segment is
%
@@ -8563,11 +8563,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% #3 - NEXT_TOKEN
% #4 used to look ahead
%
-% If the next token is not a backslash, process the rest of the argument;
+% If the next token is not a backslash, process the rest of the argument;
% otherwise, remove the next token.
@gdef@look_ahead#1!#2#3#4{%
@ifx#4\%
- @expandafter@gobble_and_check_finish
+ @expandafter@gobble_and_check_finish
@else
@expandafter@add_segment
@fi#1!{#2}#4#4%
@@ -8591,9 +8591,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% #3 - NEXT_TOKEN
% #4 is input stream until next backslash
%
-% Input stream is either at the start of the argument, or just after a
-% backslash sequence, either a lone backslash, or a doubled backslash.
-% NEXT_TOKEN contains the first token in the input stream: if it is \finish,
+% Input stream is either at the start of the argument, or just after a
+% backslash sequence, either a lone backslash, or a doubled backslash.
+% NEXT_TOKEN contains the first token in the input stream: if it is \finish,
% finish; otherwise, append to ARG_RESULT the segment of the argument up until
% the next backslash. PENDING_BACKSLASH contains a backslash to represent
% a backslash just before the start of the input stream that has not been
@@ -8605,13 +8605,13 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% append the pending backslash to the result, followed by the next segment
@expandafter@is_fi@look_ahead#1#2#4!{\}@fi
% this @fi is discarded by @look_ahead.
- % we can't get rid of it with \expandafter because we don't know how
+ % we can't get rid of it with \expandafter because we don't know how
% long #4 is.
}
% #1 - THE_MACRO
% #2 - ARG_RESULT
-% #3 discards the res of the conditional in @add_segment, and @is_fi ends the
+% #3 discards the res of the conditional in @add_segment, and @is_fi ends the
% conditional.
@gdef@call_the_macro#1#2!#3@fi{@is_fi #1{#2}}
@@ -8623,7 +8623,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% for reading the argument (slightly different in the two cases). Then,
% to read the argument, in the whole-line case, it then calls the regular
% \parsearg MAC; in the lbrace case, it calls \passargtomacro MAC.
-%
+%
\def\braceorline#1{\let\macnamexxx=#1\futurelet\nchar\braceorlinexxx}
\def\braceorlinexxx{%
\ifx\nchar\bgroup
@@ -8677,7 +8677,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% Used so that the @top node doesn't have to be wrapped in an @ifnottex
% conditional.
-% \doignore goes to more effort to skip nested conditionals but we don't need
+% \doignore goes to more effort to skip nested conditionals but we don't need
% that here.
\def\omittopnode{%
\ifx\lastnode\wordTop
@@ -8685,7 +8685,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
\def\wordTop{Top}
-% Until the next @node or @bye command, divert output to a box that is not
+% Until the next @node or @bye command, divert output to a box that is not
% output.
\def\ignorenode{\setbox\dummybox\vbox\bgroup\def\node{\egroup\node}%
\ignorenodebye
@@ -8752,7 +8752,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% automatically in xrefs, if the third arg is not explicitly specified.
% This was provided as a "secret" @set xref-automatic-section-title
% variable, now it's official.
-%
+%
\parseargdef\xrefautomaticsectiontitle{%
\def\temp{#1}%
\ifx\temp\onword
@@ -8768,7 +8768,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi\fi
}
-%
+%
% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is
% the node name, #2 the name of the Info cross-reference, #3 the printed
% node name, #4 the name of the Info file, #5 the name of the printed
@@ -8921,24 +8921,24 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi
\else
% node/anchor (non-float) references.
- %
+ %
% If we use \unhbox to print the node names, TeX does not insert
% empty discretionaries after hyphens, which means that it will not
% find a line break at a hyphen in a node names. Since some manuals
% are best written with fairly long node names, containing hyphens,
% this is a loss. Therefore, we give the text of the node name
% again, so it is as if TeX is seeing it for the first time.
- %
+ %
\ifdim \wd\printedmanualbox > 0pt
% Cross-manual reference with a printed manual name.
- %
+ %
\crossmanualxref{\cite{\printedmanual\unskip}}%
%
\else\ifdim \wd\infofilenamebox > 0pt
% Cross-manual reference with only an info filename (arg 4), no
% printed manual name (arg 5). This is essentially the same as
% the case above; we output the filename, since we have nothing else.
- %
+ %
\crossmanualxref{\code{\infofilename\unskip}}%
%
\else
@@ -8978,20 +8978,20 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\endgroup}
% Output a cross-manual xref to #1. Used just above (twice).
-%
+%
% Only include the text "Section ``foo'' in" if the foo is neither
% missing or Top. Thus, @xref{,,,foo,The Foo Manual} outputs simply
% "see The Foo Manual", the idea being to refer to the whole manual.
-%
+%
% But, this being TeX, we can't easily compare our node name against the
% string "Top" while ignoring the possible spaces before and after in
% the input. By adding the arbitrary 7sp below, we make it much less
% likely that a real node name would have the same width as "Top" (e.g.,
% in a monospaced font). Hopefully it will never happen in practice.
-%
+%
% For the same basic reason, we retypeset the "Top" at every
% reference, since the current font is indeterminate.
-%
+%
\def\crossmanualxref#1{%
\setbox\toprefbox = \hbox{Top\kern7sp}%
\setbox2 = \hbox{\ignorespaces \printedrefname \unskip \kern7sp}%
@@ -9038,7 +9038,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi\fi\fi
}
-% \refx{NAME}{SUFFIX} - reference a cross-reference string named NAME. SUFFIX
+% \refx{NAME}{SUFFIX} - reference a cross-reference string named NAME. SUFFIX
% is output afterwards if non-empty.
\def\refx#1#2{%
\requireauxfile
@@ -9070,9 +9070,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
#2% Output the suffix in any case.
}
-% This is the macro invoked by entries in the aux file. Define a control
-% sequence for a cross-reference target (we prepend XR to the control sequence
-% name to avoid collisions). The value is the page number. If this is a
float
+% This is the macro invoked by entries in the aux file. Define a control
+% sequence for a cross-reference target (we prepend XR to the control sequence
+% name to avoid collisions). The value is the page number. If this is a float
% type, we have more work to do.
%
\def\xrdef#1#2{%
@@ -9088,10 +9088,10 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\bgroup
\expandafter\gdef\csname XR\safexrefname\endcsname{#2}%
\egroup
- % We put the \gdef inside a group to avoid the definitions building up on
- % TeX's save stack, which can cause it to run out of space for aux files
with
+ % We put the \gdef inside a group to avoid the definitions building up on
+ % TeX's save stack, which can cause it to run out of space for aux files with
% thousands of lines. \gdef doesn't use the save stack, but \csname does
- % when it defines an unknown control sequence as \relax.
+ % when it defines an unknown control sequence as \relax.
%
% Was that xref control sequence that we just defined for a float?
\expandafter\iffloat\csname XR\safexrefname\endcsname
@@ -9450,7 +9450,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
\ifimagevmode
\medskip % space after a standalone image
- \fi
+ \fi
\ifx\centersub\centerV \egroup \fi
\endgroup}
@@ -10281,7 +10281,7 @@ directory should work if nowhere else does.}
\uppercase{.}
\endgroup
\else
- \errhelp = \EMsimple
+ \errhelp = \EMsimple
\errmessage{Unicode character U+#1 not supported, sorry}%
\fi
\else
@@ -10314,7 +10314,7 @@ directory should work if nowhere else does.}
\countUTFz = "#1\relax
\begingroup
\parseXMLCharref
-
+
% Give \u8:... its definition. The sequence of seven \expandafter's
% expands after the \gdef three times, e.g.
%
@@ -10326,7 +10326,7 @@ directory should work if nowhere else does.}
\expandafter\expandafter
\expandafter\expandafter
\expandafter\gdef \UTFviiiTmp{#2}%
- %
+ %
\expandafter\ifx\csname uni:#1\endcsname \relax \else
\message{Internal error, already defined: #1}%
\fi
@@ -10365,7 +10365,7 @@ directory should work if nowhere else does.}
\divide\countUTFz by 64
\countUTFy = \countUTFz % Save to be the future value of \countUTFz.
\multiply\countUTFz by 64
-
+
% \countUTFz is now \countUTFx with the last 5 bits cleared. Subtract
% in order to get the last five bits.
\advance\countUTFx by -\countUTFz
@@ -10400,7 +10400,7 @@ directory should work if nowhere else does.}
% U+0080..U+00FF =
https://en.wikipedia.org/wiki/Latin-1_Supplement_(Unicode_block)
% U+0100..U+017F = https://en.wikipedia.org/wiki/Latin_Extended-A
% U+0180..U+024F = https://en.wikipedia.org/wiki/Latin_Extended-B
-%
+%
% Many of our renditions are less than wonderful, and all the missing
% characters are available somewhere. Loading the necessary fonts
% awaits user request. We can't truly support Unicode without
@@ -11438,9 +11438,9 @@ directory should work if nowhere else does.}
\def\texinfochars{%
\let< = \activeless
\let> = \activegtr
- \let~ = \activetilde
+ \let~ = \activetilde
\let^ = \activehat
- \markupsetuplqdefault \markupsetuprqdefault
+ \markupsetuplqdefault \markupsetuprqdefault
\let\b = \strong
\let\i = \smartitalic
% in principle, all other definitions in \tex have to be undone too.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index d48fa31..e6a454b 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -125,7 +125,7 @@ Configuring @value{tramp} for use
* Connection types:: Types of connections to remote hosts.
* Inline methods:: Inline methods.
* External methods:: External methods.
-* GVFS based methods:: GVFS based external methods.
+* GVFS-based methods:: @acronym{GVFS}-based external methods.
* Default Method:: Selecting a default method.
* Default User:: Selecting a default user.
* Default Host:: Selecting a default host.
@@ -545,9 +545,9 @@ of the local file name is the share exported by the remote
host,
@anchor{Quick Start Guide: GVFS-based methods}
-@section Using GVFS-based methods
+@section Using @acronym{GVFS}-based methods
@cindex methods, gvfs
-@cindex gvfs based methods
+@cindex gvfs-based methods
@cindex method @option{sftp}
@cindex @option{sftp} method
@cindex method @option{afp}
@@ -557,10 +557,9 @@ of the local file name is the share exported by the remote
host,
@cindex @option{dav} method
@cindex @option{davs} method
-On systems, which have installed the virtual file system for the
-@acronym{GNOME} Desktop (GVFS), its offered methods could be used by
-@value{tramp}. Examples are
-@file{@trampfn{sftp,user@@host,/path/to/file}},
+On systems, which have installed @acronym{GVFS, the GNOME Virtual File
+System}, its offered methods could be used by @value{tramp}. Examples
+are @file{@trampfn{sftp,user@@host,/path/to/file}},
@file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP
file system), @file{@trampfn{dav,user@@host,/path/to/file}} and
@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares).
@@ -576,10 +575,10 @@ file system),
@file{@trampfn{dav,user@@host,/path/to/file}} and
@cindex @option{nextcloud} method
@cindex nextcloud
-GVFS-based methods include also @acronym{GNOME} Online Accounts, which
-support the @option{Files} service. These are the Google Drive file
-system, and the OwnCloud/NextCloud file system. The file name syntax
-is here always
+@acronym{GVFS}-based methods include also @acronym{GNOME} Online
+Accounts, which support the @option{Files} service. These are the
+Google Drive file system, and the OwnCloud/NextCloud file system. The
+file name syntax is here always
@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}}
(@samp{john.doe@@gmail.com} stands here for your Google Drive
account), or @file{@trampfn{nextcloud,user@@host#8081,/path/to/file}}
@@ -645,7 +644,7 @@ might be used in your init file:
* Connection types:: Types of connections to remote hosts.
* Inline methods:: Inline methods.
* External methods:: External methods.
-* GVFS based methods:: GVFS based external methods.
+* GVFS-based methods:: @acronym{GVFS}-based external methods.
* Default Method:: Selecting a default method.
Here we also try to help those who
don't have the foggiest which method
@@ -1170,8 +1169,8 @@ information}. Supported properties are @samp{mount-args},
@samp{copyto-args} and @samp{moveto-args}.
Access via @option{rclone} is slow. If you have an alternative method
-for accessing the system storage, you shall prefer this. @ref{GVFS
-based methods} for example, methods @option{gdrive} and
+for accessing the system storage, you shall prefer this.
+@ref{GVFS-based methods} for example, methods @option{gdrive} and
@option{nextcloud}.
@strong{Note}: The @option{rclone} method is experimental, don't use
@@ -1180,20 +1179,20 @@ it in production systems!
@end table
-@node GVFS based methods
-@section GVFS based external methods
+@node GVFS-based methods
+@section @acronym{GVFS}-based external methods
@cindex methods, gvfs
-@cindex gvfs based methods
+@cindex gvfs-based methods
@cindex dbus
-GVFS is the virtual file system for the @acronym{GNOME} Desktop,
-@uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are
-mounted locally through FUSE and @value{tramp} uses this locally
-mounted directory internally.
+@acronym{GVFS} is the virtual file system for the @acronym{GNOME}
+Desktop, @uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on
+@acronym{GVFS} are mounted locally through FUSE and @value{tramp} uses
+this locally mounted directory internally.
-Emacs uses the D-Bus mechanism to communicate with GVFS@. Emacs must
-have the message bus system, D-Bus integration active, @pxref{Top, ,
-D-Bus, dbus}.
+Emacs uses the D-Bus mechanism to communicate with @acronym{GVFS}@.
+Emacs must have the message bus system, D-Bus integration active,
+@pxref{Top, , D-Bus, dbus}.
@table @asis
@item @option{afp}
@@ -1216,9 +1215,10 @@ syntax requires a leading volume (share) name, for
example:
based on standard protocols, such as HTTP@. @option{davs} does the same
but with SSL encryption. Both methods support the port numbers.
-Paths being part of the WebDAV volume to be mounted by GVFS, as it is
-common for OwnCloud or NextCloud file names, are not supported by
-these methods. See method @option{nextcloud} for handling them.
+Paths being part of the WebDAV volume to be mounted by @acronym{GVFS},
+as it is common for OwnCloud or NextCloud file names, are not
+supported by these methods. See method @option{nextcloud} for
+handling them.
@item @option{gdrive}
@cindex method @option{gdrive}
@@ -1259,18 +1259,19 @@ that for security reasons refuse @command{ssh}
connections.
@end table
@defopt tramp-gvfs-methods
-This user option is a list of external methods for GVFS@. By default,
-this list includes @option{afp}, @option{dav}, @option{davs},
-@option{gdrive}, @option{nextcloud} and @option{sftp}. Other methods
-to include are @option{ftp}, @option{http}, @option{https} and
-@option{smb}. These methods are not intended to be used directly as
-GVFS based method. Instead, they are added here for the benefit of
-@ref{Archive file names}.
-
-If you want to use GVFS-based @option{ftp} or @option{smb} methods,
-you must add them to @code{tramp-gvfs-methods}, and you must disable
-the corresponding Tramp package by setting @code{tramp-ftp-method} or
-@code{tramp-smb-method} to @code{nil}, respectively:
+This user option is a list of external methods for @acronym{GVFS}@.
+By default, this list includes @option{afp}, @option{dav},
+@option{davs}, @option{gdrive}, @option{nextcloud} and @option{sftp}.
+Other methods to include are @option{ftp}, @option{http},
+@option{https} and @option{smb}. These methods are not intended to be
+used directly as @acronym{GVFS}-based method. Instead, they are added
+here for the benefit of @ref{Archive file names}.
+
+If you want to use @acronym{GVFS}-based @option{ftp} or @option{smb}
+methods, you must add them to @code{tramp-gvfs-methods}, and you must
+disable the corresponding Tramp package by setting
+@code{tramp-ftp-method} or @code{tramp-smb-method} to @code{nil},
+respectively:
@lisp
@group
@@ -2937,9 +2938,10 @@ host when the variable @code{default-directory} is
remote:
@end group
@end lisp
-Remote processes do not apply to GVFS (see @ref{GVFS based methods})
-because the remote file system is mounted on the local host and
-@value{tramp} just accesses by changing the @code{default-directory}.
+Remote processes do not apply to @acronym{GVFS} (see @ref{GVFS-based
+methods}) because the remote file system is mounted on the local host
+and @value{tramp} just accesses by changing the
+@code{default-directory}.
@value{tramp} starts a remote process when a command is executed in a
remote file or directory buffer. As of now, these packages have been
@@ -3323,10 +3325,10 @@ killing all buffers related to remote connections.
@cindex archive method
@value{tramp} offers also transparent access to files inside file
-archives. This is possible only on machines which have installed the
-virtual file system for the @acronym{GNOME} Desktop (GVFS), @ref{GVFS
-based methods}. Internally, file archives are mounted via the GVFS
-@option{archive} method.
+archives. This is possible only on machines which have installed
+@acronym{GVFS, the GNOME Virtual File System}, @ref{GVFS-based
+methods}. Internally, file archives are mounted via the
+@acronym{GVFS} @option{archive} method.
A file archive is a regular file of kind @file{/path/to/dir/file.EXT}.
The extension @samp{.EXT} identifies the type of the file archive. A
@@ -3349,9 +3351,9 @@ file names as well.
@vindex tramp-archive-suffixes
File archives are identified by the file name extension @samp{.EXT}.
-Since GVFS uses internally the library @code{libarchive(3)}, all
-suffixes, which are accepted by this library, work also for archive
-file names. Accepted suffixes are listed in the constant
+Since @acronym{GVFS} uses internally the library @code{libarchive(3)},
+all suffixes, which are accepted by this library, work also for
+archive file names. Accepted suffixes are listed in the constant
@code{tramp-archive-suffixes}. They are
@itemize
@@ -3519,11 +3521,11 @@ row are possible, like
@file{/path/to/dir/file.tar.gz.uu/dir/file}.
@vindex tramp-archive-all-gvfs-methods
An archive file name could be a remote file name, as in
@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.
-Since all file operations are mapped internally to GVFS operations,
-remote file names supported by @code{tramp-gvfs} perform better,
-because no local copy of the file archive must be downloaded first.
-For example, @samp{/sftp:user@@host:...} performs better than the
-similar @samp{/scp:user@@host:...}. See the constant
+Since all file operations are mapped internally to @acronym{GVFS}
+operations, remote file names supported by @code{tramp-gvfs} perform
+better, because no local copy of the file archive must be downloaded
+first. For example, @samp{/sftp:user@@host:...} performs better than
+the similar @samp{/scp:user@@host:...}. See the constant
@code{tramp-archive-all-gvfs-methods} for a complete list of
@code{tramp-gvfs} supported method names.
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 0cdfcac..bad7701 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -1267,7 +1267,8 @@ files, etc.
The default value specifies a subdirectory named @file{url/} in the
standard Emacs user data directory specified by the variable
-@code{user-emacs-directory} (normally @file{~/.emacs.d}). However,
+@code{user-emacs-directory} (normally @file{~/.config/emacs}
+or @file{~/.emacs.d}). However,
the old default was @file{~/.url}, and this directory is used instead
if it exists.
@end defopt
diff --git a/etc/HISTORY b/etc/HISTORY
index bf03692..6cda28d 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -218,6 +218,8 @@ GNU Emacs 26.1 (2018-05-28) emacs-26.1
GNU Emacs 26.2 (2019-04-12) emacs-26.2
+GNU Emacs 26.3 (2019-08-28) emacs-26.3
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index 7c329f0..8766674 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -16,10 +16,10 @@ You can narrow news to a specific version by calling
'view-emacs-news'
with a prefix argument or by typing 'C-u C-h C-n'.
Temporary note:
-+++ indicates that all necessary documentation updates are complete.
- (This means all relevant manuals in doc/ AND lisp doc-strings.)
++++ indicates that all relevant manuals in doc/ have been updated.
--- means no change in the manuals is needed.
-When you add a new item, use the appropriate mark if you are sure it applies,
+When you add a new item, use the appropriate mark if you are sure it
+applies, and please also update docstrings as needed.
* Installation Changes in Emacs 27.1
@@ -129,10 +129,28 @@ This is intended mostly to help developers.
** Emacs now requires GTK 2.24 and GTK 3.10 for the GTK 2 and GTK 3
builds respectively.
+** New make target 'help' shows a summary of common make targets.
+
* Startup Changes in Emacs 27.1
+++
+** Emacs now uses the XDG convention for init files.
+For example, it looks for init.el in ~/.config/emacs/init.el, and
+similarly for other init files.
+
+The XDG_CONFIG_HOME environment variable (which defaults to ~/.config)
+specifies the parent directory of these and other configuration files,
+and will override their traditional locations (the home directory,
+~/.emacs.d, etc.).
+
+Emacs will still look for init files in their traditional locations if
+XDG_CONFIG_HOME does not exist, so invoking Emacs with
+XDG_CONFIG_HOME='/nowhere' might be useful if your new-location init
+files are scrambled, or if you want to force Emacs to ignore files
+under XDG_CONFIG_HOME for some other reason.
+
++++
** Emacs can now be configured using an early init file.
The file is called 'early-init.el', in 'user-emacs-directory'. It is
loaded very early in the startup process: before graphical elements
@@ -173,12 +191,6 @@ after Emacs has finished initialization and is ready for
use.
emacs.service file to eg "~/.config/systemd/user/", you will need to copy
the new version of the file again.)
-+++
-** New option 'help-enable-completion-auto-load'.
-This allows disabling the new feature introduced in Emacs 26.1 which
-loads files during completion of 'C-h f' and 'C-h v' according to
-'definition-prefixes'.
-
* Changes in Emacs 27.1
@@ -205,6 +217,9 @@ To get the old, less-secure behavior, you can set the
*** When run by root, emacsclient no longer connects to non-root sockets.
(Instead you can use Tramp methods to run root commands in a non-root Emacs.)
+** New function 'network-lookup-address-info'.
+This does IPv4 and/or IPv6 address lookups on hostnames.
+
---
** Control of the threshold for using the 'distant-foreground' color.
The threshold for color distance below which the 'distant-foreground'
@@ -272,7 +287,8 @@ variable.
+++
** TLS connections have their security tightened by default.
Most of the checks for outdated, believed-to-be-weak TLS algorithms
-and ciphers are now switched on by default. By default, the NSM will
+and ciphers are now switched on by default. (In addition, several new
+TLS weaknesses are now warned about.) By default, the NSM will
flag connections using these weak algorithms and ask users whether to
allow them. To get the old behavior back (where certificates are
checked for validity, but no warnings about weak cryptography are
@@ -280,6 +296,14 @@ issued), you can either set
'network-security-protocol-checks' to nil,
or adjust the elements in that variable to only happen on the 'high'
security level (assuming you use the 'medium' level).
+---
+** New user option 'nsm-trust-local-network'.
+Allows skipping Network Security Manager checks for hosts on your
+local subnet(s). It defaults to nil. Usually, there should be no
+need to set this non-nil, and doing that risks opening your local
+network connections to attacks. So be sure you know what you are
+doing before changing the value.
+
+++
** Native GnuTLS connections can now use client certificates.
Previously, this support was only available when using the external
@@ -507,10 +531,19 @@ current and the previous or the next line, as before.
* Changes in Specialized Modes and Packages in Emacs 27.1
+---
+** 'autoconf-mode' is now used instead of 'm4-mode' for the
+acinclude.m4/aclocal.m4/acsite.m4 files.
+
+---
+** On GNU/Linux, 'M-x battery' will now list all batteries, no matter
+what they're named, and the 'battery-linux-sysfs-regexp' variable has
+been removed.
+
** The 'list-processes' command now includes port numbers in the
network connection information (in addition to the host name).
-** The 'cl' package is now officially deprecated in favor of `cl-lib`.
+** The 'cl' package is now officially deprecated in favor of 'cl-lib'.
+++
** winner
@@ -545,6 +578,11 @@ that it doesn't bring any measurable benefit.
---
*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can
be functions.
++++
+*** 'compilation-context-lines' can now take the value t; this is like
+nil, but instead of scrolling the current line to the top of the
+screen when there is no left fringe, it inserts a visible arrow before
+column zero.
** cl-lib.el
+++
@@ -690,7 +728,7 @@ The default value is 'find-dired-sort-by-filename'.
** Change Logs and VC
+++
-*** New command 'log-edit-generate-changelog', bound to C-c C-w.
+*** New command 'log-edit-generate-changelog-from-diff', bound to C-c C-w.
This generates ChangeLog entries from the VC fileset diff.
*** Recording ChangeLog entries doesn't require an actual file.
@@ -935,6 +973,11 @@ early init file.
** Info
++++
+*** Clicking on the left/right arrow icon in the Info tool-bar while
+holding down the Ctrl key pops up a menu of previously visited Info nodes
+where you can select a node to go back (like in browsers).
+
---
*** Info can now follow 'file://' protocol URLs.
The 'file://' URLs in Info documents can now be followed by passing
@@ -1793,6 +1836,16 @@ aliases of 'bookmark-default-file'.
When non-nil, watch whether the bookmark file has changed on disk.
---
+*** The old bookmark file format is no longer supported.
+This bookmark file format has not been used in Emacs since at least
+version 19.34, released in 1996, and will no longer be automatically
+converted to the new bookmark file format.
+
+The following functions are now declared obsolete:
+bookmark-grok-file-format-version, bookmark-maybe-upgrade-file-format,
+bookmark-upgrade-file-format-from-0, bookmark-upgrade-version-0-alist
+
+---
** The mantemp.el library is now marked obsolete.
This library generates manual C++ template instantiations. It should
no longer be useful on modern compilers, which do this automatically.
@@ -1840,6 +1893,11 @@ and 'gravatar-force-default'.
*** The built-in ada-mode is now deleted. The Gnu ELPA package is a
good replacement, even in very large source files.
+** xref
+
+---
+*** Imenu support has been added to 'xref--xref-buffer-mode'.
+
* New Modes and Packages in Emacs 27.1
@@ -2166,7 +2224,9 @@ end and duration).
+++
*** 'time-add', 'time-subtract', and 'time-less-p' now accept
infinities and NaNs too, and propagate them or return nil like
-floating-point operators do.
+floating-point operators do. If both arguments are finite, these
+functions now return exact results instead of rounding in some cases,
+and they also avoid excess precision when that is easy.
+++
*** New function 'time-equal-p' compares time values for equality.
@@ -2569,6 +2629,9 @@ subr.el so that it is available by default. It now
always returns the
non-nil argument when the other is nil. Several duplicates of 'xor'
in other packages are now obsolete aliases of 'xor'.
++++
+** 'define-globalized-minor-mode' now takes BODY forms.
+
* Changes in Emacs 27.1 on Non-Free Operating Systems
@@ -2610,6 +2673,11 @@ is being used, except in Far Eastern locales. When this
variable is
non-zero, Emacs at startup sets 'locale-coding-system' to the
corresponding encoding, instead of using 'w32-ansi-code-page'.
+---
+** The default value of 'inhibit-compacting-font-caches' is t on MS-Windows.
+Experience shows that compacting font caches causes more trouble on
+MS-Windows than it helps.
+
+++
** On NS the behaviour of drag and drop can now be modified by use of
modifier keys in line with Apples guidelines. This makes the drag and
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index aa583f4..11c526c 100644
--- a/etc/NEWS.26
+++ b/etc/NEWS.26
@@ -16,31 +16,16 @@ You can narrow news to a specific version by calling
'view-emacs-news'
with a prefix argument or by typing 'C-u C-h C-n'.
-* Installation Changes in Emacs 26.3
-
-
-* Startup Changes in Emacs 26.3
-
-
* Changes in Emacs 26.3
-
-* Editing Changes in Emacs 26.3
-
-
-* Changes in Specialized Modes and Packages in Emacs 26.3
-
-
-* New Modes and Packages in Emacs 26.3
-
-
-* Incompatible Lisp Changes in Emacs 26.3
+** New option 'help-enable-completion-auto-load'.
+This allows disabling the new feature introduced in Emacs 26.1 which
+loads files during completion of 'C-h f' and 'C-h v' according to
+'definition-prefixes'.
-
-* Lisp Changes in Emacs 26.3
-
-
-* Changes in Emacs 26.3 on Non-Free Operating Systems
+** Emacs now supports the new Japanese Era name.
+The newly assigned codepoint U+32FF was added to the Unicode Character
+Database compiled into Emacs.
* Installation Changes in Emacs 26.2
diff --git a/etc/tutorials/TUTORIAL.ru b/etc/tutorials/TUTORIAL.ru
index ba3a5c2..a9bd90d 100644
--- a/etc/tutorials/TUTORIAL.ru
+++ b/etc/tutorials/TUTORIAL.ru
@@ -985,7 +985,7 @@ Emacs также может создавать множество "фреймо
представить все это здесь не представляется возможным. Однако, возможно вы
захотите узнать больше о возможностях Emacs. Emacs предоставляет команды
для чтения документации о командах Emacs. Все команды "справки" (help)
-начинаются с сочетания CONTROL-h, который является "символом справки".
+начинаются с сочетания CONTROL-h, которое является "символом справки".
Чтобы использовать справку, нажмите C-h, а затем -- символ, который
расскажет, какой именно вид справки вы хотите получить. Если вы
@@ -1130,5 +1130,6 @@ Copyright (C) 1985, 1996, 1998, 2001-2019 Free Software
Foundation, Inc.
;;; Local Variables:
;;; coding: utf-8
;;; sentence-end-double-space: nil
+;;; mode: fundamental
;;; fill-column: 76
;;; End:
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index ba2721e..e9469f7 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -914,22 +914,38 @@ initialize_sockets (void)
#endif /* WINDOWSNT */
-/* If the home directory is HOME, return the configuration file with
- basename CONFIG_FILE. Fail if there is no home directory or if the
- configuration file could not be opened. */
+/* If the home directory is HOME, and XDG_CONFIG_HOME's value is XDG,
+ return the configuration file with basename CONFIG_FILE. Fail if
+ the configuration file could not be opened. */
static FILE *
-open_config (char const *home, char const *config_file)
+open_config (char const *home, char const *xdg, char const *config_file)
{
- if (!home)
- return NULL;
- ptrdiff_t homelen = strlen (home);
- static char const emacs_d_server[] = "/.emacs.d/server/";
- ptrdiff_t suffixsize = sizeof emacs_d_server + strlen (config_file);
- char *configname = xmalloc (homelen + suffixsize);
- strcpy (stpcpy (stpcpy (configname, home), emacs_d_server), config_file);
-
- FILE *config = fopen (configname, "rb");
+ ptrdiff_t xdgsubdirsize = xdg ? strlen (xdg) + sizeof "/emacs/server/" : 0;
+ ptrdiff_t homesuffixsizemax = max (sizeof "/.config/emacs/server/",
+ sizeof "/.emacs.d/server/");
+ ptrdiff_t homesubdirsizemax = home ? strlen (home) + homesuffixsizemax : 0;
+ char *configname = xmalloc (max (xdgsubdirsize, homesubdirsizemax)
+ + strlen (config_file));
+ FILE *config;
+ if (xdg || home)
+ {
+ strcpy ((xdg
+ ? stpcpy (stpcpy (configname, xdg), "/emacs/server/")
+ : stpcpy (stpcpy (configname, home), "/.config/emacs/server/")),
+ config_file);
+ config = fopen (configname, "rb");
+ }
+ else
+ config = NULL;
+
+ if (! config && home)
+ {
+ strcpy (stpcpy (stpcpy (configname, home), "/.emacs.d/server/"),
+ config_file);
+ config = fopen (configname, "rb");
+ }
+
free (configname);
return config;
}
@@ -949,10 +965,11 @@ get_server_config (const char *config_file, struct
sockaddr_in *server,
config = fopen (config_file, "rb");
else
{
- config = open_config (egetenv ("HOME"), config_file);
+ char const *xdg = egetenv ("XDG_CONFIG_HOME");
+ config = open_config (egetenv ("HOME"), xdg, config_file);
#ifdef WINDOWSNT
if (!config)
- config = open_config (egetenv ("APPDATA"), config_file);
+ config = open_config (egetenv ("APPDATA"), xdg, config_file);
#endif
}
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 036c485..6409407 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -1146,7 +1146,6 @@ main (int argc, char **argv)
{
error ("-o option may only be given once.");
suggest_asking_for_help ();
- /* NOTREACHED */
}
tagfile = optarg;
break;
@@ -1208,7 +1207,6 @@ main (int argc, char **argv)
case 'w': no_warnings = true; break;
default:
suggest_asking_for_help ();
- /* NOTREACHED */
}
/* No more options. Store the rest of arguments. */
@@ -1227,13 +1225,11 @@ main (int argc, char **argv)
if (help_asked)
print_help (argbuffer);
- /* NOTREACHED */
if (nincluded_files == 0 && file_count == 0)
{
error ("no input files specified.");
suggest_asking_for_help ();
- /* NOTREACHED */
}
if (tagfile == NULL)
diff --git a/lib-src/pop.c b/lib-src/pop.c
index e4bd6c0..9a0dd8c 100644
--- a/lib-src/pop.c
+++ b/lib-src/pop.c
@@ -1275,7 +1275,7 @@ pop_getline (popserver server, char **line)
server->buffer_index = 0;
}
- while (1)
+ while (true)
{
/* There's a "- 1" here to leave room for the null that we put
at the end of the read data below. We put the null there so
@@ -1288,7 +1288,7 @@ pop_getline (popserver server, char **line)
{
strcpy (pop_error, "Out of memory in pop_getline");
pop_trash (server);
- return (-1);
+ break;
}
}
ret = RECV (server->file, server->buffer + server->data,
@@ -1298,13 +1298,13 @@ pop_getline (popserver server, char **line)
snprintf (pop_error, ERROR_MAX, "%s%s",
GETLINE_ERROR, strerror (errno));
pop_trash (server);
- return (-1);
+ break;
}
else if (ret == 0)
{
strcpy (pop_error, "Unexpected EOF from server in pop_getline");
pop_trash (server);
- return (-1);
+ break;
}
else
{
@@ -1332,7 +1332,7 @@ pop_getline (popserver server, char **line)
}
}
- /* NOTREACHED */
+ return -1;
}
/*
diff --git a/lib/intprops.h b/lib/intprops.h
index fe67c1f..36c6359 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -22,6 +22,18 @@
#include <limits.h>
+/* If the compiler lacks __has_builtin, define it well enough for this
+ source file only. */
+#ifndef __has_builtin
+# define __has_builtin(x) _GL_HAS_##x
+# if 5 <= __GNUC__ && !defined __ICC
+# define _GL_HAS___builtin_add_overflow 1
+# else
+# define _GL_HAS___builtin_add_overflow 0
+# endif
+# define _GL_TEMPDEF___has_builtin
+#endif
+
/* Return a value with the common real type of E and V and the value of V.
Do not evaluate E. */
#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v))
@@ -220,14 +232,24 @@
? (a) < (min) >> (b) \
: (max) >> (b) < (a))
-/* True if __builtin_add_overflow (A, B, P) works when P is non-null. */
-#if 5 <= __GNUC__ && !defined __ICC
-# define _GL_HAS_BUILTIN_OVERFLOW 1
+/* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow
+ (A, B, P) work when P is non-null. */
+#if __has_builtin (__builtin_add_overflow)
+# define _GL_HAS_BUILTIN_ADD_OVERFLOW 1
+#else
+# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0
+#endif
+
+/* True if __builtin_mul_overflow (A, B, P) works when P is non-null. */
+#ifdef __clang__
+/* Work around Clang bug <https://bugs.llvm.org/show_bug.cgi?id=16404>. */
+# define _GL_HAS_BUILTIN_MUL_OVERFLOW 0
#else
-# define _GL_HAS_BUILTIN_OVERFLOW 0
+# define _GL_HAS_BUILTIN_MUL_OVERFLOW _GL_HAS_BUILTIN_ADD_OVERFLOW
#endif
-/* True if __builtin_add_overflow_p (A, B, C) works. */
+/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for
+ __builtin_mul_overflow_p and __builtin_mul_overflow_p. */
#define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__)
/* The _GL*_OVERFLOW macros have the same restrictions as the
@@ -351,29 +373,33 @@
/* Store the low-order bits of A + B, A - B, A * B, respectively, into *R.
Return 1 if the result overflows. See above for restrictions. */
-#define INT_ADD_WRAPV(a, b, r) \
- _GL_INT_OP_WRAPV (a, b, r, +, __builtin_add_overflow, \
- _GL_INT_ADD_RANGE_OVERFLOW)
-#define INT_SUBTRACT_WRAPV(a, b, r) \
- _GL_INT_OP_WRAPV (a, b, r, -, __builtin_sub_overflow, \
- _GL_INT_SUBTRACT_RANGE_OVERFLOW)
-#define INT_MULTIPLY_WRAPV(a, b, r) \
- _GL_INT_OP_WRAPV (a, b, r, *, _GL_BUILTIN_MUL_OVERFLOW, \
- _GL_INT_MULTIPLY_RANGE_OVERFLOW)
-
-/* Like __builtin_mul_overflow, but work around GCC bug 91450. */
-#define _GL_BUILTIN_MUL_OVERFLOW(a, b, r) \
- ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && EXPR_SIGNED (a) && EXPR_SIGNED (b) \
- && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \
- ? ((void) __builtin_mul_overflow (a, b, r), 1) \
- : __builtin_mul_overflow (a, b, r))
+#if _GL_HAS_BUILTIN_ADD_OVERFLOW
+# define INT_ADD_WRAPV(a, b, r) __builtin_add_overflow (a, b, r)
+# define INT_SUBTRACT_WRAPV(a, b, r) __builtin_sub_overflow (a, b, r)
+#else
+# define INT_ADD_WRAPV(a, b, r) \
+ _GL_INT_OP_WRAPV (a, b, r, +, _GL_INT_ADD_RANGE_OVERFLOW)
+# define INT_SUBTRACT_WRAPV(a, b, r) \
+ _GL_INT_OP_WRAPV (a, b, r, -, _GL_INT_SUBTRACT_RANGE_OVERFLOW)
+#endif
+#if _GL_HAS_BUILTIN_MUL_OVERFLOW
+/* Work around GCC bug 91450. */
+# define INT_MULTIPLY_WRAPV(a, b, r) \
+ ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && EXPR_SIGNED (a) && EXPR_SIGNED (b) \
+ && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \
+ ? ((void) __builtin_mul_overflow (a, b, r), 1) \
+ : __builtin_mul_overflow (a, b, r))
+#else
+# define INT_MULTIPLY_WRAPV(a, b, r) \
+ _GL_INT_OP_WRAPV (a, b, r, *, _GL_INT_MULTIPLY_RANGE_OVERFLOW)
+#endif
/* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193
https://llvm.org/bugs/show_bug.cgi?id=25390
For now, assume all versions of GCC-like compilers generate bogus
- warnings for _Generic. This matters only for older compilers that
- lack __builtin_add_overflow. */
+ warnings for _Generic. This matters only for compilers that
+ lack relevant builtins. */
#if __GNUC__
# define _GL__GENERIC_BOGUS 1
#else
@@ -381,13 +407,10 @@
#endif
/* Store the low-order bits of A <op> B into *R, where OP specifies
- the operation. BUILTIN is the builtin operation, and OVERFLOW the
- overflow predicate. Return 1 if the result overflows. See above
- for restrictions. */
-#if _GL_HAS_BUILTIN_OVERFLOW
-# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) builtin (a, b, r)
-#elif 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS
-# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) \
+ the operation and OVERFLOW the overflow predicate. Return 1 if the
+ result overflows. See above for restrictions. */
+#if 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS
+# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \
(_Generic \
(*(r), \
signed char: \
@@ -442,7 +465,7 @@
: (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 0)))
# endif
-# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) \
+# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \
(sizeof *(r) == sizeof (signed char) \
? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \
signed char, SCHAR_MIN, SCHAR_MAX, \
@@ -563,4 +586,10 @@
: (tmin) / (a) < (b)) \
: (tmax) / (b) < (a)))
+#ifdef _GL_TEMPDEF___has_builtin
+# undef __has_builtin
+# undef _GL_HAS___builtin_add_overflow
+# undef _GL_TEMPDEF___has_builtin
+#endif
+
#endif /* _GL_INTPROPS_H */
diff --git a/lib/regex_internal.c b/lib/regex_internal.c
index b592f06..0092cc2 100644
--- a/lib/regex_internal.c
+++ b/lib/regex_internal.c
@@ -1311,7 +1311,6 @@ re_node_set_insert (re_node_set *set, Idx elem)
first element separately to skip a check in the inner loop. */
if (elem < set->elems[0])
{
- idx = 0;
for (idx = set->nelem; idx > 0; idx--)
set->elems[idx] = set->elems[idx - 1];
}
@@ -1716,15 +1715,19 @@ create_cd_newstate (const re_dfa_t *dfa, const
re_node_set *nodes,
{
if (newstate->entrance_nodes == &newstate->nodes)
{
- newstate->entrance_nodes = re_malloc (re_node_set, 1);
- if (__glibc_unlikely (newstate->entrance_nodes == NULL))
+ re_node_set *entrance_nodes = re_malloc (re_node_set, 1);
+ if (__glibc_unlikely (entrance_nodes == NULL))
{
free_state (newstate);
return NULL;
}
+ newstate->entrance_nodes = entrance_nodes;
if (re_node_set_init_copy (newstate->entrance_nodes, nodes)
!= REG_NOERROR)
- return NULL;
+ {
+ free_state (newstate);
+ return NULL;
+ }
nctx_nodes = 0;
newstate->has_constraint = 1;
}
diff --git a/lib/verify.h b/lib/verify.h
index afdc1ad..06e975e 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -56,6 +56,16 @@
# undef _Static_assert
#endif
+/* If the compiler lacks __has_builtin, define it well enough for this
+ source file only. */
+#ifndef __has_builtin
+# define __has_builtin(x) _GL_HAS_##x
+# define _GL_HAS___builtin_unreachable (4 < __GNUC__ + (5 <= __GNUC_MINOR__))
+# define _GL_HAS___builtin_trap \
+ (3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)))
+# define _GL_TEMPDEF___has_builtin
+#endif
+
/* Each of these macros verifies that its argument R is nonzero. To
be portable, R should be an integer constant expression. Unlike
assert (R), there is no run-time overhead.
@@ -260,24 +270,17 @@ template <int w>
# define verify(R) _GL_VERIFY (R, "verify (" #R ")", -)
#endif
-#ifndef __has_builtin
-# define __has_builtin(x) 0
-#endif
-
/* Assume that R always holds. Behavior is undefined if R is false,
fails to evaluate, or has side effects. Although assuming R can
help a compiler generate better code or diagnostics, performance
can suffer if R uses hard-to-optimize features such as function
calls not inlined by the compiler. */
-#if (__has_builtin (__builtin_unreachable) \
- || 4 < __GNUC__ + (5 <= __GNUC_MINOR__))
+#if __has_builtin (__builtin_unreachable)
# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
#elif 1200 <= _MSC_VER
# define assume(R) __assume (R)
-#elif ((defined GCC_LINT || defined lint) \
- && (__has_builtin (__builtin_trap) \
- || 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <=
__GNUC_PATCHLEVEL__))))
+#elif (defined GCC_LINT || defined lint) && __has_builtin (__builtin_trap)
/* Doing it this way helps various packages when configured with
--enable-gcc-warnings, which compiles with -Dlint. It's nicer
when 'assume' silences warnings even with older GCCs. */
@@ -287,6 +290,13 @@ template <int w>
# define assume(R) ((R) ? (void) 0 : /*NOTREACHED*/ (void) 0)
#endif
+#ifdef _GL_TEMPDEF___has_builtin
+# undef __has_builtin
+# undef _GL_HAS___builtin_unreachable
+# undef _GL_HAS___builtin_trap
+# undef _GL_TEMPDEF___has_builtin
+#endif
+
/* @assert.h omit end@ */
#endif
diff --git a/lisp/battery.el b/lisp/battery.el
index 7037d07..0ef6d37 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -38,19 +38,21 @@
:prefix "battery-"
:group 'hardware)
-(defcustom battery-linux-sysfs-regexp "[bB][aA][tT][0-9]?$"
- "Regexp for folder names to be searched under
- /sys/class/power_supply/ that contain battery information."
- :version "26.1"
- :type 'regexp
- :group 'battery)
-
(defcustom battery-upower-device "battery_BAT1"
"Upower battery device name."
:version "26.1"
:type 'string
:group 'battery)
+(defun battery--find-linux-sysfs-batteries ()
+ (let ((dirs nil))
+ (dolist (file (directory-files "/sys/class/power_supply/" t))
+ (when (and (or (file-directory-p file)
+ (file-symlink-p file))
+ (file-exists-p (expand-file-name "capacity" file)))
+ (push file dirs)))
+ (nreverse dirs)))
+
(defcustom battery-status-function
(cond ((and (eq system-type 'gnu/linux)
(file-readable-p "/proc/apm"))
@@ -60,8 +62,7 @@
#'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
(file-directory-p "/sys/class/power_supply/")
- (directory-files "/sys/class/power_supply/" nil
- battery-linux-sysfs-regexp))
+ (battery--find-linux-sysfs-batteries))
#'battery-linux-sysfs)
((and (eq system-type 'berkeley-unix)
(file-executable-p "/usr/sbin/apm"))
@@ -449,9 +450,7 @@ The following %-sequences are provided:
;; available information together.
(with-temp-buffer
(dolist (dir (ignore-errors
- (directory-files
- "/sys/class/power_supply/" t
- battery-linux-sysfs-regexp)))
+ (battery--find-linux-sysfs-batteries)))
(erase-buffer)
(ignore-errors (insert-file-contents
(expand-file-name "uevent" dir)))
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index f564cd6..e58e051 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -619,8 +619,8 @@ If POSN is non-nil, record POSN as the point instead of
`(point)'."
;; was incorrect in Emacs 22 and Emacs 23.1.)
;;
;; To deal with the change from FIRST format to SECOND, conversion
-;; code was added, and it is still in use. See
-;; `bookmark-maybe-upgrade-file-format'.
+;; code was added, which is no longer used and has been declared
+;; obsolete. See `bookmark-maybe-upgrade-file-format'.
;;
;; No conversion from SECOND to CURRENT is done. Instead, the code
;; handles both formats OK. It must continue to do so.
@@ -640,7 +640,7 @@ You should never need to change this.")
(defun bookmark-alist-from-buffer ()
- "Return a `bookmark-alist' (in any format) from the current buffer.
+ "Return a `bookmark-alist' from the current buffer.
The buffer must of course contain bookmark format information.
Does not care from where in the buffer it is called, and does not
affect point."
@@ -648,19 +648,13 @@ affect point."
(goto-char (point-min))
(if (search-forward bookmark-end-of-version-stamp-marker nil t)
(read (current-buffer))
- ;; Else we're dealing with format version 0
- (if (search-forward "(" nil t)
- (progn
- (forward-char -1)
- (read (current-buffer)))
- ;; Else no hope of getting information here.
- (if buffer-file-name
- (error "File not in bookmark format: %s" buffer-file-name)
- (error "Buffer not in bookmark format: %s" (buffer-name)))))))
-
+ (if buffer-file-name
+ (error "File not in bookmark format: %s" buffer-file-name)
+ (error "Buffer not in bookmark format: %s" (buffer-name))))))
(defun bookmark-upgrade-version-0-alist (old-list)
"Upgrade a version 0 alist OLD-LIST to the current version."
+ (declare (obsolete nil "27.1"))
(mapcar
(lambda (bookmark)
(let* ((name (car bookmark))
@@ -683,11 +677,14 @@ affect point."
(defun bookmark-upgrade-file-format-from-0 ()
"Upgrade a bookmark file of format 0 (the original format) to format 1.
This expects to be called from `point-min' in a bookmark file."
+ (declare (obsolete nil "27.1"))
(let* ((reporter (make-progress-reporter
(format "Upgrading bookmark format from 0 to %d..."
- bookmark-file-format-version)))
+ bookmark-file-format-version)))
(old-list (bookmark-alist-from-buffer))
- (new-list (bookmark-upgrade-version-0-alist old-list)))
+ (new-list (with-suppressed-warnings
+ ((obsolete bookmark-upgrade-version-0-alist))
+ (bookmark-upgrade-version-0-alist old-list))))
(delete-region (point-min) (point-max))
(bookmark-insert-file-format-version-stamp buffer-file-coding-system)
(pp new-list (current-buffer))
@@ -699,6 +696,7 @@ This expects to be called from `point-min' in a bookmark
file."
(defun bookmark-grok-file-format-version ()
"Return an integer which is the file-format version of this bookmark file.
This expects to be called from `point-min' in a bookmark file."
+ (declare (obsolete nil "27.1"))
(if (looking-at "^;;;;")
(save-excursion
(save-match-data
@@ -714,12 +712,18 @@ This expects to be called from `point-min' in a bookmark
file."
"Check the file-format version of this bookmark file.
If the version is not up-to-date, upgrade it automatically.
This expects to be called from `point-min' in a bookmark file."
- (let ((version (bookmark-grok-file-format-version)))
+ (declare (obsolete nil "27.1"))
+ (let ((version
+ (with-suppressed-warnings
+ ((obsolete bookmark-grok-file-format-version))
+ (bookmark-grok-file-format-version))))
(cond
((= version bookmark-file-format-version)
) ; home free -- version is current
((= version 0)
- (bookmark-upgrade-file-format-from-0))
+ (with-suppressed-warnings
+ ((obsolete bookmark-upgrade-file-format-from-0))
+ (bookmark-upgrade-file-format-from-0)))
(t
(error "Bookmark file format version strangeness")))))
@@ -1541,7 +1545,6 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(with-current-buffer (let (enable-local-variables)
(find-file-noselect file))
(goto-char (point-min))
- (bookmark-maybe-upgrade-file-format)
(let ((blist (bookmark-alist-from-buffer)))
(unless (listp blist)
(error "Invalid bookmark list in %s" file))
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 3c46982..3ae0fcb 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -2095,7 +2095,9 @@ written into the buffer `*icalendar-errors*'."
dtstart-zone))
(start-d (icalendar--datetime-to-diary-date
dtstart-dec))
- (start-t (icalendar--datetime-to-colontime dtstart-dec))
+ (start-t (and dtstart
+ (> (length dtstart) 8)
+ (icalendar--datetime-to-colontime dtstart-dec)))
(dtend (icalendar--get-event-property e 'DTEND))
(dtend-zone (icalendar--find-time-zone
(icalendar--get-event-property-attributes
@@ -2148,8 +2150,7 @@ written into the buffer `*icalendar-errors*'."
(icalendar--get-event-property-attributes
e 'DTEND))
"DATE")))
- (icalendar--datetime-to-colontime dtend-dec)
- start-t))
+ (icalendar--datetime-to-colontime dtend-dec)))
(icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
(cond
;; recurring event
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index f3d252f..11bd469 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -421,10 +421,13 @@ changes in daylight saving time are not taken into
account."
;; Do the time part, which is pretty simple (except for leap
;; seconds, I guess).
;; Time zone adjustments are basically the same as time adjustments.
- (setq seconds (time-add (+ (* (or (decoded-time-hour delta) 0) 3600)
- (* (or (decoded-time-minute delta) 0) 60)
- (or (decoded-time-zone delta) 0))
- (or (decoded-time-second delta) 0)))
+ (setq seconds (time-convert (or (decoded-time-second delta) 0) t))
+ (setq seconds
+ (time-add seconds
+ (time-convert (+ (* (or (decoded-time-hour delta) 0) 3600)
+ (* (or (decoded-time-minute delta) 0) 60)
+ (or (decoded-time-zone delta) 0))
+ (cdr seconds))))
(decoded-time--alter-second time seconds)
time))
@@ -461,11 +464,16 @@ changes in daylight saving time are not taken into
account."
(defun decoded-time--alter-second (time seconds)
"Increase the time in TIME by SECONDS."
- (let* ((secsperday 86400)
- (old (time-add (+ (* 3600 (or (decoded-time-hour time) 0))
- (* 60 (or (decoded-time-minute time) 0)))
- (or (decoded-time-second time) 0)))
- (new (time-add old seconds)))
+ (let* ((time-sec (time-convert (or (decoded-time-second time) 0) t))
+ (time-hz (cdr time-sec))
+ (old (time-add time-sec
+ (time-convert
+ (+ (* 3600 (or (decoded-time-hour time) 0))
+ (* 60 (or (decoded-time-minute time) 0)))
+ time-hz)))
+ (new (time-convert (time-add old seconds) t))
+ (new-hz (cdr new))
+ (secsperday (time-convert 86400 new-hz)))
;; Hm... DST...
(while (time-less-p new 0)
(decoded-time--alter-day time nil)
@@ -474,8 +482,10 @@ changes in daylight saving time are not taken into
account."
(decoded-time--alter-day time t)
(setq new (time-subtract new secsperday)))
(let ((sec (time-convert new 'integer)))
- (setf (decoded-time-second time) (time-add (% sec 60)
- (time-subtract new sec))
+ (setf (decoded-time-second time) (time-add
+ (time-convert (% sec 60) new-hz)
+ (time-subtract
+ new (time-convert sec new-hz)))
(decoded-time-minute time) (% (/ sec 60) 60)
(decoded-time-hour time) (/ sec 3600)))))
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 0774a46..59ba3ff 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -216,7 +216,7 @@ This enables the creation of your target type."
(setq ede-proj-target-alist
(cons (cons name class) ede-proj-target-alist)))))
-(defclass ede-proj-project (eieio-persistent ede-project)
+(defclass ede-proj-project (eieio-persistent ede-project eieio-named)
((extension :initform ".ede")
(file-header-line :initform ";; EDE Project Files are auto generated: Do
Not Edit")
(makefile-type :initarg :makefile-type
diff --git a/lisp/composite.el b/lisp/composite.el
index d0f2094..b3661cc 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -558,9 +558,9 @@ All non-spacing characters have this function in
;; "Improper" base characters are of the following general
;; categories:
;; Mark (nonspacing, combining, enclosing)
- ;; Separator (space, line, paragraph)
+ ;; Separator (line, paragraph)
;; Other (control, format, surrogate)
- '(Mn Mc Me Zs Zl Zp Cc Cf Cs))
+ '(Mn Mc Me Zl Zp Cc Cf Cs))
nil)
;; A base character and the following non-spacing characters.
diff --git a/lisp/custom.el b/lisp/custom.el
index 9bd9712..2e42ea7 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1137,6 +1137,7 @@ Every theme X has a property `provide-theme' whose value
is \"X-theme\".
The command `customize-create-theme' writes theme files into this
directory. By default, Emacs searches for custom themes in this
directory first---see `custom-theme-load-path'."
+ :initialize #'custom-initialize-delay
:type 'string
:group 'customize
:version "22.1")
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 72deb0c..91f89e1 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -40,7 +40,7 @@
;; * Frame/buffer killing hooks
;; * Mouse-3 position relative menu
;; * Mouse motion, help-echo hacks
-;; * Mouse clicking, double clicking, & XEmacs image clicking hack
+;; * Mouse clicking & double clicking
;; * Mode line hacking
;; * Utilities for use in a program covering:
;; o keymap massage for some actions
@@ -56,7 +56,6 @@
;; 1) (require 'dframe)
;; 2) Variable Setup:
;; -frame-parameters -- Frame parameters for Emacs.
-;; -frame-plist -- Frame parameters for XEmacs.
;; -- Not on parameter lists: They can optionally include width
;; and height. If width or height is not included, then it will
;; be provided to match the originating frame. In general,
@@ -112,13 +111,9 @@
;;; Code:
-;;; Compatibility functions
-;;
-(defalias 'dframe-frame-parameter
- (if (fboundp 'frame-parameter) 'frame-parameter
- (lambda (frame parameter)
- "Return FRAME's PARAMETER value."
- (cdr (assoc parameter (frame-parameters frame))))))
+
+(define-obsolete-function-alias 'dframe-frame-parameter
+ 'frame-parameter "27.1")
;;; Variables
@@ -322,8 +317,8 @@ CREATE-HOOK is a hook to run after creating a frame."
(if (frame-live-p (symbol-value frame-var))
(raise-frame (symbol-value frame-var))
(set frame-var
- (let* ((mh (dframe-frame-parameter dframe-attached-frame
- 'menu-bar-lines))
+ (let* ((mh (frame-parameter dframe-attached-frame
+ 'menu-bar-lines))
(paramsa
;; Only add a guessed height if one is not specified
;; in the input parameters.
@@ -377,8 +372,8 @@ a cons cell indicating a position of the form (LEFT . TOP)."
;; Position dframe.
;; Do no positioning if not on a windowing system,
(unless (or (not window-system) (eq window-system 'pc))
- (let* ((pfx (dframe-frame-parameter parent-frame 'left))
- (pfy (dframe-frame-parameter parent-frame 'top))
+ (let* ((pfx (frame-parameter parent-frame 'left))
+ (pfy (frame-parameter parent-frame 'top))
(pfw (+ (tool-bar-pixel-width parent-frame)
(frame-pixel-width parent-frame)))
(pfh (frame-pixel-height parent-frame))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6c06d84..a321247 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -992,6 +992,7 @@ command with a prefix argument (the value does not matter)."
("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
("\\.gz\\'" "" "gunzip")
+ ("\\.lz\\'" "" "lzip -d")
("\\.Z\\'" "" "uncompress")
;; For .z, try gunzip. It might be an old gzip file,
;; or it might be from compact? pack? (which?) but gunzip handles both.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 40b4e2f..2fab11c 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4071,7 +4071,7 @@ that suppresses all warnings during execution of BODY."
,condition '(fboundp functionp)
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
- ,condition '(boundp default-boundp)))
+ ,condition '(boundp default-boundp local-variable-p)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
(append bound-list byte-compile-bound-variables)))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 7b22fa8..ff09691 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -110,6 +110,7 @@ a future Emacs interpreter will be able to use it.")
;; These macros are defined here so that they
;; can safely be used in init files.
+;;;###autoload
(defmacro cl-incf (place &optional x)
"Increment PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
@@ -129,9 +130,12 @@ The return value is the decremented value of PLACE."
(list 'cl-callf '- place (or x 1))))
(defmacro cl-pushnew (x place &rest keys)
- "(cl-pushnew X PLACE): insert X at the head of the list if not already there.
-Like (push X PLACE), except that the list is unmodified if X is `eql' to
-an element already on the list.
+ "Add X to the list stored in PLACE unless X is already in the list.
+PLACE is a generalized variable that stores a list.
+
+Like (push X PLACE), except that PLACE is unmodified if X is `eql'
+to an element already in the list stored in PLACE.
+
\nKeywords supported: :test :test-not :key
\n(fn X PLACE [KEYWORD VALUE]...)"
(declare (debug
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 05a4192..a02fae3 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2906,7 +2906,16 @@ Supported keywords for slots are:
(error "Duplicate slots named %s in %s" slot name))
(let ((accessor (intern (format "%s%s" conc-name slot)))
(default-value (pop desc))
- (doc (plist-get desc :documentation)))
+ (doc (plist-get desc :documentation))
+ (access-body
+ `(progn
+ ,@(and pred-check
+ (list `(or ,pred-check
+ (signal 'wrong-type-argument
+ (list ',name cl-x)))))
+ ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
+ (if (= pos 0) '(car cl-x)
+ `(nth ,pos cl-x))))))
(push slot slots)
(push default-value defaults)
;; The arg "cl-x" is referenced by name in eg pred-form
@@ -2916,13 +2925,7 @@ Supported keywords for slots are:
slot name
(if doc (concat "\n" doc) ""))
(declare (side-effect-free t))
- ,@(and pred-check
- (list `(or ,pred-check
- (signal 'wrong-type-argument
- (list ',name cl-x)))))
- ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
- (if (= pos 0) '(car cl-x)
- `(nth ,pos cl-x))))
+ ,access-body)
forms)
(when (cl-oddp (length desc))
(push
@@ -2942,11 +2945,18 @@ Supported keywords for slots are:
forms)
(push kw desc)
(setcar defaults nil))))
- (if (plist-get desc ':read-only)
- (push `(gv-define-expander ,accessor
- (lambda (_cl-do _cl-x)
- (error "%s is a read-only slot" ',accessor)))
- forms)
+ (cond
+ ((eq defsym 'defun)
+ (unless (plist-get desc ':read-only)
+ (push `(defun ,(gv-setter accessor) (val cl-x)
+ (setf ,access-body val))
+ forms)))
+ ((plist-get desc ':read-only)
+ (push `(gv-define-expander ,accessor
+ (lambda (_cl-do _cl-x)
+ (error "%s is a read-only slot" ',accessor)))
+ forms))
+ (t
;; For normal slots, we don't need to define a setf-expander,
;; since gv-get can use the compiler macro to get the
;; same result.
@@ -2964,7 +2974,7 @@ Supported keywords for slots are:
;; ,(and pred-check `',pred-check)
;; ,pos)))
;; forms)
- )
+ ))
(if print-auto
(nconc print-func
(list `(princ ,(format " %s" slot) cl-s)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index be531aa..bbc3a27 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -363,18 +363,21 @@ No problems result if this variable is not bound.
;;;###autoload
(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
;;;###autoload
-(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys)
+(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
"Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
and that should try to turn MODE on if applicable for that buffer.
-KEYS is a list of CL-style keyword arguments. As the minor mode
- defined by this function is always global, any :global keyword is
- ignored. Other keywords have the same meaning as in `define-minor-mode',
- which see. In particular, :group specifies the custom group.
- The most useful keywords are those that are passed on to the
- `defcustom'. It normally makes no sense to pass the :lighter
- or :keymap keywords to `define-globalized-minor-mode', since these
- are usually passed to the buffer-local version of the minor mode.
+Each of KEY VALUE is a pair of CL-style keyword arguments. As
+ the minor mode defined by this function is always global, any
+ :global keyword is ignored. Other keywords have the same
+ meaning as in `define-minor-mode', which see. In particular,
+ :group specifies the custom group. The most useful keywords
+ are those that are passed on to the `defcustom'. It normally
+ makes no sense to pass the :lighter or :keymap keywords to
+ `define-globalized-minor-mode', since these are usually passed
+ to the buffer-local version of the minor mode.
+BODY contains code to execute each time the mode is enabled or disabled.
+ It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
If MODE's set-up depends on the major mode in effect when it was
enabled, then disabling and reenabling MODE should make MODE work
@@ -384,7 +387,9 @@ call another major mode in their body.
When a major mode is initialized, MODE is actually turned on just
after running the major mode's hook. However, MODE is not turned
-on if the hook has explicitly disabled it."
+on if the hook has explicitly disabled it.
+
+\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)"
(declare (doc-string 2))
(let* ((global-mode-name (symbol-name global-mode))
(mode-name (symbol-name mode))
@@ -404,12 +409,12 @@ on if the hook has explicitly disabled it."
keyw)
;; Check keys.
- (while (keywordp (setq keyw (car keys)))
- (setq keys (cdr keys))
+ (while (keywordp (setq keyw (car body)))
+ (pop body)
(pcase keyw
- (:group (setq group (nconc group (list :group (pop keys)))))
- (:global (setq keys (cdr keys)))
- (_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
+ (:group (setq group (nconc group (list :group (pop body)))))
+ (:global (pop body))
+ (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
`(progn
(progn
@@ -446,7 +451,8 @@ See `%s' for more information on %s."
;; Go through existing buffers.
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1))))))
+ (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1)))))
+ ,@body)
;; Autoloading define-globalized-minor-mode autoloads everything
;; up-to-here.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 16b5863..2892faa 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -207,7 +207,24 @@ expression point is on."
(define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode
:group 'eldoc
:initialize 'custom-initialize-delay
- :init-value t)
+ :init-value t
+ ;; For `read--expression', the usual global mode mechanism of
+ ;; `change-major-mode-hook' runs in the minibuffer before
+ ;; `eldoc-documentation-function' is set, so `turn-on-eldoc-mode'
+ ;; does nothing. Configure and enable eldoc from
+ ;; `eval-expression-minibuffer-setup-hook' instead.
+ (if global-eldoc-mode
+ (add-hook 'eval-expression-minibuffer-setup-hook
+ #'eldoc--eval-expression-setup)
+ (remove-hook 'eval-expression-minibuffer-setup-hook
+ #'eldoc--eval-expression-setup)))
+
+(defun eldoc--eval-expression-setup ()
+ ;; Setup `eldoc', similar to `emacs-lisp-mode'. FIXME: Call
+ ;; `emacs-lisp-mode' itself?
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'elisp-eldoc-documentation-function)
+ (eldoc-mode +1))
;;;###autoload
(defun turn-on-eldoc-mode ()
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9fc7e4a..142c99e 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -285,10 +285,19 @@ Interactively, prompt for LIBRARY using the one at or
near point."
A library name is the filename of an Emacs Lisp library located
in a directory under `load-path' (or `find-function-source-path',
if non-nil)."
- (let* ((dirs (or find-function-source-path load-path))
- (suffixes (find-library-suffixes))
- (table (apply-partially 'locate-file-completion-table
- dirs suffixes))
+ (let* ((suffix-regexp (mapconcat
+ (lambda (suffix)
+ (concat (regexp-quote suffix) "\\'"))
+ (find-library-suffixes)
+ "\\|"))
+ (table (cl-loop for dir in (or find-function-source-path load-path)
+ when (file-readable-p dir)
+ append (mapcar
+ (lambda (file)
+ (replace-regexp-in-string suffix-regexp
+ "" file))
+ (directory-files dir nil
+ suffix-regexp))))
(def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a72522a..ef0c517 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1028,6 +1028,7 @@ is wrapped around any parts requiring it."
deps))))
(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-header-multiline "lisp-mnt" (header))
(declare-function lm-homepage "lisp-mnt" (&optional file))
(declare-function lm-keywords-list "lisp-mnt" (&optional file))
(declare-function lm-maintainer "lisp-mnt" (&optional file))
@@ -1054,8 +1055,7 @@ boundaries."
(narrow-to-region start (point))
(require 'lisp-mnt)
;; Use some headers we've invented to drive the process.
- (let* ((requires-str (lm-header "package-requires"))
- ;; Prefer Package-Version; if defined, the package author
+ (let* (;; Prefer Package-Version; if defined, the package author
;; probably wants us to use it. Otherwise try Version.
(pkg-version
(or (package-strip-rcs-id (lm-header "package-version"))
@@ -1067,9 +1067,9 @@ boundaries."
"Package lacks a \"Version\" or \"Package-Version\" header"))
(package-desc-from-define
file-name pkg-version desc
- (if requires-str
- (package--prepare-dependencies
- (package-read-from-string requires-str)))
+ (and-let* ((require-lines (lm-header-multiline "package-requires")))
+ (package--prepare-dependencies
+ (package-read-from-string (mapconcat #'identity require-lines " "))))
:kind 'single
:url homepage
:keywords keywords
@@ -2894,7 +2894,7 @@ KEYWORDS should be nil or a list of keywords."
(mapcar #'package-menu--print-info-simple info-list))))
(defun package-all-keywords ()
- "Collect all package keywords"
+ "Collect all package keywords."
(let ((key-list))
(package--mapc (lambda (desc)
(setq key-list (append (package-desc--keywords desc)
@@ -2951,7 +2951,7 @@ When none are given, the package matches."
(defun package-menu--generate (remember-pos packages &optional keywords)
"Populate the Package Menu.
- If REMEMBER-POS is non-nil, keep point on the same entry.
+If REMEMBER-POS is non-nil, keep point on the same entry.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display.
@@ -3086,12 +3086,15 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
"`package-archive-contents' before the latest refresh.")
(defun package-menu-refresh ()
- "Download the Emacs Lisp package archive.
-This fetches the contents of each archive specified in
-`package-archives', and then refreshes the package menu."
+ "In Package Menu, download the Emacs Lisp package archive.
+Fetch the contents of each archive specified in
+`package-archives', and then refresh the package menu. Signal a
+user-error if there is already a refresh running asynchronously."
(interactive)
(unless (derived-mode-p 'package-menu-mode)
(user-error "The current buffer is not a Package Menu"))
+ (when (and package-menu-async package--downloads-in-progress)
+ (user-error "Package refresh is already in progress, please wait..."))
(setq package-menu--old-archive-contents package-archive-contents)
(setq package-menu--new-package-list nil)
(package-refresh-contents package-menu-async))
@@ -3206,7 +3209,7 @@ The full list of keys can be viewed with
\\[describe-mode]."
"Return the priority of ARCHIVE.
The archive priorities are specified in
-`package-archive-priorities'. If not given there, the priority
+`package-archive-priorities'. If not given there, the priority
defaults to 0."
(or (cdr (assoc archive package-archive-priorities))
0))
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 47f3b8d..13cd1c0 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -106,7 +106,7 @@ Usage example:
(setq tchar
(if (and (display-popup-menus-p)
last-input-event ; not during startup
- (listp last-nonmenu-event)
+ (consp last-nonmenu-event)
use-dialog-box)
(x-popup-dialog
t
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index f76409c..bb2bf3d 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -236,7 +236,9 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(string-trim-left (string-trim-right string trim-right) trim-left))
(defsubst string-blank-p (string)
- "Check whether STRING is either empty or only whitespace."
+ "Check whether STRING is either empty or only whitespace.
+The following characters count as whitespace here: space, tab, newline and
+carriage return."
(string-match-p "\\`[ \t\n\r]*\\'" string))
(defsubst string-remove-prefix (prefix string)
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index d9886d3..c43641a 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -102,16 +102,15 @@ encryption is used."
(apply operation args)))
(defun epa-file-decode-and-insert (string file visit beg end replace)
- (if (fboundp 'decode-coding-inserted-region)
- (save-restriction
- (narrow-to-region (point) (point))
- (insert string)
- (decode-coding-inserted-region
- (point-min) (point-max)
- (substring file 0 (string-match epa-file-name-regexp file))
- visit beg end replace))
- (insert (epa-file--decode-coding-string string (or coding-system-for-read
- 'undecided)))))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert string)
+ (decode-coding-inserted-region
+ (point-min) (point-max)
+ (substring file 0 (string-match epa-file-name-regexp file))
+ visit beg end replace)
+ (goto-char (point-max))
+ (- (point-max) (point-min))))
(defvar epa-file-error nil)
(defun epa-file--find-file-not-found-function ()
@@ -147,8 +146,6 @@ encryption is used."
(format "Decrypting %s" file)))
(unwind-protect
(progn
- (if replace
- (goto-char (point-min)))
(condition-case error
(setq string (epg-decrypt-file context local-file nil))
(error
@@ -187,12 +184,11 @@ encryption is used."
;; really edit the buffer.
(let ((buffer-file-name
(if visit nil buffer-file-name)))
- (save-restriction
- (narrow-to-region (point) (point))
- (epa-file-decode-and-insert string file visit beg end replace)
- (setq length (- (point-max) (point-min))))
- (if replace
- (delete-region (point) (point-max))))
+ (setq length
+ (if replace
+ (epa-file--replace-text string file visit beg end)
+ (epa-file-decode-and-insert
+ string file visit beg end replace))))
(if visit
(set-visited-file-modtime))))
(if (and local-copy
@@ -201,6 +197,38 @@ encryption is used."
(list file length)))
(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
+(defun epa-file--replace-text (string file visit beg end)
+ ;; The idea here is that we want to replace the text in the buffer
+ ;; (for instance, for a `revert-buffer'), but we want to touch as
+ ;; little of the text as possible. So we compare the new and the
+ ;; old text and only starts replacing when the text changes.
+ (let ((orig-point (point))
+ new-start length)
+ (goto-char (point-max))
+ (setq new-start (point))
+ (setq length
+ (epa-file-decode-and-insert
+ string file visit beg end t))
+ (if (equal (buffer-substring (point-min) new-start)
+ (buffer-substring new-start (point-max)))
+ ;; The new text is equal to the old, so just keep the old.
+ (delete-region new-start (point-max))
+ ;; Compute the region the hard way.
+ (let ((p1 (point-min))
+ (p2 new-start))
+ (while (and (< p1 new-start)
+ (< p2 (point-max))
+ (eql (char-after p1) (char-after p2)))
+ (cl-incf p1)
+ (cl-incf p2))
+ (delete-region new-start p2)
+ (delete-region p1 new-start)))
+ ;; Restore point, if possible.
+ (if (< orig-point (point-max))
+ (goto-char orig-point)
+ (goto-char (point-max)))
+ length))
+
(defun epa-file-write-region (start end file &optional append visit lockname
mustbenew)
(if append
diff --git a/lisp/epa.el b/lisp/epa.el
index 9e6edf4..b55a55f 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -440,12 +440,12 @@ If ARG is non-nil, mark the key."
(substitute-command-keys "\
- `\\[epa-mark-key]' to mark a key on the line
- `\\[epa-unmark-key]' to unmark a key on the line\n"))
- (widget-create 'link
+ (widget-create 'push-button
:notify (lambda (&rest _ignore) (abort-recursive-edit))
:help-echo
"Click here or \\[abort-recursive-edit] to cancel"
"Cancel")
- (widget-create 'link
+ (widget-create 'push-button
:notify (lambda (&rest _ignore) (exit-recursive-edit))
:help-echo
"Click here or \\[exit-recursive-edit] to finish"
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 5549068..4a9cc77 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -148,7 +148,11 @@ Otherwise, it tries the programs listed in the entry until
the
version requirement is met."
(unless program-alist
(setq program-alist epg-config--program-alist))
- (let ((entry (assq protocol program-alist)))
+ (let ((entry (assq protocol program-alist))
+ ;; In many gnupg distributions (especially on Windows), the
+ ;; version string is "gpg (GnuPG) 2.2.15-unknown" or the like.
+ (version-regexp-alist (cons '("^[-._+ ]?unknown$" . -4)
+ version-regexp-alist)))
(unless entry
(error "Unknown protocol %S" protocol))
(cl-destructuring-bind (symbol . alist)
@@ -262,6 +266,15 @@ a single minimum version string."
(throw 'version-ok t)))
(error "Unsupported version: %s" version))))
+(defun epg-required-version-p (protocol required-version)
+ "Verify a sufficient version of GnuPG for specific protocol.
+PROTOCOL is symbol, either `OpenPGP' or `CMS'. REQUIRED-VERSION
+is a string containing the required version number. Return
+non-nil if that version or higher is installed."
+ (let ((version (cdr (assq 'version (epg-find-configuration protocol)))))
+ (and (stringp version)
+ (version<= required-version version))))
+
;;;###autoload
(defun epg-expand-group (config group)
"Look at CONFIG and try to expand GROUP."
diff --git a/lisp/epg.el b/lisp/epg.el
index ce58c52..6d377d0 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1618,7 +1618,9 @@ If you are unsure, use synchronous version of this
function
(car (epg-key-sub-key-list signer)))))
(epg-context-signers context)))
(let ((sender (epg-context-sender context)))
- (when (stringp sender)
+ (when (and (eql 'OpenPGP (epg-context-protocol context))
+ (epg-required-version-p 'OpenPGP "2.1.15")
+ (stringp sender))
(list "--sender" sender)))
(epg--args-from-sig-notations
(epg-context-sig-notations context))
@@ -1714,9 +1716,11 @@ If you are unsure, use synchronous version of this
function
(car (epg-key-sub-key-list
signer)))))
(epg-context-signers context))))
- (if sign
+ (if (and sign
+ (eql 'OpenPGP (epg-context-protocol context)))
(let ((sender (epg-context-sender context)))
- (when (stringp sender)
+ (when (and (epg-required-version-p 'OpenPGP
"2.1.15")
+ (stringp sender))
(list "--sender" sender))))
(if sign
(epg--args-from-sig-notations
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f5c9dec..fd1bd55 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2594,6 +2594,8 @@ every `erc-lurker-cleanup-interval' updates to
consumption of lurker state during long Emacs sessions and/or ERC
sessions with large numbers of incoming PRIVMSGs.")
+(defvar erc-message-parsed)
+
(defun erc-lurker-update-status (_message)
"Update `erc-lurker-state' if necessary.
@@ -2603,18 +2605,20 @@ reflect the fact that its sender has issued a PRIVMSG
at the
current time. Otherwise, take no action.
This function depends on the fact that `erc-display-message'
-dynamically binds `parsed', which is used to check if the current
-message is a PRIVMSG and to determine its sender. See also
-`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
+dynamically binds `erc-message-parsed', which is used to check if
+the current message is a PRIVMSG and to determine its sender.
+See also `erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
In order to limit memory consumption, this function also calls
`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
updates of `erc-lurker-state'."
- (when (and (boundp 'parsed) (erc-response-p parsed))
- (let* ((command (erc-response.command parsed))
+ (when (and (boundp 'erc-message-parsed)
+ (erc-response-p erc-message-parsed))
+ (let* ((command (erc-response.command erc-message-parsed))
(sender
(erc-lurker-maybe-trim
- (car (erc-parse-user (erc-response.sender parsed)))))
+ (car (erc-parse-user
+ (erc-response.sender erc-message-parsed)))))
(server
(erc-canonicalize-server-name erc-server-announced-name)))
(when (equal command "PRIVMSG")
@@ -2704,7 +2708,8 @@ ARGS, PARSED, and TYPE are used to format MSG sensibly.
See also `erc-format-message' and `erc-display-line'."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
- msg)))
+ msg))
+ (erc-message-parsed parsed))
(setq string
(cond
((null type)
diff --git a/lisp/files.el b/lisp/files.el
index f766350..ce4dd99 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1043,7 +1043,7 @@ directory if it does not exist."
(setq errtype "access"))
(with-file-modes ?\700
(condition-case nil
- (make-directory user-emacs-directory)
+ (make-directory user-emacs-directory t)
(error (setq errtype "create")))))
(when (and errtype
user-emacs-directory-warning
@@ -2719,6 +2719,8 @@ since only a single case-insensitive search through the
alist is made."
("\\.bib\\'" . bibtex-mode)
("\\.bst\\'" . bibtex-style-mode)
("\\.sql\\'" . sql-mode)
+ ;; These .m4 files are Autoconf files.
+ ("\\(acinclude\\|aclocal\\|acsite\\)\\.m4\\'" . autoconf-mode)
("\\.m[4c]\\'" . m4-mode)
("\\.mf\\'" . metafont-mode)
("\\.mp\\'" . metapost-mode)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index af8ec68..04cb087 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3628,7 +3628,7 @@ possible values."
(unless max-segments
(setq max-segments (length article-time-units)))
(cond
- ((zerop sec)
+ ((< (abs sec) 1)
"Now")
(t
(concat
@@ -5059,7 +5059,10 @@ and `gnus-mime-delete-part', and not provided at
run-time normally."
(list
(read-file-name "Replace MIME part with file: "
(or mm-default-directory default-directory)
- nil nil)))
+ nil t)))
+ (unless (file-regular-p (file-truename file))
+ (error "Can't replace part with %s, which isn't a regular file"
+ file))
(gnus-mime-save-part-and-strip file))
(defun gnus-mime-save-part-and-strip (&optional file)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 930d522..e8775c6 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -738,7 +738,6 @@ level. If ARG is nil, Gnus will be started at level 2
and not a positive number, Gnus will prompt the user for the name
of an NNTP server to use. As opposed to \\[gnus], this command
will not connect to the local server."
- (interactive "P")
(let ((val (or arg (1- gnus-level-default-subscribed))))
(gnus val t slave)
(make-local-variable 'gnus-group-use-permanent-levels)
@@ -749,8 +748,6 @@ will not connect to the local server."
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use."
- (interactive "P")
-
(if (gnus-alive-p)
(progn
(gnus-run-hooks 'gnus-before-resume-hook)
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 07d2028..e0ec829 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -915,7 +915,7 @@ If no one is selected, symmetric encryption will be
performed. "
(when sign
(setq signers (mml-secure-signers context signer-names))
(setf (epg-context-signers context) signers)
- (when mml-secure-openpgp-sign-with-sender
+ (when (and (eq 'OpenPGP protocol) mml-secure-openpgp-sign-with-sender)
(setf (epg-context-sender context) sender)))
(when (eq 'OpenPGP protocol)
(setf (epg-context-armor context) t)
@@ -945,10 +945,10 @@ If no one is selected, symmetric encryption will be
performed. "
signature micalg)
(when (eq 'OpenPGP protocol)
(setf (epg-context-armor context) t)
- (setf (epg-context-textmode context) t))
+ (setf (epg-context-textmode context) t)
+ (when mml-secure-openpgp-sign-with-sender
+ (setf (epg-context-sender context) sender)))
(setf (epg-context-signers context) signers)
- (when mml-secure-openpgp-sign-with-sender
- (setf (epg-context-sender context) sender))
(when (mml-secure-cache-passphrase-p protocol)
(epg-context-set-passphrase-callback
context
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 65465d3..b6b0e2a 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -447,7 +447,7 @@ highlighting will not update as you type."
(hi-lock-set-pattern
;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
;; or a trailing $ in REGEXP will be interpreted correctly.
- (concat "^.*\\(?:" regexp "\\).*$") face))
+ (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face))
;;;###autoload
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 1b69574..06a2248 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1846,7 +1846,8 @@ When BUF nil, default to the buffer at current line."
(stringp dired-directory)
dired-directory)))))
(when name
- (string-match regexp name))))))
+ ;; Match on the displayed file name (which is abbreviated).
+ (string-match regexp (abbreviate-file-name name)))))))
;;;###autoload
(defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers)
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 5c30f40..9c7c91e 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -720,11 +720,15 @@ was inserted."
archive-superior-buffer))
(not (and (boundp 'tar-superior-buffer)
tar-superior-buffer))
+ ;; This means the buffer holds the contents
+ ;; of a file uncompressed by jka-compr.el.
+ (not (and (local-variable-p
+ 'jka-compr-really-do-compress)
+ jka-compr-really-do-compress))
;; This means the buffer holds the
;; decrypted content (bug#21870).
- (not (and (boundp 'epa-file-encrypt-to)
- (local-variable-p
- 'epa-file-encrypt-to))))))
+ (not (local-variable-p
+ 'epa-file-encrypt-to)))))
(file-or-data
(if data-p
(let ((str
diff --git a/lisp/info.el b/lisp/info.el
index 1690973..02f3ea5 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -318,7 +318,7 @@ want to set `Info-refill-paragraphs'."
(set sym val)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (when (eq major-mode 'Info-mode)
+ (when (derived-mode-p 'Info-mode)
(revert-buffer t t)))))
:group 'info)
@@ -841,7 +841,7 @@ See a list of available Info commands in `Info-mode'."
(defun info-standalone ()
"Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
-In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
+In standalone mode, \\<Info-mode-map>\\[quit-window] exits Emacs itself."
(setq Info-standalone t)
(if (and command-line-args-left
(not (string-match "^-" (car command-line-args-left))))
@@ -2948,12 +2948,7 @@ N is the digit argument used to invoke this command."
(t
(user-error "No pointer backward from this node")))))
-(defun Info-exit ()
- "Exit Info by selecting some other buffer."
- (interactive)
- (if Info-standalone
- (save-buffers-kill-emacs)
- (quit-window)))
+(define-obsolete-function-alias 'Info-exit #'quit-window "27.1")
(defun Info-next-menu-item ()
"Go to the node of the next menu item."
@@ -4045,7 +4040,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "m" 'Info-menu)
(define-key map "n" 'Info-next)
(define-key map "p" 'Info-prev)
- (define-key map "q" 'Info-exit)
+ (define-key map "q" 'quit-window)
(define-key map "r" 'Info-history-forward)
(define-key map "s" 'Info-search)
(define-key map "S" 'Info-search-case-sensitively)
@@ -4064,6 +4059,8 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map [follow-link] 'mouse-face)
(define-key map [XF86Back] 'Info-history-back)
(define-key map [XF86Forward] 'Info-history-forward)
+ (define-key map [tool-bar C-Back\ in\ history] 'Info-history-back-menu)
+ (define-key map [tool-bar C-Forward\ in\ history]
'Info-history-forward-menu)
map)
"Keymap containing Info commands.")
@@ -4123,7 +4120,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Copy the name of the current node into the kill ring"]
["Clone Info buffer" clone-buffer
:help "Create a twin copy of the current Info buffer."]
- ["Exit" Info-exit :help "Stop reading Info"]))
+ ["Exit" quit-window :help "Stop reading Info"]))
(defvar info-tool-bar-map
@@ -4152,10 +4149,40 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:label "Index")
(tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map
:vert-only t)
- (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map
+ (tool-bar-local-item-from-menu 'quit-window "exit" map Info-mode-map
:vert-only t)
map))
+(defun Info-history-menu (e name history command)
+ (let* ((i (length history))
+ (map (make-sparse-keymap name)))
+ (mapc (lambda (history)
+ (let ((file (nth 0 history))
+ (node (nth 1 history)))
+ (when (stringp file)
+ (setq file (file-name-sans-extension
+ (file-name-nondirectory file))))
+ (define-key map (vector (intern (format "history-%i" i)))
+ `(menu-item ,(format "(%s) %s" file node)
+ (lambda ()
+ (interactive)
+ (dotimes (_ ,i) (call-interactively
',command))))))
+ (setq i (1- i)))
+ (reverse history))
+ (let* ((selection (x-popup-menu e map))
+ (binding (and selection (lookup-key map (vector (car selection))))))
+ (if binding (call-interactively binding)))))
+
+(defun Info-history-back-menu (e)
+ "Pop up the menu with a list of previously visited Info nodes."
+ (interactive "e")
+ (Info-history-menu e "Back in history" Info-history 'Info-history-back))
+
+(defun Info-history-forward-menu (e)
+ "Pop up the menu with a list of Info nodes visited with ‘Info-history-back’."
+ (interactive "e")
+ (Info-history-menu e "Forward in history" Info-history-forward
'Info-history-forward))
+
(defvar Info-menu-last-node nil)
;; Last node the menu was created for.
;; Value is a list, (FILE-NAME NODE-NAME).
@@ -4280,7 +4307,7 @@ topics. Info has commands to follow the references and
show you other nodes.
\\<Info-mode-map>\
\\[Info-help] Invoke the Info tutorial.
-\\[Info-exit] Quit Info: reselect previously selected buffer.
+\\[quit-window] Quit Info: reselect previously selected buffer.
Selecting other nodes:
\\[Info-mouse-follow-nearest-node]
@@ -4353,6 +4380,8 @@ Advanced commands:
(add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
+ (when Info-standalone
+ (add-hook 'quit-window-hook 'save-buffers-kill-emacs nil t))
(setq-local isearch-search-fun-function #'Info-isearch-search)
(setq-local isearch-wrap-function #'Info-isearch-wrap)
(setq-local isearch-push-state-function #'Info-isearch-push-state)
@@ -5303,7 +5332,7 @@ completion alternatives to currently visited manuals."
found)
(dolist (buffer blist)
(with-current-buffer buffer
- (when (and (eq major-mode 'Info-mode)
+ (when (and (derived-mode-p 'Info-mode)
(stringp Info-current-file)
(string-match manual-re Info-current-file))
(setq found buffer
@@ -5318,7 +5347,7 @@ completion alternatives to currently visited manuals."
(let (names)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (and (eq major-mode 'Info-mode)
+ (and (derived-mode-p 'Info-mode)
(stringp Info-current-file)
(not (string= (substring (buffer-name) 0 1) " "))
(push (file-name-sans-extension
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f42b594..e91175f 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1329,7 +1329,8 @@ If STR has `advice' text property, append the following
special event:
(defvar quail-conversion-str nil)
(defun quail-input-method (key)
- (if (or (and buffer-read-only
+ (if (or (and (or buffer-read-only
+ (get-char-property (point) 'read-only))
(not (or inhibit-read-only
(get-char-property (point) 'inhibit-read-only))))
(and overriding-terminal-local-map
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index e925adb..7bac452 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -59,58 +59,6 @@ should return a grid vector array that is the new solution.
;;;***
-;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-mode.el
-(push (purecopy '(ada-mode 4 0)) package--builtin-versions)
-
-(autoload 'ada-add-extensions "ada-mode" "\
-Define SPEC and BODY as being valid extensions for Ada files.
-Going from body to spec with `ff-find-other-file' used these
-extensions.
-SPEC and BODY are two regular expressions that must match against
-the file name.
-
-\(fn SPEC BODY)" nil nil)
-
-(autoload 'ada-mode "ada-mode" "\
-Ada mode is the major mode for editing Ada code.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ada-mode" '("ada-")))
-
-;;;***
-
-;;;### (autoloads nil "ada-prj" "progmodes/ada-prj.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-prj.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ada-prj" '("ada-")))
-
-;;;***
-
-;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-stmt.el
-
-(autoload 'ada-header "ada-stmt" "\
-Insert a descriptive header at the top of the file." t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ada-stmt" '("ada-")))
-
-;;;***
-
-;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-xref.el
-
-(autoload 'ada-find-file "ada-xref" "\
-Open FILENAME, from anywhere in the source path.
-Completion is available.
-
-\(fn FILENAME)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ada-xref" '("ada-")))
-
-;;;***
-
;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0))
;;; Generated autoloads from vc/add-log.el
@@ -1273,7 +1221,7 @@ Entering array mode calls the function `array-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"array" '("array-" "current-line" "limit-index" "move-to-column-untabify"
"untabify-backward" "xor")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"array" '("array-" "current-line" "limit-index" "move-to-column-untabify"
"untabify-backward")))
;;;***
@@ -2490,7 +2438,9 @@ If the value is not a function it should be a list of
pairs
\(REGEXP . FUNCTION). In this case the function called will be the one
associated with the first REGEXP which matches the current URL. The
function is passed the URL and any other args of `browse-url'. The last
-regexp should probably be \".\" to specify a default browser.")
+regexp should probably be \".\" to specify a default browser.
+
+Also see `browse-url-secondary-browser-function'.")
(custom-autoload 'browse-url-browser-function "browse-url" t)
@@ -3026,8 +2976,15 @@ it won't work in an interactive Emacs." nil nil)
Run `byte-compile-file' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
-Each file is processed even if an error occurred previously.
+
+Each file is processed even if an error occurred previously. If
+a file name denotes a directory, all Emacs Lisp source files in
+that directory (that have previously been compiled) will be
+recompiled if newer than the compiled files. In this case,
+NOFORCE is ignored.
+
For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
+
If NOFORCE is non-nil, don't recompile a file that seems to be
already up-to-date.
@@ -4763,13 +4720,6 @@ and runs the normal hook `command-history-hook'." t nil)
;;;***
-;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/cl.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl"
'("cl-" "define-" "defsetf" "flet" "labels" "lexical-let")))
-
-;;;***
-
;;;### (autoloads "actual autoloads are elsewhere" "cl-extra"
"emacs-lisp/cl-extra.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-extra.el
@@ -5250,9 +5200,8 @@ Otherwise, it saves all modified buffers without asking.")
(defvar compilation-search-path '(nil) "\
List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of
-directories. The value nil as an element means the error
-message buffer `default-directory'.")
+Elements should be directory names, not file names of directories.
+The value nil as an element means to try the default directory.")
(custom-autoload 'compilation-search-path "compile" t)
@@ -5385,7 +5334,7 @@ This is the value of `next-error-function' in Compilation
buffers.
\(fn N &optional RESET)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"compile" '("compil" "define-compilation-mode" "kill-compilation"
"overlay-arrow-overlay" "recompile")))
;;;***
@@ -8112,14 +8061,17 @@ For example, you could write
Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
and that should try to turn MODE on if applicable for that buffer.
-KEYS is a list of CL-style keyword arguments. As the minor mode
- defined by this function is always global, any :global keyword is
- ignored. Other keywords have the same meaning as in `define-minor-mode',
- which see. In particular, :group specifies the custom group.
- The most useful keywords are those that are passed on to the
- `defcustom'. It normally makes no sense to pass the :lighter
- or :keymap keywords to `define-globalized-minor-mode', since these
- are usually passed to the buffer-local version of the minor mode.
+Each of KEY VALUE is a pair of CL-style keyword arguments. As
+ the minor mode defined by this function is always global, any
+ :global keyword is ignored. Other keywords have the same
+ meaning as in `define-minor-mode', which see. In particular,
+ :group specifies the custom group. The most useful keywords
+ are those that are passed on to the `defcustom'. It normally
+ makes no sense to pass the :lighter or :keymap keywords to
+ `define-globalized-minor-mode', since these are usually passed
+ to the buffer-local version of the minor mode.
+BODY contains code to execute each time the mode is enabled or disabled.
+ It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
If MODE's set-up depends on the major mode in effect when it was
enabled, then disabling and reenabling MODE should make MODE work
@@ -8131,7 +8083,7 @@ When a major mode is initialized, MODE is actually turned
on just
after running the major mode's hook. However, MODE is not turned
on if the hook has explicitly disabled it.
-\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t)
+\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" nil t)
(function-put 'define-globalized-minor-mode 'doc-string-elt '2)
@@ -8207,6 +8159,17 @@ pairs:
if the expression evaluates to a non-nil value. `:enable' is
an alias for `:active'.
+ :label FORM
+ FORM is an expression that is dynamically evaluated and whose
+ value serves as the menu's label (the default is the first
+ element of MENU).
+
+ :help HELP
+ HELP is a string, the help to display for the menu.
+ In a GUI this is a \"tooltip\" on the menu button. (Though
+ in Lucid :help is not shown for the top-level menu bar, only
+ for sub-menus.)
+
The rest of the elements in MENU are menu items.
A menu item can be a vector of three elements:
@@ -12855,7 +12818,11 @@ to get the effect of a C-q.
\(fn &optional BUFFER)" nil nil)
(autoload 'fill-flowed "flow-fill" "\
+Apply RFC2646 decoding to BUFFER.
+If BUFFER is nil, default to the current buffer.
+If DELETE-SPACE, delete RFC2646 spaces padding at the end of
+lines.
\(fn &optional BUFFER DELETE-SPACE)" nil nil)
@@ -14762,24 +14729,6 @@ Add the window configuration CONF to
`gnus-buffer-configuration'.
;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0))
;;; Generated autoloads from net/gnutls.el
-(defvar gnutls-min-prime-bits 256 "\
-Minimum number of prime bits accepted by GnuTLS for key exchange.
-During a Diffie-Hellman handshake, if the server sends a prime
-number with fewer than this number of bits, the handshake is
-rejected. (The smaller the prime number, the less secure the
-key exchange is against man-in-the-middle attacks.)
-
-A value of nil says to use the default GnuTLS value.
-
-The default value of this variable is such that virtually any
-connection can be established, whether this connection can be
-considered cryptographically \"safe\" or not. However, Emacs
-network security is handled at a higher level via
-`open-network-stream' and the Network Security Manager. See Info
-node `(emacs) Network Security'.")
-
-(custom-autoload 'gnutls-min-prime-bits "gnutls" t)
-
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"gnutls" '("gnutls-" "open-gnutls-stream")))
;;;***
@@ -14863,11 +14812,11 @@ if ARG is `toggle'; disable the mode otherwise.
(autoload 'gravatar-retrieve "gravatar" "\
Asynchronously retrieve a gravatar for MAIL-ADDRESS.
-When finished, call CB as (apply CB GRAVATAR CBARGS),
+When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS),
where GRAVATAR is either an image descriptor, or the symbol
`error' if the retrieval failed.
-\(fn MAIL-ADDRESS CB &optional CBARGS)" nil nil)
+\(fn MAIL-ADDRESS CALLBACK &optional CBARGS)" nil nil)
(autoload 'gravatar-retrieve-synchronously "gravatar" "\
Synchronously retrieve a gravatar for MAIL-ADDRESS.
@@ -15107,9 +15056,15 @@ and source-file directory for your debugger.
\(fn COMMAND-LINE)" t nil)
(autoload 'pdb "gud" "\
-Run pdb on program FILE in buffer `*gud-FILE*'.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger.
+Run COMMAND-LINE in the `*gud-FILE*' buffer.
+
+COMMAND-LINE should include the pdb executable
+name (`gud-pdb-command-name') and the file to be debugged.
+
+If called interactively, the command line will be prompted for.
+
+The directory containing this file becomes the initial working
+directory and source-file directory for your debugger.
\(fn COMMAND-LINE)" t nil)
@@ -17117,7 +17072,8 @@ RET Select the file at the front of the list of
matches.
\\[ido-toggle-case] Toggle case-sensitive searching of file names.
\\[ido-toggle-literal] Toggle literal reading of this file.
\\[ido-completion-help] Show list of matching files in separate window.
-\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'." t
nil)
+\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
+\\[ido-reread-directory] Reread the current directory." t nil)
(autoload 'ido-find-file-other-window "ido" "\
Switch to another file and show it in another window.
@@ -17965,7 +17921,7 @@ Display the \"Reporting Bugs\" section of the Emacs
manual in Info mode." t nil)
(autoload 'info-standalone "info" "\
Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
-In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself." nil
nil)
+In standalone mode, \\<Info-mode-map>\\[quit-window] exits Emacs itself." nil
nil)
(autoload 'Info-on-current-buffer "info" "\
Use Info mode to browse the current Info buffer.
@@ -18007,7 +17963,7 @@ one topic and contains references to other nodes which
discuss related
topics. Info has commands to follow the references and show you other nodes.
\\<Info-mode-map>\\[Info-help] Invoke the Info tutorial.
-\\[Info-exit] Quit Info: reselect previously selected buffer.
+\\[quit-window] Quit Info: reselect previously selected buffer.
Selecting other nodes:
\\[Info-mouse-follow-nearest-node]
@@ -20528,10 +20484,9 @@ OTHER-HEADERS is an alist specifying additional header
fields.
Elements look like (HEADER . VALUE) where both HEADER and VALUE
are strings.
-CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and
-RETURN-ACTION and any additional arguments are IGNORED.
+Any additional arguments are IGNORED.
-\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION
SEND-ACTIONS RETURN-ACTION &rest IGNORED)" nil nil)
+\(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
(autoload 'mh-send-letter "mh-comp" "\
Save draft and send message.
@@ -21787,8 +21742,38 @@ Interactively, prompt for NAME-SERVER if invoked with
prefix argument.
This command uses `nslookup-program' for looking up the DNS information.
+See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
+non-interactive versions of this function more suitable for use
+in Lisp code.
+
\(fn HOST &optional NAME-SERVER)" t nil)
+(autoload 'nslookup-host-ipv4 "net-utils" "\
+Return the IPv4 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 4-integer
+vector of octets.
+
+This command uses `nslookup-program' to look up DNS records.
+
+\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
+
+(autoload 'nslookup-host-ipv6 "net-utils" "\
+Return the IPv6 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 8-integer
+vector of hextets.
+
+This command uses `nslookup-program' to look up DNS records.
+
+\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
+
(autoload 'nslookup "net-utils" "\
Run `nslookup-program'." t nil)
@@ -21845,7 +21830,7 @@ Open a network connection to HOST on PORT.
\(fn HOST PORT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"net-utils" '("arp-program" "dig-program" "dns-lookup-program"
"finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig"
"iwconfig-program" "net" "nslookup-" "ping-program" "route-program"
"run-network-program" "smbclient" "traceroute-program" "whois-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"net-utils" '("arp-program" "dig-program" "dns-lookup-program"
"finger-X.500-host-regexps" "ftp-" "ifconfig-program" "iwconfig-program" "net"
"nslookup-" "ping-program" "route-program" "run-network-program" "smbclient"
"traceroute-program" "whois-")))
;;;***
@@ -24268,7 +24253,7 @@ matching parenthesis is highlighted in
`show-paren-style' after
(put 'parse-time-rules 'risky-local-variable t)
(autoload 'parse-time-string "parse-time" "\
-Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
+Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
somewhat liberal in what format it accepts, and will attempt to
@@ -33258,7 +33243,7 @@ If DATE lacks timezone information, GMT is assumed.
(defalias 'time-to-seconds 'float-time)
-(defalias 'seconds-to-time 'encode-time)
+(defalias 'seconds-to-time 'time-convert)
(autoload 'days-to-time "time-date" "\
Convert DAYS into a time value.
@@ -36411,7 +36396,7 @@ Usage:
Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
vhdl-mode\") in a directory with an existing project setup file, it is
automatically loaded and its project activated if option
- `vhdl-project-auto-load' is non-nil. Names/paths of the project setup
+ `vhdl-project-autoload' is non-nil. Names/paths of the project setup
files can be specified in option `vhdl-project-file-name'. Multiple
project setups can be automatically loaded from global directories.
This is an alternative to specifying project setups with option
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index e802c24..8491181 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -517,7 +517,8 @@ If the \"..\" directory entry has nil attributes, the
attributes
are copied from the \".\" entry, if they are non-nil. Otherwise,
the offending element is removed from the list, as are any
elements for other directory entries with nil attributes."
- (if (and (null (cdr (assoc ".." file-alist)))
+ (if (and (consp (assoc ".." file-alist))
+ (null (cdr (assoc ".." file-alist)))
(cdr (assoc "." file-alist)))
(setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist))))
(rassq-delete-all nil file-alist))
diff --git a/lisp/macros.el b/lisp/macros.el
index 4b38506..3470359 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -38,13 +38,13 @@
(defun macros--insert-vector-macro (definition)
"Print DEFINITION, a vector, into the current buffer."
- (dotimes (i (length definition))
- (let ((char (aref definition i)))
- (insert (if (zerop i) ?\[ ?\s))
- (if (characterp char)
- (princ (prin1-char char) (current-buffer))
- (prin1 char (current-buffer)))))
- (insert ?\]))
+ (insert ?\[
+ (mapconcat (lambda (event)
+ (or (prin1-char event)
+ (prin1-to-string event)))
+ definition
+ " ")
+ ?\]))
;;;###autoload
(defun insert-kbd-macro (macroname &optional keys)
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 7b50fcd..4dbd4d7 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -33,8 +33,7 @@
;; paragraph and we let `fill-region' fill the long line into several
;; lines with the quote prefix as `fill-prefix'.
-;; Todo: implement basic `fill-region' (Emacs and XEmacs
-;; implementations differ..)
+;; Todo: implement basic `fill-region'
;;; History:
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 3151dae..87a8248 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -781,7 +781,9 @@ as ARGS."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
- (when (and url-handler-mode (not (file-name-absolute-p url)))
+ (when (and url-handler-mode
+ (not (file-name-absolute-p url))
+ (not (string-match "\\`[a-z]+:" url)))
(setq url (expand-file-name url)))
(let ((process-environment (copy-sequence process-environment))
(function (or (and (string-match "\\`mailto:"; url)
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 61480f3..da76650 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -113,16 +113,14 @@ Security'."
"/etc/ssl/cert.pem" ; macOS
)
"List of CA bundle location filenames or a function returning said list.
+If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
:group 'gnutls
:type '(choice (function :tag "Function to produce list of bundle filenames")
(repeat (file :tag "Bundle filename"))))
-;;;###autoload
-(defcustom gnutls-min-prime-bits 256
- ;; Several mail servers send fewer bits than the GnuTLS default.
- ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
+(defcustom gnutls-min-prime-bits nil
"Minimum number of prime bits accepted by GnuTLS for key exchange.
During a Diffie-Hellman handshake, if the server sends a prime
number with fewer than this number of bits, the handshake is
@@ -138,9 +136,22 @@ network security is handled at a higher level via
`open-network-stream' and the Network Security Manager. See Info
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)
- (integer :tag "Number of bits" 512))
+ (integer :tag "Number of bits" 2048))
:group 'gnutls)
+(defcustom gnutls-crlfiles
+ '(
+ "/etc/grid-security/certificates/*.crl.pem"
+ )
+ "List of CRL file paths or a function returning said list.
+If a file path contains glob wildcards, they will be expanded.
+The files may be in PEM or DER format, as per the GnuTLS documentation.
+The files may not exist, in which case they will be ignored."
+ :group 'gnutls
+ :type '(choice (function :tag "Function to produce list of CRL filenames")
+ (repeat (file :tag "CRL filename")))
+ :version "27.1")
+
(defun open-gnutls-stream (name buffer host service &optional parameters)
"Open a SSL/TLS connection for a service to a host.
Returns a subprocess-object to represent the connection.
@@ -304,6 +315,7 @@ here's a recent version of the list.
It must be omitted, a number, or nil; if omitted or nil it
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(let* ((trustfiles (or trustfiles (gnutls-trustfiles)))
+ (crlfiles (or crlfiles (gnutls-crlfiles)))
(maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p))
":%DUMBFW"
""))
@@ -345,13 +357,18 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:verify-error ,verify-error
:callbacks nil)))
+(defun gnutls--get-files (files)
+ (cl-loop for f in files
+ if f do (setq f (if (functionp f) (funcall f) f))
+ append (cl-delete-if-not #'file-exists-p (file-expand-wildcards f
t))))
+
(defun gnutls-trustfiles ()
"Return a list of usable trustfiles."
- (delq nil
- (mapcar (lambda (f) (and f (file-exists-p f) f))
- (if (functionp gnutls-trustfiles)
- (funcall gnutls-trustfiles)
- gnutls-trustfiles))))
+ (gnutls--get-files gnutls-trustfiles))
+
+(defun gnutls-crlfiles ()
+ "Return a list of usable CRL files."
+ (gnutls--get-files gnutls-crlfiles))
(declare-function gnutls-error-string "gnutls.c" (error))
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index dcc7e01..4f68e5d 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -43,6 +43,10 @@
;; still use them for queries). Actually the trend these
;; days is for /sbin to be a symlink to /usr/sbin, but we still need to
;; search both for older systems.
+
+(require 'subr-x)
+(require 'cl-lib)
+
(defun net-utils--executable-find-sbin (command)
"Return absolute name of COMMAND if found in an sbin directory."
(let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin")))
@@ -514,7 +518,11 @@ Optional argument NAME-SERVER says which server to use for
DNS resolution.
Interactively, prompt for NAME-SERVER if invoked with prefix argument.
-This command uses `nslookup-program' for looking up the DNS information."
+This command uses `nslookup-program' for looking up the DNS information.
+
+See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
+non-interactive versions of this function more suitable for use
+in Lisp code."
(interactive
(list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
(if current-prefix-arg (read-from-minibuffer "Name server: "))))
@@ -531,6 +539,71 @@ This command uses `nslookup-program' for looking up the
DNS information."
options)))
;;;###autoload
+(defun nslookup-host-ipv4 (host &optional name-server format)
+ "Return the IPv4 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 4-integer
+vector of octets.
+
+This command uses `nslookup-program' to look up DNS records."
+ (let* ((args `(,nslookup-program "-type=A" ,host ,name-server))
+ (output (shell-command-to-string
+ (string-join (cl-remove nil args) " ")))
+ (ip (or (and (string-match
+ "Name:.*\nAddress:
*\\(\\([0-9]\\{1,3\\}\\.?\\)\\{4\\}\\)"
+ output)
+ (match-string 1 output))
+ host)))
+ (cond ((memq format '(string nil))
+ ip)
+ ((eq format 'vector)
+ (apply #'vector (mapcar #'string-to-number (split-string ip
"\\."))))
+ (t (error "Invalid format: %s" format)))))
+
+(defun ipv6-expand (ipv6-vector)
+ (let ((len (length ipv6-vector)))
+ (if (< len 8)
+ (let* ((pivot (cl-position 0 ipv6-vector))
+ (head (cl-subseq ipv6-vector 0 pivot))
+ (tail (cl-subseq ipv6-vector (1+ pivot) len)))
+ (vconcat head (make-vector (- 8 (1- len)) 0) tail))
+ ipv6-vector)))
+
+;;;###autoload
+(defun nslookup-host-ipv6 (host &optional name-server format)
+ "Return the IPv6 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 8-integer
+vector of hextets.
+
+This command uses `nslookup-program' to look up DNS records."
+ (let* ((args `(,nslookup-program "-type=AAAA" ,host ,name-server))
+ (output (shell-command-to-string
+ (string-join (cl-remove nil args) " ")))
+ (hextet "[0-9a-fA-F]\\{1,4\\}")
+ (ip-regex (concat "\\(\\(" hextet "[:]\\)\\{1,6\\}\\([:]?\\(" hextet
"\\)\\{1,6\\}\\)\\)"))
+ (ip (or (and (string-match
+ (if (eq system-type 'windows-nt)
+ (concat "Name:.*\nAddress: *" ip-regex)
+ (concat "has AAAA address " ip-regex))
+ output)
+ (match-string 1 output))
+ host)))
+ (cond ((memq format '(string nil))
+ ip)
+ ((eq format 'vector)
+ (ipv6-expand (apply #'vector
+ (cl-loop for hextet in (split-string ip "[:]")
+ collect (string-to-number hextet
16)))))
+ (t (error "Invalid format: %s" format)))))
+
+;;;###autoload
(defun nslookup ()
"Run `nslookup-program'."
(interactive)
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index dbfa210..11535a5 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -26,7 +26,9 @@
(require 'cl-lib)
(require 'rmc) ; read-multiple-choice
-(eval-when-compile (require 'subr-x))
+(require 'subr-x)
+(require 'seq)
+(require 'map)
(defvar nsm-permanent-host-settings nil)
(defvar nsm-temporary-host-settings nil)
@@ -44,26 +46,43 @@ connection should be handled.
The following values are possible:
-`low': Absolutely no checks are performed.
-`medium': This is the default level, should be reasonable for most usage.
-`high': This warns about additional things that many people would
-not find useful.
+`low': No checks are performed: This is extremely insecure.
+`medium': Default. Suitable for most circumstances.
+`high': Warns about additional issues not enabled in `medium' due to
+compatibility concerns.
`paranoid': On this level, the user is queried for most new connections.
See the Emacs manual for a description of all things that are
checked and warned against."
:version "25.1"
- :group 'nsm
:type '(choice (const :tag "Low" low)
- (const :tag "Medium" medium)
- (const :tag "High" high)
+ (const :tag "Medium" medium)
+ (const :tag "High" high)
(const :tag "Paranoid" paranoid)))
+(defcustom nsm-trust-local-network nil
+ "Disable warnings when visiting trusted hosts on local networks.
+
+The default suite of TLS checks in NSM is designed to follow the
+most current security best practices. Under some situations,
+such as attempting to connect to an email server that do not
+follow these practices inside a school or corporate network, NSM
+may produce warnings for such occasions. Setting this option to
+a non-nil value, or a zero-argument function that returns non-nil
+tells NSM to skip checking for potential TLS vulnerabilities when
+connecting to hosts on a local network.
+
+Make sure you know what you are doing before enabling this
+option."
+ :version "27.1"
+ :type '(choice (const :tag "On" t)
+ (const :tag "Off" nil)
+ (function :tag "Custom function")))
+
(defcustom nsm-settings-file (expand-file-name "network-security.data"
user-emacs-directory)
"The file the security manager settings will be stored in."
:version "25.1"
- :group 'nsm
:type 'file)
(defcustom nsm-save-host-names nil
@@ -71,7 +90,6 @@ checked and warned against."
By default, only hosts that have exceptions have their names
stored in plain text."
:version "25.1"
- :group 'nsm
:type 'boolean)
(defvar nsm-noninteractive nil
@@ -98,241 +116,673 @@ to keep track of the TLS status of STARTTLS servers.
If WARN-UNENCRYPTED, query the user if the connection is
unencrypted."
- (if (eq network-security-level 'low)
- process
- (let* ((status (gnutls-peer-status process))
- (id (nsm-id host port))
- (settings (nsm-host-settings id)))
- (cond
- ((not (process-live-p process))
- nil)
- ((not status)
- ;; This is a non-TLS connection.
- (nsm-check-plain-connection process host port settings
- warn-unencrypted))
- (t
- (let ((process
- (nsm-check-tls-connection process host port status settings)))
- (when (and process save-fingerprint
- (null (nsm-host-settings id)))
- (nsm-save-host host port status 'fingerprint 'always))
- process))))))
+ (let* ((status (gnutls-peer-status process))
+ (id (nsm-id host port))
+ (settings (nsm-host-settings id)))
+ (cond
+ ((not (process-live-p process))
+ nil)
+ ((not status)
+ ;; This is a non-TLS connection.
+ (nsm-check-plain-connection process host port settings
+ warn-unencrypted))
+ (t
+ (let ((process
+ (nsm-check-tls-connection process host port status settings)))
+ (when (and process save-fingerprint
+ (null (nsm-host-settings id)))
+ (nsm-save-host host port status 'fingerprint nil 'always))
+ process)))))
+
+(defcustom network-security-protocol-checks
+ '(;; Old Known Weaknesses.
+ (version medium)
+ (compression medium)
+ (renegotiation-info-ext medium)
+ (verify-cert medium)
+ (same-cert medium)
+ (null-suite medium)
+ (export-kx medium)
+ (anon-kx medium)
+ (md5-sig medium)
+ (rc4-cipher medium)
+ ;; Weaknesses made known after 2013.
+ (dhe-prime-kx medium)
+ (sha1-sig medium)
+ (ecdsa-cbc-cipher medium)
+ ;; Towards TLS 1.3
+ (dhe-kx high)
+ (rsa-kx high)
+ (3des-cipher high)
+ (cbc-cipher high))
+ "This variable specifies what TLS connection checks to perform.
+It's an alist where the key is the name of the check, and the
+value is the minimum security level the check should begin.
+
+Each check function is called with the parameters HOST PORT
+STATUS SETTINGS. HOST is the host domain, PORT is a TCP port
+number, STATUS is the peer status returned by
+`gnutls-peer-status', and SETTINGS is the persistent and session
+settings for the host HOST. Please refer to the contents of
+`nsm-setting-file' for details. If a problem is found, the check
+function is required to return an error message, and nil
+otherwise.
+
+See also: `nsm-check-tls-connection', `nsm-save-host-names',
+`nsm-settings-file'"
+ :version "27.1"
+ :type '(repeat (list (symbol :tag "Check function")
+ (choice :tag "Level"
+ :value medium
+ (const :tag "Low" low)
+ (const :tag "Medium" medium)
+ (const :tag "High" high)))))
+
+(defun nsm-save-fingerprint-maybe (host port status &rest _)
+ "Saves the certificate's fingerprint.
+
+In order to detect man-in-the-middle attacks, when
+`network-security-level' is `high', this function will save the
+fingerprint of the certificate for check functions to check."
+ (when (>= (nsm-level network-security-level) (nsm-level 'high))
+ ;; Save the host fingerprint so that we can check it the
+ ;; next time we connect.
+ (nsm-save-host host port status 'fingerprint nil 'always)))
+
+(defvar nsm-tls-post-check-functions '(nsm-save-fingerprint-maybe)
+ "Functions to run after checking a TLS session.
+
+Each function will be run with the parameters HOST PORT STATUS
+SETTINGS and RESULTS. The parameters HOST PORT STATUS and
+SETTINGS are the same as those supplied to each check function.
+RESULTS is an alist where the keys are the checks run and the
+values the results of the checks.")
+
+(defun nsm-network-same-subnet (local-ip mask ip)
+ "Returns t if IP is in the same subnet as LOCAL-IP/MASK.
+LOCAL-IP, MASK, and IP are specified as vectors of integers, and
+are expected to have the same length. Works for both IPv4 and
+IPv6 addresses."
+ (let ((matches t)
+ (length (length local-ip)))
+ (unless (memq length '(4 5 8 9))
+ (error "Unexpected length of IP address %S" local-ip))
+ (dotimes (i length)
+ (setq matches (and matches
+ (=
+ (logand (aref local-ip i)
+ (aref mask i))
+ (logand (aref ip i)
+ (aref mask i))))))
+ matches))
+
+(defun nsm-should-check (host)
+ "Determines whether NSM should check for TLS problems for HOST.
+
+If `nsm-trust-local-network' is or returns non-nil, and if the
+host address is a localhost address, or in the same subnet as one
+of the local interfaces, this function returns nil. Non-nil
+otherwise."
+ (let ((addresses (network-lookup-address-info host))
+ (network-interface-list (network-interface-list))
+ (off-net t))
+ (when
+ (or (and (functionp nsm-trust-local-network)
+ (funcall nsm-trust-local-network))
+ nsm-trust-local-network)
+ (mapc
+ (lambda (address)
+ (mapc
+ (lambda (iface)
+ (let ((info (network-interface-info (car iface))))
+ (when
+ (nsm-network-same-subnet (substring (car info) 0 -1)
+ (substring (car (cddr info)) 0 -1)
+ address)
+ (setq off-net nil))))
+ network-interface-list))
+ addresses))
+ off-net))
(defun nsm-check-tls-connection (process host port status settings)
- (when-let ((process
- (nsm-check-certificate process host port status settings)))
- ;; Do further protocol-level checks.
- (nsm-check-protocol process host port status settings)))
+ "Check TLS connection against potential security problems.
+
+This function runs each test defined in
+`network-security-protocol-checks' in the order specified against
+the TLS connection's peer status STATUS for the host HOST and
+port PORT.
+
+If one or more problems are found, this function will collect all
+the error messages returned by the check functions, and confirm
+with the user in interactive mode whether to continue with the
+TLS session.
+
+If the user declines to continue, or problem(s) are found under
+non-interactive mode, the process PROCESS will be deleted, thus
+terminating the connection.
+
+This function returns the process PROCESS if no problems are
+found, and nil otherwise.
+
+See also: `network-security-protocol-checks' and `nsm-noninteractive'"
+ (when (nsm-should-check host)
+ (let* ((results
+ (cl-loop
+ for check in network-security-protocol-checks
+ for type = (intern (format ":%s" (car check)) obarray)
+ ;; Skip the check if the user has already said that this
+ ;; host is OK for this type of "error".
+ for result = (and (not (memq type
+ (plist-get settings :conditions)))
+ (>= (nsm-level network-security-level)
+ (nsm-level (cadr check)))
+ (funcall
+ (intern (format "nsm-protocol-check--%s"
+ (car check))
+ obarray)
+ host port status settings))
+ when result
+ collect (cons type result)))
+ (problems (nconc (plist-get status :warnings) (map-keys results))))
+
+ ;; We haven't seen this before, and we're paranoid.
+ (when (and (eq network-security-level 'paranoid)
+ (not (nsm-fingerprint-ok-p status settings)))
+ (push '(:not-seen . "Certificate not seen before") results))
+
+ (when (and results
+ (not (seq-set-equal-p (plist-get settings :conditions)
+ problems))
+ (not (nsm-query host port status
+ 'conditions
+ problems
+ (format-message
+ "The TLS connection to %s:%s is insecure\nfor
the following reason%s:\n\n%s"
+ host port
+ (if (> (length problems) 1)
+ "s" "")
+ (concat "* " (string-join
+ (split-string
+ (string-join
+ (map-values results)
+ "\n")
+ "\n")
+ "\n* ")))))
+ (delete-process process)
+ (setq process nil)))
+ (run-hook-with-args 'nsm-tls-post-check-functions
+ host port status settings results)))
+ process)
+
+
+
+;; Certificate checks
(declare-function gnutls-peer-status-warning-describe "gnutls.c"
- (status-symbol))
+ (status-symbol))
+
+(defun nsm-protocol-check--verify-cert (host port status settings)
+ "Check for warnings from the certificate verification status.
-(defun nsm-check-certificate (process host port status settings)
+This is the most basic security check for a TLS connection. If
+ certificate verification fails, it means the server's identity
+ cannot be verified by the credentials received."
(let ((warnings (plist-get status :warnings)))
- (cond
+ (and warnings
+ (not (nsm-warnings-ok-p status settings))
+ (mapconcat #'gnutls-peer-status-warning-describe warnings "\n"))))
- ;; The certificate validated, but perhaps we want to do
- ;; certificate pinning.
- ((null warnings)
- (cond
- ((< (nsm-level network-security-level) (nsm-level 'high))
- process)
- ;; The certificate is fine, but if we're paranoid, we might
- ;; want to check whether it's changed anyway.
- ((and (>= (nsm-level network-security-level) (nsm-level 'high))
- (not (nsm-fingerprint-ok-p host port status settings)))
- (delete-process process)
- nil)
- ;; We haven't seen this before, and we're paranoid.
- ((and (eq network-security-level 'paranoid)
- (null settings)
- (not (nsm-new-fingerprint-ok-p host port status)))
- (delete-process process)
- nil)
- (t
- process)))
-
- ;; The certificate did not validate.
- ((not (equal network-security-level 'low))
- ;; We always want to pin the certificate of invalid connections
- ;; to track man-in-the-middle or the like.
- (if (not (nsm-fingerprint-ok-p host port status settings))
- (progn
- (delete-process process)
- nil)
- ;; We have a warning, so query the user.
- (if (and (not (nsm-warnings-ok-p status settings))
- (not (nsm-query
- host port status 'conditions
- "The TLS connection to %s:%s is insecure for the
following reason%s:\n\n%s"
- host port
- (if (> (length warnings) 1)
- "s" "")
- (mapconcat #'gnutls-peer-status-warning-describe
- warnings
- "\n"))))
- (progn
- (delete-process process)
- nil)
- process))))))
-
-(defvar network-security-protocol-checks
- '((diffie-hellman-prime-bits medium 1024)
- (rc4 medium)
- (signature-sha1 medium)
- (intermediate-sha1 medium)
- (3des high)
- (ssl medium))
- "This variable specifies what TLS connection checks to perform.
-It's an alist where the first element is the name of the check,
-the second is the security level where the check kicks in, and the
-optional third element is a parameter supplied to the check.
-
-An element like `(rc4 medium)' will result in the function
-`nsm-protocol-check--rc4' being called with the parameters
-HOST PORT STATUS OPTIONAL-PARAMETER.")
-
-(defun nsm-check-protocol (process host port status settings)
- (cl-loop for check in network-security-protocol-checks
- for type = (intern (format ":%s" (car check)) obarray)
- while process
- ;; Skip the check if the user has already said that this
- ;; host is OK for this type of "error".
- when (and (not (memq type (plist-get settings :conditions)))
- (>= (nsm-level network-security-level)
- (nsm-level (cadr check))))
- do (let ((result
- (funcall (intern (format "nsm-protocol-check--%s"
- (car check))
- obarray)
- host port status (nth 2 check))))
- (unless result
- (delete-process process)
- (setq process nil))))
- ;; If a test failed we return nil, otherwise the process object.
- process)
+(defun nsm-protocol-check--same-cert (host port status settings)
+ "Check for certificate fingerprint mismatch.
-(defun nsm--encryption (status)
- (format "%s-%s-%s"
- (plist-get status :key-exchange)
- (plist-get status :cipher)
- (plist-get status :mac)))
+If the fingerprints saved do not match the fingerprint of the
+certificate presented, the TLS session may be under a
+man-in-the-middle attack."
+ (and (not (nsm-fingerprint-ok-p status settings))
+ (format-message
+ "fingerprint has changed")))
+
+;; Key exchange checks
+
+(defun nsm-protocol-check--rsa-kx (host port status &optional settings)
+ "Check for static RSA key exchange.
+
+Static RSA key exchange methods do not offer perfect forward
+secrecy, therefore, the security of a TLS session is only as
+secure as the server's private key. Due to TLS' use of RSA key
+exchange to create a session key (the key negotiated between the
+client and the server to encrypt traffic), if the server's
+private key had been compromised, the attacker will be able to
+decrypt any past TLS session recorded, as opposed to just one TLS
+session if the key exchange was conducted via a key exchange
+method that offers perfect forward secrecy, such as ephemeral
+Diffie-Hellman key exchange.
-(defun nsm-protocol-check--diffie-hellman-prime-bits (host port status bits)
+By default, this check is only enabled when
+`network-security-level' is set to `high' for compatibility
+reasons.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", \"(4.1. General Guidelines)\"
+`https://tools.ietf.org/html/rfc7525\#section-4.1'"
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "^\\bRSA\\b" kx)
+ (format-message
+ "RSA key exchange method (%s) does not offer perfect forward secrecy"
+ kx))))
+
+(defun nsm-protocol-check--dhe-prime-kx (host port status &optional settings)
+ "Check for the key strength of DH key exchange based on integer
factorization.
+
+This check is a response to Logjam[1]. Logjam is an attack that
+allows an attacker with sufficient resource, and positioned
+between the user and the server, to downgrade vulnerable TLS
+connections to insecure 512-bit export grade crypotography.
+
+The Logjam paper suggests using 1024-bit prime on the client to
+mitigate some effects of this attack, and upgrade to 2048-bit as
+soon as server configurations allow. According to SSLLabs' SSL
+Pulse tracker, only about 75% of server support 2048-bit key
+exchange in June 2018[2]. To provide a balance between
+compatibility and security, this function only checks for a
+minimum key strength of 1024-bit.
+
+See also: `nsm-protocol-check--dhe-kx'
+
+Reference:
+
+[1]: Adrian et al (2014). \"Imperfect Forward Secrecy: How
+Diffie-Hellman Fails in Practice\", `https://weakdh.org/'
+[2]: SSL Pulse (June 03, 2018). \"Key Exchange Strength\",
+`https://www.ssllabs.com/ssl-pulse/'"
(let ((prime-bits (plist-get status :diffie-hellman-prime-bits)))
- (or (not prime-bits)
- (>= prime-bits bits)
- (nsm-query
- host port status :diffie-hellman-prime-bits
- "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s
is less than what is considered safe (%s)."
- prime-bits host port bits))))
-
-(defun nsm-protocol-check--3des (host port status _)
- (or (not (string-match "\\b3DES\\b" (plist-get status :cipher)))
- (nsm-query
- host port status :rc4
- "The connection to %s:%s uses the 3DES cipher (%s), which is believed
to be unsafe."
- host port (plist-get status :cipher))))
-
-(defun nsm-protocol-check--rc4 (host port status _)
- (or (not (string-match "\\bRC4\\b" (nsm--encryption status)))
- (nsm-query
- host port status :rc4
- "The connection to %s:%s uses the RC4 algorithm (%s), which is believed
to be unsafe."
- host port (nsm--encryption status))))
-
-(defun nsm-protocol-check--signature-sha1 (host port status _)
- (let ((signature-algorithm
- (plist-get (plist-get status :certificate) :signature-algorithm)))
- (or (not (string-match "\\bSHA1\\b" signature-algorithm))
- (nsm-query
- host port status :signature-sha1
- "The certificate used to verify the connection to %s:%s uses the SHA1
algorithm (%s), which is believed to be unsafe."
- host port signature-algorithm))))
-
-(defun nsm-protocol-check--intermediate-sha1 (host port status _)
- ;; Skip the first certificate, because that's the host certificate.
- (cl-loop for certificate in (cdr (plist-get status :certificates))
+ (if (and (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
+ (< prime-bits 1024))
+ (format-message
+ "Diffie-Hellman key strength (%s bits) too weak (%s bits)"
+ prime-bits 1024))))
+
+(defun nsm-protocol-check--dhe-kx (host port status &optional settings)
+ "Check for existence of DH key exchange based on integer factorization.
+
+In the years since the discovery of Logjam, it was discovered
+that there were rampant use of small subgroup prime or composite
+number for DHE by many servers, and thus allowed themselves to be
+vulnerable to backdoors[1]. Given the difficulty in validating
+Diffie-Hellman parameters, major browser vendors had started to
+remove DHE since 2016[2]. Emacs stops short of banning DHE and
+terminating connection, but prompts the user instead.
+
+References:
+
+[1]: Dorey, Fong, and Essex (2016). \"Indiscreet Logs: Persistent
+Diffie-Hellman Backdoors in TLS.\",
+`https://eprint.iacr.org/2016/999.pdf'
+[2]: Chrome Platform Status (2017). \"Remove DHE-based ciphers\",
+`https://www.chromestatus.com/feature/5128908798164992'"
+ (let ((kx (plist-get status :key-exchange)))
+ (when (string-match "^\\bDHE\\b" kx)
+ (format-message
+ "unable to verify Diffie-Hellman key exchange method (%s) parameters"
+ kx))))
+
+(defun nsm-protocol-check--export-kx (host port status &optional settings)
+ "Check for RSA-EXPORT key exchange.
+
+EXPORT cipher suites are a family of 40-bit and 56-bit effective
+security algorithms legally exportable by the United States in
+the early 90s[1]. They can be broken in seconds on 2018 hardware.
+
+Prior to 3.2.0, GnuTLS had only supported RSA-EXPORT key
+exchange. Since 3.2.0, RSA-EXPORT had been removed, therefore,
+this check has no effect on GnuTLS >= 3.2.0.
+
+Reference:
+
+[1]: Schneier, Bruce (1996). Applied Cryptography (Second ed.). John
+Wiley & Sons. ISBN 0-471-11709-9.
+[2]: N. Mavrogiannopoulos, FSF (Apr 2015). \"GnuTLS NEWS -- History
+of user-visible changes.\" Version 3.4.0,
+`https://gitlab.com/gnutls/gnutls/blob/master/NEWS'"
+ (when (< libgnutls-version 30200)
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "\\bEXPORT\\b" kx)
+ (format-message
+ "EXPORT level key exchange (%s) is insecure"
+ kx)))))
+
+(defun nsm-protocol-check--anon-kx (host port status &optional settings)
+ "Check for anonymous key exchange.
+
+Anonymous key exchange exposes the connection to
+man-in-the-middle attacks.
+
+Reference:
+
+GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous
+authentication\",
+`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'"
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "\\bANON\\b" kx)
+ (format-message
+ "anonymous key exchange method (%s) can be unsafe"
+ kx))))
+
+;; Cipher checks
+
+(defun nsm-protocol-check--cbc-cipher (host port status &optional settings)
+ "Check for CBC mode ciphers.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt. This construction is vulnerable to
+padding oracle attacks[1].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[2] has
+been enabled by default[3]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+Reference:
+
+[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[3]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (when (not (plist-get status :encrypt-then-mac))
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\bCBC\\b" cipher)
+ (format-message
+ "CBC mode cipher (%s) can be insecure"
+ cipher)))))
+
+(defun nsm-protocol-check--ecdsa-cbc-cipher (host port status &optional
settings)
+ "Check for CBC mode cipher usage under ECDSA key exchange.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt. This construction is vulnerable to
+padding oracle attacks[1].
+
+Due to current widespread use of CBC mode ciphers by servers,
+this function only checks for CBC mode cipher usage in
+combination with ECDSA key exchange, which is virtually
+non-existent[2].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[3] has
+been enabled by default[4]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+References:
+
+[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: Chrome Platform Status (2017). \"Remove CBC-mode ECDSA ciphers in
+TLS\", `https://www.chromestatus.com/feature/5740978103123968'
+[3]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[4]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (when (not (plist-get status :encrypt-then-mac))
+ (let ((kx (plist-get status :key-exchange))
+ (cipher (plist-get status :cipher)))
+ (and (string-match "\\bECDSA\\b" kx)
+ (string-match "\\bCBC\\b" cipher)
+ (format-message
+ "CBC mode cipher (%s) can be insecure"
+ cipher)))))
+
+(defun nsm-protocol-check--3des-cipher (host port status &optional settings)
+ "Check for 3DES ciphers.
+
+Due to its use of 64-bit block size, it is known that a
+ciphertext collision is highly likely when 2^32 blocks are
+encrypted with the same key bundle under 3-key 3DES. Practical
+birthday attacks of this kind have been demostrated by Sweet32[1].
+As such, NIST is in the process of disallowing its use in TLS[2].
+
+[1]: Bhargavan, Leurent (2016). \"On the Practical (In-)Security of
+64-bit Block Ciphers — Collision Attacks on HTTP over TLS and
+OpenVPN\", `https://sweet32.info/'
+[2]: NIST Information Technology Laboratory (Jul 2017). \"Update to
+Current Use and Deprecation of TDEA\",
+`https://csrc.nist.gov/News/2017/Update-to-Current-Use-and-Deprecation-of-TDEA'"
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\b3DES\\b" cipher)
+ (format-message
+ "3DES cipher (%s) is weak"
+ cipher))))
+
+(defun nsm-protocol-check--rc4-cipher (host port status &optional settings)
+ "Check for RC4 ciphers.
+
+RC4 cipher has been prohibited by RFC 7465[1].
+
+Since GnuTLS 3.4.0, RC4 is not enabled by default[2], but can be
+enabled if requested. This check is mainly provided to secure
+Emacs built with older version of GnuTLS.
+
+Reference:
+
+[1]: Popov A (Feb 2015). \"Prohibiting RC4 Cipher Suites\",
+`https://tools.ietf.org/html/rfc7465'
+[2]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\bARCFOUR\\b" cipher)
+ (format-message
+ "RC4 cipher (%s) is insecure"
+ cipher))))
+
+;; Signature checks
+
+(defun nsm-protocol-check--sha1-sig (host port status &optional settings)
+ "Check for SHA1 signatures on certificates.
+
+The first SHA1 collision was found in 2017[1], as a precaution
+against the events following the discovery of cheap collisions in
+MD5, major browsers[2][3][4][5] have removed the use of SHA1
+signatures in certificates.
+
+References:
+
+[1]: Stevens M, Karpman P et al (2017). \"The first collision for
+full SHA-1\", `https://shattered.io/static/shattered.pdf'
+[2]: Chromium Security Education TLS/SSL. \"Deprecated and Removed
+Features (SHA-1 Certificate Signatures)\",
+`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures'
+[3]: Jones J.C (2017). \"The end of SHA-1 on the Public Web\",
+`https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/'
+[4]: Apple Support (2017). \"Move to SHA-256 signed certificates to
+avoid connection failures\",
+`https://support.apple.com/en-gb/HT207459'
+[5]: Microsoft Security Advisory 4010323 (2017). \"Deprecation of
+SHA-1 for SSL/TLS Certificates in Microsoft Edge and Internet Explorer
+11\",
+`https://docs.microsoft.com/en-us/security-updates/securityadvisories/2017/4010323'"
+ (cl-loop for certificate in (plist-get status :certificates)
+ for algo = (plist-get certificate :signature-algorithm)
+ ;; Don't check root certificates -- root is always trusted.
+ if (and (not (equal (plist-get certificate :issuer)
+ (plist-get certificate :subject)))
+ (string-match "\\bSHA1\\b" algo))
+ return (format-message
+ "SHA1 signature (%s) is prone to collisions"
+ algo)
+ end))
+
+(defun nsm-protocol-check--md5-sig (host port status &optional settings)
+ "Check for MD5 signatures on certificates.
+
+In 2008, a group of researchers were able to forge an
+intermediate CA certificate that appeared to be legitimate when
+checked by MD5[1]. RFC 6151[2] has recommended against the usage
+of MD5 for digital signatures, which includes TLS certificate
+signatures.
+
+Since GnuTLS 3.3.0, MD5 has been disabled by default, but can be
+enabled if requested.
+
+References:
+
+[1]: Sotirov A, Stevens M et al (2008). \"MD5 considered harmful today
+- Creating a rogue CA certificate\",
+`http://www.win.tue.nl/hashclash/rogue-ca/'
+[2]: Turner S, Chen L (2011). \"Updated Security Considerations for
+the MD5 Message-Digest and the HMAC-MD5 Algorithms\",
+`https://tools.ietf.org/html/rfc6151'"
+ (cl-loop for certificate in (plist-get status :certificates)
for algo = (plist-get certificate :signature-algorithm)
- ;; Don't check root certificates -- SHA1 isn't dangerous
- ;; there.
- when (and (not (equal (plist-get certificate :issuer)
- (plist-get certificate :subject)))
- (string-match "\\bSHA1\\b" algo)
- (not (nsm-query
- host port status :intermediate-sha1
- "An intermediate certificate used to verify the
connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be
unsafe."
- host port algo)))
- do (cl-return nil)
- finally (cl-return t)))
-
-(defun nsm-protocol-check--ssl (host port status _)
+ ;; Don't check root certificates -- root is always trusted.
+ if (and (not (equal (plist-get certificate :issuer)
+ (plist-get certificate :subject)))
+ (string-match "\\bMD5\\b" algo))
+ return (format-message
+ "MD5 signature (%s) is very prone to collisions"
+ algo)
+ end))
+
+;; Extension checks
+
+(defun nsm-protocol-check--renegotiation-info-ext (host port status
+ &optional settings)
+ "Check for renegotiation_info TLS extension status.
+
+If this TLS extension is not used, the connection established is
+vulnerable to an attack in which an impersonator can extract
+sensitive information such as HTTP session ID cookies or login
+passwords. Renegotiation was removed in TLS1.3, so this is only
+checked for earlier protocol versions.
+
+Reference:
+
+E. Rescorla, M. Ray, S. Dispensa, N. Oskov (Feb 2010). \"Transport
+Layer Security (TLS) Renegotiation Indication Extension\",
+`https://tools.ietf.org/html/rfc5746'"
+ (when (plist-member status :safe-renegotiation)
+ (let ((unsafe-renegotiation (not (plist-get status :safe-renegotiation))))
+ (and unsafe-renegotiation
+ (format-message
+ "safe renegotiation is not supported, connection not protected
from impersonators")))))
+
+;; Compression checks
+
+(defun nsm-protocol-check--compression (host port status &optional settings)
+ "Check for TLS compression.
+
+TLS compression attacks such as CRIME would allow an attacker to
+decrypt ciphertext. As a result, RFC 7525 has recommended its
+disablement.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", `https://tools.ietf.org/html/rfc7525'"
+ (let ((compression (plist-get status :compression)))
+ (and compression
+ (string-match "^\\bDEFLATE\\b" compression)
+ (format-message
+ "compression method (%s) may lead to leakage of sensitive
information"
+ compression))))
+
+;; Protocol version checks
+
+(defun nsm-protocol-check--version (host port status &optional settings)
+ "Check for SSL/TLS protocol version.
+
+This function guards against the usage of SSL3.0, which has been
+deprecated by RFC7568[1], and TLS 1.0, which has been deprecated
+by PCI DSS[2].
+
+References:
+
+[1]: Barnes, Thomson, Pironti, Langley (2015). \"Deprecating Secure
+Sockets Layer Version 3.0\", `https://tools.ietf.org/html/rfc7568'
+[2]: PCI Security Standards Council (2016). \"Migrating from SSL and
+Early TLS\"
+`https://www.pcisecuritystandards.org/documents/Migrating-from-SSL-Early-TLS-Info-Supp-v1_1.pdf'"
(let ((protocol (plist-get status :protocol)))
- (or (not protocol)
- (not (string-match "SSL" protocol))
- (nsm-query
- host port status :ssl
- "The connection to %s:%s uses the %s protocol, which is believed to be
unsafe."
- host port protocol))))
+ (and protocol
+ (or (string-match "SSL" protocol)
+ (and (string-match "TLS1.\\([0-9]+\\)" protocol)
+ (< (string-to-number (match-string 1 protocol)) 1)))
+ (format-message
+ "%s protocol is deprecated by standard bodies"
+ protocol))))
+
+;; Full suite checks
+
+(defun nsm-protocol-check--null-suite (host port status &optional settings)
+ "Check for NULL cipher suites.
+
+This function checks for NULL key exchange, cipher and message
+authentication code key derivation function. As the name
+suggests, a NULL assigned for any of the above disables an
+integral part of the security properties that makes up the TLS
+protocol."
+ (let ((suite (nsm-cipher-suite status)))
+ (and (string-match "\\bNULL\\b" suite)
+ (format-message
+ "NULL cipher suite (%s) violates authenticity, integrity, or
confidentiality guarantees"
+ suite))))
+
+
(defun nsm-fingerprint (status)
(plist-get (plist-get status :certificate) :public-key-id))
-(defun nsm-fingerprint-ok-p (host port status settings)
- (let ((did-query nil))
- (if (and settings
- (not (eq (plist-get settings :fingerprint) :none))
- (not (equal (nsm-fingerprint status)
- (plist-get settings :fingerprint)))
- (not
- (setq did-query
- (nsm-query
- host port status 'fingerprint
- "The fingerprint for the connection to %s:%s has changed
from %s to %s"
- host port
- (plist-get settings :fingerprint)
- (nsm-fingerprint status)))))
- ;; Not OK.
- nil
- (when did-query
- ;; Remove any exceptions that have been set on the previous
- ;; certificate.
- (plist-put settings :conditions nil))
- t)))
-
-(defun nsm-new-fingerprint-ok-p (host port status)
- (nsm-query
- host port status 'fingerprint
- "The fingerprint for the connection to %s:%s is new: %s"
- host port
- (nsm-fingerprint status)))
+(defun nsm-fingerprint-ok-p (status settings)
+ (let ((saved-fingerprints (plist-get settings :fingerprints)))
+ ;; Haven't seen this host before or not pinning cert.
+ (or (null saved-fingerprints)
+ ;; Plain connection allowed.
+ (memq :none saved-fingerprints)
+ ;; We are pinning certs, and we have seen this host before,
+ ;; but the credientials for this host differs from the last
+ ;; times we saw it.
+ (member (nsm-fingerprint status) saved-fingerprints))))
(defun nsm-check-plain-connection (process host port settings warn-unencrypted)
- ;; If this connection used to be TLS, but is now plain, then it's
- ;; possible that we're being Man-In-The-Middled by a proxy that's
- ;; stripping out STARTTLS announcements.
- (cond
- ((and (plist-get settings :fingerprint)
- (not (eq (plist-get settings :fingerprint) :none))
- (not
- (nsm-query
- host port nil 'conditions
- "The connection to %s:%s used to be an encrypted connection, but is
now unencrypted. This might mean that there's a man-in-the-middle tapping this
connection."
- host port)))
- (delete-process process)
- nil)
- ((and warn-unencrypted
- (not (memq :unencrypted (plist-get settings :conditions)))
- (not (nsm-query
- host port nil 'conditions
- "The connection to %s:%s is unencrypted."
- host port)))
- (delete-process process)
- nil)
- (t
- process)))
-
-(defun nsm-query (host port status what message &rest args)
+ (if (nsm-should-check host)
+ ;; If this connection used to be TLS, but is now plain, then it's
+ ;; possible that we're being Man-In-The-Middled by a proxy that's
+ ;; stripping out STARTTLS announcements.
+ (let ((fingerprints (plist-get settings :fingerprints)))
+ (cond
+ ((and fingerprints
+ (not (memq :none fingerprints))
+ (not
+ (nsm-query
+ host port nil 'conditions '(:unencrypted)
+ (format-message
+ "The connection to %s:%s used to be an encrypted connection,
but is now unencrypted. This might mean that there's a man-in-the-middle
tapping this connection."
+ host port))))
+ (delete-process process)
+ nil)
+ ((and warn-unencrypted
+ (not (memq :unencrypted (plist-get settings :conditions)))
+ (not (nsm-query
+ host port nil 'conditions '(:unencrypted)
+ (format-message
+ "The connection to %s:%s is unencrypted."
+ host port))))
+ (delete-process process)
+ nil)
+ (t
+ process)))
+ process))
+
+(defun nsm-query (host port status what problems message)
;; If there is no user to answer queries, then say `no' to everything.
(if (or noninteractive
nsm-noninteractive)
@@ -340,9 +790,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(let ((response
(condition-case nil
(intern
- (car (split-string
- (nsm-query-user message args
- (nsm-format-certificate status))))
+ (car (split-string (nsm-query-user message status)))
obarray)
;; Make sure we manage to close the process if the user hits
;; `C-g'.
@@ -356,46 +804,111 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
"Accepting certificate for %s:%s this session only"
"Permanently accepting certificate for %s:%s")
host port)
- (nsm-save-host host port status what response)
- t))))
-
-(defun nsm-query-user (message args cert)
- (catch 'return
- (while t
- (let ((buffer (get-buffer-create "*Network Security Manager*")))
- (save-window-excursion
- ;; First format the certificate and warnings.
- (with-help-window buffer
- (with-current-buffer buffer
- (erase-buffer)
- (when (> (length cert) 0)
- (insert cert "\n"))
- (let ((start (point)))
- (insert (apply #'format-message message args))
- (goto-char start)
- ;; Fill the first line of the message, which usually
- ;; contains lots of explanatory text.
- (fill-region (point) (line-end-position)))))
- ;; Then ask the user what to do about it.
- (pcase (unwind-protect
- (cadr
- (read-multiple-choice
- "Continue connecting?"
- '((?a "always" "Accept this certificate this session
and for all future sessions.")
- (?s "session only" "Accept this certificate this
session only.")
- (?n "no" "Refuse to use this certificate, and close
the connection.")
- (?r "reshow" "Reshow certificate information."))))
- (kill-buffer buffer))
- ("reshow")
- (val (throw 'return val))))))))
-
-(defun nsm-save-host (host port status what permanency)
+ (nsm-save-host host port status what problems response)
+ t))))
+
+(set-advertised-calling-convention
+ 'nsm-query '(host port status what problems message) "27.1")
+
+(declare-function gnutls-format-certificate "gnutls.c" (cert))
+
+(defun nsm-query-user (message status)
+ (let ((buffer (get-buffer-create "*Network Security Manager*"))
+ (cert-buffer (get-buffer-create "*Certificate Details*"))
+ (certs (plist-get status :certificates)))
+ (save-window-excursion
+ ;; First format the certificate and warnings.
+ (with-current-buffer-window
+ buffer nil nil
+ (when status (insert (nsm-format-certificate status)))
+ (insert message)
+ (goto-char (point-min))
+ ;; Fill the first line of the message, which usually
+ ;; contains lots of explanatory text.
+ (fill-region (point) (line-end-position)))
+ ;; Then ask the user what to do about it.
+ (unwind-protect
+ (let* ((accept-choices '((?a "always" "Accept this certificate this
session and for all future sessions.")
+ (?s "session only" "Accept this certificate
this session only.")
+ (?n "no" "Refuse to use this certificate,
and close the connection.")
+ (?d "details" "See certificate details")))
+ (details-choices '((?b "backward page" "See previous page")
+ (?f "forward page" "See next page")
+ (?n "next" "Next certificate")
+ (?p "previous" "Previous certificate")
+ (?q "quit" "Quit details view")))
+ (answer (read-multiple-choice "Continue connecting?"
+ accept-choices))
+ (show-details (char-equal (car answer) ?d))
+ (pems (cl-loop for cert in certs
+ collect (gnutls-format-certificate
+ (plist-get cert :pem))))
+ (cert-index 0))
+ (while show-details
+ (unless (get-buffer-window cert-buffer)
+ (set-window-buffer (get-buffer-window buffer) cert-buffer)
+ (with-current-buffer cert-buffer
+ (read-only-mode -1)
+ (insert (nth cert-index pems))
+ (goto-char (point-min))
+ (read-only-mode)))
+
+ (setq answer (read-multiple-choice "Viewing certificate:"
details-choices))
+
+ (cond
+ ((char-equal (car answer) ?q)
+ (setq show-details (not show-details))
+ (set-window-buffer (get-buffer-window cert-buffer) buffer)
+ (setq show-details (char-equal
+ (car (setq answer
+ (read-multiple-choice
+ "Continue connecting?"
+ accept-choices)))
+ ?d)))
+
+ ((char-equal (car answer) ?b)
+ (with-selected-window (get-buffer-window cert-buffer)
+ (with-current-buffer cert-buffer
+ (ignore-errors (scroll-down)))))
+
+ ((char-equal (car answer) ?f)
+ (with-selected-window (get-buffer-window cert-buffer)
+ (with-current-buffer cert-buffer
+ (ignore-errors (scroll-up)))))
+
+ ((char-equal (car answer) ?n)
+ (with-current-buffer cert-buffer
+ (read-only-mode -1)
+ (erase-buffer)
+ (setq cert-index (mod (1+ cert-index) (length pems)))
+ (insert (nth cert-index pems))
+ (goto-char (point-min))
+ (read-only-mode)))
+
+ ((char-equal (car answer) ?p)
+ (with-current-buffer cert-buffer
+ (read-only-mode -1)
+ (erase-buffer)
+ (setq cert-index (mod (1- cert-index) (length pems)))
+ (insert (nth cert-index pems))
+ (goto-char (point-min))
+ (read-only-mode)))))
+ (cadr answer))
+ (kill-buffer cert-buffer)
+ (kill-buffer buffer)))))
+
+(set-advertised-calling-convention 'nsm-query-user '(message status) "27.1")
+
+(defun nsm-save-host (host port status what problems permanency)
(let* ((id (nsm-id host port))
- (saved
- (list :id id
- :fingerprint (or (nsm-fingerprint status)
- ;; Plain connection.
- :none))))
+ (saved-fingerprints (plist-get (nsm-host-settings id) :fingerprints))
+ (fingerprints (cl-delete-duplicates
+ (append saved-fingerprints
+ (list (or (nsm-fingerprint status)
+ ;; Plain connection.
+ :none)))
+ :test #'string=))
+ (saved (list :id id :fingerprints fingerprints)))
(when (or (eq what 'conditions)
nsm-save-host-names)
(nconc saved (list :host (format "%s:%s" host port))))
@@ -403,20 +916,19 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
;; of the certificate/unencrypted connection.
(cond
((eq what 'conditions)
- (cond
- ((not status)
- (nconc saved '(:conditions (:unencrypted))))
- ((plist-get status :warnings)
- (nconc saved
- (list :conditions (plist-get status :warnings))))))
- ((not (eq what 'fingerprint))
+ (plist-put saved :conditions problems))
+ ;; Make sure the conditions are not erased when we save a
+ ;; fingerprint
+ ((eq what 'fingerprint)
;; Store additional protocol settings.
(let ((settings (nsm-host-settings id)))
- (when settings
- (setq saved settings))
- (if (plist-get saved :conditions)
- (nconc (plist-get saved :conditions) (list what))
- (nconc saved (list :conditions (list what)))))))
+ (when settings
+ (setq saved settings))
+ (if (plist-get saved :conditions)
+ (plist-put saved :conditions
+ (cl-delete-duplicates
+ (nconc (plist-get saved :conditions) problems)))
+ (plist-put saved :conditions problems)))))
(if (eq permanency 'always)
(progn
(nsm-remove-temporary-setting id)
@@ -426,6 +938,11 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(nsm-remove-temporary-setting id)
(push saved nsm-temporary-host-settings))))
+(set-advertised-calling-convention
+ 'nsm-save-host
+ '(host port status what problems permanency)
+ "27.1")
+
(defun nsm-write-settings ()
(with-temp-file nsm-settings-file
(insert "(\n")
@@ -483,44 +1000,58 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(let ((cert (plist-get status :certificate)))
(when cert
(with-temp-buffer
- (insert
- "Certificate information\n"
- "Issued by:"
- (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
- "Issued to:"
+ (insert
+ (propertize "Certificate information" 'face 'underline) "\n"
+ " Issued by:"
+ (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
+ " Issued to:"
(or (nsm-certificate-part (plist-get cert :subject) "O")
(nsm-certificate-part (plist-get cert :subject) "OU" t))
- "\n"
- "Hostname:"
+ "\n"
+ " Hostname:"
(nsm-certificate-part (plist-get cert :subject) "CN" t) "\n")
(when (and (plist-get cert :public-key-algorithm)
(plist-get cert :signature-algorithm))
(insert
- "Public key:" (plist-get cert :public-key-algorithm)
+ " Public key:" (plist-get cert :public-key-algorithm)
", signature: " (plist-get cert :signature-algorithm) "\n"))
- (when (and (plist-get status :key-exchange)
+ (when (and (plist-get status :key-exchange)
(plist-get status :cipher)
(plist-get status :mac)
(plist-get status :protocol))
(insert
- "Protocol:" (plist-get status :protocol)
+ " Session:" (plist-get status :protocol)
", key: " (plist-get status :key-exchange)
", cipher: " (plist-get status :cipher)
", mac: " (plist-get status :mac) "\n"))
- (when (plist-get cert :certificate-security-level)
+ (when (plist-get cert :certificate-security-level)
(insert
- "Security level:"
+ " Security level:"
(propertize (plist-get cert :certificate-security-level)
'face 'bold)
"\n"))
(insert
- "Valid:From " (plist-get cert :valid-from)
- " to " (plist-get cert :valid-to) "\n\n")
- (goto-char (point-min))
+ " Valid:From " (plist-get cert :valid-from)
+ " to " (plist-get cert :valid-to) "\n")
+ (insert "\n")
+ (goto-char (point-min))
(while (re-search-forward "^[^:]+:" nil t)
- (insert (make-string (- 20 (current-column)) ? )))
+ (insert (make-string (- 22 (current-column)) ? )))
(buffer-string)))))
+(defun nsm-level (symbol)
+ "Return a numerical level for SYMBOL for easier comparison."
+ (cond
+ ((eq symbol 'low) 0)
+ ((eq symbol 'medium) 1)
+ (t 2)))
+
+(defun nsm-cipher-suite (status)
+ (format "%s-%s-%s"
+ (plist-get status :key-exchange)
+ (plist-get status :cipher)
+ (plist-get status :mac)))
+
(defun nsm-certificate-part (string part &optional full)
(let ((part (cadr (assoc part (nsm-parse-subject string)))))
(cond
@@ -552,13 +1083,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
elem)))
(nreverse result)))))
-(defun nsm-level (symbol)
- "Return a numerical level for SYMBOL for easier comparison."
- (cond
- ((eq symbol 'low) 0)
- ((eq symbol 'medium) 1)
- ((eq symbol 'high) 2)
- (t 3)))
+(define-obsolete-function-alias 'nsm--encryption #'nsm-cipher-suite "27.1")
(provide 'nsm)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index fbd1a9b..81c3fb4 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -715,10 +715,15 @@ size, and full-buffer size."
;; Success; continue.
(when (= (preceding-char) ?\s)
(delete-char -1))
- (let ((gap-start (point)))
- (insert "\n")
+ (let ((gap-start (point))
+ (face (get-text-property (point) 'face)))
+ ;; Extend the background to the end of the line.
+ (if face
+ (insert (propertize "\n" 'face (shr-face-background face)))
+ (insert "\n"))
(shr-indent)
(when (and (> (1- gap-start) (point-min))
+ (get-text-property (point) 'shr-url)
;; The link on both sides of the newline are the
;; same...
(equal (get-text-property (point) 'shr-url)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index f1f0abc..bcfac78 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -719,7 +719,7 @@ for($i = 0; $i < $n; $i++)
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" .
getgrgid($stat[5]) . \"\\\"\";
$filename =~ s/\"/\\\\\"/g;
printf(
- \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u
t (%%u . %%u) (%%u . %%u))\\n\",
+ \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t
%%u -1)\\n\",
$filename,
$type,
$stat[3],
@@ -733,10 +733,7 @@ for($i = 0; $i < $n; $i++)
$stat[10] & 0xffff,
$stat[7],
$stat[2],
- $stat[1] >> 16 & 0xffff,
- $stat[1] & 0xffff,
- $stat[0] >> 16 & 0xffff,
- $stat[0] & 0xffff);
+ $stat[1]);
}
printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
"Perl script implementing `directory-files-attributes' as Lisp `read'able
@@ -1762,11 +1759,14 @@ of."
;; We must care about file names with spaces, or starting with
;; "-"; this would confuse xargs. "ls -aQ" might be a
;; solution, but it does not work on all remote systems.
+ ;; Therefore, we use \000 as file separator.
+ ;; `tramp-sh--quoting-style-options' do not work for file names
+ ;; with spaces piped to "xargs".
;; Apostrophes in the stat output are masked as
;; `tramp-stat-marker', in order to make a proper shell escape
;; of them in file names.
- "cd %s && echo \"(\"; (%s %s -a | "
- "xargs %s -c "
+ "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
+ "xargs -0 %s -c "
"'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
"-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\""))
(tramp-shell-quote-argument localname)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d419f9d..ed0f1de 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4211,9 +4211,10 @@ the remote host use line-endings as defined in the
variable
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
(tramp-flush-directory-properties vec ""))
- (goto-char (point-max))
- (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
- (delete-region (point) (point-max))))))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-max))
+ (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
+ (delete-region (point) (point-max)))))))
(defun tramp-get-inode (vec)
"Returns the virtual inode number.
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 2d19c14..be09a73 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -562,7 +562,8 @@ FILE is created there."
(gamegrid-shared-game-dir
(not (zerop (logand #o6000 (or update-game-score-modes 0))))))
(cond ((or (not update-game-score-modes) (file-name-absolute-p file))
- (gamegrid-add-score-insecure file score))
+ (gamegrid-add-score-insecure file score
+ gamegrid-user-score-file-directory))
((and gamegrid-shared-game-dir
(file-exists-p (expand-file-name file
shared-game-score-directory)))
;; Use the setgid (or setuid) "update-game-score" program
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4cc1daf..f0b34c7 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -701,9 +701,8 @@ of `my-compilation-root' here."
;;;###autoload
(defcustom compilation-search-path '(nil)
"List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of
-directories. The value nil as an element means the error
-message buffer `default-directory'."
+Elements should be directory names, not file names of directories.
+The value nil as an element means to try the default directory."
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
@@ -2575,28 +2574,94 @@ region and the first line of the next region."
(defcustom compilation-context-lines nil
"Display this many lines of leading context before the current message.
-If nil and the left fringe is displayed, don't scroll the
+If nil or t, and the left fringe is displayed, don't scroll the
compilation output window; an arrow in the left fringe points to
-the current message. If nil and there is no left fringe, the message
-displays at the top of the window; there is no arrow."
- :type '(choice integer (const :tag "No window scrolling" nil))
+the current message. With no left fringe, If nil, the message
+scrolls to the top of the window; there is no arrow. If t, don't
+scroll the compilation output window at all; an arrow before
+column zero points to the current message."
+ :type '(choice integer
+ (const :tag "Scroll window when no fringe" nil)
+ (const :tag "No window scrolling" t))
:version "22.1")
(defsubst compilation-set-window (w mk)
- "Align the compilation output window W with marker MK near top."
- (if (integerp compilation-context-lines)
- (set-window-start w (save-excursion
- (goto-char mk)
- (compilation-beginning-of-line
- (- 1 compilation-context-lines))
- (point)))
+ "Maybe align the compilation output window W with marker MK near top."
+ (cond ((integerp compilation-context-lines)
+ (set-window-start w (save-excursion
+ (goto-char mk)
+ (compilation-beginning-of-line
+ (- 1 compilation-context-lines))
+ (point))))
+ ((eq compilation-context-lines t))
;; If there is no left fringe.
- (when (equal (car (window-fringes w)) 0)
- (set-window-start w (save-excursion
- (goto-char mk)
- (beginning-of-line 1)
- (point)))))
- (set-window-point w mk))
+ ((equal (car (window-fringes w)) 0)
+ (set-window-start w (save-excursion
+ (goto-char mk)
+ (beginning-of-line 1)
+ (point)))
+ (set-window-point w mk))
+ (t (set-window-point w mk))))
+
+(defvar-local compilation-arrow-overlay nil
+ "Overlay with the before-string property of `overlay-arrow-string'.
+
+When non-nil, this overlay causes redisplay to display `overlay-arrow-string'
+at the overlay's start position.")
+
+(defconst compilation--margin-string (propertize "=>" 'face 'default)
+ "The string which will appear in the margin in compilation mode.")
+
+(defconst compilation--dummy-string
+ (propertize ">" 'display
+ `((margin left-margin) ,compilation--margin-string))
+ "A string which is only a placeholder for `compilation--margin-string'.
+Actual value is never used, only the text property.")
+
+(defun compilation-set-up-arrow-spec-in-margin ()
+ "Set up compilation-arrow-overlay to display as an arrow in a margin."
+ (setq overlay-arrow-string "")
+ (setq compilation-arrow-overlay
+ (make-overlay overlay-arrow-position overlay-arrow-position))
+ (overlay-put compilation-arrow-overlay
+ 'before-string compilation--dummy-string)
+ (set-window-margins (selected-window) (+ (or (car (window-margins)) 0) 2)))
+
+(defun compilation-tear-down-arrow-spec-in-margin ()
+ "Restore compilation-arrow-overlay to not using the margin, which is
removed."
+ (overlay-put compilation-arrow-overlay 'before-string nil)
+ (delete-overlay compilation-arrow-overlay)
+ (setq compilation-arrow-overlay nil)
+ (set-window-margins (selected-window) (- (car (window-margins)) 2)))
+
+(defun compilation-set-overlay-arrow (w)
+ "Set up, or switch off, the overlay-arrow for window W."
+ (with-selected-window w ; So the later `goto-char' will work.
+ (if (and (eq compilation-context-lines t)
+ (equal (car (window-fringes w)) 0)) ; No left fringe
+ ;; Insert a before-string overlay at the beginning of the line
+ ;; pointed to by `overlay-arrow-position', such that it will
+ ;; display in a 2-character margin.
+ (progn
+ (cond
+ ((overlayp compilation-arrow-overlay)
+ (when (not (eq (overlay-start compilation-arrow-overlay)
+ overlay-arrow-position))
+ (if overlay-arrow-position
+ (move-overlay compilation-arrow-overlay
+ overlay-arrow-position overlay-arrow-position)
+ (compilation-tear-down-arrow-spec-in-margin))))
+
+ (overlay-arrow-position
+ (compilation-set-up-arrow-spec-in-margin)))
+ ;; Ensure that the "=>" remains in the window by causing
+ ;; the window to be scrolled, if needed.
+ (goto-char (overlay-start compilation-arrow-overlay)))
+
+ ;; `compilation-context-lines' isn't t, or we've got a left
+ ;; fringe, so remove any overlay arrow.
+ (when (overlayp compilation-arrow-overlay)
+ (compilation-tear-down-arrow-spec-in-margin)))))
(defvar next-error-highlight-timer)
@@ -2618,7 +2683,8 @@ and overlay is highlighted between MK and END-MK."
(highlight-regexp (with-current-buffer (marker-buffer msg)
;; also do this while we change buffer
(goto-char (marker-position msg))
- (and w (compilation-set-window w msg))
+ (and w (progn (compilation-set-window w msg)
+ (compilation-set-overlay-arrow w)))
compilation-highlight-regexp)))
;; Ideally, the window-size should be passed to `display-buffer'
;; so it's only used when creating a new window.
@@ -2739,7 +2805,8 @@ attempts to find a file whose name is produced by (format
FMT FILENAME)."
'(nil (allow-no-window . t))))))
(with-current-buffer (marker-buffer marker)
(goto-char marker)
- (and w (compilation-set-window w marker)))
+ (and w (progn (compilation-set-window w marker)
+ (compilation-set-overlay-arrow w))))
(let* ((name (read-file-name
(format "Find this %s in (default %s): "
compilation-error filename)
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 2d5a47a..f08ba2f 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -654,7 +654,14 @@ Create parent directories as needed."
(let ((cleanup-f (flymake-proc--get-cleanup-function
(buffer-file-name))))
(flymake-log 3 "cleaning up using %s" cleanup-f)
- (funcall cleanup-f))))
+ ;; Make cleanup-f see the temporary file names
+ ;; created by its corresponding init function
+ ;; (bug#31981).
+ (let ((flymake-proc--temp-source-file-name
+ (process-get proc
'flymake-proc--temp-source-file-name))
+ (flymake-proc--temp-master-file-name
+ (process-get proc
'flymake-proc--temp-master-file-name)))
+ (funcall cleanup-f)))))
(kill-buffer output-buffer)))))))
(defun flymake-proc--panic (problem explanation)
@@ -824,6 +831,10 @@ can also be executed interactively independently of
(process-put proc 'flymake-proc--output-buffer
(generate-new-buffer
(format " *flymake output for %s*"
(current-buffer))))
+ (process-put proc 'flymake-proc--temp-source-file-name
+ flymake-proc--temp-source-file-name)
+ (process-put proc 'flymake-proc--temp-master-file-name
+ flymake-proc--temp-master-file-name)
(setq flymake-proc--current-process proc)
(flymake-log 2 "started process %d, command=%s, dir=%s"
(process-id proc) (process-command proc)
@@ -865,6 +876,7 @@ can also be executed interactively independently of
(let* ((ext (file-name-extension file-name))
(temp-name (file-truename
(concat (file-name-sans-extension file-name)
+ "_" (format-time-string "%H%M%S%N")
"_" prefix
(and ext (concat "." ext))))))
(flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 30d4b19..235546e 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1610,7 +1610,9 @@ and source-file directory for your debugger."
;; characters we match in the file name shown in the prompt.
;; (Of course, this matches the "<string>" case too.)
(defvar gud-pdb-marker-regexp
- "^> \\([[:graph:]
\\]*\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]")
+ (concat "^> \\([[:graph:] \\]*\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|"
+
"<\\(?:module\\|listcomp\\|dictcomp\\|setcomp\\|genexpr\\|lambda\\|\\)>"
+ "\\)()\\(->[^\n\r]*\\)?[\n\r]"))
(defvar gud-pdb-marker-regexp-file-group 1)
(defvar gud-pdb-marker-regexp-line-group 2)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 1b06077..9fea447 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -112,28 +112,23 @@
(defcustom hide-ifdef-initially nil
"Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
- :type 'boolean
- :group 'hide-ifdef)
+ :type 'boolean)
(defcustom hide-ifdef-read-only nil
"Set to non-nil if you want buffer to be read-only while hiding text."
- :type 'boolean
- :group 'hide-ifdef)
+ :type 'boolean)
(defcustom hide-ifdef-lines nil
"Non-nil means hide the #ifX, #else, and #endif lines."
- :type 'boolean
- :group 'hide-ifdef)
+ :type 'boolean)
(defcustom hide-ifdef-shadow nil
"Non-nil means shadow text instead of hiding it."
:type 'boolean
- :group 'hide-ifdef
:version "23.1")
(defface hide-ifdef-shadow '((t (:inherit shadow)))
"Face for shadowing ifdef blocks."
- :group 'hide-ifdef
:version "23.1")
(defcustom hide-ifdef-exclude-define-regexp nil
@@ -168,7 +163,6 @@ This behavior is generally undesirable. If this option is
non-nil, the outermos
"C/C++ header file name patterns to determine if current buffer is a header.
Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
:type 'string
- :group 'hide-ifdef
:version "25.1")
(defvar hide-ifdef-mode-submap
@@ -196,8 +190,10 @@ Effective only if
`hide-ifdef-expand-reinclusion-protection' is t."
map)
"Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
-(defconst hide-ifdef-mode-prefix-key "\C-c@"
- "Prefix key for all Hide-Ifdef mode commands.")
+(defcustom hide-ifdef-mode-prefix-key "\C-c@"
+ "Prefix key for all Hide-Ifdef mode commands."
+ :type 'key-sequence
+ :version "27.1")
(defvar hide-ifdef-mode-map
;; Set up the mode's main map, which leads via the prefix key to the submap.
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index cb39e62..8d3513b 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -39,7 +39,8 @@
(defcustom prog-mode-hook nil
"Normal hook run when entering programming modes."
:type 'hook
- :options '(flyspell-prog-mode abbrev-mode flymake-mode linum-mode
+ :options '(flyspell-prog-mode abbrev-mode flymake-mode
+ display-line-numbers-mode
prettify-symbols-mode)
:group 'prog-mode)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index ae35766..eef2ca6 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -728,7 +728,11 @@ references displayed in the current *xref* buffer."
"Mode for displaying cross-references."
(setq buffer-read-only t)
(setq next-error-function #'xref--next-error-function)
- (setq next-error-last-buffer (current-buffer)))
+ (setq next-error-last-buffer (current-buffer))
+ (setq imenu-prev-index-position-function
+ #'xref--imenu-prev-index-position)
+ (setq imenu-extract-index-name-function
+ #'xref--imenu-extract-index-name))
(defvar xref--transient-buffer-mode-map
(let ((map (make-sparse-keymap)))
@@ -740,6 +744,22 @@ references displayed in the current *xref* buffer."
xref--xref-buffer-mode
"XREF Transient")
+(defun xref--imenu-prev-index-position ()
+ "Move point to previous line in `xref' buffer.
+This function is used as a value for
+`imenu-prev-index-position-function'."
+ (if (bobp)
+ nil
+ (xref--search-property 'xref-group t)))
+
+(defun xref--imenu-extract-index-name ()
+ "Return imenu name for line at point.
+This function is used as a value for
+`imenu-extract-index-name-function'. Point should be at the
+beginning of the line."
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position)))
+
(defun xref--next-error-function (n reset?)
(when reset?
(goto-char (point-min)))
@@ -789,7 +809,8 @@ GROUP is a string for decoration purposes and XREF is an
for line-format = (and max-line-width
(format "%%%dd: " max-line-width))
do
- (xref--insert-propertized '(face xref-file-header) group "\n")
+ (xref--insert-propertized '(face xref-file-header 'xref-group t)
+ group "\n")
(cl-loop for (xref . more2) on xrefs do
(with-slots (summary location) xref
(let* ((line (xref-location-line location))
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 8dd1d1e..5956c9f 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1320,29 +1320,18 @@ Please send all bug fixes and enhancements to
;; Known bugs and limitations of ps-print
;; --------------------------------------
;;
-;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
-;; particular, bold or italic fonts don't print in the right background color.
-;;
-;; Invisible properties aren't correctly ignored in XEmacs 19.12.
-;;
;; Automatic font-attribute detection doesn't work well, especially with
;; hilit19 and older versions of get-create-face. Users having problems with
;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
;; and `ps-underlined-faces' and/or turn off automatic detection by setting
;; `ps-auto-font-detect' to nil.
;;
-;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
-;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
-;; `ps-underlined-faces' instead.
-;;
;; Still too slow; could use some hand-optimization.
;;
;; Default background color isn't working.
;;
;; Faces are always treated as opaque.
;;
-;; Epoch, Lucid and Emacs 22 not supported. At all.
-;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 4112b44..2720286 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1184,9 +1184,6 @@ IGNORE other arguments."
:format "%[%t\n%]"
:help-echo ,(concat "Open " (cdr menu-element))
:action recentf-open-files-action
- ;; Override the (problematic) follow-link property of the
- ;; `link' widget (bug#22434).
- :follow-link nil
,(cdr menu-element))))
(defun recentf-open-files-items (files)
diff --git a/lisp/server.el b/lisp/server.el
index d491a26..ac81cdb 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -926,12 +926,11 @@ This handles splitting the command if it would be bigger
than
(isearch-cancel))))
;; Signaled by isearch-cancel.
(quit (message nil)))
- (when (> (recursion-depth) 0)
+ (when (> (minibuffer-depth) 0)
;; We're inside a minibuffer already, so if the emacs-client is trying
;; to open a frame on a new display, we might end up with an unusable
;; frame because input from that display will be blocked (until exiting
;; the minibuffer). Better exit this minibuffer right away.
- ;; Similarly with recursive-edits such as the splash screen.
(run-with-timer 0 nil (lambda () (server-execute-continuation proc)))
(top-level)))
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 07e7850..2778e58 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -165,6 +165,9 @@ created by `shadow-define-regexp-group'.")
(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file
(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file
+(defvar shadow-debug nil
+ "Use for debug messages.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Syntactic sugar; General list and string manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -631,6 +634,10 @@ Consider them as regular expressions if third arg REGEXP
is true."
(let ((shadows (shadow-shadows-of
(shadow-expand-file-name
(buffer-file-name (current-buffer))))))
+ (when shadow-debug
+ (message
+ "shadow-add-to-todo: %s %s\n%s"
+ shadows shadow-files-to-copy (with-output-to-string (backtrace))))
(when shadows
(setq shadow-files-to-copy
(shadow-union shadows shadow-files-to-copy))
@@ -644,6 +651,10 @@ Consider them as regular expressions if third arg REGEXP
is true."
(defun shadow-remove-from-todo (pair)
"Remove PAIR from `shadow-files-to-copy'.
PAIR must be `eq' to one of the elements of that list."
+ (when shadow-debug
+ (message
+ "shadow-remove-from-todo: %s %s\n%s"
+ pair shadow-files-to-copy (with-output-to-string (backtrace))))
(setq shadow-files-to-copy
(cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy)))
@@ -673,7 +684,7 @@ Return t unless files were locked; then return nil."
(eval-buffer))
(when shadow-todo-file
(set-buffer (setq shadow-todo-buffer
- (find-file-noselect shadow-todo-file)))
+ (find-file-noselect shadow-todo-file 'nowarn)))
(when (and (not (buffer-modified-p))
(file-newer-than-file-p (make-auto-save-file-name)
shadow-todo-file))
@@ -714,6 +725,8 @@ With non-nil argument also saves the buffer."
(if save (shadow-save-todo-file))))
(defun shadow-save-todo-file ()
+ (when shadow-debug
+ (message "shadow-save-todo-file:\n%s" (with-output-to-string (backtrace))))
(if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
(with-current-buffer shadow-todo-buffer
(condition-case nil ; have to continue even in case of
@@ -769,7 +782,7 @@ look for files that have been changed and need to be copied
to other systems."
(buffer-list))))
(yes-or-no-p "Modified buffers exist; exit anyway? "))
(or (not (fboundp 'process-list))
- ;; process-list is not defined on MSDOS.
+ ;; `process-list' is not defined on MSDOS.
(let ((processes (process-list))
active)
(while processes
diff --git a/lisp/shell.el b/lisp/shell.el
index 2914d1d..fb2c36f 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -184,13 +184,16 @@ shell buffer. The value may depend on the operating
system or shell."
shell-environment-variable-completion
shell-command-completion
shell-c-a-p-replace-by-expanded-directory
- pcomplete-completions-at-point
shell-filename-completion
- comint-filename-completion)
+ comint-filename-completion
+ ;; Put `pcomplete-completions-at-point' last so that other
+ ;; functions can run before it does, see bug#34330.
+ pcomplete-completions-at-point)
"List of functions called to perform completion.
This variable is used to initialize `comint-dynamic-complete-functions' in the
shell buffer."
:type '(repeat function)
+ :version "27.1"
:group 'shell)
(defcustom shell-command-regexp "[^;&|\n]+"
@@ -553,6 +556,8 @@ Variables `comint-output-filter-functions', a hook, and
`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
control whether input and output cause the window to scroll to the end of the
buffer."
+ (when (called-interactively-p 'any)
+ (error "Can't be called interactively; did you mean `shell-script-mode'
instead?"))
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
(setq-local paragraph-separate "\\'")
diff --git a/lisp/simple.el b/lisp/simple.el
index 84497c3..358b6a4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1587,10 +1587,8 @@ display the result of expression evaluation."
(let ((minibuffer-completing-symbol t))
(minibuffer-with-setup-hook
(lambda ()
- ;; FIXME: call emacs-lisp-mode?
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
- (eldoc-mode 1)
+ ;; FIXME: call emacs-lisp-mode (see also
+ ;; `eldoc--eval-expression-setup')?
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil t)
(run-hooks 'eval-expression-minibuffer-setup-hook))
@@ -3946,15 +3944,14 @@ interactively, this is t."
(when (and error-file (file-exists-p error-file))
(if (< 0 (file-attribute-size (file-attributes error-file)))
(with-current-buffer (get-buffer-create error-buffer)
- (let ((pos-from-end (- (point-max) (point))))
- (or (bobp)
- (insert "\f\n"))
- ;; Do no formatting while reading error file,
- ;; because that can run a shell command, and we
- ;; don't want that to cause an infinite recursion.
- (format-insert-file error-file nil)
- ;; Put point after the inserted errors.
- (goto-char (- (point-max) pos-from-end)))
+ (goto-char (point-max))
+ ;; Insert a separator if there's already text here.
+ (unless (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
(and display-error-buffer
(display-buffer (current-buffer)))))
(delete-file error-file))
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index bce73d6..67fc4aa 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -105,8 +105,8 @@ are integer buffer positions in the reverse order of the
insertion order.")
(defvar skeleton-regions)
(def-edebug-spec skeleton-edebug-spec
- ([&or null stringp (stringp &rest stringp) [[¬ atom] def-form]]
- &rest &or "n" "_" "-" ">" "@" "&" "!" "resume:"
+ ([&or null stringp (stringp &rest stringp) [[¬ atom] sexp]]
+ &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:"
("quote" def-form) skeleton-edebug-spec def-form))
;;;###autoload
(defmacro define-skeleton (command documentation &rest skeleton)
diff --git a/lisp/sort.el b/lisp/sort.el
index 6ea1c44..6ceda8e 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -225,11 +225,17 @@ the sort order."
(narrow-to-region beg end)
(goto-char (point-min))
(sort-subr reverse
- (function
- (lambda ()
- (while (and (not (eobp)) (looking-at paragraph-separate))
- (forward-line 1))))
- 'forward-paragraph))))
+ (lambda ()
+ (while (and (not (eobp)) (looking-at paragraph-separate))
+ (forward-line 1)))
+ (lambda ()
+ (forward-paragraph)
+ ;; If the buffer doesn't end with a newline, add a
+ ;; newline to avoid having paragraphs being
+ ;; concatenated after sorting.
+ (when (and (eobp)
+ (not (bolp)))
+ (insert "\n")))))))
;;;###autoload
(defun sort-pages (reverse beg end)
diff --git a/lisp/startup.el b/lisp/startup.el
index 5644285..a16db24 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,4 +1,4 @@
-;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
+;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1992, 1994-2019 Free Software Foundation,
;; Inc.
@@ -490,6 +490,27 @@ DIRS are relative."
(when tail
(setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
+;; The default location for XDG-convention Emacs init files.
+(defconst startup--xdg-config-default "~/.config/emacs/")
+;; The location for XDG-convention Emacs init files.
+(defvar startup--xdg-config-home-emacs)
+
+;; Return the name of the init file directory for Emacs, assuming
+;; XDG-DIR is the XDG location and USER-NAME is the user name.
+;; If USER-NAME is nil or "", use the current user.
+;; Prefer the XDG location unless it does does not exist and the
+;; .emacs.d location does exist.
+(defun startup--xdg-or-homedot (xdg-dir user-name)
+ (if (file-exists-p xdg-dir)
+ xdg-dir
+ (let ((emacs-d-dir (concat "~" user-name
+ (if (eq system-type 'ms-dos)
+ "/_emacs.d/"
+ "/.emacs.d/"))))
+ (if (file-exists-p emacs-d-dir)
+ emacs-d-dir
+ xdg-dir))))
+
(defun normal-top-level ()
"Emacs calls this function when it first starts up.
It sets `command-line-processed', processes the command-line,
@@ -499,6 +520,14 @@ It is the default value of the variable `top-level'."
(message internal--top-level-message)
(setq command-line-processed t)
+ (setq startup--xdg-config-home-emacs
+ (let ((xdg-config-home (getenv-internal "XDG_CONFIG_HOME")))
+ (if xdg-config-home
+ (concat xdg-config-home "/emacs/")
+ startup--xdg-config-default)))
+ (setq user-emacs-directory
+ (startup--xdg-or-homedot startup--xdg-config-home-emacs nil))
+
;; Look in each dir in load-path for a subdirs.el file. If we
;; find one, load it, which will add the appropriate subdirs of
;; that dir into load-path. This needs to be done before setting
@@ -906,16 +935,19 @@ init-file, or to a default value if loading is not
possible."
;; the name of the file that it loads into
;; `user-init-file'.
(setq user-init-file t)
- (load (if (equal (file-name-extension init-file-name)
- "el")
- (file-name-sans-extension init-file-name)
- init-file-name)
- 'noerror 'nomessage)
+ (when init-file-name
+ (load (if (equal (file-name-extension init-file-name)
+ "el")
+ (file-name-sans-extension init-file-name)
+ init-file-name)
+ 'noerror 'nomessage))
(when (and (eq user-init-file t) alternate-filename-function)
(let ((alt-file (funcall alternate-filename-function)))
(and (equal (file-name-extension alt-file) "el")
(setq alt-file (file-name-sans-extension alt-file)))
+ (unless init-file-name
+ (setq init-file-name alt-file))
(load alt-file 'noerror 'nomessage)))
;; If we did not find the user's init file, set
@@ -971,18 +1003,10 @@ the `--debug-init' option to view a complete error
backtrace."
(when debug-on-error-should-be-set
(setq debug-on-error debug-on-error-from-init-file))))
-(defun find-init-path (fn)
- "Look in ~/.config/FOO or ~/.FOO for the dotfile or dot directory FOO.
-It is expected that the output will undergo ~ expansion. Implements the
-XDG convention for dotfiles."
- (let* ((xdg-path (concat "~" init-file-user "/.config/" fn))
- (oldstyle-path (concat "~" init-file-user "/." fn))
- (found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path)))
- found-path))
-
(defun command-line ()
"A subroutine of `normal-top-level'.
Amongst another things, it parses the command-line arguments."
+ (let (xdg-dir startup-init-directory)
(setq before-init-time (current-time)
after-init-time nil
command-line-default-directory default-directory)
@@ -1171,6 +1195,19 @@ please check its value")
init-file-user))
:error))))
+ ;; Calculate the name of the Emacs init directory.
+ ;; This is typically ~INIT-FILE-USER/.config/emacs unless the user
+ ;; is following the ~INIT-FILE-USER/.emacs.d convention.
+ (setq xdg-dir startup--xdg-config-home-emacs)
+ (setq startup-init-directory
+ (if (or (zerop (length init-file-user))
+ (and (eq xdg-dir user-emacs-directory)
+ (not (eq xdg-dir startup--xdg-config-default))))
+ user-emacs-directory
+ ;; The name is not obvious, so access more directories to calculate
it.
+ (setq xdg-dir (concat "~" init-file-user "/.config/emacs/"))
+ (startup--xdg-or-homedot xdg-dir init-file-user)))
+
;; Load the early init file, if found.
(startup--load-user-init-file
(lambda ()
@@ -1180,8 +1217,7 @@ please check its value")
;; with the .el extension, if the file doesn't exist, not just
;; "early-init" without an extension, as it does for ".emacs".
"early-init.el"
- (file-name-as-directory
- (find-init-path "emacs.d")))))
+ startup-init-directory)))
(setq early-init-file user-init-file)
;; If any package directory exists, initialize the package system.
@@ -1319,10 +1355,11 @@ please check its value")
(startup--load-user-init-file
(lambda ()
(cond
+ ((eq startup-init-directory xdg-dir) nil)
((eq system-type 'ms-dos)
(concat "~" init-file-user "/_emacs"))
((not (eq system-type 'windows-nt))
- (find-init-path "emacs"))
+ (concat "~" init-file-user "/.emacs"))
;; Else deal with the Windows situation.
((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
;; Prefer .emacs on Windows.
@@ -1339,8 +1376,7 @@ please check its value")
(lambda ()
(expand-file-name
"init"
- (file-name-as-directory
- (find-init-path "emacs.d"))))
+ startup-init-directory))
(not inhibit-default-init))
(when (and deactivate-mark transient-mark-mode)
@@ -1456,7 +1492,7 @@ Consider using a subdirectory instead, e.g.: %s"
(if (and (boundp 'x-session-previous-id)
(stringp x-session-previous-id))
(with-no-warnings
- (emacs-session-restore x-session-previous-id))))
+ (emacs-session-restore x-session-previous-id)))))
(defun x-apply-session-resources ()
"Apply X resources which specify initial values for Emacs variables.
diff --git a/lisp/subr.el b/lisp/subr.el
index b22db65..0d7bffb 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2937,11 +2937,9 @@ When the hook runs, the temporary buffer is current.
This hook is normally set up with a function to put the buffer in Help
mode.")
-(defconst user-emacs-directory
- (if (eq system-type 'ms-dos)
- ;; MS-DOS cannot have initial dot.
- "~/_emacs.d/"
- "~/.emacs.d/")
+(defvar user-emacs-directory
+ ;; The value does not matter since Emacs sets this at startup.
+ nil
"Directory beneath which additional per-user Emacs-specific files are placed.
Various programs in Emacs store information in this directory.
Note that this should end with a directory separator.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 713f3d9..8e7e194 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -450,6 +450,7 @@ checksum before doing the check."
(progn (beep) (message "Invalid checksum for file %s!" file-name))))
(defun tar-clip-time-string (time)
+ (declare (obsolete format-time-string "27.1"))
(let ((str (current-time-string time)))
(concat " " (substring str 4 16) (format-time-string " %Y" time))))
@@ -508,7 +509,9 @@ MODE should be an integer which is a file mode value."
(if (= 0 (length uname)) uid uname)
(if (= 0 (length gname)) gid gname)
size
- (if tar-mode-show-date (tar-clip-time-string time) "")
+ (if tar-mode-show-date
+ (format-time-string " %Y-%m-%d %H:%M" time)
+ "")
(propertize name
'mouse-face 'highlight
'help-echo "mouse-2: extract this file into a buffer")
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 9dfa9f3..5c77e03 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -394,7 +394,12 @@ for language-specific arguments."
"Indicates whether ispell should skip spell checking of SGML markup.
If t, always skip SGML markup; if nil, never skip; if non-t and non-nil,
guess whether SGML markup should be skipped according to the name of the
-buffer's major mode."
+buffer's major mode.
+
+SGML markup is any text inside the brackets \"<>\" or entities
+such as \"&\". See `ispell-html-skip-alists' for more details.
+
+This variable affects spell-checking of HTML, XML, and SGML files."
:type '(choice (const :tag "always" t) (const :tag "never" nil)
(const :tag "use-mode-name" use-mode-name))
:group 'ispell)
diff --git a/lisp/tmm.el b/lisp/tmm.el
index bf76652..c1c8638 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -240,8 +240,6 @@ instead of executing it."
(car elt)))
tmm-km-list)))))
(setq history-len (length tmm--history))
- (setq tmm--history (append tmm--history tmm--history
- tmm--history tmm--history))
(setq tmm-c-prompt (nth (- history-len 1 index-of-default)
tmm--history))
(setq out
@@ -249,18 +247,17 @@ instead of executing it."
(car (nth index-of-default tmm-km-list))
(minibuffer-with-setup-hook #'tmm-add-prompt
;; tmm-km-list is reversed, because history
- ;; needs it in LIFO order. But completion
+ ;; needs it in LIFO order. But default list
;; needs it in non-reverse order, so that the
- ;; menu items are displayed as completion
- ;; candidates in the order they are shown on
- ;; the menu bar. So pass completing-read the
+ ;; menu items are displayed by M-n as default
+ ;; values in the order they are shown on
+ ;; the menu bar. So pass the DEFAULT arg the
;; reversed copy of the list.
(completing-read-default
(concat gl-str
" (up/down to change, PgUp to menu): ")
- (tmm--completion-table (reverse tmm-km-list)) nil t nil
- (cons 'tmm--history
- (- (* 2 history-len) index-of-default))))))))
+ (tmm--completion-table tmm-km-list) nil t nil
+ 'tmm--history (reverse tmm--history)))))))
(setq choice (cdr (assoc out tmm-km-list)))
(and (null choice)
(string-prefix-p tmm-c-prompt out)
@@ -404,8 +401,7 @@ Stores a list of all the shortcuts in the free variable
`tmm-short-cuts'."
;; Try to show everything just inserted and preserve height of
;; *Completions* window. This should fix a behavior described
;; in Bug#1291.
- (fit-window-to-buffer window nil nil nil nil t)))))
- (insert tmm-c-prompt))
+ (fit-window-to-buffer window nil nil nil nil t))))))
(defun tmm-shortcut ()
"Choose the shortcut that the user typed."
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index f287adf..c2a5a6f 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1359,6 +1359,8 @@ commands, which only operated on marked files."
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
+ ;; Disable pager.
+ (process-environment (cons "HGPLAIN=1" process-environment))
(hg-program vc-hg-program)
args)
;; If necessary, prompt for the exact command.
@@ -1431,7 +1433,9 @@ call \"hg push -r REVS\" to push the specified revisions
REVS."
"Merge incoming changes into the current working directory.
This runs the command \"hg merge\"."
(let* ((root (vc-hg-root default-directory))
- (buffer (format "*vc-hg : %s*" (expand-file-name root))))
+ (buffer (format "*vc-hg : %s*" (expand-file-name root)))
+ ;; Disable pager.
+ (process-environment (cons "HGPLAIN=1" process-environment)))
(apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
@@ -1442,11 +1446,13 @@ This runs the command \"hg merge\"."
"A wrapper around `vc-do-command' for use in vc-hg.el.
This function differs from vc-do-command in that it invokes
`vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS."
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list
- (if (stringp vc-hg-global-switches)
- (cons vc-hg-global-switches flags)
- (append vc-hg-global-switches
- flags))))
+ ;; Disable pager.
+ (let ((process-environment (cons "HGPLAIN=1" process-environment)))
+ (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program
file-or-list
+ (if (stringp vc-hg-global-switches)
+ (cons vc-hg-global-switches flags)
+ (append vc-hg-global-switches
+ flags)))))
(defun vc-hg-root (file)
(vc-find-root file ".hg"))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index dd03a24..9bc7a07 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1790,17 +1790,22 @@ If END is omitted, it defaults to the length of LIST."
:type 'string
:group 'widget-button)
+(defvar widget-link-keymap
+ (let ((map (copy-keymap widget-keymap)))
+ ;; Only bind mouse-2, since mouse-1 will be translated accordingly to
+ ;; the customization of `mouse-1-click-follows-link'.
+ (define-key map [down-mouse-1] (lookup-key widget-global-map
[down-mouse-1]))
+ (define-key map [down-mouse-2] 'widget-button-click)
+ (define-key map [mouse-2] 'widget-button-click)
+ map)
+ "Keymap used inside a link widget.")
+
(define-widget 'link 'item
"An embedded link."
:button-prefix 'widget-link-prefix
:button-suffix 'widget-link-suffix
- ;; The `follow-link' property should only be used in those contexts where the
- ;; mouse-1 event normally doesn't follow the link, yet the `link' widget
- ;; seems to almost always be used in contexts where (down-)mouse-1 is bound
- ;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is
- ;; not necessary (and can even be harmful). So let's not add a :follow-link
- ;; by default. See (bug#22434).
- ;; :follow-link 'mouse-face
+ :follow-link 'mouse-face
+ :keymap widget-link-keymap
:help-echo "Follow the link."
:format "%[%t%]")
@@ -3078,7 +3083,9 @@ as the value."
(define-widget 'file 'string
"A file widget.
It reads a file name from an editable text field."
- :completions #'completion-file-name-table
+ :completions (completion-table-case-fold
+ #'completion-file-name-table
+ (not read-file-name-completion-ignore-case))
:prompt-value 'widget-file-prompt-value
:format "%{%t%}: %v"
;; Doesn't work well with terminating newline.
@@ -3113,6 +3120,11 @@ It reads a file name from an editable text field."
(define-widget 'directory 'file
"A directory widget.
It reads a directory name from an editable text field."
+ :completions (apply-partially #'completion-table-with-predicate
+ (completion-table-case-fold
+ #'completion-file-name-table
+ (not read-file-name-completion-ignore-case))
+ #'directory-name-p 'strict)
:tag "Directory")
(defvar widget-symbol-prompt-value-history nil
@@ -3328,13 +3340,13 @@ It reads a directory name from an editable text field."
(condition-case data ;Note: We get a spurious byte-compile warning here.
(progn
;; Avoid a confusing end-of-file error.
- (skip-syntax-forward "\\s-")
+ (skip-syntax-forward "-")
(if (eobp)
(setq err "Empty sexp -- use nil?")
(unless (widget-apply widget :match (read (current-buffer)))
(setq err (widget-get widget :type-error))))
;; Allow whitespace after expression.
- (skip-syntax-forward "\\s-")
+ (skip-syntax-forward "-")
(if (and (not (eobp))
(not err))
(setq err (format "Junk at end of expression: %s"
diff --git a/lisp/window.el b/lisp/window.el
index 80dbd64..cf73315 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -4849,7 +4849,7 @@ all window-local buffer lists."
(unrecord-window-buffer window buffer)))))
(defcustom quit-window-hook nil
- "Hook run before performing any other actions in the `quit-buffer' command."
+ "Hook run before performing any other actions in the `quit-window' command."
:type 'hook
:version "27.1"
:group 'windows)
@@ -4882,11 +4882,7 @@ nil means to not handle the buffer in a particular way.
This
most reliable remedy to not have `switch-to-prev-buffer' switch
to this buffer again without killing the buffer.
-`kill' means to kill WINDOW's buffer.
-
-The functions in `quit-window-hook' will be run before doing
-anything else."
- (run-hooks 'quit-window-hook)
+`kill' means to kill WINDOW's buffer."
(setq window (window-normalize-window window t))
(let* ((buffer (window-buffer window))
(quit-restore (window-parameter window 'quit-restore))
@@ -4986,6 +4982,10 @@ one. If non-nil, reset `quit-restore' parameter to nil.
The functions in `quit-window-hook' will be run before doing
anything else."
(interactive "P")
+ ;; Run the hook from the buffer implied to get any buffer-local
+ ;; values.
+ (with-current-buffer (window-buffer (window-normalize-window window))
+ (run-hooks 'quit-window-hook))
(quit-restore-window window (if kill 'kill 'bury)))
(defun quit-windows-on (&optional buffer-or-name kill frame)
diff --git a/src/alloc.c b/src/alloc.c
index bb8e97f..be98cfd 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -297,20 +297,20 @@ static ptrdiff_t pure_bytes_used_non_lisp;
static intptr_t garbage_collection_inhibited;
+/* The GC threshold in bytes, the last time it was calculated
+ from gc-cons-threshold and gc-cons-percentage. */
+static intmax_t gc_threshold;
+
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
const char *pending_malloc_warning;
-#if 0 /* Normally, pointer sanity only on request... */
+/* Pointer sanity only on request. FIXME: Code depending on
+ SUSPICIOUS_OBJECT_CHECKING is obsolete; remove it entirely. */
#ifdef ENABLE_CHECKING
#define SUSPICIOUS_OBJECT_CHECKING 1
#endif
-#endif
-
-/* ... but unconditionally use SUSPICIOUS_OBJECT_CHECKING while the GC
- bug is unresolved. */
-#define SUSPICIOUS_OBJECT_CHECKING 1
#ifdef SUSPICIOUS_OBJECT_CHECKING
struct suspicious_free_record
@@ -327,8 +327,8 @@ static int suspicious_free_history_index;
static void *find_suspicious_object_in_range (void *begin, void *end);
static void detect_suspicious_free (void *ptr);
#else
-# define find_suspicious_object_in_range(begin, end) NULL
-# define detect_suspicious_free(ptr) (void)
+# define find_suspicious_object_in_range(begin, end) ((void *) NULL)
+# define detect_suspicious_free(ptr) ((void) 0)
#endif
/* Maximum amount of C stack to save when a GC happens. */
@@ -4621,11 +4621,11 @@ mark_maybe_pointer (void *p)
if (pdumper_object_p (p))
{
- enum Lisp_Type type = pdumper_find_object_type (p);
- if (type != PDUMPER_NO_OBJECT)
- mark_object ((type == Lisp_Symbol)
- ? make_lisp_symbol(p)
- : make_lisp_ptr(p, type));
+ int type = pdumper_find_object_type (p);
+ if (pdumper_valid_object_type_p (type))
+ mark_object (type == Lisp_Symbol
+ ? make_lisp_symbol (p)
+ : make_lisp_ptr (p, type));
/* See mark_maybe_object for why we can confidently return. */
return;
}
@@ -5290,9 +5290,10 @@ make_pure_float (double num)
space. */
static Lisp_Object
-make_pure_bignum (struct Lisp_Bignum *value)
+make_pure_bignum (Lisp_Object value)
{
- size_t i, nlimbs = mpz_size (value->value);
+ mpz_t const *n = xbignum_val (value);
+ size_t i, nlimbs = mpz_size (*n);
size_t nbytes = nlimbs * sizeof (mp_limb_t);
mp_limb_t *pure_limbs;
mp_size_t new_size;
@@ -5303,10 +5304,10 @@ make_pure_bignum (struct Lisp_Bignum *value)
int limb_alignment = alignof (mp_limb_t);
pure_limbs = pure_alloc (nbytes, - limb_alignment);
for (i = 0; i < nlimbs; ++i)
- pure_limbs[i] = mpz_getlimbn (value->value, i);
+ pure_limbs[i] = mpz_getlimbn (*n, i);
new_size = nlimbs;
- if (mpz_sgn (value->value) < 0)
+ if (mpz_sgn (*n) < 0)
new_size = -new_size;
mpz_roinit_n (b->value, pure_limbs, new_size);
@@ -5456,7 +5457,7 @@ purecopy (Lisp_Object obj)
return obj;
}
else if (BIGNUMP (obj))
- obj = make_pure_bignum (XBIGNUM (obj));
+ obj = make_pure_bignum (obj);
else
{
AUTO_STRING (fmt, "Don't know how to purify: %S");
@@ -5784,6 +5785,77 @@ mark_and_sweep_weak_table_contents (void)
}
}
+/* Return the number of bytes to cons between GCs, assuming
+ gc-cons-threshold is THRESHOLD and gc-cons-percentage is
+ PERCENTAGE. */
+static intmax_t
+consing_threshold (intmax_t threshold, Lisp_Object percentage)
+{
+ if (!NILP (Vmemory_full))
+ return memory_full_cons_threshold;
+ else
+ {
+ threshold = max (threshold, GC_DEFAULT_THRESHOLD / 10);
+ if (FLOATP (percentage))
+ {
+ double tot = (XFLOAT_DATA (percentage)
+ * total_bytes_of_live_objects ());
+ if (threshold < tot)
+ {
+ if (tot < INTMAX_MAX)
+ threshold = tot;
+ else
+ threshold = INTMAX_MAX;
+ }
+ }
+ return threshold;
+ }
+}
+
+/* Adjust consing_until_gc, assuming gc-cons-threshold is THRESHOLD and
+ gc-cons-percentage is PERCENTAGE. */
+static Lisp_Object
+bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage)
+{
+ /* If consing_until_gc is negative leave it alone, since this prevents
+ negative integer overflow and a GC would have been done soon anyway. */
+ if (0 <= consing_until_gc)
+ {
+ threshold = consing_threshold (threshold, percentage);
+ intmax_t sum;
+ if (INT_ADD_WRAPV (consing_until_gc, threshold - gc_threshold, &sum))
+ {
+ /* Scale the threshold down so that consing_until_gc does
+ not overflow. */
+ sum = INTMAX_MAX;
+ threshold = INTMAX_MAX - consing_until_gc + gc_threshold;
+ }
+ consing_until_gc = sum;
+ gc_threshold = threshold;
+ }
+
+ return Qnil;
+}
+
+/* Watch changes to gc-cons-threshold. */
+static Lisp_Object
+watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object newval,
+ Lisp_Object operation, Lisp_Object where)
+{
+ intmax_t threshold;
+ if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold)))
+ return Qnil;
+ return bump_consing_until_gc (threshold, Vgc_cons_percentage);
+}
+
+/* Watch changes to gc-cons-percentage. */
+static Lisp_Object
+watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
+ Lisp_Object operation, Lisp_Object where)
+{
+ return bump_consing_until_gc (gc_cons_threshold, newval);
+}
+
/* Subroutine of Fgarbage_collect that does most of the work. */
static bool
garbage_collect_1 (struct gcstat *gcst)
@@ -5926,25 +5998,8 @@ garbage_collect_1 (struct gcstat *gcst)
unblock_input ();
- if (!NILP (Vmemory_full))
- consing_until_gc = memory_full_cons_threshold;
- else
- {
- intmax_t threshold = max (gc_cons_threshold, GC_DEFAULT_THRESHOLD / 10);
- if (FLOATP (Vgc_cons_percentage))
- {
- double tot = (XFLOAT_DATA (Vgc_cons_percentage)
- * total_bytes_of_live_objects ());
- if (threshold < tot)
- {
- if (tot < INTMAX_MAX)
- threshold = tot;
- else
- threshold = INTMAX_MAX;
- }
- }
- consing_until_gc = threshold;
- }
+ consing_until_gc = gc_threshold
+ = consing_threshold (gc_cons_threshold, Vgc_cons_percentage);
if (garbage_collection_messages && NILP (Vmemory_full))
{
@@ -7365,6 +7420,7 @@ do hash-consing of the objects allocated to pure space.
*/);
DEFSYM (Qheap, "heap");
DEFSYM (QAutomatic_GC, "Automatic GC");
+ DEFSYM (Qgc_cons_percentage, "gc-cons-percentage");
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
@@ -7398,6 +7454,22 @@ N should be nonnegative. */);
defsubr (&Smemory_info);
defsubr (&Smemory_use_counts);
defsubr (&Ssuspicious_object);
+
+ Lisp_Object watcher;
+
+ static union Aligned_Lisp_Subr Swatch_gc_cons_threshold =
+ {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
+ { .a4 = watch_gc_cons_threshold },
+ 4, 4, "watch_gc_cons_threshold", 0, 0}};
+ XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
+ Fadd_variable_watcher (Qgc_cons_threshold, watcher);
+
+ static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
+ {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
+ { .a4 = watch_gc_cons_percentage },
+ 4, 4, "watch_gc_cons_percentage", 0, 0}};
+ XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
+ Fadd_variable_watcher (Qgc_cons_percentage, watcher);
}
#ifdef HAVE_X_WINDOWS
diff --git a/src/bignum.c b/src/bignum.c
index 3883d3a..167b73e 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -31,9 +31,10 @@ 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,
- time_arith, rounddiv_q and rounding_driver each need four. */
+ rounddiv_q and rounding_driver both need four and time_arith needs
+ five. */
-mpz_t mpz[4];
+mpz_t mpz[5];
static void *
xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
@@ -62,7 +63,7 @@ init_bignum (void)
double
bignum_to_double (Lisp_Object n)
{
- return mpz_get_d_rounded (XBIGNUM (n)->value);
+ return mpz_get_d_rounded (*xbignum_val (n));
}
/* Return D, converted to a Lisp integer. Discard any fraction.
@@ -263,13 +264,13 @@ intmax_t
bignum_to_intmax (Lisp_Object x)
{
intmax_t i;
- return mpz_to_intmax (XBIGNUM (x)->value, &i) ? i : 0;
+ return mpz_to_intmax (*xbignum_val (x), &i) ? i : 0;
}
uintmax_t
bignum_to_uintmax (Lisp_Object x)
{
uintmax_t i;
- return mpz_to_uintmax (XBIGNUM (x)->value, &i) ? i : 0;
+ return mpz_to_uintmax (*xbignum_val (x), &i) ? i : 0;
}
/* Yield an upper bound on the buffer size needed to contain a C
@@ -283,7 +284,7 @@ mpz_bufsize (mpz_t const num, int base)
ptrdiff_t
bignum_bufsize (Lisp_Object num, int base)
{
- return mpz_bufsize (XBIGNUM (num)->value, base);
+ return mpz_bufsize (*xbignum_val (num), base);
}
/* Convert NUM to a nearest double, as opposed to mpz_get_d which
@@ -317,7 +318,7 @@ ptrdiff_t
bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base)
{
eassert (bignum_bufsize (num, abs (base)) == size);
- mpz_get_str (buf, base, XBIGNUM (num)->value);
+ mpz_get_str (buf, base, *xbignum_val (num));
ptrdiff_t n = size - 2;
return !buf[n - 1] ? n - 1 : n + !!buf[n];
}
diff --git a/src/bignum.h b/src/bignum.h
index a9c7a0a..bf7b366 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -41,7 +41,7 @@ struct Lisp_Bignum
mpz_t value;
} GCALIGNED_STRUCT;
-extern mpz_t mpz[4];
+extern mpz_t mpz[5];
extern void init_bignum (void);
extern Lisp_Object make_integer_mpz (void);
@@ -80,6 +80,19 @@ mpz_set_uintmax (mpz_t result, uintmax_t v)
mpz_set_uintmax_slow (result, v);
}
+/* Return a pointer to the mpz_t value represented by the bignum I.
+ It is const because the value should not change. */
+INLINE mpz_t const *
+bignum_val (struct Lisp_Bignum const *i)
+{
+ return &i->value;
+}
+INLINE mpz_t const *
+xbignum_val (Lisp_Object i)
+{
+ return bignum_val (XBIGNUM (i));
+}
+
/* 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;
otherwise this sets *TMP to I's value and returns TMP. */
@@ -91,7 +104,7 @@ bignum_integer (mpz_t *tmp, Lisp_Object i)
mpz_set_intmax (*tmp, XFIXNUM (i));
return tmp;
}
- return &XBIGNUM (i)->value;
+ return xbignum_val (i);
}
/* Set RESULT to the value stored in the Lisp integer I. If I is a
@@ -103,7 +116,7 @@ mpz_set_integer (mpz_t result, Lisp_Object i)
if (FIXNUMP (i))
mpz_set_intmax (result, XFIXNUM (i));
else
- mpz_set (result, XBIGNUM (i)->value);
+ mpz_set (result, *xbignum_val (i));
}
INLINE_HEADER_END
diff --git a/src/buffer.c b/src/buffer.c
index ea785bb..77e8b6b 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -105,7 +105,7 @@ static char
buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
/* Number of per-buffer variables used. */
-int last_per_buffer_idx;
+static int last_per_buffer_idx;
static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
bool after, Lisp_Object arg1,
@@ -655,6 +655,12 @@ set_buffer_overlays_after (struct buffer *b, struct
Lisp_Overlay *o)
b->overlays_after = o;
}
+bool
+valid_per_buffer_idx (int idx)
+{
+ return 0 <= idx && idx < last_per_buffer_idx;
+}
+
/* Clone per-buffer values of buffer FROM.
Buffer TO gets the same per-buffer values as FROM, with the
@@ -4568,7 +4574,7 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
prop_i = copy[i++];
overlay_i = copy[i++];
/* It is possible that the recorded overlay has been deleted
- (which makes it's markers' buffers be nil), or that (due to
+ (which makes its markers' buffers be nil), or that (due to
some bug) it belongs to a different buffer. Only run this
hook if the overlay belongs to the current buffer. */
if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer)
diff --git a/src/buffer.h b/src/buffer.h
index 2080a6f..82d9350 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -31,12 +31,11 @@ INLINE_HEADER_BEGIN
/* Accessing the parameters of the current buffer. */
-/* These macros come in pairs, one for the char position
+/* These constants and macros come in pairs, one for the char position
and one for the byte position. */
/* Position of beginning of buffer. */
-#define BEG (1)
-#define BEG_BYTE (BEG)
+enum { BEG = 1, BEG_BYTE = BEG };
/* Position of beginning of accessible range of buffer. */
#define BEGV (current_buffer->begv)
@@ -96,59 +95,7 @@ INLINE_HEADER_BEGIN
/* Modification count as of last visit or save. */
#define SAVE_MODIFF (current_buffer->text->save_modiff)
-
-/* BUFFER_CEILING_OF (resp. BUFFER_FLOOR_OF), when applied to n, return
- the max (resp. min) p such that
-
- BYTE_POS_ADDR (p) - BYTE_POS_ADDR (n) == p - n */
-
-#define BUFFER_CEILING_OF(BYTEPOS) \
- (((BYTEPOS) < GPT_BYTE && GPT < ZV ? GPT_BYTE : ZV_BYTE) - 1)
-#define BUFFER_FLOOR_OF(BYTEPOS) \
- (BEGV <= GPT && GPT_BYTE <= (BYTEPOS) ? GPT_BYTE : BEGV_BYTE)
-/* Similar macros to operate on a specified buffer.
- Note that many of these evaluate the buffer argument more than once. */
-
-/* Position of beginning of buffer. */
-#define BUF_BEG(buf) (BEG)
-#define BUF_BEG_BYTE(buf) (BEG_BYTE)
-
-/* The BUF_BEGV[_BYTE], BUF_ZV[_BYTE], and BUF_PT[_BYTE] macros cannot
- be used for assignment; use SET_BUF_* macros below for that. */
-
-/* Position of beginning of accessible range of buffer. */
-#define BUF_BEGV(buf) \
- (buf == current_buffer ? BEGV \
- : NILP (BVAR (buf, begv_marker)) ? buf->begv \
- : marker_position (BVAR (buf, begv_marker)))
-
-#define BUF_BEGV_BYTE(buf) \
- (buf == current_buffer ? BEGV_BYTE \
- : NILP (BVAR (buf, begv_marker)) ? buf->begv_byte \
- : marker_byte_position (BVAR (buf, begv_marker)))
-
-/* Position of point in buffer. */
-#define BUF_PT(buf) \
- (buf == current_buffer ? PT \
- : NILP (BVAR (buf, pt_marker)) ? buf->pt \
- : marker_position (BVAR (buf, pt_marker)))
-
-#define BUF_PT_BYTE(buf) \
- (buf == current_buffer ? PT_BYTE \
- : NILP (BVAR (buf, pt_marker)) ? buf->pt_byte \
- : marker_byte_position (BVAR (buf, pt_marker)))
-
-/* Position of end of accessible range of buffer. */
-#define BUF_ZV(buf) \
- (buf == current_buffer ? ZV \
- : NILP (BVAR (buf, zv_marker)) ? buf->zv \
- : marker_position (BVAR (buf, zv_marker)))
-
-#define BUF_ZV_BYTE(buf) \
- (buf == current_buffer ? ZV_BYTE \
- : NILP (BVAR (buf, zv_marker)) ? buf->zv_byte \
- : marker_byte_position (BVAR (buf, zv_marker)))
/* Position of gap in buffer. */
#define BUF_GPT(buf) ((buf)->text->gpt)
@@ -161,15 +108,6 @@ INLINE_HEADER_BEGIN
/* Address of beginning of buffer. */
#define BUF_BEG_ADDR(buf) ((buf)->text->beg)
-/* Address of beginning of gap of buffer. */
-#define BUF_GPT_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte - BEG_BYTE)
-
-/* Address of end of buffer. */
-#define BUF_Z_ADDR(buf) ((buf)->text->beg + (buf)->text->gap_size +
(buf)->text->z_byte - BEG_BYTE)
-
-/* Address of end of gap in buffer. */
-#define BUF_GAP_END_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte +
(buf)->text->gap_size - BEG_BYTE)
-
/* Size of gap. */
#define BUF_GAP_SIZE(buf) ((buf)->text->gap_size)
@@ -209,43 +147,8 @@ INLINE_HEADER_BEGIN
BUF_OVERLAY_UNCHANGED_MODIFIED (current_buffer)
#define BEG_UNCHANGED BUF_BEG_UNCHANGED (current_buffer)
#define END_UNCHANGED BUF_END_UNCHANGED (current_buffer)
-
-/* Compute how many characters at the top and bottom of BUF are
- unchanged when the range START..END is modified. This computation
- must be done each time BUF is modified. */
-
-#define BUF_COMPUTE_UNCHANGED(buf, start, end) \
- do \
- { \
- if (BUF_UNCHANGED_MODIFIED (buf) == BUF_MODIFF (buf) \
- && (BUF_OVERLAY_UNCHANGED_MODIFIED (buf) \
- == BUF_OVERLAY_MODIFF (buf))) \
- { \
- BUF_BEG_UNCHANGED (buf) = (start) - BUF_BEG (buf); \
- BUF_END_UNCHANGED (buf) = BUF_Z (buf) - (end); \
- } \
- else \
- { \
- if (BUF_Z (buf) - (end) < BUF_END_UNCHANGED (buf)) \
- BUF_END_UNCHANGED (buf) = BUF_Z (buf) - (end); \
- if ((start) - BUF_BEG (buf) < BUF_BEG_UNCHANGED (buf)) \
- BUF_BEG_UNCHANGED (buf) = (start) - BUF_BEG (buf); \
- } \
- } \
- while (false)
-
-/* Macros to set PT in the current buffer, or another buffer. */
-
-#define SET_PT(position) (set_point (position))
-#define TEMP_SET_PT(position) (temp_set_point (current_buffer, (position)))
-
-#define SET_PT_BOTH(position, byte) (set_point_both (position, byte))
-#define TEMP_SET_PT_BOTH(position, byte) \
- (temp_set_point_both (current_buffer, (position), (byte)))
-
-#define BUF_TEMP_SET_PT(buffer, position) \
- (temp_set_point ((buffer), (position)))
+/* Functions to set PT in the current buffer, or another buffer. */
extern void set_point (ptrdiff_t);
extern void temp_set_point (struct buffer *, ptrdiff_t);
@@ -255,39 +158,32 @@ extern void temp_set_point_both (struct buffer *,
extern void set_point_from_marker (Lisp_Object);
extern void enlarge_buffer_text (struct buffer *, ptrdiff_t);
+INLINE void
+SET_PT (ptrdiff_t position)
+{
+ set_point (position);
+}
+INLINE void
+TEMP_SET_PT (ptrdiff_t position)
+{
+ temp_set_point (current_buffer, position);
+}
+INLINE void
+SET_PT_BOTH (ptrdiff_t position, ptrdiff_t byte)
+{
+ set_point_both (position, byte);
+}
+INLINE void
+TEMP_SET_PT_BOTH (ptrdiff_t position, ptrdiff_t byte)
+{
+ temp_set_point_both (current_buffer, position, byte);
+}
+INLINE void
+BUF_TEMP_SET_PT (struct buffer *buffer, ptrdiff_t position)
+{
+ temp_set_point (buffer, position);
+}
-/* Macros for setting the BEGV, ZV or PT of a given buffer.
-
- The ..._BOTH macros take both a charpos and a bytepos,
- which must correspond to each other.
-
- The macros without ..._BOTH take just a charpos,
- and compute the bytepos from it. */
-
-#define SET_BUF_BEGV(buf, charpos) \
- ((buf)->begv_byte = buf_charpos_to_bytepos ((buf), (charpos)), \
- (buf)->begv = (charpos))
-
-#define SET_BUF_ZV(buf, charpos) \
- ((buf)->zv_byte = buf_charpos_to_bytepos ((buf), (charpos)), \
- (buf)->zv = (charpos))
-
-#define SET_BUF_BEGV_BOTH(buf, charpos, byte) \
- ((buf)->begv = (charpos), \
- (buf)->begv_byte = (byte))
-
-#define SET_BUF_ZV_BOTH(buf, charpos, byte) \
- ((buf)->zv = (charpos), \
- (buf)->zv_byte = (byte))
-
-#define SET_BUF_PT_BOTH(buf, charpos, byte) \
- ((buf)->pt = (charpos), \
- (buf)->pt_byte = (byte))
-
-/* Macros to access a character or byte in the current buffer,
- or convert between a byte position and an address.
- These macros do not check that the position is in range. */
-
/* Maximum number of bytes in a buffer.
A buffer cannot contain more bytes than a 1-origin fixnum can represent,
nor can it be so large that C pointer arithmetic stops working.
@@ -298,115 +194,21 @@ extern void enlarge_buffer_text (struct buffer *,
ptrdiff_t);
/* Maximum gap size after compact_buffer, in bytes. Also
used in make_gap_larger to get some extra reserved space. */
-#define GAP_BYTES_DFL 2000
+enum { GAP_BYTES_DFL = 2000 };
/* Minimum gap size after compact_buffer, in bytes. Also
used in make_gap_smaller to avoid too small gap size. */
-#define GAP_BYTES_MIN 20
-
-/* Return the address of byte position N in current buffer. */
-
-#define BYTE_POS_ADDR(n) \
- (((n) >= GPT_BYTE ? GAP_SIZE : 0) + (n) + BEG_ADDR - BEG_BYTE)
-
-/* Return the address of char position N. */
-
-#define CHAR_POS_ADDR(n) \
- (((n) >= GPT ? GAP_SIZE : 0) \
- + buf_charpos_to_bytepos (current_buffer, n) \
- + BEG_ADDR - BEG_BYTE)
-
-/* Convert a character position to a byte position. */
-
-#define CHAR_TO_BYTE(charpos) \
- (buf_charpos_to_bytepos (current_buffer, charpos))
-
-/* Convert a byte position to a character position. */
-
-#define BYTE_TO_CHAR(bytepos) \
- (buf_bytepos_to_charpos (current_buffer, bytepos))
+enum { GAP_BYTES_MIN = 20 };
/* For those very rare cases where you may have a "random" pointer into
the middle of a multibyte char, this moves to the next boundary. */
extern ptrdiff_t advance_to_char_boundary (ptrdiff_t byte_pos);
-/* Convert PTR, the address of a byte in the buffer, into a byte position. */
-
-#define PTR_BYTE_POS(ptr) \
- ((ptr) - (current_buffer)->text->beg \
- - (ptr - (current_buffer)->text->beg <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE)
\
- + BEG_BYTE)
-
-/* Return character at byte position POS. See the caveat WARNING for
- FETCH_MULTIBYTE_CHAR below. */
-
-#define FETCH_CHAR(pos) \
- (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \
- ? FETCH_MULTIBYTE_CHAR ((pos)) \
- : FETCH_BYTE ((pos)))
-
-/* Return the byte at byte position N. */
+/* Return the byte at byte position N.
+ Do not check that the position is in range. */
#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n)))
-
-/* Return character at byte position POS. If the current buffer is unibyte
- and the character is not ASCII, make the returning character
- multibyte. */
-
-#define FETCH_CHAR_AS_MULTIBYTE(pos) \
- (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \
- ? FETCH_MULTIBYTE_CHAR ((pos)) \
- : UNIBYTE_TO_CHAR (FETCH_BYTE ((pos))))
-
-
-/* Macros for accessing a character or byte,
- or converting between byte positions and addresses,
- in a specified buffer. */
-
-/* Return the address of character at byte position POS in buffer BUF.
- Note that both arguments can be computed more than once. */
-
-#define BUF_BYTE_ADDRESS(buf, pos) \
- ((buf)->text->beg + (pos) - BEG_BYTE \
- + ((pos) >= (buf)->text->gpt_byte ? (buf)->text->gap_size : 0))
-
-/* Return the address of character at char position POS in buffer BUF.
- Note that both arguments can be computed more than once. */
-
-#define BUF_CHAR_ADDRESS(buf, pos) \
- ((buf)->text->beg + buf_charpos_to_bytepos ((buf), (pos)) - BEG_BYTE \
- + ((pos) >= (buf)->text->gpt ? (buf)->text->gap_size : 0))
-
-/* Convert PTR, the address of a char in buffer BUF,
- into a character position. */
-
-#define BUF_PTR_BYTE_POS(buf, ptr) \
- ((ptr) - (buf)->text->beg \
- - (ptr - (buf)->text->beg <= BUF_GPT_BYTE (buf) - BEG_BYTE \
- ? 0 : BUF_GAP_SIZE ((buf))) \
- + BEG_BYTE)
-
-/* Return the character at byte position POS in buffer BUF. */
-
-#define BUF_FETCH_CHAR(buf, pos) \
- (!NILP (buf->enable_multibyte_characters) \
- ? BUF_FETCH_MULTIBYTE_CHAR ((buf), (pos)) \
- : BUF_FETCH_BYTE ((buf), (pos)))
-
-/* Return character at byte position POS in buffer BUF. If BUF is
- unibyte and the character is not ASCII, make the returning
- character multibyte. */
-
-#define BUF_FETCH_CHAR_AS_MULTIBYTE(buf, pos) \
- (! NILP (BVAR ((buf), enable_multibyte_characters)) \
- ? BUF_FETCH_MULTIBYTE_CHAR ((buf), (pos)) \
- : UNIBYTE_TO_CHAR (BUF_FETCH_BYTE ((buf), (pos))))
-
-/* Return the byte at byte position N in buffer BUF. */
-
-#define BUF_FETCH_BYTE(buf, n) \
- *(BUF_BYTE_ADDRESS ((buf), (n)))
/* Define the actual buffer data structures. */
@@ -482,6 +284,13 @@ struct buffer_text
#define BVAR(buf, field) ((buf)->field ## _)
+/* Max number of builtin per-buffer variables. */
+enum { MAX_PER_BUFFER_VARS = 50 };
+
+/* Special values for struct buffer.modtime. */
+enum { NONEXISTENT_MODTIME_NSECS = -1 };
+enum { UNKNOWN_MODTIME_NSECS = -2 };
+
/* This is the structure that the buffer Lisp object points to. */
struct buffer
@@ -796,7 +605,6 @@ struct buffer
for a buffer-local variable is stored in that variable's slot
in buffer_local_flags as a Lisp integer. If the index is -1,
this means the variable is always local in all buffers. */
-#define MAX_PER_BUFFER_VARS 50
char local_flags[MAX_PER_BUFFER_VARS];
/* Set to the modtime of the visited file when read or written.
@@ -804,8 +612,6 @@ struct buffer
visited file was nonexistent. modtime.tv_nsec ==
UNKNOWN_MODTIME_NSECS means visited file modtime unknown;
in no case complain about any mismatch on next save attempt. */
-#define NONEXISTENT_MODTIME_NSECS (-1)
-#define UNKNOWN_MODTIME_NSECS (-2)
struct timespec modtime;
/* Size of the file when modtime was set. This is used to detect the
@@ -1018,49 +824,281 @@ bset_width_table (struct buffer *b, Lisp_Object val)
b->width_table_ = val;
}
+/* BUFFER_CEILING_OF (resp. BUFFER_FLOOR_OF), when applied to n, return
+ the max (resp. min) p such that
+
+ BYTE_POS_ADDR (p) - BYTE_POS_ADDR (n) == p - n */
+
+INLINE ptrdiff_t
+BUFFER_CEILING_OF (ptrdiff_t bytepos)
+{
+ return (bytepos < GPT_BYTE && GPT < ZV ? GPT_BYTE : ZV_BYTE) - 1;
+}
+
+INLINE ptrdiff_t
+BUFFER_FLOOR_OF (ptrdiff_t bytepos)
+{
+ return BEGV <= GPT && GPT_BYTE <= bytepos ? GPT_BYTE : BEGV_BYTE;
+}
+
+/* The BUF_BEGV[_BYTE], BUF_ZV[_BYTE], and BUF_PT[_BYTE] functions cannot
+ be used for assignment; use SET_BUF_* functions below for that. */
+
+/* Position of beginning of accessible range of buffer. */
+INLINE ptrdiff_t
+BUF_BEGV (struct buffer *buf)
+{
+ return (buf == current_buffer ? BEGV
+ : NILP (BVAR (buf, begv_marker)) ? buf->begv
+ : marker_position (BVAR (buf, begv_marker)));
+}
+
+INLINE ptrdiff_t
+BUF_BEGV_BYTE (struct buffer *buf)
+{
+ return (buf == current_buffer ? BEGV_BYTE
+ : NILP (BVAR (buf, begv_marker)) ? buf->begv_byte
+ : marker_byte_position (BVAR (buf, begv_marker)));
+}
+
+/* Position of point in buffer. */
+INLINE ptrdiff_t
+BUF_PT (struct buffer *buf)
+{
+ return (buf == current_buffer ? PT
+ : NILP (BVAR (buf, pt_marker)) ? buf->pt
+ : marker_position (BVAR (buf, pt_marker)));
+}
+
+INLINE ptrdiff_t
+BUF_PT_BYTE (struct buffer *buf)
+{
+ return (buf == current_buffer ? PT_BYTE
+ : NILP (BVAR (buf, pt_marker)) ? buf->pt_byte
+ : marker_byte_position (BVAR (buf, pt_marker)));
+}
+
+/* Position of end of accessible range of buffer. */
+INLINE ptrdiff_t
+BUF_ZV (struct buffer *buf)
+{
+ return (buf == current_buffer ? ZV
+ : NILP (BVAR (buf, zv_marker)) ? buf->zv
+ : marker_position (BVAR (buf, zv_marker)));
+}
+
+INLINE ptrdiff_t
+BUF_ZV_BYTE (struct buffer *buf)
+{
+ return (buf == current_buffer ? ZV_BYTE
+ : NILP (BVAR (buf, zv_marker)) ? buf->zv_byte
+ : marker_byte_position (BVAR (buf, zv_marker)));
+}
+
+/* Similar functions to operate on a specified buffer. */
+
+/* Position of beginning of buffer. */
+INLINE ptrdiff_t
+BUF_BEG (struct buffer *buf)
+{
+ return BEG;
+}
+
+INLINE ptrdiff_t
+BUF_BEG_BYTE (struct buffer *buf)
+{
+ return BEG_BYTE;
+}
+
+/* Address of beginning of gap of buffer. */
+INLINE unsigned char *
+BUF_GPT_ADDR (struct buffer *buf)
+{
+ return buf->text->beg + buf->text->gpt_byte - BEG_BYTE;
+}
+
+/* Address of end of buffer. */
+INLINE unsigned char *
+BUF_Z_ADDR (struct buffer *buf)
+{
+ return buf->text->beg + buf->text->gap_size + buf->text->z_byte - BEG_BYTE;
+}
+
+/* Address of end of gap in buffer. */
+INLINE unsigned char *
+BUF_GAP_END_ADDR (struct buffer *buf)
+{
+ return buf->text->beg + buf->text->gpt_byte + buf->text->gap_size - BEG_BYTE;
+}
+
+/* Compute how many characters at the top and bottom of BUF are
+ unchanged when the range START..END is modified. This computation
+ must be done each time BUF is modified. */
+
+INLINE void
+BUF_COMPUTE_UNCHANGED (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
+{
+ if (BUF_UNCHANGED_MODIFIED (buf) == BUF_MODIFF (buf)
+ && (BUF_OVERLAY_UNCHANGED_MODIFIED (buf)
+ == BUF_OVERLAY_MODIFF (buf)))
+ {
+ buf->text->beg_unchanged = start - BUF_BEG (buf);
+ buf->text->end_unchanged = BUF_Z (buf) - (end);
+ }
+ else
+ {
+ if (BUF_Z (buf) - end < BUF_END_UNCHANGED (buf))
+ buf->text->end_unchanged = BUF_Z (buf) - end;
+ if (start - BUF_BEG (buf) < BUF_BEG_UNCHANGED (buf))
+ buf->text->beg_unchanged = start - BUF_BEG (buf);
+ }
+}
+
+/* Functions for setting the BEGV, ZV or PT of a given buffer.
+
+ The ..._BOTH functions take both a charpos and a bytepos,
+ which must correspond to each other.
+
+ The functions without ..._BOTH take just a charpos,
+ and compute the bytepos from it. */
+
+INLINE void
+SET_BUF_BEGV (struct buffer *buf, ptrdiff_t charpos)
+{
+ buf->begv_byte = buf_charpos_to_bytepos (buf, charpos);
+ buf->begv = charpos;
+}
+
+INLINE void
+SET_BUF_ZV (struct buffer *buf, ptrdiff_t charpos)
+{
+ buf->zv_byte = buf_charpos_to_bytepos (buf, charpos);
+ buf->zv = charpos;
+}
+
+INLINE void
+SET_BUF_BEGV_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
+{
+ buf->begv = charpos;
+ buf->begv_byte = byte;
+}
+
+INLINE void
+SET_BUF_ZV_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
+{
+ buf->zv = charpos;
+ buf->zv_byte = byte;
+}
+
+INLINE void
+SET_BUF_PT_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
+{
+ buf->pt = charpos;
+ buf->pt_byte = byte;
+}
+
+/* Functions to access a character or byte in the current buffer,
+ or convert between a byte position and an address.
+ These functions do not check that the position is in range. */
+
+/* Return the address of byte position N in current buffer. */
+
+INLINE unsigned char *
+BYTE_POS_ADDR (ptrdiff_t n)
+{
+ return (n < GPT_BYTE ? 0 : GAP_SIZE) + n + BEG_ADDR - BEG_BYTE;
+}
+
+/* Return the address of char position N. */
+
+INLINE unsigned char *
+CHAR_POS_ADDR (ptrdiff_t n)
+{
+ return ((n < GPT ? 0 : GAP_SIZE)
+ + buf_charpos_to_bytepos (current_buffer, n)
+ + BEG_ADDR - BEG_BYTE);
+}
+
+/* Convert a character position to a byte position. */
+
+INLINE ptrdiff_t
+CHAR_TO_BYTE (ptrdiff_t charpos)
+{
+ return buf_charpos_to_bytepos (current_buffer, charpos);
+}
+
+/* Convert a byte position to a character position. */
+
+INLINE ptrdiff_t
+BYTE_TO_CHAR (ptrdiff_t bytepos)
+{
+ return buf_bytepos_to_charpos (current_buffer, bytepos);
+}
+
+/* Convert PTR, the address of a byte in the buffer, into a byte position. */
+
+INLINE ptrdiff_t
+PTR_BYTE_POS (unsigned char const *ptr)
+{
+ ptrdiff_t byte = ptr - current_buffer->text->beg;
+ return byte - (byte <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE) + BEG_BYTE;
+}
+
/* Number of Lisp_Objects at the beginning of struct buffer.
If you add, remove, or reorder Lisp_Objects within buffer
structure, make sure that this is still correct. */
-#define BUFFER_LISP_SIZE \
- PSEUDOVECSIZE (struct buffer, cursor_in_non_selected_windows_)
+enum { BUFFER_LISP_SIZE = PSEUDOVECSIZE (struct buffer,
+ cursor_in_non_selected_windows_) };
/* Allocated size of the struct buffer part beyond leading
Lisp_Objects, in word_size units. */
-#define BUFFER_REST_SIZE (VECSIZE (struct buffer) - BUFFER_LISP_SIZE)
+enum { BUFFER_REST_SIZE = VECSIZE (struct buffer) - BUFFER_LISP_SIZE };
/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE
is required for GC, but BUFFER_REST_SIZE is set up just to be consistent
with other pseudovectors. */
-#define BUFFER_PVEC_INIT(b) \
- XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE)
+INLINE void
+BUFFER_PVEC_INIT (struct buffer *b)
+{
+ XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE);
+}
/* Convenient check whether buffer B is live. */
-#define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name)))
+INLINE bool
+BUFFER_LIVE_P (struct buffer *b)
+{
+ return !NILP (BVAR (b, name));
+}
/* Convenient check whether buffer B is hidden (i.e. its name
starts with a space). Caller must ensure that B is live. */
-#define BUFFER_HIDDEN_P(b) (SREF (BVAR (b, name), 0) == ' ')
+INLINE bool
+BUFFER_HIDDEN_P (struct buffer *b)
+{
+ return SREF (BVAR (b, name), 0) == ' ';
+}
/* Verify indirection counters. */
-#define BUFFER_CHECK_INDIRECTION(b) \
- do { \
- if (BUFFER_LIVE_P (b)) \
- { \
- if (b->base_buffer) \
- { \
- eassert (b->indirections == -1); \
- eassert (b->base_buffer->indirections > 0); \
- } \
- else \
- eassert (b->indirections >= 0); \
- } \
- } while (false)
+INLINE void
+BUFFER_CHECK_INDIRECTION (struct buffer *b)
+{
+ if (BUFFER_LIVE_P (b))
+ {
+ if (b->base_buffer)
+ {
+ eassert (b->indirections == -1);
+ eassert (b->base_buffer->indirections > 0);
+ }
+ else
+ eassert (b->indirections >= 0);
+ }
+}
/* Chain of all buffers, including killed ones. */
@@ -1157,7 +1195,9 @@ record_unwind_current_buffer (void)
/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements.
If NEXTP is non-NULL, return next overlay there.
- See overlay_at arg CHANGE_REQ for meaning of CHRQ arg. */
+ See overlay_at arg CHANGE_REQ for meaning of CHRQ arg.
+ This macro might evaluate its args multiple times,
+ and it treat some args as lvalues. */
#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq)
\
do { \
@@ -1207,6 +1247,10 @@ buffer_has_overlays (void)
{
return current_buffer->overlays_before || current_buffer->overlays_after;
}
+
+/* Functions for accessing a character or byte,
+ or converting between byte positions and addresses,
+ in a specified buffer. */
/* Return character code of multi-byte form at byte position POS. If POS
doesn't point the head of valid multi-byte form, only the byte at
@@ -1232,6 +1276,80 @@ BUF_FETCH_MULTIBYTE_CHAR (struct buffer *buf, ptrdiff_t
pos)
return STRING_CHAR (p);
}
+/* Return character at byte position POS.
+ If the current buffer is unibyte and the character is not ASCII,
+ make the returning character multibyte. */
+
+INLINE int
+FETCH_CHAR_AS_MULTIBYTE (ptrdiff_t pos)
+{
+ return (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? FETCH_MULTIBYTE_CHAR (pos)
+ : UNIBYTE_TO_CHAR (FETCH_BYTE (pos)));
+}
+
+/* Return character at byte position POS.
+ See the caveat WARNING for FETCH_MULTIBYTE_CHAR above. */
+
+INLINE int
+FETCH_CHAR (ptrdiff_t pos)
+{
+ return (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? FETCH_MULTIBYTE_CHAR (pos)
+ : FETCH_BYTE (pos));
+}
+
+/* Return the address of character at byte position POS in buffer BUF.
+ Note that both arguments can be computed more than once. */
+
+INLINE unsigned char *
+BUF_BYTE_ADDRESS (struct buffer *buf, ptrdiff_t pos)
+{
+ return (buf->text->beg + pos - BEG_BYTE
+ + (pos < buf->text->gpt_byte ? 0 : buf->text->gap_size));
+}
+
+/* Return the address of character at char position POS in buffer BUF.
+ Note that both arguments can be computed more than once. */
+
+INLINE unsigned char *
+BUF_CHAR_ADDRESS (struct buffer *buf, ptrdiff_t pos)
+{
+ return (buf->text->beg + buf_charpos_to_bytepos (buf, pos) - BEG_BYTE
+ + (pos < buf->text->gpt ? 0 : buf->text->gap_size));
+}
+
+/* Convert PTR, the address of a char in buffer BUF,
+ into a character position. */
+
+INLINE ptrdiff_t
+BUF_PTR_BYTE_POS (struct buffer *buf, unsigned char *ptr)
+{
+ ptrdiff_t byte = ptr - buf->text->beg;
+ return (byte - (byte <= BUF_GPT_BYTE (buf) - BEG_BYTE ? 0 : BUF_GAP_SIZE
(buf))
+ + BEG_BYTE);
+}
+
+/* Return the byte at byte position N in buffer BUF. */
+
+INLINE unsigned char
+BUF_FETCH_BYTE (struct buffer *buf, ptrdiff_t n)
+{
+ return *BUF_BYTE_ADDRESS (buf, n);
+}
+
+/* Return character at byte position POS in buffer BUF. If BUF is
+ unibyte and the character is not ASCII, make the returning
+ character multibyte. */
+
+INLINE int
+BUF_FETCH_CHAR_AS_MULTIBYTE (struct buffer *buf, ptrdiff_t pos)
+{
+ return (! NILP (BVAR (buf, enable_multibyte_characters))
+ ? BUF_FETCH_MULTIBYTE_CHAR (buf, pos)
+ : UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (buf, pos)));
+}
+
/* Return number of windows showing B. */
INLINE int
@@ -1260,18 +1378,17 @@ buffer_window_count (struct buffer *b)
/* Return the actual buffer position for the marker P.
We assume you know which buffer it's pointing into. */
-#define OVERLAY_POSITION(P) \
- (MARKERP (P) ? marker_position (P) : (emacs_abort (), 0))
+INLINE ptrdiff_t
+OVERLAY_POSITION (Lisp_Object p)
+{
+ return marker_position (p);
+}
/***********************************************************************
Buffer-local Variables
***********************************************************************/
-/* Number of per-buffer variables used. */
-
-extern int last_per_buffer_idx;
-
/* Return the offset in bytes of member VAR of struct buffer
from the start of a buffer structure. */
@@ -1296,23 +1413,27 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_VAR_IDX(VAR) \
PER_BUFFER_IDX (PER_BUFFER_VAR_OFFSET (VAR))
+extern bool valid_per_buffer_idx (int);
+
/* Value is true if the variable with index IDX has a local value
in buffer B. */
-#define PER_BUFFER_VALUE_P(B, IDX) \
- (((IDX) < 0 || IDX >= last_per_buffer_idx) \
- ? (emacs_abort (), false) \
- : ((B)->local_flags[IDX] != 0))
+INLINE bool
+PER_BUFFER_VALUE_P (struct buffer *b, int idx)
+{
+ eassert (valid_per_buffer_idx (idx));
+ return b->local_flags[idx];
+}
/* Set whether per-buffer variable with index IDX has a buffer-local
value in buffer B. VAL zero means it hasn't. */
-#define SET_PER_BUFFER_VALUE_P(B, IDX, VAL) \
- do { \
- if ((IDX) < 0 || (IDX) >= last_per_buffer_idx) \
- emacs_abort (); \
- (B)->local_flags[IDX] = (VAL); \
- } while (false)
+INLINE void
+SET_PER_BUFFER_VALUE_P (struct buffer *b, int idx, bool val)
+{
+ eassert (valid_per_buffer_idx (idx));
+ b->local_flags[idx] = val;
+}
/* Return the index value of the per-buffer variable at offset OFFSET
in the buffer structure.
@@ -1332,11 +1453,13 @@ extern int last_per_buffer_idx;
new buffer.
If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
- zero, that is a bug */
+ zero, that is a bug. */
-
-#define PER_BUFFER_IDX(OFFSET) \
- XFIXNUM (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags))
+INLINE int
+PER_BUFFER_IDX (ptrdiff_t offset)
+{
+ return XFIXNUM (*(Lisp_Object *) (offset + (char *) &buffer_local_flags));
+}
/* Functions to get and set default value of the per-buffer
variable at offset OFFSET in the buffer structure. */
diff --git a/src/coding.c b/src/coding.c
index 2ddd34e..c0408fb 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9842,7 +9842,10 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object
buffer,
If BUFFER is Qnil, return a multibyte string from the decoded result.
As a special case, return STRING itself in the following cases:
1. STRING contains only ASCII characters.
- 2. NOCOPY, and STRING contains only valid UTF-8 sequences.
+ 2. NOCOPY is true, and STRING contains only valid UTF-8 sequences.
+
+ For maximum speed, always specify NOCOPY true when STRING is
+ guaranteed to contain only valid UTF-8 sequences.
HANDLE-8-BIT and HANDLE-OVER-UNI specify how to handle a invalid
byte sequence. The former is for an 1-byte invalid sequence that
diff --git a/src/composite.c b/src/composite.c
index a6606d5..efbd055 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -919,16 +919,17 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos,
ptrdiff_t bytepos,
}
/* 1 iff the character C is composable. Characters of general
- category Z? or C? are not composable except for ZWNJ and ZWJ. */
+ category Z? or C? are not composable except for ZWNJ and ZWJ,
+ and characters of category Zs. */
static bool
char_composable_p (int c)
{
Lisp_Object val;
- return (c > ' '
+ return (c >= ' '
&& (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER
|| (val = CHAR_TABLE_REF (Vunicode_category_table, c),
- (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_So)))));
+ (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs)))));
}
/* Update cmp_it->stop_pos to the next position after CHARPOS (and
diff --git a/src/conf_post.h b/src/conf_post.h
index 4af1ba9..43f9862 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -373,8 +373,13 @@ extern int emacs_setenv_TZ (char const *);
#undef noinline
#endif
-/* Use Gnulib's extern-inline module for extern inline functions.
- An include file foo.h should prepend FOO_INLINE to function
+/* INLINE marks functions defined in Emacs-internal C headers.
+ INLINE is implemented via C99-style 'extern inline' if Emacs is built
+ with -DEMACS_EXTERN_INLINE; otherwise it is implemented via 'static'.
+ EMACS_EXTERN_INLINE is no longer the default, as 'static' seems to
+ have better performance with GCC.
+
+ An include file foo.h should prepend INLINE to function
definitions, with the following overall pattern:
[#include any other .h files first.]
@@ -399,20 +404,40 @@ extern int emacs_setenv_TZ (char const *);
For Emacs, this is done by having emacs.c first '#define INLINE
EXTERN_INLINE' and then include every .h file that uses INLINE.
- The INLINE_HEADER_BEGIN and INLINE_HEADER_END suppress bogus
- warnings in some GCC versions; see ../m4/extern-inline.m4.
+ The INLINE_HEADER_BEGIN and INLINE_HEADER_END macros suppress bogus
+ warnings in some GCC versions; see ../m4/extern-inline.m4. */
+
+#ifdef EMACS_EXTERN_INLINE
+
+/* Use Gnulib's extern-inline module for extern inline functions.
C99 compilers compile functions like 'incr' as C99-style extern
inline functions. Buggy GCC implementations do something similar with
GNU-specific keywords. Buggy non-GCC compilers use static
functions, which bloats the code but is good enough. */
-#ifndef INLINE
-# define INLINE _GL_INLINE
+# ifndef INLINE
+# define INLINE _GL_INLINE
+# endif
+# define EXTERN_INLINE _GL_EXTERN_INLINE
+# define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
+# define INLINE_HEADER_END _GL_INLINE_HEADER_END
+
+#else
+
+/* Use 'static' instead of 'extern inline' because 'static' typically
+ has better performance for Emacs. Do not use the 'inline' keyword,
+ as modern compilers inline automatically. ATTRIBUTE_UNUSED
+ pacifies gcc -Wunused-function. */
+
+# ifndef INLINE
+# define INLINE EXTERN_INLINE
+# endif
+# define EXTERN_INLINE static ATTRIBUTE_UNUSED
+# define INLINE_HEADER_BEGIN
+# define INLINE_HEADER_END
+
#endif
-#define EXTERN_INLINE _GL_EXTERN_INLINE
-#define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
-#define INLINE_HEADER_END _GL_INLINE_HEADER_END
/* 'int x UNINIT;' is equivalent to 'int x;', except it cajoles GCC
into not warning incorrectly about use of an uninitialized variable. */
diff --git a/src/data.c b/src/data.c
index cf9f8e5..1d9222e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -525,7 +525,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
(Lisp_Object object)
{
return ((FIXNUMP (object) ? 0 <= XFIXNUM (object)
- : BIGNUMP (object) && 0 <= mpz_sgn (XBIGNUM (object)->value))
+ : BIGNUMP (object) && 0 <= mpz_sgn (*xbignum_val (object)))
? Qt : Qnil);
}
@@ -771,10 +771,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
- /* Convert to eassert or remove after GC bug is found. In the
- meantime, check unconditionally, at a slight perf hit. */
- if (! valid_lisp_object_p (definition))
- emacs_abort ();
+ eassert (valid_lisp_object_p (definition));
set_symbol_function (symbol, definition);
@@ -2481,7 +2478,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
else if (isnan (f1))
lt = eq = gt = false;
else
- i2 = mpz_cmp_d (XBIGNUM (num2)->value, f1);
+ i2 = mpz_cmp_d (*xbignum_val (num2), f1);
}
else if (FIXNUMP (num1))
{
@@ -2502,7 +2499,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
i2 = XFIXNUM (num2);
}
else
- i2 = mpz_sgn (XBIGNUM (num2)->value);
+ i2 = mpz_sgn (*xbignum_val (num2));
}
else if (FLOATP (num2))
{
@@ -2510,12 +2507,12 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
if (isnan (f2))
lt = eq = gt = false;
else
- i1 = mpz_cmp_d (XBIGNUM (num1)->value, f2);
+ i1 = mpz_cmp_d (*xbignum_val (num1), f2);
}
else if (FIXNUMP (num2))
- i1 = mpz_sgn (XBIGNUM (num1)->value);
+ i1 = mpz_sgn (*xbignum_val (num1));
else
- i1 = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value);
+ i1 = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2));
if (eq)
{
@@ -3005,7 +3002,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest
MORE-NUMBERS-OR-MARKERS) */)
return make_int (-XFIXNUM (a));
if (FLOATP (a))
return make_float (-XFLOAT_DATA (a));
- mpz_neg (mpz[0], XBIGNUM (a)->value);
+ mpz_neg (mpz[0], *xbignum_val (a));
return make_integer_mpz ();
}
return arith_driver (Asub, nargs, args, a);
@@ -3058,58 +3055,67 @@ usage: (/ NUMBER &rest DIVISORS) */)
return arith_driver (Adiv, nargs, args, a);
}
-DEFUN ("%", Frem, Srem, 2, 2, 0,
- doc: /* Return remainder of X divided by Y.
-Both must be integers or markers. */)
- (register Lisp_Object x, Lisp_Object y)
-{
- CHECK_INTEGER_COERCE_MARKER (x);
- CHECK_INTEGER_COERCE_MARKER (y);
-
- /* A bignum can never be 0, so don't check that case. */
- if (EQ (y, make_fixnum (0)))
- xsignal0 (Qarith_error);
-
- if (FIXNUMP (x) && FIXNUMP (y))
- return make_fixnum (XFIXNUM (x) % XFIXNUM (y));
- else
- {
- mpz_tdiv_r (mpz[0],
- *bignum_integer (&mpz[0], x),
- *bignum_integer (&mpz[1], y));
- return make_integer_mpz ();
- }
-}
-
-/* Return X mod Y. Both must be integers and Y must be nonzero. */
-Lisp_Object
-integer_mod (Lisp_Object x, Lisp_Object y)
+/* Return NUM % DEN (or NUM mod DEN, if MODULO). NUM and DEN must be
+ integers. */
+static Lisp_Object
+integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
{
- if (FIXNUMP (x) && FIXNUMP (y))
+ if (FIXNUMP (den))
{
- EMACS_INT i1 = XFIXNUM (x), i2 = XFIXNUM (y);
+ EMACS_INT d = XFIXNUM (den);
+ if (d == 0)
+ xsignal0 (Qarith_error);
- i1 %= i2;
+ EMACS_INT r;
+ bool have_r = false;
+ if (FIXNUMP (num))
+ {
+ r = XFIXNUM (num) % d;
+ have_r = true;
+ }
+ else if (eabs (d) <= ULONG_MAX)
+ {
+ mpz_t const *n = xbignum_val (num);
+ bool neg_n = mpz_sgn (*n) < 0;
+ r = mpz_tdiv_ui (*n, eabs (d));
+ if (neg_n)
+ r = -r;
+ have_r = true;
+ }
- /* If the "remainder" comes out with the wrong sign, fix it. */
- if (i2 < 0 ? i1 > 0 : i1 < 0)
- i1 += i2;
+ if (have_r)
+ {
+ /* If MODULO and the remainder has the wrong sign, fix it. */
+ if (modulo && (d < 0 ? r > 0 : r < 0))
+ r += d;
- return make_fixnum (i1);
+ return make_fixnum (r);
+ }
}
- else
- {
- mpz_t const *ym = bignum_integer (&mpz[1], y);
- bool neg_y = mpz_sgn (*ym) < 0;
- mpz_mod (mpz[0], *bignum_integer (&mpz[0], x), *ym);
- /* Fix the sign if needed. */
- int sgn_r = mpz_sgn (mpz[0]);
- if (neg_y ? sgn_r > 0 : sgn_r < 0)
- mpz_add (mpz[0], mpz[0], *ym);
+ mpz_t const *d = bignum_integer (&mpz[1], den);
+ mpz_t *r = &mpz[0];
+ mpz_tdiv_r (*r, *bignum_integer (&mpz[0], num), *d);
- return make_integer_mpz ();
+ if (modulo)
+ {
+ /* If the remainder has the wrong sign, fix it. */
+ int sgn_r = mpz_sgn (*r);
+ if (mpz_sgn (*d) < 0 ? sgn_r > 0 : sgn_r < 0)
+ mpz_add (*r, *r, *d);
}
+
+ return make_integer_mpz ();
+}
+
+DEFUN ("%", Frem, Srem, 2, 2, 0,
+ doc: /* Return remainder of X divided by Y.
+Both must be integers or markers. */)
+ (register Lisp_Object x, Lisp_Object y)
+{
+ CHECK_INTEGER_COERCE_MARKER (x);
+ CHECK_INTEGER_COERCE_MARKER (y);
+ return integer_remainder (x, y, false);
}
DEFUN ("mod", Fmod, Smod, 2, 2, 0,
@@ -3120,12 +3126,9 @@ Both X and Y must be numbers or markers. */)
{
CHECK_NUMBER_COERCE_MARKER (x);
CHECK_NUMBER_COERCE_MARKER (y);
-
- /* A bignum can never be 0, so don't check that case. */
- if (EQ (y, make_fixnum (0)))
- xsignal0 (Qarith_error);
-
- return (FLOATP (x) || FLOATP (y) ? fmod_float : integer_mod) (x, y);
+ if (FLOATP (x) || FLOATP (y))
+ return fmod_float (x, y);
+ return integer_remainder (x, y, true);
}
static Lisp_Object
@@ -3214,7 +3217,7 @@ representation. */)
if (BIGNUMP (value))
{
- mpz_t *nonneg = &XBIGNUM (value)->value;
+ mpz_t const *nonneg = xbignum_val (value);
if (mpz_sgn (*nonneg) < 0)
{
mpz_com (mpz[0], *nonneg);
@@ -3245,10 +3248,10 @@ In this case, the sign bit is duplicated. */)
{
if (EQ (value, make_fixnum (0)))
return value;
- if (mpz_sgn (XBIGNUM (count)->value) < 0)
+ if (mpz_sgn (*xbignum_val (count)) < 0)
{
EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value)
- : mpz_sgn (XBIGNUM (value)->value));
+ : mpz_sgn (*xbignum_val (value)));
return make_fixnum (v < 0 ? -1 : 0);
}
overflow_error ();
@@ -3291,8 +3294,8 @@ expt_integer (Lisp_Object x, Lisp_Object y)
if (TYPE_RANGED_FIXNUMP (unsigned long, y))
exp = XFIXNUM (y);
else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y)
- && mpz_fits_ulong_p (XBIGNUM (y)->value))
- exp = mpz_get_ui (XBIGNUM (y)->value);
+ && mpz_fits_ulong_p (*xbignum_val (y)))
+ exp = mpz_get_ui (*xbignum_val (y));
else
overflow_error ();
@@ -3311,7 +3314,7 @@ Markers are converted to integers. */)
return make_int (XFIXNUM (number) + 1);
if (FLOATP (number))
return (make_float (1.0 + XFLOAT_DATA (number)));
- mpz_add_ui (mpz[0], XBIGNUM (number)->value, 1);
+ mpz_add_ui (mpz[0], *xbignum_val (number), 1);
return make_integer_mpz ();
}
@@ -3326,7 +3329,7 @@ Markers are converted to integers. */)
return make_int (XFIXNUM (number) - 1);
if (FLOATP (number))
return (make_float (-1.0 + XFLOAT_DATA (number)));
- mpz_sub_ui (mpz[0], XBIGNUM (number)->value, 1);
+ mpz_sub_ui (mpz[0], *xbignum_val (number), 1);
return make_integer_mpz ();
}
@@ -3337,7 +3340,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
CHECK_INTEGER (number);
if (FIXNUMP (number))
return make_fixnum (~XFIXNUM (number));
- mpz_com (mpz[0], XBIGNUM (number)->value);
+ mpz_com (mpz[0], *xbignum_val (number));
return make_integer_mpz ();
}
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 90ba461..7f4c871 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -728,22 +728,27 @@ xd_append_arg (int dtype, Lisp_Object object,
DBusMessageIter *iter)
strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
else
- /* If the element type is DBUS_TYPE_SIGNATURE, and this is
- the only element, the value of this element is used as
- the array's element signature. */
- if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
- == DBUS_TYPE_SIGNATURE)
- && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
- && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
- {
- lispstpcpy (signature, CAR_SAFE (XD_NEXT_VALUE (object)));
- object = CDR_SAFE (XD_NEXT_VALUE (object));
- }
-
- else
- xd_signature (signature,
- XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
- dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
+ {
+ /* If the element type is DBUS_TYPE_SIGNATURE, and this is
+ the only element, the value of this element is used as
+ the array's element signature. */
+ if (CONSP (object) && (XD_OBJECT_TO_DBUS_TYPE (XCAR (object))
+ == DBUS_TYPE_SIGNATURE))
+ {
+ Lisp_Object val = XD_NEXT_VALUE (object);
+ if (CONSP (val) && STRINGP (XCAR (val)) && NILP (XCDR (val))
+ && SBYTES (XCAR (val)) < DBUS_MAXIMUM_SIGNATURE_LENGTH)
+ {
+ lispstpcpy (signature, XCAR (val));
+ object = Qnil;
+ }
+ }
+
+ if (!NILP (object))
+ xd_signature (signature,
+ XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
+ dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
+ }
XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
XD_OBJECT_TO_STRING (object));
diff --git a/src/emacs.c b/src/emacs.c
index cc58183..53572d7 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2084,8 +2084,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
/* Enter editor command loop. This never returns. */
Frecursive_edit ();
- /* NOTREACHED */
- return 0;
+ eassume (false);
}
/* Sort the args so we can find the most important ones
diff --git a/src/floatfns.c b/src/floatfns.c
index a913aad..9049185 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -48,6 +48,14 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <count-leading-zeros.h>
+/* Emacs needs proper handling of +/-inf; correct printing as well as
+ important packages depend on it. Make sure the user didn't specify
+ -ffinite-math-only, either directly or implicitly with -Ofast or
+ -ffast-math. */
+#if defined __FINITE_MATH_ONLY__ && __FINITE_MATH_ONLY__
+ #error Emacs cannot be built with -ffinite-math-only
+#endif
+
/* Check that X is a floating point number. */
static void
@@ -268,9 +276,9 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
}
else
{
- if (mpz_sgn (XBIGNUM (arg)->value) < 0)
+ if (mpz_sgn (*xbignum_val (arg)) < 0)
{
- mpz_neg (mpz[0], XBIGNUM (arg)->value);
+ mpz_neg (mpz[0], *xbignum_val (arg));
arg = make_integer_mpz ();
}
}
@@ -315,7 +323,7 @@ This is the same as the exponent of a float. */)
value = ivalue - 1;
}
else if (!FIXNUMP (arg))
- value = mpz_sizeinbase (XBIGNUM (arg)->value, 2) - 1;
+ value = mpz_sizeinbase (*xbignum_val (arg), 2) - 1;
else
{
EMACS_INT i = XFIXNUM (arg);
diff --git a/src/fns.c b/src/fns.c
index 920adde..df921e2 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -47,7 +47,6 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
static bool internal_equal (Lisp_Object, Lisp_Object,
enum equal_kind, int, Lisp_Object);
-static EMACS_UINT sxhash_bignum (struct Lisp_Bignum *);
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
doc: /* Return the argument unchanged. */
@@ -1444,7 +1443,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
}
else
{
- if (mpz_sgn (XBIGNUM (n)->value) < 0)
+ if (mpz_sgn (*xbignum_val (n)) < 0)
return tail;
num = large_num;
}
@@ -1482,11 +1481,11 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
CYCLE_LENGTH. */
/* Add N mod CYCLE_LENGTH to NUM. */
if (cycle_length <= ULONG_MAX)
- num += mpz_tdiv_ui (XBIGNUM (n)->value, cycle_length);
+ num += mpz_tdiv_ui (*xbignum_val (n), cycle_length);
else
{
mpz_set_intmax (mpz[0], cycle_length);
- mpz_tdiv_r (mpz[0], XBIGNUM (n)->value, mpz[0]);
+ mpz_tdiv_r (mpz[0], *xbignum_val (n), mpz[0]);
intptr_t iz;
mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]);
num += iz;
@@ -1595,7 +1594,7 @@ The value is actually the tail of LIST whose car is ELT.
*/)
{
Lisp_Object tem = XCAR (tail);
if (BIGNUMP (tem)
- && mpz_cmp (XBIGNUM (elt)->value, XBIGNUM (tem)->value) == 0)
+ && mpz_cmp (*xbignum_val (elt), *xbignum_val (tem)) == 0)
return tail;
}
}
@@ -2307,7 +2306,7 @@ This differs from numeric comparison: (eql 0.0 -0.0)
returns nil and
return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil;
else if (BIGNUMP (obj1))
return ((BIGNUMP (obj2)
- && mpz_cmp (XBIGNUM (obj1)->value, XBIGNUM (obj2)->value) == 0)
+ && mpz_cmp (*xbignum_val (obj1), *xbignum_val (obj2)) == 0)
? Qt : Qnil);
else
return EQ (obj1, obj2) ? Qt : Qnil;
@@ -2437,7 +2436,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum
equal_kind equal_kind,
if (ASIZE (o2) != size)
return false;
if (BIGNUMP (o1))
- return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0;
+ return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
if (OVERLAYP (o1))
{
if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
@@ -2951,9 +2950,12 @@ suppressed. */)
But not more than once in any file,
and not when we aren't loading or reading from a file. */
if (!from_file)
- for (tem = Vcurrent_load_list; CONSP (tem); tem = XCDR (tem))
- if (NILP (XCDR (tem)) && STRINGP (XCAR (tem)))
- from_file = 1;
+ {
+ Lisp_Object tail = Vcurrent_load_list;
+ FOR_EACH_TAIL_SAFE (tail)
+ if (NILP (XCDR (tail)) && STRINGP (XCAR (tail)))
+ from_file = true;
+ }
if (from_file)
{
@@ -3278,11 +3280,11 @@ static ptrdiff_t base64_encode_1 (const char *, char *,
ptrdiff_t, bool, bool,
static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
bool, ptrdiff_t *);
-Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool,
- bool, bool);
+static Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool,
+ bool, bool);
-Lisp_Object base64_encode_string_1(Lisp_Object, bool,
- bool, bool);
+static Lisp_Object base64_encode_string_1 (Lisp_Object, bool,
+ bool, bool);
DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
@@ -3293,7 +3295,7 @@ Optional third argument NO-LINE-BREAK means do not break
long lines
into shorter lines. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
{
- return base64_encode_region_1(beg, end, NILP (no_line_break), true, false);
+ return base64_encode_region_1 (beg, end, NILP (no_line_break), true, false);
}
@@ -3306,10 +3308,10 @@ Optional second argument NO-PAD means do not add
padding char =.
This produces the URL variant of base 64 encoding defined in RFC 4648. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object no_pad)
{
- return base64_encode_region_1(beg, end, false, NILP(no_pad), true);
+ return base64_encode_region_1 (beg, end, false, NILP(no_pad), true);
}
-Lisp_Object
+static Lisp_Object
base64_encode_region_1 (Lisp_Object beg, Lisp_Object end, bool line_break,
bool pad, bool base64url)
{
@@ -3374,11 +3376,11 @@ into shorter lines. */)
(Lisp_Object string, Lisp_Object no_line_break)
{
- return base64_encode_string_1(string, NILP (no_line_break), true, false);
+ return base64_encode_string_1 (string, NILP (no_line_break), true, false);
}
-DEFUN ("base64url-encode-string", Fbase64url_encode_string,
Sbase64url_encode_string,
- 1, 2, 0,
+DEFUN ("base64url-encode-string", Fbase64url_encode_string,
+ Sbase64url_encode_string, 1, 2, 0,
doc: /* Base64url-encode STRING and return the result.
Optional second argument NO-PAD means do not add padding char =.
@@ -3386,12 +3388,12 @@ This produces the URL variant of base 64 encoding
defined in RFC 4648. */)
(Lisp_Object string, Lisp_Object no_pad)
{
- return base64_encode_string_1(string, false, NILP(no_pad), true);
+ return base64_encode_string_1 (string, false, NILP(no_pad), true);
}
-Lisp_Object
-base64_encode_string_1(Lisp_Object string, bool line_break,
- bool pad, bool base64url)
+static Lisp_Object
+base64_encode_string_1 (Lisp_Object string, bool line_break,
+ bool pad, bool base64url)
{
ptrdiff_t allength, length, encoded_length;
char *encoded;
@@ -3508,9 +3510,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t
length,
{
*e++ = b64_value_to_char[value];
if (pad)
- {
- *e++ = '=';
- }
+ *e++ = '=';
break;
}
@@ -4196,21 +4196,20 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
new_size);
ptrdiff_t next_size = ASIZE (next);
for (ptrdiff_t i = old_size; i < next_size - 1; i++)
- gc_aset (next, i, make_fixnum (i + 1));
- gc_aset (next, next_size - 1, make_fixnum (-1));
- ptrdiff_t index_size = hash_index_size (h, next_size);
+ ASET (next, i, make_fixnum (i + 1));
+ ASET (next, next_size - 1, make_fixnum (-1));
/* Build the new&larger key_and_value vector, making sure the new
fields are initialized to `unbound`. */
Lisp_Object key_and_value
= larger_vecalloc (h->key_and_value, 2 * (next_size - old_size),
2 * next_size);
- for (ptrdiff_t i = ASIZE (h->key_and_value);
- i < ASIZE (key_and_value); i++)
+ for (ptrdiff_t i = 2 * old_size; i < 2 * next_size; i++)
ASET (key_and_value, i, Qunbound);
Lisp_Object hash = larger_vector (h->hash, next_size - old_size,
next_size);
+ ptrdiff_t index_size = hash_index_size (h, next_size);
h->index = make_vector (index_size, make_fixnum (-1));
h->key_and_value = key_and_value;
h->hash = hash;
@@ -4402,17 +4401,17 @@ hash_clear (struct Lisp_Hash_Table *h)
{
if (h->count > 0)
{
- ptrdiff_t i, size = HASH_TABLE_SIZE (h);
-
- for (i = 0; i < size; ++i)
+ ptrdiff_t size = HASH_TABLE_SIZE (h);
+ if (!hash_rehash_needed_p (h))
+ memclear (XVECTOR (h->hash)->contents, size * word_size);
+ for (ptrdiff_t i = 0; i < size; i++)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
set_hash_key_slot (h, i, Qunbound);
set_hash_value_slot (h, i, Qnil);
- set_hash_hash_slot (h, i, Qnil);
}
- for (i = 0; i < ASIZE (h->index); ++i)
+ for (ptrdiff_t i = 0; i < ASIZE (h->index); i++)
ASET (h->index, i, make_fixnum (-1));
h->next_free = 0;
@@ -4640,13 +4639,14 @@ sxhash_bool_vector (Lisp_Object vec)
/* Return a hash for a bignum. */
static EMACS_UINT
-sxhash_bignum (struct Lisp_Bignum *bignum)
+sxhash_bignum (Lisp_Object bignum)
{
- size_t i, nlimbs = mpz_size (bignum->value);
+ mpz_t const *n = xbignum_val (bignum);
+ size_t i, nlimbs = mpz_size (*n);
EMACS_UINT hash = 0;
for (i = 0; i < nlimbs; ++i)
- hash = sxhash_combine (hash, mpz_getlimbn (bignum->value, i));
+ hash = sxhash_combine (hash, mpz_getlimbn (*n, i));
return SXHASH_REDUCE (hash);
}
@@ -4680,7 +4680,7 @@ sxhash (Lisp_Object obj, int depth)
/* This can be everything from a vector to an overlay. */
case Lisp_Vectorlike:
if (BIGNUMP (obj))
- hash = sxhash_bignum (XBIGNUM (obj));
+ hash = sxhash_bignum (obj);
else if (VECTORP (obj) || RECORDP (obj))
/* According to the CL HyperSpec, two arrays are equal only if
they are `eq', except for strings and bit-vectors. In
diff --git a/src/font.c b/src/font.c
index ce85e0b..935dd64 100644
--- a/src/font.c
+++ b/src/font.c
@@ -5509,7 +5509,14 @@ and cannot switch to a smaller font for those
characters, set
this variable non-nil.
Disabling compaction of font caches might enlarge the Emacs memory
footprint in sessions that use lots of different fonts. */);
+
+#ifdef WINDOWSNT
+ /* Compacting font caches causes slow redisplay on Windows with many
+ large fonts, so we disable it by default. */
+ inhibit_compacting_font_caches = 1;
+#else
inhibit_compacting_font_caches = 0;
+#endif
DEFVAR_BOOL ("xft-ignore-color-fonts",
Vxft_ignore_color_fonts,
diff --git a/src/frame.c b/src/frame.c
index 50a7f13..1d42d0c 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3492,7 +3492,7 @@ DEFUN ("frame-bottom-divider-width",
Fbottom_divider_width, Sbottom_divider_widt
}
DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4,
- "(list (selected-frame) current-prefix-arg)",
+ "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
doc: /* Set text height of frame FRAME to HEIGHT lines.
Optional third arg PRETEND non-nil means that redisplay should use
HEIGHT lines but that the idea of the actual height of the frame should
@@ -3521,7 +3521,7 @@ currenly selected frame will be set to this height. */)
}
DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4,
- "(list (selected-frame) current-prefix-arg)",
+ "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
doc: /* Set text width of frame FRAME to WIDTH columns.
Optional third arg PRETEND non-nil means that redisplay should use WIDTH
columns but that the idea of the actual width of the frame should not
@@ -5327,9 +5327,11 @@ or a list (- N) meaning -N pixels relative to
bottom/right corner.
On Nextstep, this just calls `ns-parse-geometry'. */)
(Lisp_Object string)
{
- int geometry, x, y;
+ /* x and y don't need initialization, as they are not accessed
+ unless XParseGeometry sets them, in which case it always returns
+ a non-zero value. */
+ int x UNINIT, y UNINIT;
unsigned int width, height;
- Lisp_Object result;
CHECK_STRING (string);
@@ -5337,9 +5339,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
if (strchr (SSDATA (string), ' ') != NULL)
return call1 (Qns_parse_geometry, string);
#endif
- geometry = XParseGeometry (SSDATA (string),
- &x, &y, &width, &height);
- result = Qnil;
+ int geometry = XParseGeometry (SSDATA (string),
+ &x, &y, &width, &height);
+ Lisp_Object result = Qnil;
if (geometry & XValue)
{
Lisp_Object element;
diff --git a/src/ftfont.c b/src/ftfont.c
index 16b18de..77a4cf5 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -433,7 +433,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for
cache_for)
return cache;
}
-FcCharSet *
+static FcCharSet *
ftfont_get_fc_charset (Lisp_Object entity)
{
Lisp_Object val, cache;
diff --git a/src/ftfont.h b/src/ftfont.h
index b2280e9..f771dc1 100644
--- a/src/ftfont.h
+++ b/src/ftfont.h
@@ -41,7 +41,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#endif /* HAVE_M17N_FLT */
#endif /* HAVE_LIBOTF */
-extern FcCharSet *ftfont_get_fc_charset (Lisp_Object);
extern void ftfont_fix_match (FcPattern *, FcPattern *);
extern void ftfont_add_rendering_parameters (FcPattern *, Lisp_Object);
extern FcPattern *ftfont_entity_pattern (Lisp_Object, int);
diff --git a/src/gnutls.c b/src/gnutls.c
index 267ba9a..d43534b 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -44,6 +44,14 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# define HAVE_GNUTLS_EXT__DUMBFW
#endif
+#if GNUTLS_VERSION_NUMBER >= 0x030400
+# define HAVE_GNUTLS_ETM_STATUS
+#endif
+
+#if GNUTLS_VERSION_NUMBER < 0x030600
+# define HAVE_GNUTLS_COMPRESSION_GET
+#endif
+
/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was
exported only since 3.3.0. */
#if GNUTLS_VERSION_NUMBER >= 0x030300
@@ -159,6 +167,8 @@ DEF_DLL_FN (int, gnutls_x509_crt_check_hostname,
DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
(gnutls_x509_crt_t, gnutls_x509_crt_t));
DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
+DEF_DLL_FN (int, gnutls_x509_crt_export,
+ (gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_import,
(gnutls_x509_crt_t, const gnutls_datum_t *,
gnutls_x509_crt_fmt_t));
@@ -180,6 +190,9 @@ DEF_DLL_FN (int, gnutls_x509_crt_get_dn,
(gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm,
(gnutls_x509_crt_t, unsigned int *));
+DEF_DLL_FN (int, gnutls_x509_crt_print,
+ (gnutls_x509_crt_t, gnutls_certificate_print_formats_t,
+ gnutls_datum_t *));
DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name,
(gnutls_pk_algorithm_t));
DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param,
@@ -208,6 +221,13 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
(gnutls_cipher_algorithm_t));
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
+#ifdef HAVE_GNUTLS_COMPRESSION_GET
+DEF_DLL_FN (gnutls_compression_method_t, gnutls_compression_get,
+ (gnutls_session_t));
+DEF_DLL_FN (const char *, gnutls_compression_get_name,
+ (gnutls_compression_method_t));
+#endif
+DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
# ifdef HAVE_GNUTLS3
DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
@@ -250,6 +270,9 @@ DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
(gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
size_t, size_t, const void *, size_t, void *, size_t *));
# endif
+# ifdef HAVE_GNUTLS_ETM_STATUS
+DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
+# endif
DEF_DLL_FN (int, gnutls_hmac_init,
(gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
@@ -267,6 +290,7 @@ DEF_DLL_FN (const char *, gnutls_ext_get_name, (unsigned
int));
# endif
# endif /* HAVE_GNUTLS3 */
+static gnutls_free_function *gnutls_free_func;
static bool
init_gnutls_functions (void)
@@ -322,6 +346,7 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname);
LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
+ LOAD_DLL_FN (library, gnutls_x509_crt_export);
LOAD_DLL_FN (library, gnutls_x509_crt_import);
LOAD_DLL_FN (library, gnutls_x509_crt_init);
LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint);
@@ -332,6 +357,7 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time);
LOAD_DLL_FN (library, gnutls_x509_crt_get_dn);
LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm);
+ LOAD_DLL_FN (library, gnutls_x509_crt_print);
LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name);
LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param);
LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id);
@@ -349,6 +375,11 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_get_name);
LOAD_DLL_FN (library, gnutls_mac_get);
LOAD_DLL_FN (library, gnutls_mac_get_name);
+# ifdef HAVE_GNUTLS_COMPRESSION_GET
+ LOAD_DLL_FN (library, gnutls_compression_get);
+ LOAD_DLL_FN (library, gnutls_compression_get_name);
+# endif
+ LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
# ifdef HAVE_GNUTLS3
LOAD_DLL_FN (library, gnutls_rnd);
LOAD_DLL_FN (library, gnutls_mac_list);
@@ -380,6 +411,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
# endif
+# ifdef HAVE_GNUTLS_ETM_STATUS
+ LOAD_DLL_FN (library, gnutls_session_etm_status);
+# endif
LOAD_DLL_FN (library, gnutls_hmac_init);
LOAD_DLL_FN (library, gnutls_hmac_get_len);
LOAD_DLL_FN (library, gnutls_hmac);
@@ -395,6 +429,13 @@ init_gnutls_functions (void)
# endif
# endif /* HAVE_GNUTLS3 */
+ /* gnutls_free is a variable inside GnuTLS, whose value is the
+ "free" function. So it needs special handling. */
+ gnutls_free_func = (gnutls_free_function *) GetProcAddress (library,
+ "gnutls_free");
+ if (!gnutls_free_func)
+ return false;
+
max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
{
Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
@@ -437,6 +478,11 @@ init_gnutls_functions (void)
# define gnutls_kx_get_name fn_gnutls_kx_get_name
# define gnutls_mac_get fn_gnutls_mac_get
# define gnutls_mac_get_name fn_gnutls_mac_get_name
+# ifdef HAVE_GNUTLS_COMPRESSION_GET
+# define gnutls_compression_get fn_gnutls_compression_get
+# define gnutls_compression_get_name fn_gnutls_compression_get_name
+# endif
+# define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status
# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
@@ -456,6 +502,7 @@ init_gnutls_functions (void)
# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
+# define gnutls_x509_crt_export fn_gnutls_x509_crt_export
# define gnutls_x509_crt_get_activation_time
fn_gnutls_x509_crt_get_activation_time
# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
# define gnutls_x509_crt_get_expiration_time
fn_gnutls_x509_crt_get_expiration_time
@@ -464,6 +511,7 @@ init_gnutls_functions (void)
# define gnutls_x509_crt_get_issuer_unique_id
fn_gnutls_x509_crt_get_issuer_unique_id
# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
+# define gnutls_x509_crt_print fn_gnutls_x509_crt_print
# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
# define gnutls_x509_crt_get_signature_algorithm
fn_gnutls_x509_crt_get_signature_algorithm
# define gnutls_x509_crt_get_subject_unique_id
fn_gnutls_x509_crt_get_subject_unique_id
@@ -501,6 +549,9 @@ init_gnutls_functions (void)
# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
# endif
+# ifdef HAVE_GNUTLS_ETM_STATUS
+# define gnutls_session_etm_status fn_gnutls_session_etm_status
+# endif
# define gnutls_hmac_init fn_gnutls_hmac_init
# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
# define gnutls_hmac fn_gnutls_hmac
@@ -516,6 +567,11 @@ init_gnutls_functions (void)
# endif
# endif /* HAVE_GNUTLS3 */
+/* gnutls_free_func is a data pointer to a variable which holds an
+ address of a function. We use #undef because MinGW64 defines
+ gnutls_free as a macro as well in the GnuTLS headers. */
+# undef gnutls_free
+# define gnutls_free (*gnutls_free_func)
/* This wrapper is called from fns.c, which doesn't know about the
LOAD_DLL_FN stuff above. */
@@ -1041,7 +1097,35 @@ gnutls_hex_string (unsigned char *buf, ptrdiff_t
buf_size, const char *prefix)
}
static Lisp_Object
-gnutls_certificate_details (gnutls_x509_crt_t cert)
+emacs_gnutls_certificate_export_pem (gnutls_x509_crt_t cert)
+{
+ size_t size = 0;
+ int err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, NULL, &size);
+ check_memory_full (err);
+
+ if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
+ {
+ USE_SAFE_ALLOCA;
+ char *buf = SAFE_ALLOCA (size);
+ err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
+ check_memory_full (err);
+
+ if (err < GNUTLS_E_SUCCESS)
+ error ("GnuTLS certificate export error: %s",
+ emacs_gnutls_strerror (err));
+
+ Lisp_Object result = build_string (buf);
+ SAFE_FREE ();
+ return result;
+ }
+ else if (err < GNUTLS_E_SUCCESS)
+ error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));
+
+ return Qnil;
+}
+
+static Lisp_Object
+emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
{
Lisp_Object res = Qnil;
int err;
@@ -1209,6 +1293,10 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
xfree (buf);
}
+ /* PEM */
+ res = nconc2 (res, list2 (intern (":pem"),
+ emacs_gnutls_certificate_export_pem(cert)));
+
return res;
}
@@ -1246,6 +1334,29 @@ DEFUN ("gnutls-peer-status-warning-describe",
Fgnutls_peer_status_warning_descri
if (EQ (status_symbol, intern (":no-host-match")))
return build_string ("certificate host does not match hostname");
+ if (EQ (status_symbol, intern (":signature-failure")))
+ return build_string ("certificate signature could not be verified");
+
+ if (EQ (status_symbol, intern (":revocation-data-superseded")))
+ return build_string ("certificate revocation data are old and have been "
+ "superseded");
+
+ if (EQ (status_symbol, intern (":revocation-data-issued-in-future")))
+ return build_string ("certificate revocation data have a future issue
date");
+
+ if (EQ (status_symbol, intern (":signer-constraints-failure")))
+ return build_string ("certificate signer constraints were violated");
+
+ if (EQ (status_symbol, intern (":purpose-mismatch")))
+ return build_string ("certificate does not match the intended purpose");
+
+ if (EQ (status_symbol, intern (":missing-ocsp-status")))
+ return build_string ("certificate requires the server to send a OCSP "
+ "certificate status, but no status was received");
+
+ if (EQ (status_symbol, intern (":invalid-ocsp-status")))
+ return build_string ("the received OCSP certificate status is invalid");
+
return Qnil;
}
@@ -1297,6 +1408,35 @@ returned as the :certificate entry. */)
if (verification & GNUTLS_CERT_EXPIRED)
warnings = Fcons (intern (":expired"), warnings);
+#if GNUTLS_VERSION_NUMBER >= 0x030100
+ if (verification & GNUTLS_CERT_SIGNATURE_FAILURE)
+ warnings = Fcons (intern (":signature-failure"), warnings);
+
+# if GNUTLS_VERSION_NUMBER >= 0x030114
+ if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED)
+ warnings = Fcons (intern (":revocation-data-superseded"), warnings);
+
+ if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE)
+ warnings = Fcons (intern (":revocation-data-issued-in-future"), warnings);
+
+ if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE)
+ warnings = Fcons (intern (":signer-constraints-failure"), warnings);
+
+# if GNUTLS_VERSION_NUMBER >= 0x030400
+ if (verification & GNUTLS_CERT_PURPOSE_MISMATCH)
+ warnings = Fcons (intern (":purpose-mismatch"), warnings);
+
+# if GNUTLS_VERSION_NUMBER >= 0x030501
+ if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS)
+ warnings = Fcons (intern (":missing-ocsp-status"), warnings);
+
+ if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS)
+ warnings = Fcons (intern (":invalid-ocsp-status"), warnings);
+# endif
+# endif
+# endif
+#endif
+
if (XPROCESS (proc)->gnutls_extra_peer_verification &
CERTIFICATE_NOT_MATCHING)
warnings = Fcons (intern (":no-host-match"), warnings);
@@ -1319,7 +1459,7 @@ returned as the :certificate entry. */)
/* Return all the certificates in a list. */
for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++)
- certs = nconc2 (certs, list1 (gnutls_certificate_details
+ certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details
(XPROCESS
(proc)->gnutls_certificates[i])));
result = nconc2 (result, list2 (intern (":certificates"), certs));
@@ -1347,10 +1487,10 @@ returned as the :certificate entry. */)
(gnutls_kx_get (state)))));
/* Protocol name. */
+ gnutls_protocol_t proto = gnutls_protocol_get_version (state);
result = nconc2
(result, list2 (intern (":protocol"),
- build_string (gnutls_protocol_get_name
- (gnutls_protocol_get_version (state)))));
+ build_string (gnutls_protocol_get_name (proto))));
/* Cipher name. */
result = nconc2
@@ -1364,6 +1504,26 @@ returned as the :certificate entry. */)
build_string (gnutls_mac_get_name
(gnutls_mac_get (state)))));
+ /* Compression name. */
+#ifdef HAVE_GNUTLS_COMPRESSION_GET
+ result = nconc2
+ (result, list2 (intern (":compression"),
+ build_string (gnutls_compression_get_name
+ (gnutls_compression_get (state)))));
+#endif
+
+ /* Encrypt-then-MAC. */
+#ifdef HAVE_GNUTLS_ETM_STATUS
+ result = nconc2
+ (result, list2 (intern (":encrypt-then-mac"),
+ gnutls_session_etm_status (state) ? Qt : Qnil));
+#endif
+
+ /* Renegotiation Indication */
+ if (proto <= GNUTLS_TLS1_2)
+ result = nconc2
+ (result, list2 (intern (":safe-renegotiation"),
+ gnutls_safe_renegotiation_status (state) ? Qt : Qnil));
return result;
}
@@ -1425,6 +1585,52 @@ boot_error (struct Lisp_Process *p, const char *m, ...)
va_end (ap);
}
+DEFUN ("gnutls-format-certificate", Fgnutls_format_certificate,
+ Sgnutls_format_certificate, 1, 1, 0,
+ doc: /* Format a X.509 certificate to a string.
+
+Given a PEM-encoded X.509 certificate CERT, returns a human-readable
+string representation. */)
+ (Lisp_Object cert)
+{
+ CHECK_STRING (cert);
+
+ int err;
+ gnutls_x509_crt_t crt;
+
+ err = gnutls_x509_crt_init (&crt);
+ check_memory_full (err);
+ if (err < GNUTLS_E_SUCCESS)
+ error ("gnutls-format-certificate error: %s", emacs_gnutls_strerror (err));
+
+ gnutls_datum_t crt_data = { SDATA (cert), strlen (SSDATA (cert)) };
+ err = gnutls_x509_crt_import (crt, &crt_data, GNUTLS_X509_FMT_PEM);
+ check_memory_full (err);
+ if (err < GNUTLS_E_SUCCESS)
+ {
+ gnutls_x509_crt_deinit (crt);
+ error ("gnutls-format-certificate error: %s",
+ emacs_gnutls_strerror (err));
+ }
+
+ gnutls_datum_t out;
+ err = gnutls_x509_crt_print (crt, GNUTLS_CRT_PRINT_FULL, &out);
+ check_memory_full (err);
+ if (err < GNUTLS_E_SUCCESS)
+ {
+ gnutls_x509_crt_deinit (crt);
+ error ("gnutls-format-certificate error: %s",
+ emacs_gnutls_strerror (err));
+ }
+
+ Lisp_Object result = make_string_from_bytes ((char *) out.data, out.size,
+ out.size);
+ gnutls_free (out.data);
+ gnutls_x509_crt_deinit (crt);
+
+ return result;
+}
+
Lisp_Object
gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
{
@@ -2706,6 +2912,7 @@ syms_of_gnutls (void)
defsubr (&Sgnutls_bye);
defsubr (&Sgnutls_peer_status);
defsubr (&Sgnutls_peer_status_warning_describe);
+ defsubr (&Sgnutls_format_certificate);
#ifdef HAVE_GNUTLS3
defsubr (&Sgnutls_ciphers);
diff --git a/src/image.c b/src/image.c
index 81d8cb4..fe7bd90 100644
--- a/src/image.c
+++ b/src/image.c
@@ -6234,7 +6234,10 @@ DEF_DLL_FN (void, png_read_info, (png_structp,
png_infop));
DEF_DLL_FN (png_uint_32, png_get_IHDR,
(png_structp, png_infop, png_uint_32 *, png_uint_32 *,
int *, int *, int *, int *, int *));
-DEF_DLL_FN (png_uint_32, png_get_valid, (png_structp, png_infop, png_uint_32));
+# ifdef PNG_tRNS_SUPPORTED
+DEF_DLL_FN (png_uint_32, png_get_tRNS, (png_structp, png_infop, png_bytep *,
+ int *, png_color_16p *));
+# endif
DEF_DLL_FN (void, png_set_strip_16, (png_structp));
DEF_DLL_FN (void, png_set_expand, (png_structp));
DEF_DLL_FN (void, png_set_gray_to_rgb, (png_structp));
@@ -6273,7 +6276,9 @@ init_png_functions (void)
LOAD_DLL_FN (library, png_set_sig_bytes);
LOAD_DLL_FN (library, png_read_info);
LOAD_DLL_FN (library, png_get_IHDR);
- LOAD_DLL_FN (library, png_get_valid);
+# ifdef PNG_tRNS_SUPPORTED
+ LOAD_DLL_FN (library, png_get_tRNS);
+# endif
LOAD_DLL_FN (library, png_set_strip_16);
LOAD_DLL_FN (library, png_set_expand);
LOAD_DLL_FN (library, png_set_gray_to_rgb);
@@ -6304,7 +6309,7 @@ init_png_functions (void)
# undef png_get_IHDR
# undef png_get_io_ptr
# undef png_get_rowbytes
-# undef png_get_valid
+# undef png_get_tRNS
# undef png_longjmp
# undef png_read_end
# undef png_read_image
@@ -6329,7 +6334,7 @@ init_png_functions (void)
# define png_get_IHDR fn_png_get_IHDR
# define png_get_io_ptr fn_png_get_io_ptr
# define png_get_rowbytes fn_png_get_rowbytes
-# define png_get_valid fn_png_get_valid
+# define png_get_tRNS fn_png_get_tRNS
# define png_longjmp fn_png_longjmp
# define png_read_end fn_png_read_end
# define png_read_image fn_png_read_image
@@ -6589,10 +6594,22 @@ png_load_body (struct frame *f, struct image *img,
struct png_load_context *c)
/* If image contains simply transparency data, we prefer to
construct a clipping mask. */
- if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
- transparent_p = 1;
- else
- transparent_p = 0;
+ transparent_p = false;
+# ifdef PNG_tRNS_SUPPORTED
+ png_bytep trans_alpha;
+ int num_trans;
+ if (png_get_tRNS (png_ptr, info_ptr, &trans_alpha, &num_trans, NULL))
+ {
+ transparent_p = true;
+ if (trans_alpha)
+ for (int i = 0; i < num_trans; i++)
+ if (0 < trans_alpha[i] && trans_alpha[i] < 255)
+ {
+ transparent_p = false;
+ break;
+ }
+ }
+# endif
/* This function is easier to write if we only have to handle
one data format: RGB or RGBA with 8 bits per channel. Let's
@@ -6680,7 +6697,7 @@ png_load_body (struct frame *f, struct image *img, struct
png_load_context *c)
/* Create an image and pixmap serving as mask if the PNG image
contains an alpha channel. */
if (channels == 4
- && !transparent_p
+ && transparent_p
&& !image_create_x_image_and_pixmap (f, img, width, height, 1,
&mask_img, 1))
{
diff --git a/src/keyboard.c b/src/keyboard.c
index 30686a2..1b9a603 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -8304,6 +8304,10 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
AUTO_STRING (end, ")");
Lisp_Object orig = PROP (TOOL_BAR_ITEM_HELP);
Lisp_Object desc = Fkey_description (keys, Qnil);
+
+ if (NILP (orig))
+ orig = PROP (TOOL_BAR_ITEM_CAPTION);
+
set_prop (TOOL_BAR_ITEM_HELP, CALLN (Fconcat, orig, beg, desc, end));
}
diff --git a/src/keymap.c b/src/keymap.c
index 6762915..b1e09a9 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3371,12 +3371,10 @@ describe_vector (Lisp_Object vector, Lisp_Object
prefix, Lisp_Object args,
if (!keymap_p)
{
- /* Call Fkey_description first, to avoid GC bug for the other string. */
if (!NILP (prefix) && XFIXNAT (Flength (prefix)) > 0)
{
- Lisp_Object tem = Fkey_description (prefix, Qnil);
AUTO_STRING (space, " ");
- elt_prefix = concat2 (tem, space);
+ elt_prefix = concat2 (Fkey_description (prefix, Qnil), space);
}
prefix = Qnil;
}
diff --git a/src/lisp.h b/src/lisp.h
index 56ad99b..a7b19ab 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2307,7 +2307,7 @@ struct Lisp_Hash_Table
weakness of the table. */
Lisp_Object weak;
- /* Vector of hash codes.
+ /* Vector of hash codes, or nil if the table needs rehashing.
If the I-th entry is unused, then hash[I] should be nil. */
Lisp_Object hash;
@@ -2327,8 +2327,7 @@ struct Lisp_Hash_Table
'index' are special and are either ignored by the GC or traced in
a special way (e.g. because of weakness). */
- /* Number of key/value entries in the table. This number is
- negated if the table needs rehashing. */
+ /* Number of key/value entries in the table. */
ptrdiff_t count;
/* Index of first free entry in free list, or -1 if none. */
@@ -2413,7 +2412,9 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
INLINE ptrdiff_t
HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
{
- return ASIZE (h->next);
+ ptrdiff_t size = ASIZE (h->next);
+ eassume (0 < size);
+ return size;
}
void hash_table_rehash (struct Lisp_Hash_Table *h);
@@ -3614,7 +3615,6 @@ extern void set_default_internal (Lisp_Object,
Lisp_Object,
extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
extern void syms_of_data (void);
extern void swap_in_global_binding (struct Lisp_Symbol *);
-extern Lisp_Object integer_mod (Lisp_Object, Lisp_Object);
/* Defined in cmds.c */
extern void syms_of_cmds (void);
diff --git a/src/lread.c b/src/lread.c
index 1bfbf5a..6ae7a0d 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1064,18 +1064,13 @@ required.
This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
(void)
{
- Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
- while (CONSP (suffixes))
+ Lisp_Object lst = Qnil, suffixes = Vload_suffixes;
+ FOR_EACH_TAIL (suffixes)
{
Lisp_Object exts = Vload_file_rep_suffixes;
- suffix = XCAR (suffixes);
- suffixes = XCDR (suffixes);
- while (CONSP (exts))
- {
- ext = XCAR (exts);
- exts = XCDR (exts);
- lst = Fcons (concat2 (suffix, ext), lst);
- }
+ Lisp_Object suffix = XCAR (suffixes);
+ FOR_EACH_TAIL (exts)
+ lst = Fcons (concat2 (suffix, XCAR (exts)), lst);
}
return Fnreverse (lst);
}
@@ -1290,8 +1285,8 @@ Return t if the file exists and loads successfully. */)
the general case; the second load may do something different. */
{
int load_count = 0;
- Lisp_Object tem;
- for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
+ Lisp_Object tem = Vloads_in_progress;
+ FOR_EACH_TAIL_SAFE (tem)
if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
record_unwind_protect (record_load_unwind, Vloads_in_progress);
@@ -1611,7 +1606,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object
suffixes,
CHECK_STRING (str);
- for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
+ tail = suffixes;
+ FOR_EACH_TAIL_SAFE (tail)
{
CHECK_STRING_CAR (tail);
max_suffix_len = max (max_suffix_len,
@@ -1625,12 +1621,17 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object
suffixes,
absolute = complete_filename_p (str);
+ AUTO_LIST1 (just_use_str, Qnil);
+ if (NILP (path))
+ path = just_use_str;
+
/* Go through all entries in the path and see whether we find the
executable. */
- do {
+ FOR_EACH_TAIL_SAFE (path)
+ {
ptrdiff_t baselen, prefixlen;
- if (NILP (path))
+ if (EQ (path, just_use_str))
filename = str;
else
filename = Fexpand_file_name (str, XCAR (path));
@@ -1663,8 +1664,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object
suffixes,
memcpy (fn, SDATA (filename) + prefixlen, baselen);
/* Loop over suffixes. */
- for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
- CONSP (tail); tail = XCDR (tail))
+ AUTO_LIST1 (empty_string_only, empty_unibyte_string);
+ tail = NILP (suffixes) ? empty_string_only : suffixes;
+ FOR_EACH_TAIL_SAFE (tail)
{
Lisp_Object suffix = XCAR (tail);
ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
@@ -1808,10 +1810,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object
suffixes,
}
}
}
- if (absolute || NILP (path))
+ if (absolute)
break;
- path = XCDR (path);
- } while (CONSP (path));
+ }
SAFE_FREE ();
errno = last_errno;
@@ -1838,7 +1839,7 @@ build_load_history (Lisp_Object filename, bool entire)
tail = Vload_history;
prev = Qnil;
- while (CONSP (tail))
+ FOR_EACH_TAIL (tail)
{
tem = XCAR (tail);
@@ -1861,22 +1862,19 @@ build_load_history (Lisp_Object filename, bool entire)
{
tem2 = Vcurrent_load_list;
- while (CONSP (tem2))
+ FOR_EACH_TAIL (tem2)
{
newelt = XCAR (tem2);
if (NILP (Fmember (newelt, tem)))
Fsetcar (tail, Fcons (XCAR (tem),
Fcons (newelt, XCDR (tem))));
-
- tem2 = XCDR (tem2);
maybe_quit ();
}
}
}
else
prev = tail;
- tail = XCDR (tail);
maybe_quit ();
}
@@ -1918,10 +1916,9 @@ readevalloop_eager_expand_eval (Lisp_Object val,
Lisp_Object macroexpand)
if (EQ (CAR_SAFE (val), Qprogn))
{
Lisp_Object subforms = XCDR (val);
-
- for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms))
- val = readevalloop_eager_expand_eval (XCAR (subforms),
- macroexpand);
+ val = Qnil;
+ FOR_EACH_TAIL (subforms)
+ val = readevalloop_eager_expand_eval (XCAR (subforms), macroexpand);
}
else
val = eval_sub (call2 (macroexpand, val, Qt));
@@ -2588,7 +2585,8 @@ read_escape (Lisp_Object readcharfun, bool stringp)
want. */
int digit = char_hexdigit (c);
if (digit < 0)
- error ("Non-hex digit used for Unicode escape");
+ error ("Non-hex character used for Unicode escape: %c (%d)",
+ c, c);
i = (i << 4) + digit;
}
if (i > 0x10FFFF)
@@ -2861,16 +2859,19 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
/* Now use params to make a new hash table and fill it. */
ht = Fmake_hash_table (param_count, params);
- while (CONSP (data))
- {
+ Lisp_Object last = data;
+ FOR_EACH_TAIL_SAFE (data)
+ {
key = XCAR (data);
data = XCDR (data);
if (!CONSP (data))
- error ("Odd number of elements in hash table data");
+ break;
val = XCAR (data);
- data = XCDR (data);
+ last = XCDR (data);
Fputhash (key, val, ht);
- }
+ }
+ if (!NILP (last))
+ error ("Hash table data is not a list of even length");
return ht;
}
diff --git a/src/mini-gmp.c b/src/mini-gmp.c
index 88b71c3..e92e7cf 100644
--- a/src/mini-gmp.c
+++ b/src/mini-gmp.c
@@ -2,7 +2,7 @@
Contributed to the GNU project by Niels Möller
-Copyright 1991-1997, 1999-2018 Free Software Foundation, Inc.
+Copyright 1991-1997, 1999-2019 Free Software Foundation, Inc.
This file is part of the GNU MP Library.
@@ -295,7 +295,7 @@ gmp_default_alloc (size_t size)
}
static void *
-gmp_default_realloc (void *old, size_t old_size, size_t new_size)
+gmp_default_realloc (void *old, size_t unused_old_size, size_t new_size)
{
void * p;
@@ -308,7 +308,7 @@ gmp_default_realloc (void *old, size_t old_size, size_t
new_size)
}
static void
-gmp_default_free (void *p, size_t size)
+gmp_default_free (void *p, size_t unused_size)
{
free (p);
}
@@ -1595,7 +1595,7 @@ mpz_get_ui (const mpz_t u)
int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS;
unsigned long r = 0;
mp_size_t n = GMP_ABS (u->_mp_size);
- n = GMP_MIN (n, 1 + (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS);
+ n = GMP_MIN (n, 1 + (mp_size_t) (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS);
while (--n >= 0)
r = (r << LOCAL_GMP_LIMB_BITS) + u->_mp_d[n];
return r;
@@ -3499,7 +3499,7 @@ gmp_stronglucas (const mpz_t x, mpz_t Qk)
b0 = mpz_scan0 (n, 0);
/* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */
- Q = (D & 2) ? (D >> 2) + 1 : -(long) (D >> 2);
+ Q = (D & 2) ? (long) (D >> 2) + 1 : -(long) (D >> 2);
if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */
while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */
diff --git a/src/minibuf.c b/src/minibuf.c
index 14a0dbe..f6cf47f 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -169,7 +169,8 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
{
int c = SREF (val, i);
if (c != ' ' && c != '\t' && c != '\n')
- error ("Trailing garbage following expression");
+ xsignal1 (Qinvalid_read_syntax,
+ build_string ("Trailing garbage following expression"));
}
}
diff --git a/src/pdumper.c b/src/pdumper.c
index 326a346..9809023 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -105,8 +105,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# define VM_SUPPORTED 0
#endif
-#define DANGEROUS 0
-
/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to
check, for each hash table it dumps, that the hash table means the
same thing after rehashing. */
@@ -129,7 +127,11 @@ verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object));
verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT));
verify (CHAR_BIT == 8);
-#define DIVIDE_ROUND_UP(x, y) (((x) + (y) - 1) / (y))
+static size_t
+divide_round_up (size_t x, size_t y)
+{
+ return (x + y - 1) / y;
+}
static const char dump_magic[16] = {
'D', 'U', 'M', 'P', 'E', 'D',
@@ -235,9 +237,12 @@ enum emacs_reloc_type
RELOC_EMACS_EMACS_LV,
};
-#define EMACS_RELOC_TYPE_BITS 3
-#define EMACS_RELOC_LENGTH_BITS \
- (sizeof (dump_off) * CHAR_BIT - EMACS_RELOC_TYPE_BITS)
+enum
+ {
+ EMACS_RELOC_TYPE_BITS = 3,
+ EMACS_RELOC_LENGTH_BITS = (sizeof (dump_off) * CHAR_BIT
+ - EMACS_RELOC_TYPE_BITS)
+ };
struct emacs_reloc
{
@@ -274,19 +279,22 @@ struct dump_table_locator
dump_off nr_entries;
};
-#define DUMP_RELOC_TYPE_BITS 5
-verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS));
+enum
+ {
+ DUMP_RELOC_TYPE_BITS = 5,
+ DUMP_RELOC_ALIGNMENT_BITS = 2,
-#define DUMP_RELOC_ALIGNMENT_BITS 2
-#define DUMP_RELOC_OFFSET_BITS \
- (sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS)
+ /* Minimum alignment required by dump file format. */
+ DUMP_RELOCATION_ALIGNMENT = 1 << DUMP_RELOC_ALIGNMENT_BITS,
-/* Minimum alignment required by dump file format. */
-#define DUMP_RELOCATION_ALIGNMENT (1<<DUMP_RELOC_ALIGNMENT_BITS)
+ /* The alignment granularity (in bytes) for objects we store in the
+ dump. Always suitable for heap objects; may be more aligned. */
+ DUMP_ALIGNMENT = max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT),
+
+ DUMP_RELOC_OFFSET_BITS = sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS
+ };
-/* The alignment granularity (in bytes) for objects we store in the
- dump. Always suitable for heap objects; may be more aligned. */
-#define DUMP_ALIGNMENT (max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT))
+verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS));
verify (DUMP_ALIGNMENT >= GCALIGNMENT);
struct dump_reloc
@@ -572,23 +580,17 @@ enum dump_object_special_offset
};
/* Weights for score scores for object non-locality. */
-enum link_weight_enum
- {
- WEIGHT_NONE_VALUE = 0,
- WEIGHT_NORMAL_VALUE = 1000,
- WEIGHT_STRONG_VALUE = 1200,
- };
struct link_weight
{
/* Wrapped in a struct to break unwanted implicit conversion. */
- enum link_weight_enum value;
+ int value;
};
-#define LINK_WEIGHT_LITERAL(x) ((struct link_weight){.value=(x)})
-#define WEIGHT_NONE LINK_WEIGHT_LITERAL (WEIGHT_NONE_VALUE)
-#define WEIGHT_NORMAL LINK_WEIGHT_LITERAL (WEIGHT_NORMAL_VALUE)
-#define WEIGHT_STRONG LINK_WEIGHT_LITERAL (WEIGHT_STRONG_VALUE)
+static struct link_weight const
+ WEIGHT_NONE = { .value = 0 },
+ WEIGHT_NORMAL = { .value = 1000 },
+ WEIGHT_STRONG = { .value = 1200 };
/* Dump file creation */
@@ -628,35 +630,27 @@ dump_set_have_current_referrer (struct dump_context *ctx,
bool have)
#endif
}
-/* Remember the reason objects are enqueued.
+/* Return true if if objects should be enqueued in CTX to refer to an
+ object that the caller should store into CTX->current_referrer.
- Until DUMP_CLEAR_REFERRER is called, any objects enqueued are being
- enqueued because OBJECT refers to them. It is not legal to enqueue
- objects without a referer set. We check this constraint
+ Until dump_clear_referrer is called, any objects enqueued are being
+ enqueued because the object refers to them. It is not valid to
+ enqueue objects without a referrer set. We check this constraint
at runtime.
- It is illegal to call DUMP_SET_REFERRER twice without an
- intervening call to DUMP_CLEAR_REFERRER.
-
- Define as a macro so we can avoid evaluating OBJECT
- if we dont want referrer tracking. */
-#define DUMP_SET_REFERRER(ctx, object) \
- do \
- { \
- struct dump_context *_ctx = (ctx); \
- eassert (!_ctx->have_current_referrer); \
- dump_set_have_current_referrer (_ctx, true); \
- if (dump_tracking_referrers_p (_ctx)) \
- ctx->current_referrer = (object); \
- } \
- while (0)
-
-/* Unset the referer that DUMP_SET_REFERRER set.
-
- Named with upper-case letters for symmetry with
- DUMP_SET_REFERRER. */
+ It is invalid to call dump_set_referrer twice without an
+ intervening call to dump_clear_referrer. */
+static bool
+dump_set_referrer (struct dump_context *ctx)
+{
+ eassert (!ctx->have_current_referrer);
+ dump_set_have_current_referrer (ctx, true);
+ return dump_tracking_referrers_p (ctx);
+}
+
+/* Unset the referrer that dump_set_referrer prepared for. */
static void
-DUMP_CLEAR_REFERRER (struct dump_context *ctx)
+dump_clear_referrer (struct dump_context *ctx)
{
eassert (ctx->have_current_referrer);
dump_set_have_current_referrer (ctx, false);
@@ -732,34 +726,36 @@ dump_object_self_representing_p (Lisp_Object object)
return FIXNUMP (object) || dump_builtin_symbol_p (object);
}
-#define DEFINE_FROMLISP_FUNC(fn, type) \
- static type \
- fn (Lisp_Object value) \
- { \
- ALLOW_IMPLICIT_CONVERSION; \
- if (FIXNUMP (value)) \
- return XFIXNUM (value); \
- eassert (BIGNUMP (value)); \
- type result; \
- if (TYPE_SIGNED (type)) \
- result = bignum_to_intmax (value); \
- else \
- result = bignum_to_uintmax (value); \
- DISALLOW_IMPLICIT_CONVERSION; \
- return result; \
- }
+static intmax_t
+intmax_t_from_lisp (Lisp_Object value)
+{
+ intmax_t n;
+ bool ok = integer_to_intmax (value, &n);
+ eassert (ok);
+ return n;
+}
-#define DEFINE_TOLISP_FUNC(fn, type) \
- static Lisp_Object \
- fn (type value) \
- { \
- return INT_TO_INTEGER (value); \
- }
+static Lisp_Object
+intmax_t_to_lisp (intmax_t value)
+{
+ return INT_TO_INTEGER (value);
+}
+
+static dump_off
+dump_off_from_lisp (Lisp_Object value)
+{
+ intmax_t n = intmax_t_from_lisp (value);
+ eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX);
+ ALLOW_IMPLICIT_CONVERSION;
+ return n;
+ DISALLOW_IMPLICIT_CONVERSION;
+}
-DEFINE_FROMLISP_FUNC (intmax_t_from_lisp, intmax_t)
-DEFINE_TOLISP_FUNC (intmax_t_to_lisp, intmax_t)
-DEFINE_FROMLISP_FUNC (dump_off_from_lisp, dump_off)
-DEFINE_TOLISP_FUNC (dump_off_to_lisp, dump_off)
+static Lisp_Object
+dump_off_to_lisp (dump_off value)
+{
+ return INT_TO_INTEGER (value);
+}
static void
dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte)
@@ -1731,9 +1727,10 @@ dump_root_visitor (Lisp_Object const *root_ptr, enum
gc_root_type type,
eassert (dump_builtin_symbol_p (value));
/* Remember to dump the object itself later along with all the
rest of the copied-to-Emacs objects. */
- DUMP_SET_REFERRER (ctx, build_string ("built-in symbol list"));
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = build_string ("built-in symbol list");
dump_enqueue_object (ctx, value, WEIGHT_NONE);
- DUMP_CLEAR_REFERRER (ctx);
+ dump_clear_referrer (ctx);
}
else
{
@@ -1743,9 +1740,11 @@ dump_root_visitor (Lisp_Object const *root_ptr, enum
gc_root_type type,
ctx->staticpro_table);
if (root_ptr != &Vinternal_interpreter_environment)
{
- DUMP_SET_REFERRER (ctx, dump_ptr_referrer ("emacs root", root_ptr));
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer
+ = dump_ptr_referrer ("emacs root", root_ptr);
dump_emacs_reloc_to_lv (ctx, root_ptr, *root_ptr);
- DUMP_CLEAR_REFERRER (ctx);
+ dump_clear_referrer (ctx);
}
}
}
@@ -1759,7 +1758,7 @@ dump_roots (struct dump_context *ctx)
visit_static_gc_roots (visitor);
}
-#define PDUMPER_MAX_OBJECT_SIZE 2048
+enum { PDUMPER_MAX_OBJECT_SIZE = 2048 };
static dump_off
field_relpos (const void *in_start, const void *in_field)
@@ -1788,11 +1787,7 @@ cpyptr (void *out, const void *in)
/* Convenience macro for regular assignment. */
#define DUMP_FIELD_COPY(out, in, name) \
- do \
- { \
- (out)->name = (in)->name; \
- } \
- while (0)
+ ((out)->name = (in)->name)
static void
dump_field_lv_or_rawptr (struct dump_context *ctx,
@@ -1848,6 +1843,7 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
intptr_t out_value;
dump_off out_field_offset = ctx->obj_offset + relpos;
dump_off target_offset = dump_recall_object (ctx, value);
+ enum { DANGEROUS = false };
if (DANGEROUS
&& target_offset > 0 && dump_object_emacs_ptr (value) == NULL)
{
@@ -2211,7 +2207,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object)
const struct Lisp_Bignum *bignum = XBIGNUM (object);
START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out);
verify (sizeof (out->value) >= sizeof (struct bignum_reload_info));
- dump_field_fixup_later (ctx, out, bignum, &bignum->value);
+ dump_field_fixup_later (ctx, out, bignum, xbignum_val (object));
dump_off bignum_offset = finish_dump_pvec (ctx, &out->header);
if (ctx->flags.dump_object_contents)
{
@@ -2408,7 +2404,8 @@ dump_pre_dump_symbol (struct dump_context *ctx, struct
Lisp_Symbol *symbol)
{
Lisp_Object symbol_lv = make_lisp_symbol (symbol);
eassert (!dump_recall_symbol_aux (ctx, symbol_lv));
- DUMP_SET_REFERRER (ctx, symbol_lv);
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = symbol_lv;
switch (symbol->u.s.redirect)
{
case SYMBOL_LOCALIZED:
@@ -2422,7 +2419,7 @@ dump_pre_dump_symbol (struct dump_context *ctx, struct
Lisp_Symbol *symbol)
default:
break;
}
- DUMP_CLEAR_REFERRER (ctx);
+ dump_clear_referrer (ctx);
}
static dump_off
@@ -2443,13 +2440,14 @@ dump_symbol (struct dump_context *ctx,
{
eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
|| offset == DUMP_OBJECT_NOT_SEEN);
- DUMP_CLEAR_REFERRER (ctx);
+ dump_clear_referrer (ctx);
struct dump_flags old_flags = ctx->flags;
ctx->flags.dump_object_contents = false;
ctx->flags.defer_symbols = false;
dump_object (ctx, object);
ctx->flags = old_flags;
- DUMP_SET_REFERRER (ctx, object);
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = object;
offset = DUMP_OBJECT_ON_SYMBOL_QUEUE;
dump_remember_object (ctx, object, offset);
@@ -2696,7 +2694,7 @@ dump_hash_table (struct dump_context *ctx,
Lisp_Object object,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_BB1ACF756E
+#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_12AFBF47AF
# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
@@ -3118,7 +3116,8 @@ dump_object (struct dump_context *ctx, Lisp_Object object)
}
/* Object needs to be dumped. */
- DUMP_SET_REFERRER (ctx, object);
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = object;
switch (XTYPE (object))
{
case Lisp_String:
@@ -3142,7 +3141,7 @@ dump_object (struct dump_context *ctx, Lisp_Object object)
default:
emacs_abort ();
}
- DUMP_CLEAR_REFERRER (ctx);
+ dump_clear_referrer (ctx);
/* offset can be < 0 if we've deferred an object. */
if (ctx->flags.dump_object_contents && offset > DUMP_OBJECT_NOT_SEEN)
@@ -3397,19 +3396,18 @@ dump_cold_buffer (struct dump_context *ctx, Lisp_Object
data)
static void
dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
{
- const struct Lisp_Bignum *bignum = XBIGNUM (object);
- size_t sz_nlimbs = mpz_size (bignum->value);
+ mpz_t const *n = xbignum_val (object);
+ size_t sz_nlimbs = mpz_size (*n);
eassert (sz_nlimbs < DUMP_OFF_MAX);
dump_align_output (ctx, alignof (mp_limb_t));
dump_off nlimbs = (dump_off) sz_nlimbs;
Lisp_Object descriptor
= list2 (dump_off_to_lisp (ctx->offset),
- dump_off_to_lisp ((mpz_sgn (bignum->value) < 0
- ? -nlimbs : nlimbs)));
+ dump_off_to_lisp (mpz_sgn (*n) < 0 ? -nlimbs : nlimbs));
Fputhash (object, descriptor, ctx->bignum_data);
for (mp_size_t i = 0; i < nlimbs; ++i)
{
- mp_limb_t limb = mpz_getlimbn (bignum->value, i);
+ mp_limb_t limb = mpz_getlimbn (*n, i);
dump_write (ctx, &limb, sizeof (limb));
}
}
@@ -3508,9 +3506,10 @@ dump_drain_user_remembered_data_hot (struct dump_context
*ctx)
read_ptr_raw_and_lv (mem, type, &value, &lv);
if (value != NULL)
{
- DUMP_SET_REFERRER (ctx, dump_ptr_referrer ("user data", mem));
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = dump_ptr_referrer ("user data", mem);
dump_enqueue_object (ctx, lv, WEIGHT_NONE);
- DUMP_CLEAR_REFERRER (ctx);
+ dump_clear_referrer (ctx);
}
}
}
@@ -4735,7 +4734,7 @@ dump_mmap_release_vm (struct dump_memory_map *map)
static bool
needs_mmap_retry_p (void)
{
-#if defined (CYGWIN) || VM_SUPPORTED == VM_MS_WINDOWS
+#if defined CYGWIN || VM_SUPPORTED == VM_MS_WINDOWS || defined _AIX
return true;
#else
return false;
@@ -4878,7 +4877,7 @@ dump_bitset_init (struct dump_bitset *bitset, size_t
number_bits)
{
int xword_size = sizeof (bitset->bits[0]);
int bits_per_word = xword_size * CHAR_BIT;
- ptrdiff_t words_needed = DIVIDE_ROUND_UP (number_bits, bits_per_word);
+ ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
bitset->number_words = words_needed;
bitset->bits = calloc (words_needed, xword_size);
return bitset->bits != NULL;
@@ -5058,7 +5057,7 @@ pdumper_cold_object_p_impl (const void *obj)
return offset >= dump_private.header.cold_start;
}
-enum Lisp_Type
+int
pdumper_find_object_type_impl (const void *obj)
{
eassert (pdumper_object_p (obj));
@@ -5068,7 +5067,7 @@ pdumper_find_object_type_impl (const void *obj)
const struct dump_reloc *reloc =
dump_find_relocation (&dump_private.header.object_starts, offset);
return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
- ? (enum Lisp_Type) reloc->type
+ ? reloc->type
: PDUMPER_NO_OBJECT;
}
@@ -5205,8 +5204,8 @@ dump_do_dump_relocation (const uintptr_t dump_base,
{
struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset);
struct bignum_reload_info reload_info;
- verify (sizeof (reload_info) <= sizeof (bignum->value));
- memcpy (&reload_info, &bignum->value, sizeof (reload_info));
+ verify (sizeof (reload_info) <= sizeof (*bignum_val (bignum)));
+ memcpy (&reload_info, bignum_val (bignum), sizeof (reload_info));
const mp_limb_t *limbs =
dump_ptr (dump_base, reload_info.data_location);
mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs);
@@ -5421,7 +5420,7 @@ pdumper_load (const char *dump_filename)
err = PDUMPER_LOAD_ERROR;
mark_bits_needed =
- DIVIDE_ROUND_UP (header->discardable_start, DUMP_ALIGNMENT);
+ divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
if (!dump_bitset_init (&mark_bits, mark_bits_needed))
goto out;
diff --git a/src/pdumper.h b/src/pdumper.h
index 5d1e9c3..83c094f 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -24,7 +24,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
INLINE_HEADER_BEGIN
-#define PDUMPER_NO_OBJECT ((enum Lisp_Type) -1)
+enum { PDUMPER_NO_OBJECT = -1 };
/* Indicate in source code that we're deliberately relying on pdumper
not preserving the given value. Compiles to nothing --- for humans
@@ -170,12 +170,12 @@ pdumper_cold_object_p (const void *obj)
}
-extern enum Lisp_Type pdumper_find_object_type_impl (const void *obj);
+extern int pdumper_find_object_type_impl (const void *obj);
/* Return the type of the dumped object that starts at OBJ. It is a
programming error to call this routine for an OBJ for which
pdumper_object_p would return false. */
-INLINE _GL_ATTRIBUTE_CONST enum Lisp_Type
+INLINE _GL_ATTRIBUTE_CONST int
pdumper_find_object_type (const void *obj)
{
#ifdef HAVE_PDUMPER
@@ -186,6 +186,14 @@ pdumper_find_object_type (const void *obj)
#endif
}
+/* Return true if TYPE is that of a Lisp object.
+ PDUMPER_NO_OBJECT is invalid. */
+INLINE bool
+pdumper_valid_object_type_p (int type)
+{
+ return 0 <= type;
+}
+
/* Return whether OBJ points exactly to the start of some object in
the loaded dump image. It is a programming error to call this
routine for an OBJ for which pdumper_object_p would return
@@ -194,7 +202,7 @@ INLINE _GL_ATTRIBUTE_CONST bool
pdumper_object_p_precise (const void *obj)
{
#ifdef HAVE_PDUMPER
- return pdumper_find_object_type (obj) != PDUMPER_NO_OBJECT;
+ return pdumper_valid_object_type_p (pdumper_find_object_type (obj));
#else
(void) obj;
emacs_abort ();
diff --git a/src/process.c b/src/process.c
index 066edbc..372277a 100644
--- a/src/process.c
+++ b/src/process.c
@@ -276,6 +276,10 @@ static int read_process_output (Lisp_Object, int);
static void create_pty (Lisp_Object);
static void exec_sentinel (Lisp_Object, Lisp_Object);
+static Lisp_Object
+network_lookup_address_info_1 (Lisp_Object host, const char *service,
+ struct addrinfo *hints, struct addrinfo **res);
+
/* Number of bits set in connect_wait_mask. */
static int num_pending_connects;
@@ -4106,7 +4110,7 @@ usage: (make-network-process &rest ARGS) */)
if (!NILP (host))
{
struct addrinfo *res, *lres;
- int ret;
+ Lisp_Object msg;
maybe_quit ();
@@ -4115,20 +4119,9 @@ usage: (make-network-process &rest ARGS) */)
hints.ai_family = family;
hints.ai_socktype = socktype;
- ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
- if (ret)
-#ifdef HAVE_GAI_STRERROR
- {
- synchronize_system_messages_locale ();
- char const *str = gai_strerror (ret);
- if (! NILP (Vlocale_coding_system))
- str = SSDATA (code_convert_string_norecord
- (build_string (str), Vlocale_coding_system, 0));
- error ("%s/%s %s", SSDATA (host), portstring, str);
- }
-#else
- error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
-#endif
+ msg = network_lookup_address_info_1 (host, portstring, &hints, &res);
+ if (!EQ (msg, Qt))
+ error ("%s", SSDATA (msg));
for (lres = res; lres; lres = lres->ai_next)
addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
@@ -4576,6 +4569,86 @@ Data that is unavailable is returned as nil. */)
#endif
}
+static Lisp_Object
+network_lookup_address_info_1 (Lisp_Object host, const char *service,
+ struct addrinfo *hints, struct addrinfo **res)
+{
+ Lisp_Object msg = Qt;
+ int ret;
+
+ if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
+ error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
+ SSDATA (host));
+ ret = getaddrinfo (SSDATA (host), service, hints, res);
+ if (ret)
+ {
+ if (service == NULL)
+ service = "0";
+#ifdef HAVE_GAI_STRERROR
+ synchronize_system_messages_locale ();
+ char const *str = gai_strerror (ret);
+ if (! NILP (Vlocale_coding_system))
+ str = SSDATA (code_convert_string_norecord
+ (build_string (str), Vlocale_coding_system, 0));
+ AUTO_STRING (format, "%s/%s %s");
+ msg = CALLN (Fformat, format, host, build_string (service),
+ build_string (str));
+#else
+ AUTO_STRING (format, "%s/%s getaddrinfo error %d");
+ msg = CALLN (Fformat, format, host, build_string (service),
+ make_int (ret));
+#endif
+ }
+ return msg;
+}
+
+DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
+ Snetwork_lookup_address_info, 1, 2, 0,
+ doc: /* Look up ip address info of NAME.
+Optional parameter FAMILY controls whether to look up IPv4 or IPv6
+addresses. The default of nil means both, symbol `ipv4' means IPv4
+only, symbol `ipv6' means IPv6 only. Returns a list of addresses, or
+nil if none were found. Each address is a vector of integers. */)
+ (Lisp_Object name, Lisp_Object family)
+{
+ Lisp_Object addresses = Qnil;
+ Lisp_Object msg = Qnil;
+
+ struct addrinfo *res, *lres;
+ struct addrinfo hints;
+
+ memset (&hints, 0, sizeof hints);
+ if (EQ (family, Qnil))
+ hints.ai_family = AF_UNSPEC;
+ else if (EQ (family, Qipv4))
+ hints.ai_family = AF_INET;
+ else if (EQ (family, Qipv6))
+#ifdef AF_INET6
+ hints.ai_family = AF_INET6;
+#else
+ /* If we don't support IPv6, querying will never work anyway */
+ return addresses;
+#endif
+ else
+ error ("Unsupported lookup type");
+ hints.ai_socktype = SOCK_DGRAM;
+
+ msg = network_lookup_address_info_1 (name, NULL, &hints, &res);
+ if (!EQ (msg, Qt))
+ message ("%s", SSDATA(msg));
+ else
+ {
+ for (lres = res; lres; lres = lres->ai_next)
+ addresses = Fcons (conv_sockaddr_to_lisp (lres->ai_addr,
+ lres->ai_addrlen),
+ addresses);
+ addresses = Fnreverse (addresses);
+
+ freeaddrinfo (res);
+ }
+ return addresses;
+}
+
/* Turn off input and output for process PROC. */
static void
@@ -8345,6 +8418,7 @@ returns non-`nil'. */);
defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
defsubr (&Sformat_network_address);
+ defsubr (&Snetwork_lookup_address_info);
defsubr (&Snetwork_interface_list);
defsubr (&Snetwork_interface_info);
#ifdef DATAGRAM_SOCKETS
diff --git a/src/sound.c b/src/sound.c
index 4ba826e..44d4cbc 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -72,12 +72,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <soundcard.h>
#endif
#ifdef HAVE_ALSA
-#ifdef ALSA_SUBDIR_INCLUDE
#include <alsa/asoundlib.h>
-#else
-#include <asoundlib.h>
-#endif /* ALSA_SUBDIR_INCLUDE */
-#endif /* HAVE_ALSA */
+#endif
/* END: Non Windows Includes */
diff --git a/src/sysdep.c b/src/sysdep.c
index f747825..aa18ee2 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2810,12 +2810,6 @@ errputc (int c)
}
void
-verrprintf (char const *fmt, va_list ap)
-{
- vfprintf (errstream (), fmt, ap);
-}
-
-void
errwrite (void const *buf, ptrdiff_t nbuf)
{
fwrite_unlocked (buf, 1, nbuf, errstream ());
diff --git a/src/sysstdio.h b/src/sysstdio.h
index f402bd6..1e1180a 100644
--- a/src/sysstdio.h
+++ b/src/sysstdio.h
@@ -28,7 +28,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
extern FILE *emacs_fopen (char const *, char const *);
extern void errputc (int);
-extern void verrprintf (char const *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern void errwrite (void const *, ptrdiff_t);
extern void close_output_streams (void);
diff --git a/src/systime.h b/src/systime.h
index 125b2f1..2f783ef 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -41,6 +41,8 @@ typedef unsigned long Time;
#endif
#include <sys/time.h> /* for 'struct timeval' */
+
+#undef hz /* AIX <sys/param.h> #defines this. */
/* Emacs uses struct timespec to represent nonnegative temporal intervals.
diff --git a/src/timefns.c b/src/timefns.c
index 2d545a4..c1e3141 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -91,7 +91,7 @@ static Lisp_Object timespec_hz;
#define TRILLION 1000000000000
#if FIXNUM_OVERFLOW_P (TRILLION)
static Lisp_Object trillion;
-# define ztrillion (XBIGNUM (trillion)->value)
+# define ztrillion (*xbignum_val (trillion))
#else
# define trillion make_fixnum (TRILLION)
# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS
@@ -99,6 +99,22 @@ mpz_t ztrillion;
# endif
#endif
+/* True if the nonzero Lisp integer HZ divides evenly into a trillion. */
+static bool
+trillion_factor (Lisp_Object hz)
+{
+ if (FASTER_TIMEFNS)
+ {
+ if (FIXNUMP (hz))
+ return TRILLION % XFIXNUM (hz) == 0;
+ if (!FIXNUM_OVERFLOW_P (TRILLION))
+ return false;
+ }
+ verify (TRILLION <= INTMAX_MAX);
+ intmax_t ihz;
+ return integer_to_intmax (hz, &ihz) && TRILLION % ihz == 0;
+}
+
/* 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. */
@@ -391,16 +407,36 @@ decode_float_time (double t, struct lisp_time *result)
else
{
int exponent = ilogb (t);
- if (exponent == FP_ILOGBNAN)
- return EINVAL;
-
- /* An enormous or infinite T would make SCALE < 0 which would make
- HZ < 1, which the (TICKS . HZ) representation does not allow. */
- if (DBL_MANT_DIG - 1 < exponent)
- return EOVERFLOW;
-
- /* min so we don't scale tiny numbers as if they were normalized. */
- int scale = min (DBL_MANT_DIG - 1 - exponent, flt_radix_power_size - 1);
+ int scale;
+ if (exponent < DBL_MANT_DIG)
+ {
+ if (exponent < DBL_MIN_EXP - 1)
+ {
+ if (exponent == FP_ILOGBNAN
+ && (FP_ILOGBNAN != FP_ILOGB0 || isnan (t)))
+ return EINVAL;
+ /* T is tiny. SCALE must be less than FLT_RADIX_POWER_SIZE,
+ as otherwise T would be scaled as if it were normalized. */
+ scale = flt_radix_power_size - 1;
+ }
+ else
+ {
+ /* The typical case. */
+ scale = DBL_MANT_DIG - 1 - exponent;
+ }
+ }
+ else if (exponent < INT_MAX)
+ {
+ /* T is finite but so large that HZ would be less than 1 if
+ T's precision were represented exactly. SCALE must be
+ nonnegative, as the (TICKS . HZ) representation requires
+ HZ to be at least 1. So use SCALE = 0, which converts T to
+ (T . 1), which is the exact numeric value with too-large HZ,
+ which is typically better than signaling overflow. */
+ scale = 0;
+ }
+ else
+ return FP_ILOGBNAN == INT_MAX && isnan (t) ? EINVAL : EOVERFLOW;
double scaled = scalbn (t, scale);
eassert (trunc (scaled) == scaled);
@@ -498,7 +534,7 @@ lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz)
return make_int (ticks / XFIXNUM (t.hz)
- (ticks % XFIXNUM (t.hz) < 0));
}
- else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value)))
+ else if (! (BIGNUMP (hz) && 0 < mpz_sgn (*xbignum_val (hz))))
invalid_hz (hz);
mpz_mul (mpz[0],
@@ -661,18 +697,10 @@ enum timeform
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) */
- /* These two should be last; see timeform_sub_ps_p. */
TIMEFORM_FLOAT, /* time as a float */
TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
};
-/* True if Lisp times of form FORM can express sub-picosecond timestamps. */
-static bool
-timeform_sub_ps_p (enum timeform form)
-{
- return TIMEFORM_FLOAT <= form;
-}
-
/* 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
@@ -878,6 +906,7 @@ lisp_to_timespec (struct lisp_time t)
struct timespec result = invalid_timespec ();
int ns;
mpz_t *q = &mpz[0];
+ mpz_t const *qt = q;
if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz))
{
@@ -896,7 +925,7 @@ lisp_to_timespec (struct lisp_time t)
return result;
}
else
- ns = mpz_fdiv_q_ui (*q, XBIGNUM (t.ticks)->value, TIMESPEC_HZ);
+ ns = mpz_fdiv_q_ui (*q, *xbignum_val (t.ticks), TIMESPEC_HZ);
}
else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1)))
{
@@ -913,7 +942,7 @@ lisp_to_timespec (struct lisp_time t)
return result;
}
else
- q = &XBIGNUM (t.ticks)->value;
+ qt = xbignum_val (t.ticks);
}
else
{
@@ -925,7 +954,7 @@ lisp_to_timespec (struct lisp_time t)
/* 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))
+ if (mpz_time (*qt, &sec))
{
result.tv_sec = sec;
result.tv_nsec = ns;
@@ -1010,7 +1039,7 @@ lispint_arith (Lisp_Object a, Lisp_Object b, bool
subtract)
if (eabs (XFIXNUM (b)) <= ULONG_MAX)
{
((XFIXNUM (b) < 0) == subtract ? mpz_add_ui : mpz_sub_ui)
- (mpz[0], XBIGNUM (a)->value, eabs (XFIXNUM (b)));
+ (mpz[0], *xbignum_val (a), eabs (XFIXNUM (b)));
mpz_done = true;
}
}
@@ -1060,9 +1089,14 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
else
{
/* The plan is to decompose ta into na/da and tb into nb/db.
- Start by computing da and db. */
+ Start by computing da and db, their minimum (which will be
+ needed later) and the iticks temporary that will become
+ available once only their minimum is needed. */
mpz_t const *da = bignum_integer (&mpz[1], ta.hz);
mpz_t const *db = bignum_integer (&mpz[2], tb.hz);
+ bool da_lt_db = mpz_cmp (*da, *db) < 0;
+ mpz_t const *hzmin = da_lt_db ? da : db;
+ mpz_t *iticks = &mpz[da_lt_db + 1];
/* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
where g = gcd (da, db). Start by computing g. */
@@ -1070,34 +1104,83 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
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);
+ mpz_t *fa = &mpz[4], *fb = &mpz[3];
+ mpz_divexact (*fa, *da, *g);
+ mpz_divexact (*fb, *db, *g);
+
+ /* ihz = fa * db. This is equal to lcm (da, db). */
+ mpz_t *ihz = &mpz[0];
+ mpz_mul (*ihz, *fa, *db);
+
+ /* When warning about obsolete timestamps, if the smaller
+ denominator comes from a non-(TICKS . HZ) timestamp and could
+ generate a (TICKS . HZ) timestamp that would look obsolete,
+ arrange for the result to have a higher HZ to avoid a
+ spurious warning by a later consumer of this function's
+ returned value. */
+ verify (1 << LO_TIME_BITS <= ULONG_MAX);
+ if (WARN_OBSOLETE_TIMESTAMPS
+ && (da_lt_db ? aform : bform) == TIMEFORM_FLOAT
+ && (da_lt_db ? bform : aform) != TIMEFORM_TICKS_HZ
+ && mpz_cmp_ui (*hzmin, 1) > 0
+ && mpz_cmp_ui (*hzmin, 1 << LO_TIME_BITS) < 0)
+ {
+ mpz_t *hzmin1 = &mpz[2 - da_lt_db];
+ mpz_set_ui (*hzmin1, 1 << LO_TIME_BITS);
+ hzmin = hzmin1;
+ }
- /* FIXME: Maybe omit need for extra temp by computing fa * db here? */
+ /* iticks = (fb * na) OP (fa * nb), where OP is + or -. */
+ mpz_t const *na = bignum_integer (iticks, ta.ticks);
+ mpz_mul (*iticks, *fb, *na);
+ mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
+ (subtract ? mpz_submul : mpz_addmul) (*iticks, *fa, *nb);
+
+ /* Normalize iticks/ihz by dividing both numerator and
+ denominator by ig = gcd (iticks, ihz). However, if that
+ would cause the denominator to become less than hzmin,
+ rescale the denominator upwards from its ordinary value by
+ multiplying numerator and denominator so that the denominator
+ becomes at least hzmin. This rescaling avoids returning a
+ timestamp that is less precise than both a and b, or a
+ timestamp that looks obsolete when that might be a problem. */
+ mpz_t *ig = &mpz[3];
+ mpz_gcd (*ig, *iticks, *ihz);
+
+ if (!FASTER_TIMEFNS || mpz_cmp_ui (*ig, 1) > 0)
+ {
+ mpz_divexact (*iticks, *iticks, *ig);
+ mpz_divexact (*ihz, *ihz, *ig);
- /* hz = fa * db. This is equal to lcm (da, db). */
- mpz_mul (mpz[0], *fa, *db);
+ if (!FASTER_TIMEFNS || mpz_cmp (*ihz, *hzmin) < 0)
+ {
+ /* Rescale straightforwardly. Although this might not
+ yield the minimal denominator that preserves numeric
+ value and is at least hzmin, calculating such a
+ denominator would be too expensive because it would
+ require testing multisets of factors of lcm (da, db). */
+ mpz_t *rescale = &mpz[3];
+ mpz_cdiv_q (*rescale, *hzmin, *ihz);
+ mpz_mul (*iticks, *iticks, *rescale);
+ mpz_mul (*ihz, *ihz, *rescale);
+ }
+ }
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 const *na = bignum_integer (&mpz[0], ta.ticks);
- mpz_mul (mpz[0], *fb, *na);
- mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
- (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb);
+ mpz_swap (mpz[0], *iticks);
ticks = make_integer_mpz ();
}
/* Return an integer if the timestamp resolution is 1,
otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if
- either input form supports timestamps that cannot be expressed
+ either input used (TICKS . HZ) form or the result can't be expressed
exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form
for backward compatibility. */
return (EQ (hz, make_fixnum (1))
? ticks
: (!CURRENT_TIME_LIST
- || timeform_sub_ps_p (aform) || timeform_sub_ps_p (bform))
+ || aform == TIMEFORM_TICKS_HZ
+ || bform == TIMEFORM_TICKS_HZ
+ || !trillion_factor (hz))
? Fcons (ticks, hz)
: ticks_hz_list4 (ticks, hz));
}
diff --git a/src/w32.c b/src/w32.c
index 36a5a37..d7a9169 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -3918,7 +3918,7 @@ logon_network_drive (const char *path)
return;
n_slashes = 2;
- strncpy (share, path, MAX_UTF8_PATH);
+ strncpy (share, path, MAX_UTF8_PATH - 1);
/* Truncate to just server and share name. */
for (p = share + 2; *p && p < share + MAX_UTF8_PATH; p++)
{
diff --git a/src/xdisp.c b/src/xdisp.c
index af772bd..94f969f 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -184,7 +184,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
infrequently. These include the face of the characters, whether
text is invisible, the object (buffer or display or overlay string)
being iterated, character composition info, etc. For any given
- buffer or string position, these sources of information that
+ buffer or string position, the sources of information that
affects the display can be determined by calling the appropriate
primitives, such as Fnext_single_property_change, but both these
calls and the processing of their return values is relatively
@@ -214,7 +214,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
string's interval tree to determine where the text properties
change, finds the next position where overlays and character
composition can change, and stores in stop_charpos the closest
- position where any of these factors should be reconsider.
+ position where any of these factors should be reconsidered.
Producing glyphs.
@@ -13509,7 +13509,8 @@ hscroll_window_tree (Lisp_Object window)
get glyph rows whose start and end have zero buffer
positions, which we cannot handle below. Just skip
such windows. */
- && CHARPOS (cursor_row->start.pos) >= BUF_BEG (w->contents)
+ && (CHARPOS (cursor_row->start.pos)
+ >= BUF_BEG (XBUFFER (w->contents)))
/* For left-to-right rows, hscroll when cursor is either
(i) inside the right hscroll margin, or (ii) if it is
inside the left margin and the window is already
@@ -20463,7 +20464,7 @@ append_space_for_newline (struct it *it, bool
default_face_p)
static void
extend_face_to_end_of_line (struct it *it)
{
- struct face *face, *default_face;
+ struct face *face;
struct frame *f = it->f;
/* If line is already filled, do nothing. Non window-system frames
@@ -20481,10 +20482,6 @@ extend_face_to_end_of_line (struct it *it)
|| WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0))
return;
- /* The default face, possibly remapped. */
- default_face =
- FACE_FROM_ID_OR_NULL (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
-
/* Face extension extends the background and box of IT->face_id
to the end of the line. If the background equals the background
of the frame, we don't have to do anything. */
@@ -20517,7 +20514,14 @@ extend_face_to_end_of_line (struct it *it)
it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil);
}
+ /* The default face, possibly remapped. */
+ struct face *default_face =
+ FACE_FROM_ID (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
+
#ifdef HAVE_WINDOW_SYSTEM
+ if (default_face == NULL)
+ error ("extend_face_to_end_of_line: default_face is not set!");
+
if (FRAME_WINDOW_P (f))
{
/* If the row is empty, add a space with the current face of IT,
diff --git a/src/xterm.c b/src/xterm.c
index 0d22406..b761eaf 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10044,7 +10044,6 @@ For details, see etc/PROBLEMS.\n",
{
fprintf (stderr, "%s\n", error_msg);
Fkill_emacs (make_fixnum (70));
- /* NOTREACHED */
}
totally_unblock_input ();
diff --git a/test/Makefile.in b/test/Makefile.in
index b795907..abcba94 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -233,6 +233,7 @@ define test_template
ifeq (,$(patsubst %-tests,,$(1))$(findstring -tests/,$(1)))
$(1).log: $(patsubst %-tests,$(srcdir)/../%,$(1))$(if \
$(patsubst src/%,,$(patsubst
lib-src/%,,$(1))),.el,.c)
+ $(notdir $(1).log): $(1).log
endif
## Short aliases that always re-run the tests, with no logging.
diff --git a/test/README b/test/README
index c34cdce..b55e245 100644
--- a/test/README
+++ b/test/README
@@ -44,6 +44,9 @@ The Makefile in this directory supports the following targets:
tests. In the former case the output is shown on the terminal, in
the latter case the output is written to <filename>.log.
+<filename> could be either a relative file name like
+"lisp/files-tests", or a package name like "files-tests".
+
ERT offers selectors, which make it possible to filter out which test
cases shall run. The make variable $(SELECTOR) gives you a simple
mean to use your own selectors. The ERT manual describes how
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 0ff3c5a..0aec180 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -277,6 +277,9 @@ This expects `auto-revert--messages' to be bound by
; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(let ((tmpfile (make-temp-file "auto-revert-test"))
+ ;; Try to catch bug#32645.
+ (auto-revert-debug (getenv "EMACS_HYDRA_CI"))
+ (file-notify-debug (getenv "EMACS_HYDRA_CI"))
buf desc)
(unwind-protect
(progn
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index baea480..0d7004d 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -1300,6 +1300,24 @@ UID:9188710a-08a7-4061-bae3-d4cf4972599a
"
))
+(ert-deftest icalendar-import-bug-33277 ()
+ ;;bug#33277 -- start time equals end time
+ (icalendar-tests--test-import
+ "DTSTART:20181105T200000Z
+DTSTAMP:20181105T181652Z
+DESCRIPTION:
+LAST-MODIFIED:20181105T181646Z
+LOCATION:
+SEQUENCE:0
+SUMMARY:event with same start/end time
+TRANSP:OPAQUE
+"
+
+ "&2018/11/5 21:00 event with same start/end time\n"
+ "&5/11/2018 21:00 event with same start/end time\n"
+ "&11/5/2018 21:00 event with same start/end time\n"
+ ))
+
(ert-deftest icalendar-import-multiple-vcalendars ()
(icalendar-tests--test-import
"DTSTART;VALUE=DATE:20110723
diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
new file mode 100644
index 0000000..bf6ac04
--- /dev/null
+++ b/test/lisp/net/nsm-tests.el
@@ -0,0 +1,69 @@
+;;; network-stream-tests.el --- tests for network security manager -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Robert Pluim <address@hidden>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+
+;;; Code:
+
+(require 'nsm)
+(eval-when-compile (require 'cl-lib))
+
+(ert-deftest nsm-check-local-subnet-ipv4 ()
+ "Check that nsm can be avoided for local subnets."
+ (let ((local-ip '[172 26 128 160 0])
+ (mask '[255 255 255 0 0])
+
+ (wrong-length-mask '[255 255 255])
+ (wrong-mask '[255 255 255 255 0])
+ (remote-ip-yes '[172 26 128 161 0])
+ (remote-ip-no '[172 26 129 161 0]))
+
+ (should (eq t (nsm-network-same-subnet local-ip mask remote-ip-yes)))
+ (should (eq nil (nsm-network-same-subnet local-ip mask remote-ip-no)))
+ (should-error (nsm-network-same-subnet local-ip wrong-length-mask
remote-ip-yes))
+ (should (eq nil (nsm-network-same-subnet local-ip wrong-mask
remote-ip-yes)))
+ (should (eq t (nsm-should-check "google.com")))
+ (should (eq t (nsm-should-check "127.1")))
+ (should (eq t (nsm-should-check "localhost")))
+ (let ((nsm-trust-local-network t))
+ (should (eq t (nsm-should-check "google.com")))
+ (should (eq nil (nsm-should-check "127.1")))
+ (should (eq nil (nsm-should-check "localhost"))))))
+
+;; FIXME This will never return true, since
+;; network-interface-list only gives the primary address of each
+;; interface, which will be the IPv4 one
+(defun nsm-ipv6-is-available ()
+ (and (featurep 'make-network-process '(:family ipv6))
+ (cl-rassoc-if
+ (lambda (elt)
+ (eq 9 (length elt)))
+ (network-interface-list))))
+
+(ert-deftest nsm-check-local-subnet-ipv6 ()
+ (skip-unless (nsm-ipv6-is-available))
+ (should (eq t (nsm-should-check "::1")))
+ (let ((nsm-trust-local-network t))
+ (should (eq nil (nsm-should-check "::1")))))
+
+
+;;; nsm-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 180f746..dd6b9ed 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3098,6 +3098,12 @@ They might differ only in time attributes or directory
size."
(let ((attr1 (copy-sequence attr1))
(attr2 (copy-sequence attr2))
(start-time (- tramp--test-start-time 10)))
+ ;; Link number. For directories, it includes the number of
+ ;; subdirectories. Set it to 1.
+ (when (eq (tramp-compat-file-attribute-type attr1) t)
+ (setcar (nthcdr 1 attr1) 1))
+ (when (eq (tramp-compat-file-attribute-type attr2) t)
+ (setcar (nthcdr 1 attr2) 1))
;; Access time.
(setcar (nthcdr 4 attr1) tramp-time-dont-know)
(setcar (nthcdr 4 attr2) tramp-time-dont-know)
@@ -3473,7 +3479,9 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
;; Cleanup.
- (ignore-errors (delete-directory tmp-name1 'recursive)))
+ (ignore-errors
+ (delete-file tmp-name3)
+ (delete-directory tmp-name1 'recursive)))
;; Detect cyclic symbolic links.
(unwind-protect
@@ -3533,9 +3541,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(file-attributes tmp-name1))
tramp-time-dont-know)
(should
- (equal (tramp-compat-file-attribute-modification-time
- (file-attributes tmp-name1))
- (seconds-to-time 1)))
+ (tramp-compat-time-equal-p
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes tmp-name1))
+ (seconds-to-time 1)))
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))
@@ -4182,8 +4191,9 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "killed\n\\'" (buffer-string))))
+ ;; echoes also the sent string. And a remote macOS sends
+ ;; a slightly modified string.
+ (should (string-match "killed.*\n\\'" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -5145,7 +5155,8 @@ This requires restrictions of file name syntax."
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
(files (delq nil files))
- (process-environment process-environment))
+ (process-environment process-environment)
+ (sorted-files (sort (copy-sequence files) #'string-lessp)))
(unwind-protect
(progn
(make-directory tmp-name1)
@@ -5192,10 +5203,20 @@ This requires restrictions of file name syntax."
;; Check file names.
(should (equal (directory-files
tmp-name1 nil directory-files-no-dot-files-regexp)
- (sort (copy-sequence files) #'string-lessp)))
+ sorted-files))
(should (equal (directory-files
tmp-name2 nil directory-files-no-dot-files-regexp)
- (sort (copy-sequence files) #'string-lessp)))
+ sorted-files))
+ (should (equal (mapcar
+ #'car
+ (directory-files-and-attributes
+ tmp-name1 nil directory-files-no-dot-files-regexp))
+ sorted-files))
+ (should (equal (mapcar
+ #'car
+ (directory-files-and-attributes
+ tmp-name2 nil directory-files-no-dot-files-regexp))
+ sorted-files))
;; `substitute-in-file-name' could return different
;; values. For `adb', there could be strange file
@@ -5268,7 +5289,10 @@ This requires restrictions of file name syntax."
(should-not (file-exists-p file1))))
;; Check, that environment variables are set correctly.
- (when (and (tramp--test-expensive-test) (tramp--test-sh-p))
+ ;; We do not run on macOS due to encoding problems. See
+ ;; Bug#36940.
+ (when (and (tramp--test-expensive-test) (tramp--test-sh-p)
+ (not (eq system-type 'darwin)))
(dolist (elt files)
(let ((envvar (concat "VAR_" (upcase (md5 elt))))
(elt (encode-coding-string elt coding-system-for-read))
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 2a777af..a93664f 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -64,6 +64,7 @@
"Temporary directory for Tramp tests.")
(setq password-cache-expiry nil
+ shadow-debug t
tramp-verbose 0
tramp-message-show-message nil)
@@ -79,6 +80,35 @@
(expand-file-name "shadow_todo_test" temporary-file-directory)
"File to store the list of uncopied shadows in during tests.")
+(defun shadow--tests-cleanup ()
+ "Reset all `shadowfile' internals."
+ ;; Delete auto-saved files.
+ (with-current-buffer (find-file-noselect shadow-info-file 'nowarn)
+ (ignore-errors (delete-file (make-auto-save-file-name)))
+ (set-buffer-modified-p nil)
+ (kill-buffer))
+ (with-current-buffer (find-file-noselect shadow-todo-file 'nowarn)
+ (ignore-errors (delete-file (make-auto-save-file-name)))
+ (set-buffer-modified-p nil)
+ (kill-buffer))
+ ;; Delete buffers.
+ (ignore-errors
+ (with-current-buffer shadow-info-buffer
+ (set-buffer-modified-p nil)
+ (kill-buffer)))
+ (ignore-errors
+ (with-current-buffer shadow-todo-buffer
+ (set-buffer-modified-p nil)
+ (kill-buffer)))
+ ;; Delete files.
+ (ignore-errors (delete-file shadow-info-file))
+ (ignore-errors (delete-file shadow-todo-file))
+ ;; Reset variables.
+ (setq shadow-info-buffer nil
+ shadow-hashtable nil
+ shadow-todo-buffer nil
+ shadow-files-to-copy nil))
+
(ert-deftest shadow-test00-clusters ()
"Check cluster definitions.
Per definition, all files are identical on the different hosts of
@@ -96,23 +126,21 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function 'read-from-minibuffer)
+ (cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest args) (pop mocked-input)))
- ((symbol-function 'read-string)
+ ((symbol-function #'read-string)
(lambda (&rest args) (pop mocked-input))))
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define a cluster.
(setq cluster "cluster"
primary shadow-system-name
regexp (shadow-regexp-superquote primary)
mocked-input `(,cluster ,primary ,regexp))
- (call-interactively 'shadow-define-cluster)
+ (call-interactively #'shadow-define-cluster)
(should
(string-equal
(shadow-cluster-name (shadow-get-cluster cluster)) cluster))
@@ -136,7 +164,7 @@ guaranteed by the originator of a cluster definition."
mocked-input `(,cluster ,cluster ,primary ,regexp))
(with-current-buffer (messages-buffer)
(narrow-to-region (point-max) (point-max)))
- (call-interactively 'shadow-define-cluster)
+ (call-interactively #'shadow-define-cluster)
(should
(string-match
(regexp-quote "Not a valid primary!")
@@ -157,7 +185,7 @@ guaranteed by the originator of a cluster definition."
mocked-input `(,cluster ,primary ,cluster ,regexp))
(with-current-buffer (messages-buffer)
(narrow-to-region (point-max) (point-max)))
- (call-interactively 'shadow-define-cluster)
+ (call-interactively #'shadow-define-cluster)
(should
(string-match
(regexp-quote "Regexp doesn't include the primary host!")
@@ -178,7 +206,7 @@ guaranteed by the originator of a cluster definition."
(file-remote-p shadow-test-remote-temporary-file-directory)
regexp (shadow-regexp-superquote primary)
mocked-input `(,cluster ,primary ,regexp))
- (call-interactively 'shadow-define-cluster)
+ (call-interactively #'shadow-define-cluster)
(should
(string-equal
(shadow-cluster-name (shadow-get-cluster cluster)) cluster))
@@ -198,10 +226,7 @@ guaranteed by the originator of a cluster definition."
;; Cleanup.
(with-current-buffer (messages-buffer) (widen))
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test01-sites ()
"Check site definitions.
@@ -218,16 +243,14 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function 'read-from-minibuffer)
+ (cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest args) (pop mocked-input)))
- ((symbol-function 'read-string)
+ ((symbol-function #'read-string)
(lambda (&rest args) (pop mocked-input))))
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define a cluster.
(setq cluster1 "cluster1"
@@ -308,10 +331,7 @@ guaranteed by the originator of a cluster definition."
(shadow-site-match (shadow-site-primary cluster1) cluster2)))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test02-files ()
"Check file manipulation functions."
@@ -324,11 +344,10 @@ guaranteed by the originator of a cluster definition."
cluster primary regexp file hup)
(unwind-protect
(progn
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define a cluster.
(setq cluster "cluster"
@@ -384,10 +403,7 @@ guaranteed by the originator of a cluster definition."
(should-not (shadow-local-file nil)))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test03-expand-cluster-in-file-name ()
"Check canonical file name of a cluster or site."
@@ -400,11 +416,10 @@ guaranteed by the originator of a cluster definition."
cluster primary regexp file1 file2)
(unwind-protect
(progn
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define a cluster.
(setq cluster "cluster"
@@ -455,10 +470,7 @@ guaranteed by the originator of a cluster definition."
(concat primary file1))))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test04-contract-file-name ()
"Check canonical file name of a cluster or site."
@@ -471,11 +483,10 @@ guaranteed by the originator of a cluster definition."
cluster primary regexp file)
(unwind-protect
(progn
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define a cluster.
(setq cluster "cluster"
@@ -516,10 +527,7 @@ guaranteed by the originator of a cluster definition."
(concat "/cluster:" file))))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test05-file-match ()
"Check `shadow-same-site' and `shadow-file-match'."
@@ -532,11 +540,10 @@ guaranteed by the originator of a cluster definition."
cluster primary regexp file)
(unwind-protect
(progn
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define a cluster.
(setq cluster "cluster"
@@ -575,10 +582,7 @@ guaranteed by the originator of a cluster definition."
file)))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test06-literal-groups ()
"Check literal group definitions."
@@ -592,16 +596,14 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function 'read-from-minibuffer)
+ (cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest args) (pop mocked-input)))
- ((symbol-function 'read-string)
+ ((symbol-function #'read-string)
(lambda (&rest args) (pop mocked-input))))
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define clusters.
(setq cluster1 "cluster1"
@@ -627,7 +629,8 @@ guaranteed by the originator of a cluster definition."
mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET")))
(with-temp-buffer
(set-visited-file-name file1)
- (call-interactively 'shadow-define-literal-group))
+ (call-interactively #'shadow-define-literal-group)
+ (set-buffer-modified-p nil))
;; `shadow-literal-groups' is a list of lists.
(should (consp shadow-literal-groups))
@@ -640,10 +643,7 @@ guaranteed by the originator of a cluster definition."
(car shadow-literal-groups))))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test07-regexp-groups ()
"Check regexp group definitions."
@@ -657,16 +657,14 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function 'read-from-minibuffer)
+ (cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest args) (pop mocked-input)))
- ((symbol-function 'read-string)
+ ((symbol-function #'read-string)
(lambda (&rest args) (pop mocked-input))))
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define clusters.
(setq cluster1 "cluster1"
@@ -688,7 +686,8 @@ guaranteed by the originator of a cluster definition."
,cluster1 ,cluster2 ,(kbd "RET")))
(with-temp-buffer
(set-visited-file-name nil)
- (call-interactively 'shadow-define-regexp-group))
+ (call-interactively #'shadow-define-regexp-group)
+ (set-buffer-modified-p nil))
;; `shadow-regexp-groups' is a list of lists.
(should (consp shadow-regexp-groups))
@@ -707,10 +706,7 @@ guaranteed by the originator of a cluster definition."
(car shadow-regexp-groups))))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file)))))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test08-shadow-todo ()
"Check that needed shadows are added to todo."
@@ -722,28 +718,37 @@ guaranteed by the originator of a cluster definition."
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
+ (shadow-test-remote-temporary-file-directory
+ (file-truename shadow-test-remote-temporary-file-directory))
shadow-clusters shadow-literal-groups shadow-regexp-groups
shadow-files-to-copy
cluster1 cluster2 primary regexp file)
(unwind-protect
(progn
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
+
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define clusters.
(setq cluster1 "cluster1"
primary shadow-system-name
regexp (shadow-regexp-superquote primary))
(shadow-set-cluster cluster1 primary regexp)
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s %s %s"
+ cluster1 primary regexp shadow-clusters))
(setq cluster2 "cluster2"
primary
(file-remote-p shadow-test-remote-temporary-file-directory)
regexp (shadow-regexp-superquote primary))
(shadow-set-cluster cluster2 primary regexp)
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s %s %s"
+ cluster2 primary regexp shadow-clusters))
;; Define a literal group.
(setq file
@@ -751,12 +756,20 @@ guaranteed by the originator of a cluster definition."
(expand-file-name "shadowfile-tests" temporary-file-directory))
shadow-literal-groups
`((,(concat "/cluster1:" file) ,(concat "/cluster2:" file))))
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s" file shadow-literal-groups))
;; Save file from "cluster1" definition.
(with-temp-buffer
(set-visited-file-name file)
(insert "foo")
(save-buffer))
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s"
+ (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
+ shadow-files-to-copy))
(should
(member
(cons file (shadow-contract-file-name (concat "/cluster2:" file)))
@@ -767,6 +780,13 @@ guaranteed by the originator of a cluster definition."
(set-visited-file-name (concat (shadow-site-primary cluster2)
file))
(insert "foo")
(save-buffer))
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s"
+ (cons
+ (concat (shadow-site-primary cluster2) file)
+ (shadow-contract-file-name (concat "/cluster1:" file)))
+ shadow-files-to-copy))
(should
(member
(cons
@@ -781,12 +801,20 @@ guaranteed by the originator of a cluster definition."
(shadow-regexp-superquote file))
,(concat (shadow-site-primary cluster2)
(shadow-regexp-superquote file)))))
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s" file shadow-regexp-groups))
;; Save file from "cluster1" definition.
(with-temp-buffer
(set-visited-file-name file)
(insert "foo")
(save-buffer))
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s"
+ (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
+ shadow-files-to-copy))
(should
(member
(cons file (shadow-contract-file-name (concat "/cluster2:" file)))
@@ -797,6 +825,13 @@ guaranteed by the originator of a cluster definition."
(set-visited-file-name (concat (shadow-site-primary cluster2)
file))
(insert "foo")
(save-buffer))
+ (when shadow-debug
+ (message
+ "shadow-test08-shadow-todo: %s %s"
+ (cons
+ (concat (shadow-site-primary cluster2) file)
+ (shadow-contract-file-name (concat "/cluster1:" file)))
+ shadow-files-to-copy))
(should
(member
(cons
@@ -805,16 +840,13 @@ guaranteed by the originator of a cluster definition."
shadow-files-to-copy)))
;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
- (ignore-errors
- (when (file-exists-p file)
- (delete-file file)))
- (ignore-errors
- (when (file-exists-p (concat (shadow-site-primary cluster2) file))
- (delete-file (concat (shadow-site-primary cluster2) file)))))))
+ (dolist (elt `(,file ,(concat (shadow-site-primary cluster2) file)))
+ (ignore-errors
+ (with-current-buffer (get-file-buffer elt)
+ (set-buffer-modified-p nil)
+ (kill-buffer)))
+ (ignore-errors (delete-file elt)))
+ (shadow--tests-cleanup))))
(ert-deftest shadow-test09-shadow-copy-files ()
"Check that needed shadow files are copied."
@@ -826,18 +858,17 @@ guaranteed by the originator of a cluster definition."
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
+ (shadow-test-remote-temporary-file-directory
+ (file-truename shadow-test-remote-temporary-file-directory))
(shadow-noquery t)
shadow-clusters shadow-files-to-copy
cluster1 cluster2 primary regexp file mocked-input)
(unwind-protect
(progn
- ;; Cleanup.
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
- (when (buffer-live-p shadow-todo-buffer)
- (with-current-buffer shadow-todo-buffer (erase-buffer)))
+
+ ;; Cleanup & initialize.
+ (shadow--tests-cleanup)
+ (shadow-initialize)
;; Define clusters.
(setq cluster1 "cluster1"
@@ -878,7 +909,7 @@ guaranteed by the originator of a cluster definition."
;; We must mock `write-region', in order to check proper
;; action.
(add-function
- :before (symbol-function 'write-region)
+ :before (symbol-function #'write-region)
(lambda (&rest args)
(when (and (buffer-file-name) mocked-input)
(should (equal (buffer-file-name) (pop mocked-input)))))
@@ -893,17 +924,14 @@ guaranteed by the originator of a cluster definition."
(looking-at (regexp-quote "(setq shadow-files-to-copy nil)")))))
;; Cleanup.
- (remove-function (symbol-function 'write-region) "write-region-mock")
- (when (file-exists-p shadow-info-file)
- (delete-file shadow-info-file))
- (when (file-exists-p shadow-todo-file)
- (delete-file shadow-todo-file))
- (ignore-errors
- (when (file-exists-p file)
- (delete-file file)))
- (ignore-errors
- (when (file-exists-p (concat (shadow-site-primary cluster2) file))
- (delete-file (concat (shadow-site-primary cluster2) file)))))))
+ (remove-function (symbol-function #'write-region) "write-region-mock")
+ (dolist (elt `(,file ,(concat (shadow-site-primary cluster2) file)))
+ (ignore-errors
+ (with-current-buffer (get-file-buffer elt)
+ (set-buffer-modified-p nil)
+ (kill-buffer)))
+ (ignore-errors (delete-file elt)))
+ (shadow--tests-cleanup))))
(defun shadowfile-test-all (&optional interactive)
"Run all tests for \\[shadowfile]."
@@ -912,9 +940,5 @@ guaranteed by the originator of a cluster definition."
(ert-run-tests-interactively "^shadowfile-")
(ert-run-tests-batch "^shadowfile-")))
-(let ((shadow-info-file shadow-test-info-file)
- (shadow-todo-file shadow-test-todo-file))
- (shadow-initialize))
-
(provide 'shadowfile-tests)
;;; shadowfile-tests.el ends here
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index a9d48e2..3a7462b 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -653,6 +653,13 @@ comparing the subr with a much slower lisp implementation."
(data-tests-check-sign (% -1 -3) (% nb1 nb3))
(data-tests-check-sign (mod -1 -3) (mod nb1 nb3))))
+(ert-deftest data-tests-mod-0 ()
+ (dolist (num (list (1- most-negative-fixnum) -1 0 1
+ (1+ most-positive-fixnum)))
+ (should-error (mod num 0)))
+ (when (ignore-errors (/ 0.0 0))
+ (should (equal (abs (mod 0.0 0)) (abs (- 0.0 (/ 0.0 0)))))))
+
(ert-deftest data-tests-ash-lsh ()
(should (= (ash most-negative-fixnum 1)
(* most-negative-fixnum 2)))
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 82b75b1..ba5bfe0 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -220,4 +220,7 @@ literals (Bug#20852)."
(* most-positive-fixnum most-positive-fixnum)))
(should (= n (string-to-number (format "%d." n))))))
+(ert-deftest lread-circular-hash ()
+ (should-error (read "#s(hash-table data #0=(#0# . #0#))")))
+
;;; lread-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 7745fcc..158c036 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
+(require 'puny)
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
@@ -154,24 +155,30 @@
(concat invocation-directory invocation-name)
"-Q" "--batch" "--eval"
(prin1-to-string
- '(let (s)
- (while (setq s (read-from-minibuffer "$ "))
+ '(let ((s nil) (count 0))
+ (while (setq s (read-from-minibuffer
+ (format "%d> " count)))
(princ s)
- (princ "\n")))))))
+ (princ "\n")
+ (setq count (1+ count))))))))
(set-process-query-on-exit-flag proc nil)
(send-string proc "one\n")
- (should
- (accept-process-output proc 1)) ; Read "one".
- (should (equal (buffer-string) "$ one\n$ "))
+ (while (not (equal (buffer-substring
+ (line-beginning-position) (point-max))
+ "1> "))
+ (accept-process-output proc)) ; Read "one".
+ (should (equal (buffer-string) "0> one\n1> "))
(set-process-filter proc t) ; Stop reading from proc.
(send-string proc "two\n")
(should-not
(accept-process-output proc 1)) ; Can't read "two" yet.
- (should (equal (buffer-string) "$ one\n$ "))
+ (should (equal (buffer-string) "0> one\n1> "))
(set-process-filter proc nil) ; Resume reading from proc.
- (should
- (accept-process-output proc 1)) ; Read "two" from proc.
- (should (equal (buffer-string) "$ one\n$ two\n$ ")))))
+ (while (not (equal (buffer-substring
+ (line-beginning-position) (point-max))
+ "2> "))
+ (accept-process-output proc)) ; Read "Two".
+ (should (equal (buffer-string) "0> one\n1> two\n2> ")))))
(ert-deftest start-process-should-not-modify-arguments ()
"`start-process' must not modify its arguments in-place."
@@ -322,5 +329,41 @@ See Bug#30460."
invocation-directory))
:stop t)))
+;; All the following tests require working DNS, which appears not to
+;; be the case for hydra.nixos.org, so disable them there for now.
+
+(ert-deftest lookup-family-specification ()
+ "network-lookup-address-info should only accept valid family symbols."
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (should-error (network-lookup-address-info "google.com" 'both))
+ (should (network-lookup-address-info "google.com" 'ipv4))
+ (should (network-lookup-address-info "google.com" 'ipv6)))
+
+(ert-deftest lookup-unicode-domains ()
+ "Unicode domains should fail"
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (should-error (network-lookup-address-info "faß.de"))
+ (should (network-lookup-address-info (puny-encode-domain "faß.de"))))
+
+(ert-deftest unibyte-domain-name ()
+ "Unibyte domain names should work"
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (should (network-lookup-address-info (string-to-unibyte "google.com"))))
+
+(ert-deftest lookup-google ()
+ "Check that we can look up google IP addresses"
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (let ((addresses-both (network-lookup-address-info "google.com"))
+ (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))
+ (addresses-v6 (network-lookup-address-info "google.com" 'ipv6)))
+ (should addresses-both)
+ (should addresses-v4)
+ (should addresses-v6)))
+
+(ert-deftest non-existent-lookup-failure ()
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ "Check that looking up non-existent domain returns nil"
+ (should (eq nil (network-lookup-address-info "emacs.invalid"))))
+
(provide 'process-tests)
;; process-tests.el ends here.
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index a30b2de..3a18a4a 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -19,6 +19,12 @@
(require 'ert)
+(defun timefns-tests--decode-time (look zone decoded-time)
+ (should (equal (decode-time look zone t) decoded-time))
+ (should (equal (decode-time look zone 'integer)
+ (cons (time-convert (car decoded-time) 'integer)
+ (cdr decoded-time)))))
+
;;; 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.
@@ -40,31 +46,29 @@
(7879679999900 . 100000)
(78796799999999999999 . 1000000000000)))
;; UTC.
- (let ((sec (time-add 59 (time-subtract (time-convert look t)
- (time-convert look 'integer)))))
+ (let* ((look-ticks-hz (time-convert look t))
+ (hz (cdr look-ticks-hz))
+ (look-integer (time-convert look 'integer))
+ (sec (time-add (time-convert 59 hz)
+ (time-subtract look-ticks-hz
+ (time-convert look-integer hz)))))
(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 'integer)
- '(59 59 23 30 6 1972 5 nil 0)))
- (should (equal (decode-time look t t)
- (list sec 59 23 30 6 1972 5 nil 0)))
+ (timefns-tests--decode-time look t
+ (list sec 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" 'integer)
- '(59 59 23 30 6 1972 5 nil 0)))
- (should (equal (decode-time look "UTC0" t)
- (list sec 59 23 30 6 1972 5 nil 0)))
+ (timefns-tests--decode-time look "UTC0"
+ (list sec 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") 'integer)
- '(59 59 15 30 6 1972 5 nil -28800)))
- (should (equal (decode-time look '(-28800 "PST") t)
- (list sec 59 15 30 6 1972 5 nil -28800)))
+ (timefns-tests--decode-time look '(-28800 "PST")
+ (list sec 59 15 30 6 1972 5 nil -28800))
;; Negative UTC offset, as a Lisp integer.
(should (string-equal
(format-time-string format look -28800)
@@ -73,18 +77,14 @@
(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 'integer)
- '(59 59 15 30 6 1972 5 nil -28800)))
- (should (equal (decode-time look -28800 t)
- (list sec 59 15 30 6 1972 5 nil -28800)))
+ (timefns-tests--decode-time look -28800
+ (list sec 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" 'integer)
- '(59 29 5 1 7 1972 6 nil 19800)))
- (should (equal (decode-time look "IST-5:30" t)
- (list sec 29 5 1 7 1972 6 nil 19800)))))))
+ (timefns-tests--decode-time look "IST-5:30"
+ (list sec 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
@@ -129,6 +129,12 @@
most-negative-fixnum most-positive-fixnum
(1- most-negative-fixnum)
(1+ most-positive-fixnum)
+ 1e1 -1e1 1e-1 -1e-1
+ 1e8 -1e8 1e-8 -1e-8
+ 1e9 -1e9 1e-9 -1e-9
+ 1e10 -1e10 1e-10 -1e-10
+ 1e16 -1e16 1e-16 -1e-16
+ 1e37 -1e37 1e-37 -1e-37
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)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 3d44231 2/2: Merge commit '74e9799bd89484b8d15bdd6597c68fc00d07e7f7',
Stephen Leake <=