aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStephen Leake2019-09-10 03:37:51 -0700
committerStephen Leake2019-09-10 03:37:51 -0700
commit3d442312889ef2d14c07282d0aff6199d00cc165 (patch)
tree74034ca2dded6ed233d0701b4cb5c10a0b5e9034
parentac1a2e260e8ece34500b5879f766b4e54ee57b94 (diff)
parent74e9799bd89484b8d15bdd6597c68fc00d07e7f7 (diff)
downloademacs-3d442312889ef2d14c07282d0aff6199d00cc165.tar.gz
emacs-3d442312889ef2d14c07282d0aff6199d00cc165.zip
Merge commit '74e9799bd89484b8d15bdd6597c68fc00d07e7f7'
-rw-r--r--.gitattributes3
-rw-r--r--ChangeLog.3551
-rw-r--r--GNUmakefile33
-rw-r--r--INSTALL3
-rw-r--r--admin/admin.el4
-rwxr-xr-xbuild-aux/install-sh13
-rw-r--r--configure.ac23
-rw-r--r--doc/emacs/building.texi11
-rw-r--r--doc/emacs/custom.texi78
-rw-r--r--doc/emacs/maintaining.texi10
-rw-r--r--doc/emacs/misc.texi12
-rw-r--r--doc/lispref/customize.texi2
-rw-r--r--doc/lispref/errors.texi6
-rw-r--r--doc/lispref/files.texi6
-rw-r--r--doc/lispref/hooks.texi3
-rw-r--r--doc/lispref/modes.texi8
-rw-r--r--doc/lispref/os.texi41
-rw-r--r--doc/lispref/processes.texi15
-rw-r--r--doc/lispref/windows.texi8
-rw-r--r--doc/misc/efaq.texi22
-rw-r--r--doc/misc/emacs-mime.texi2
-rw-r--r--doc/misc/ido.texi56
-rw-r--r--doc/misc/info.texi11
-rw-r--r--doc/misc/texinfo.tex220
-rw-r--r--doc/misc/tramp.texi110
-rw-r--r--doc/misc/url.texi3
-rw-r--r--etc/HISTORY2
-rw-r--r--etc/NEWS94
-rw-r--r--etc/NEWS.2629
-rw-r--r--etc/tutorials/TUTORIAL.ru3
-rw-r--r--lib-src/emacsclient.c47
-rw-r--r--lib-src/etags.c4
-rw-r--r--lib-src/pop.c10
-rw-r--r--lib/intprops.h91
-rw-r--r--lib/regex_internal.c11
-rw-r--r--lib/verify.h28
-rw-r--r--lisp/battery.el23
-rw-r--r--lisp/bookmark.el39
-rw-r--r--lisp/calendar/icalendar.el7
-rw-r--r--lisp/calendar/time-date.el32
-rw-r--r--lisp/cedet/ede/proj.el2
-rw-r--r--lisp/composite.el4
-rw-r--r--lisp/custom.el1
-rw-r--r--lisp/dframe.el21
-rw-r--r--lisp/dired-aux.el1
-rw-r--r--lisp/emacs-lisp/bytecomp.el2
-rw-r--r--lisp/emacs-lisp/cl-lib.el10
-rw-r--r--lisp/emacs-lisp/cl-macs.el38
-rw-r--r--lisp/emacs-lisp/easy-mmode.el38
-rw-r--r--lisp/emacs-lisp/eldoc.el19
-rw-r--r--lisp/emacs-lisp/find-func.el17
-rw-r--r--lisp/emacs-lisp/package.el25
-rw-r--r--lisp/emacs-lisp/rmc.el2
-rw-r--r--lisp/emacs-lisp/subr-x.el4
-rw-r--r--lisp/epa-file.el64
-rw-r--r--lisp/epa.el4
-rw-r--r--lisp/epg-config.el15
-rw-r--r--lisp/epg.el10
-rw-r--r--lisp/erc/erc.el19
-rw-r--r--lisp/files.el4
-rw-r--r--lisp/gnus/gnus-art.el7
-rw-r--r--lisp/gnus/gnus-start.el3
-rw-r--r--lisp/gnus/mml-sec.el8
-rw-r--r--lisp/hi-lock.el2
-rw-r--r--lisp/ibuf-ext.el3
-rw-r--r--lisp/image-mode.el10
-rw-r--r--lisp/info.el57
-rw-r--r--lisp/international/quail.el3
-rw-r--r--lisp/ldefs-boot.el201
-rw-r--r--lisp/ls-lisp.el3
-rw-r--r--lisp/macros.el14
-rw-r--r--lisp/mail/flow-fill.el3
-rw-r--r--lisp/net/browse-url.el4
-rw-r--r--lisp/net/gnutls.el37
-rw-r--r--lisp/net/net-utils.el75
-rw-r--r--lisp/net/nsm.el1133
-rw-r--r--lisp/net/shr.el9
-rw-r--r--lisp/net/tramp-sh.el14
-rw-r--r--lisp/net/tramp.el7
-rw-r--r--lisp/play/gamegrid.el3
-rw-r--r--lisp/progmodes/compile.el111
-rw-r--r--lisp/progmodes/flymake-proc.el14
-rw-r--r--lisp/progmodes/gud.el4
-rw-r--r--lisp/progmodes/hideif.el18
-rw-r--r--lisp/progmodes/prog-mode.el3
-rw-r--r--lisp/progmodes/xref.el25
-rw-r--r--lisp/ps-print.el11
-rw-r--r--lisp/recentf.el3
-rw-r--r--lisp/server.el3
-rw-r--r--lisp/shadowfile.el17
-rw-r--r--lisp/shell.el9
-rw-r--r--lisp/simple.el23
-rw-r--r--lisp/skeleton.el4
-rw-r--r--lisp/sort.el16
-rw-r--r--lisp/startup.el78
-rw-r--r--lisp/subr.el8
-rw-r--r--lisp/tar-mode.el5
-rw-r--r--lisp/textmodes/ispell.el7
-rw-r--r--lisp/tmm.el18
-rw-r--r--lisp/vc/vc-hg.el18
-rw-r--r--lisp/wid-edit.el32
-rw-r--r--lisp/window.el12
-rw-r--r--src/alloc.c146
-rw-r--r--src/bignum.c15
-rw-r--r--src/bignum.h19
-rw-r--r--src/buffer.c10
-rw-r--r--src/buffer.h671
-rw-r--r--src/coding.c5
-rw-r--r--src/composite.c7
-rw-r--r--src/conf_post.h43
-rw-r--r--src/data.c139
-rw-r--r--src/dbusbind.c37
-rw-r--r--src/emacs.c3
-rw-r--r--src/floatfns.c14
-rw-r--r--src/fns.c82
-rw-r--r--src/font.c7
-rw-r--r--src/frame.c16
-rw-r--r--src/ftfont.c2
-rw-r--r--src/ftfont.h1
-rw-r--r--src/gnutls.c215
-rw-r--r--src/image.c35
-rw-r--r--src/keyboard.c4
-rw-r--r--src/keymap.c4
-rw-r--r--src/lisp.h10
-rw-r--r--src/lread.c71
-rw-r--r--src/mini-gmp.c10
-rw-r--r--src/minibuf.c3
-rw-r--r--src/pdumper.c219
-rw-r--r--src/pdumper.h16
-rw-r--r--src/process.c104
-rw-r--r--src/sound.c6
-rw-r--r--src/sysdep.c6
-rw-r--r--src/sysstdio.h1
-rw-r--r--src/systime.h2
-rw-r--r--src/timefns.c163
-rw-r--r--src/w32.c2
-rw-r--r--src/xdisp.c20
-rw-r--r--src/xterm.c1
-rw-r--r--test/Makefile.in1
-rw-r--r--test/README3
-rw-r--r--test/lisp/autorevert-tests.el3
-rw-r--r--test/lisp/calendar/icalendar-tests.el18
-rw-r--r--test/lisp/net/nsm-tests.el69
-rw-r--r--test/lisp/net/tramp-tests.el44
-rw-r--r--test/lisp/shadowfile-tests.el272
-rw-r--r--test/src/data-tests.el7
-rw-r--r--test/src/lread-tests.el3
-rw-r--r--test/src/process-tests.el63
-rw-r--r--test/src/timefns-tests.el50
149 files changed, 4594 insertions, 2057 deletions
diff --git a/.gitattributes b/.gitattributes
index 65a943f6954..e1fd4b12a8a 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -31,9 +31,6 @@ test/manual/etags/html-src/algrthms.html whitespace=cr-at-eol
31# The todo-mode file format includes trailing whitespace. 31# The todo-mode file format includes trailing whitespace.
32*.tod[aorty] -whitespace=blank-at-eol 32*.tod[aorty] -whitespace=blank-at-eol
33 33
34# The upstream maintainer does not want to remove trailing whitespace.
35doc/misc/texinfo.tex -whitespace=blank-at-eol
36
37# Some files should not be treated as text when diffing or merging. 34# Some files should not be treated as text when diffing or merging.
38*.cur binary 35*.cur binary
39*.gpg binary 36*.gpg binary
diff --git a/ChangeLog.3 b/ChangeLog.3
index c04940257fa..747fd5627ca 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,552 @@
12019-08-29 Nicolas Petton <nicolas@petton.fr>
2
3 * etc/AUTHORS: Update.
4
52019-08-29 Nicolas Petton <nicolas@petton.fr>
62019-08-29 Nicolas Petton <nicolas@petton.fr>
7
8 * etc/NEWS: Delete temporary markup.
9
102019-08-29 Noam Postavsky <npostavs@gmail.com>
11
12 Fix process filter documentation (Bug#13400)
13
14 * doc/lispref/processes.texi (Asynchronous Processes): Note that input
15 may read when sending data as well.
16 (Output from Processes): Note that functions which send data may also
17 trigger reading from processes.
18 (Input to Processes, Filter Functions): Note that filter functions may
19 be called recursively.
20
212019-08-29 Tino Calancha <tino.calancha@gmail.com>
22
23 Fix query-replace-regexp undo feature
24
25 Ensure that non-regexp strings used with `looking-at' are quoted.
26 * lisp/replace.el (perform-replace): Quote regexp (Bug#37073).
27 * test/lisp/replace-tests.el (replace-tests-perform-replace-regexp-flag):
28 New variable.
29 (replace-tests-with-undo): Use it.
30 (query-replace-undo-bug37073): Add tests.
31
322019-08-29 Eli Zaretskii <eliz@gnu.org>
33
34 Support the new Japanese era name
35
36 * admin/unidata/NormalizationTest.txt:
37 * admin/unidata/UnicodeData.txt: Add U+32FF SQUARE ERA NAME REIWA.
38 Do not merge to master.
39
40 * test/lisp/international/ucs-normalize-tests.el
41 (ucs-normalize-tests--failing-lines-part1)
42 (ucs-normalize-tests--failing-lines-part2): Update. Do not
43 merge to master.
44
45 * etc/NEWS: Mention the change.
46
472019-08-29 Eli Zaretskii <eliz@gnu.org>
48
49 Fix a typo in char-width-table
50
51 * lisp/international/characters.el (char-width-table): Fix a
52 typo in zero-width characters.
53
542019-08-29 Eli Zaretskii <eliz@gnu.org>
55
56 Minor update in admin/notes/unicode
57
58 * admin/notes/unicode: Mention changes to be done in
59 setup-default-fontset in fontset.el. (Bug#14461)
60
612019-08-29 Noam Postavsky <npostavs@gmail.com>
62
63 Fix lisp indent infloop on unfinished strings (Bug#37045)
64
65 * lisp/emacs-lisp/lisp-mode.el (lisp-indent-calc-next): Stop trying to
66 skip over strings if we've hit the end of buffer.
67 * test/lisp/emacs-lisp/lisp-mode-tests.el
68 (lisp-indent-unfinished-string): New test.
69
702019-08-29 Eli Zaretskii <eliz@gnu.org>
71
72 Improve commentary in composite.el
73
74 * lisp/composite.el (compose-gstring-for-graphic)
75 (compose-gstring-for-terminal): Add comments that explain
76 Unicode General Category mnemonics in human-readable terms.
77 (Bug#14461)
78
792019-08-29 Eli Zaretskii <eliz@gnu.org>
80
81 Fix markup in dired-x.texi
82
83 * doc/misc/dired-x.texi (Omitting Variables)
84 (Local Variables, Shell Command Guessing)
85 (Advanced Cleaning Variables, Special Marking Function): Fix
86 markup and indexing. (Bug#14212)
87
882019-08-29 Eli Zaretskii <eliz@gnu.org>
89
90 * src/callproc.c (Fcall_process): Doc fix.
91
922019-08-29 Eli Zaretskii <eliz@gnu.org>
93
94 Improve documentation of features that use the fringes
95
96 * doc/emacs/display.texi (Fringes): Add cross-reference to
97 where indicate-empty-lines is described.
98 (Useless Whitespace): Add an @anchor for a more accurate
99 cross-reference in "Fringes".
100
1012019-08-29 Mauro Aranda <maurooaranda@gmail.com>
102
103 Fix docstrings in pong
104
105 * lisp/play/pong.el (pong-move-left pong-move-right): Refer to the
106 right bats and directions of movement. (Bug#36959)
107
1082019-08-29 Eli Zaretskii <eliz@gnu.org>
109
110 Improve doc strings of 'append-to-buffer' and friends
111
112 * lisp/simple.el (append-to-buffer, prepend-to-buffer)
113 (copy-to-buffer): Doc fixes.
114
1152019-08-29 Mauro Aranda <maurooaranda@gmail.com>
116
117 Fix octave-mode ElDoc support
118
119 * lisp/progmodes/octave.el (octave-eldoc-function-signatures): Fix the
120 regexp used, so no match happens when there is no defined function FN.
121 Also, tweak the regexp to support GNU Octave 4.2.x and newer. (Bug#36459)
122
1232019-08-29 Eli Zaretskii <eliz@gnu.org>
124
125 Avoid Groff hanging on MS-Windows when invoked by "M-x man"
126
127 * lisp/man.el (Man-build-man-command): On MS-Windows, redirect
128 stdin of 'man' to the null device, to make sure Groff exits
129 immediately after formatting the man page.
130
1312019-08-29 Philipp Stephani <p.stephani2@gmail.com>
132
133 Ignore pending_signals when checking for quits.
134
135 pending_signals is often set if no quit is pending. This results in
136 bugs in module code if the module returns but no quit is actually
137 pending.
138
139 * src/emacs-module.c (module_should_quit): Use QUITP macro to check
140 whether the caller should quit.
141
142 * src/eval.c: Remove obsolete comment.
143
1442019-08-29 Basil L. Contovounesios <contovob@tcd.ie>
145
146 Fix nnmail-expiry-wait docs and custom :types
147
148 * doc/misc/gnus.texi (Group Parameters, Expiring Mail):
149 * lisp/gnus/gnus-cus.el (gnus-group-parameters): Clarify
150 descriptions of nnmail-expiry, nnmail-expiry-wait, and
151 nnmail-expiry-wait-function.
152 * lisp/gnus/nnmail.el (nnmail-expiry-wait)
153 (nnmail-expiry-wait-function): Clarify docstrings and fix custom
154 :types (bug#36850).
155
1562019-08-29 Eli Zaretskii <eliz@gnu.org>
157
158 * lisp/simple.el (kill-do-not-save-duplicates): Doc fix. (Bug#36827)
159
1602019-08-29 Eli Zaretskii <eliz@gnu.org>
161
162 Improve documentation of debugging Lisp syntax error
163
164 * doc/lispref/debugging.texi (Syntax Errors, Excess Open)
165 (Excess Close): Name the commands invoked by the key
166 sequences. Add cross-references to appropriate sections of
167 the Emacs manual. (Bug#21385)
168
169 (cherry picked from commit faafd467a374c9398ee4668cdc173611d35693ed)
170
1712019-08-29 Noam Postavsky <npostavs@gmail.com>
172
173 Add index for "\( in strings" (Bug#25195)
174
175 * doc/emacs/programs.texi (Left Margin Paren): Add index for "\( in
176 strings".
177 * doc/lispref/positions.texi (List Motion): Add index, and cross
178 reference.
179
1802019-08-29 Martin Rudalics <rudalics@gmx.at>
181
182 Fix doc-string of 'fit-window-to-buffer' (Bug#36848)
183
184 * lisp/window.el (fit-window-to-buffer): Fix doc-string.
185
186 Suggested by Drew Adams <drew.adams@oracle.com>
187
1882019-08-29 Tino Calancha <tino.calancha@gmail.com>
189
190 Update view-mode docstring
191
192 Not all the kill commands save the text in the kill ring
193 by default (e.g. `kill-rectangle').
194 It is more precise to just say that the kill commands save
195 the text and do not change the buffer (Bug#36741).
196 * lisp/view.el (view-mode): Update docstring.
197
1982019-08-29 Noam Postavsky <npostavs@gmail.com>
199
200 Fix subproc listening when setting filter to non-t (Bug#36591)
201
202 * src/process.c (Fset_process_filter): Call add_process_read_fd
203 according to the state of process filter before it's updated. This
204 restores the correct functioning as it was before 2016-02-16 "Allow
205 setting the filter masks later". Inline the set_process_filter_masks
206 call instead of fixing it that function, because it is also called
207 from connect_network_socket, and we don't want to change the behavior
208 of that function so close to release.
209 * test/src/process-tests.el (set-process-filter-t): New test.
210
2112019-08-29 Noam Postavsky <npostavs@gmail.com>
212
213 * etc/NEWS.25: Belatedly announce rcirc-reconnect-delay.
214
2152019-08-29 Noam Postavsky <npostavs@gmail.com>
216
217 Mention term.el's \032 dir tracking in commentary (Bug#19524)
218
219 * lisp/term.el: Mention both forms of directory tracking in
220 commentary. Remove obsolete ChangeLog comments. Move more relevant
221 summary comments to the top.
222
2232019-08-29 Stefan Kangas <stefankangas@gmail.com>
224
225 Remove upload functionality of package-x from the elisp manual
226
227 Suggested by Stefan Monnier.
228 Ref: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19537#8
229
230 * doc/lispref/package.texi (Package Archives): Don't document
231 package-x upload functions in the elisp manual, since they are not
232 very commonly used. (Bug#19537)
233 * lisp/emacs-lisp/package-x.el (package-archive-upload-base)
234 (package-upload-buffer, package-upload-file): Add to the doc strings
235 any details removed from the elisp manual that would otherwise be
236 missing.
237
2382019-08-29 Nicolas Petton <nicolas@petton.fr>
239
240 * etc/AUTHORS: Update.
241
2422019-08-29 Basil L. Contovounesios <contovob@tcd.ie>
243
244 Clarify Gravatar docs
245
246 For discussion, see the following thread:
247 https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html
248 * doc/misc/gnus.texi (X-Face): Fix cross-reference.
249 (Gravatars):
250 * lisp/gnus/gnus-gravatar.el (gnus-gravatar-too-ugly):
251 * lisp/image/gravatar.el (gravatar-cache-ttl, gravatar-rating)
252 (gravatar-size): Clarify user option descriptions.
253 (gravatar-retrieve, gravatar-retrieve-synchronously): Document
254 return value.
255
2562019-08-29 Alan Mackenzie <acm@muc.de>
257
258 * doc/lispref/display.texi (Defining Faces): Say a face can't be undefined.
259
2602019-08-29 Noam Postavsky <npostavs@gmail.com>
261
262 Handle completely undecoded input in term (Bug#29918)
263
264 * lisp/term.el (term-emulate-terminal): Avoid errors if the whole
265 decoded string is eight-bit characters. Don't attempt to save the
266 string for next iteration in that case.
267 * test/lisp/term-tests.el (term-decode-partial)
268 (term-undecodable-input): New tests.
269
2702019-08-29 N. Jackson <nljlistbox2@gmail.com> (tiny change)
271
272 * doc/misc/forms.texi (Control File Format): Fix a doc error.
273
274 (Bug#36693)
275
2762019-08-29 Basil L. Contovounesios <contovob@tcd.ie>
277
278 Fix typo in package-alist docstring
279
280 Pointed out by Michael Heerdegen <michael_heerdegen@web.de>.
281 * lisp/emacs-lisp/package.el (package-alist): Fix docstring
282 grammar (bug#17403).
283
2842019-08-29 Markus Triska <triska@metalevel.at>
285
286 * doc/lispref/text.texi (Mode-Specific Indent): Fix a typo (bug#36646).
287
2882019-08-29 Eli Zaretskii <eliz@gnu.org>
289
290 Improve doc string of 'bidi-display-reordering'
291
292 * src/buffer.c (syms_of_buffer) <bidi-display-reordering>:
293 Further doc fix.
294
2952019-08-29 Stefan Kangas <stefankangas@gmail.com>
296
297 Add warning to bidi-display-reordering doc string
298
299 This explanation was given by Eli Zaretskii on emacs-devel.
300 For discussion, see:
301 https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00294.html
302
303 * src/buffer.c (syms_of_buffer): Add warning to doc string of
304 bidi-display-reordering to explain that it should only be used for
305 debugging.
306
3072019-08-29 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
308
309 Raise required librsvg version so as to match the current use
310
311 * configure.ac: Set RSVG_REQUIRED to 2.14.0 as rsvg_handle_get_dimensions
312 needs it.
313
3142019-08-29 Michael Albinus <michael.albinus@gmx.de>
315
316 * lisp/net/tramp-sh.el (tramp-inline-compress-start-size): Set nil on w32.
317
3182019-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
319
320 * lisp/progmodes/verilog-mode.el: One more ELPA Version:
321
3222019-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
323
324 * lisp/svg.el, lisp/progmodes/ada-mode.el: Fix bug#36360.
325
326 Tell package.el their version number, for better behavior w.r.t the
327 versions available in GNU ELPA
328
3292019-08-29 Eli Zaretskii <eliz@gnu.org>
330
331 Minor copyedit of "Font Lock" in user manual
332
333 * doc/emacs/display.texi (Font Lock): Make the wording about
334 "enabling Font Lock" crystal clear. (Bug#36529)
335
3362019-08-29 Eli Zaretskii <eliz@gnu.org>
337
338 Improve description of image descriptors
339
340 * doc/lispref/display.texi (Image Descriptors): More accurate
341 description of where image files are looked up. (Bug#36523)
342
3432019-08-29 Eli Zaretskii <eliz@gnu.org>
344
345 Improve documentation of secondary selections
346
347 * doc/emacs/killing.texi (Secondary Selection): Improve
348 wording. Mention that 'M-mouse-1' can be used to cancel
349 secondary selections. (Bug#36365)
350
3512019-08-29 Eli Zaretskii <eliz@gnu.org>
352
353 * src/fns.c (Fmapconcat): Doc fix. (Bug#36418)
354
3552019-08-29 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
356
357 Avoid crash inside CFCharacterSetIsLongCharacterMember (Bug#36507)
358
359 * src/macfont.m (macfont_supports_charset_and_languages_p)
360 (macfont_has_char): Don't pass integers outside the Unicode codespace to
361 CFCharacterSetIsLongCharacterMember. Do not merge to master.
362
3632019-08-29 Noam Postavsky <npostavs@gmail.com>
364
365 Fix python.el docstring (Bug#36458)
366
367 * lisp/progmodes/python.el (python-shell--prompt-calculated-output-regexp):
368 python-shell-set-prompt-regexp doesn't exist, presumably
369 python-shell-prompt-set-calculated-regexps was meant.
370
3712019-08-29 Eli Zaretskii <eliz@gnu.org>
372
373 * lisp/hi-lock.el (hi-lock-line-face-buffer): Doc fix. (Bug36448)
374
3752019-08-29 Stefan Kangas <stefankangas@gmail.com>
376
377 Fix typo in doc string of file-exists-p (bug#36408)
378
379 * src/fileio.c (Ffile_exists_p): Fix typo in doc string.
380
3812019-08-29 Juanma Barranquero <lekktu@gmail.com>
382
383 * test/lisp/url/url-file-tests.el (url-file): Fix for POSIX filenames.
384
3852019-08-29 Stefan Kangas <stefankangas@gmail.com>
386
387 Fix typo in windows.texi
388
389 * doc/lispref/windows.texi (Window History): Fix typo. (Bug#36412)
390
3912019-08-29 Basil L. Contovounesios <contovob@tcd.ie>
392
393 Clarify & update (elisp) Writing Emacs Primitives
394
395 * doc/lispref/internals.texi (Writing Emacs Primitives): Update some
396 of the sample code listings, fixing argument lists and parentheses.
397 Replace ... with @dots{}. Describe UNEVALLED special forms as
398 taking a single argument. (bug#36392)
399
4002019-08-29 Eli Zaretskii <eliz@gnu.org>
401
402 Clarify a subtle issue in the Internals chapter of lispref
403
404 * doc/lispref/internals.texi (Writing Emacs Primitives):
405 Clarify the issue with relocation of buffer or string text as
406 side effect of Lisp evaluation. (Bug#36392)
407
4082019-08-29 Noam Postavsky <npostavs@gmail.com>
409
410 Fix sgml-mode handling of quotes within parens (Bug#36347)
411
412 * lisp/textmodes/sgml-mode.el (sgml-syntax-propertize): Use
413 syntax-ppss-table if set. This is only needed on the release branch,
414 on master the caller (syntax-propertize) already does this.
415 (sgml-mode): Set syntax-ppss-table to sgml-tag-syntax-table. This
416 correctly classifies parens as punctuation, so they won't confuse the
417 parser.
418 * test/lisp/textmodes/sgml-mode-tests.el (sgml-tests--quotes-syntax):
419 New test copied from master, with two cases added for this bug.
420
4212019-08-29 Juanma Barranquero <lekktu@gmail.com>
422
423 Rename 'make-symbolic-link' argument NEWNAME to LINKNAME
424
425 * src/fileio.c (Fmake_symbolic_link): Fix docstring.
426 * doc/lispref/files.texi (Changing Files): Doc fix.
427
4282019-08-29 Robert Pluim <rpluim@gmail.com>
429
430 Check that length of data returned by sysctl is non-zero
431
432 The length of the data returned by sysctl can be zero, which was not
433 checked for. This could cause crashes, e.g. when querying
434 non-existent processes. (Bug#36279)
435
436 * src/sysdep.c (list_system_processes) [DARWIN_OS || __FreeBSD__]:
437 (system_process_attributes) [__FreeBSD__]:
438 (system_process_attributes) [DARWIN_OS]:
439 * src/filelock.c (get_boot_time) [CTL_KERN && KERN_BOOTTIME]: Check
440 for zero length data returned by sysctl.
441
4422019-08-29 Juanma Barranquero <lekktu@gmail.com>
443
444 * test/lisp/progmodes/python-tests.el (python-virt-bin): Doc fix.
445
4462019-08-29 Juanma Barranquero <lekktu@gmail.com>
447
448 Fix Python tests depending on system-type
449
450 * test/lisp/progmodes/python-tests.el (python-virt-bin): New function.
451 (python-shell-calculate-exec-path-2)
452 (python-shell-calculate-exec-path-3)
453 (python-shell-calculate-exec-path-4)
454 (python-shell-with-environment-1, python-shell-with-environment-2):
455 Use it.
456
4572019-08-29 Juanma Barranquero <lekktu@gmail.com>
458
459 Fix problem with wdired test when symlinks cannot be created.
460
461 * test/lisp/wdired-tests.el (wdired-test-symlink-name):
462 Skip test if 'make-symbolic-link' fails for whatever reason;
463 that's not what's being tested.
464
4652019-08-29 Eli Zaretskii <eliz@gnu.org>
466
467 Improve wording of documentation of click events
468
469 * doc/lispref/commands.texi (Click Events, Accessing Mouse):
470 Improve and clarify wording. (Bug#36232)
471
4722019-08-29 Mattias Engdegård <mattiase@acm.org>
473
474 Backport: Fix typo in regexp-opt example code
475
476 * doc/lispref/searching.texi (Regexp Functions):
477 Fix typo in example code (Bug#34596).
478
4792019-08-29 Stefan Kangas <stefankangas@gmail.com>
480
481 Remove outdated comment in winner.el (Bug#36185)
482
483 * lisp/winner.el: Remove outdated comment.
484
4852019-08-29 Michael Albinus <michael.albinus@gmx.de>
486
487 Fix accidential change in tramp-tests; do not merge with master
488
489 * lisp/net/trampver.el: Change version to "2.3.5.26.3".
490 (customize-package-emacs-version-alist): Add Tramp version
491 integrated in Emacs 26.3.
492
493 * test/lisp/net/tramp-tests.el (tramp-test42-auto-load):
494 Add skip for w32.
495
4962019-08-29 Juanma Barranquero <lekktu@gmail.com>
497
498 tramp-test42-auto-load: Add expected-result.
499
500 * test/lisp/net/tramp-tests.el (tramp-test42-auto-load):
501 Expect a failed result if remote file access is not enabled,
502 as it happens while doing the test on Windows.
503
5042019-08-29 Juanma Barranquero <lekktu@gmail.com>
505
506 * test/lisp/url/url-file-tests.el (url-file): Use file:///, not file://.
507
5082019-08-29 Juanma Barranquero <lekktu@gmail.com>
509
510 Fix doc of srecompile-compile-split-code (Bug#36200)
511
512 * lisp/cedet/srecode/compile.el (srecode-compile-split-code):
513 Remove leftover text from docstring.
514
5152019-08-29 Eric Abrahamsen <eric@ericabrahamsen.net>
516
517 Make sure Gnus imap group names are decoded before searching
518
519 do not merge (fix unnecessary in Emacs 27)
520
521 * lisp/gnus/nnir.el (nnir-run-imap): Ensure that non-ascii group names
522 have been fully decoded before passing them to imap search.
523
5242019-08-29 Eli Zaretskii <eliz@gnu.org>
525
526 Remove failing test erroneously added in backport
527
528 * test/src/thread-tests.el (threads-test-bug33073): Remove
529 test which cannot work on the emacs-26 branch. Do not merge
530 to master. Reported by Juanma Barranquero <lekktu@gmail.com>.
531
5322019-08-29 Juanma Barranquero <lekktu@gmail.com>
533
534 * lisp/net/sieve-manage.el (sieve-manage-parse-capability): Doc fix.
535
5362019-08-29 Nicolas Petton <nicolas@petton.fr>
537
538 Bump Emacs version to 26.2.90
539
540 * README:
541 * configure.ac:
542 * msdos/sed2v2.inp:
543 * nt/README.W32: Bump Emacs version.
544
5452019-08-29 Nicolas Petton <nicolas@petton.fr>
546
547 * etc/AUTHORS: Update.
548
5492019-08-29 Martin Rudalics <rudalics@gmx.at>
12019-06-15 Martin Rudalics <rudalics@gmx.at> 5502019-06-15 Martin Rudalics <rudalics@gmx.at>
2 551
3 Fix description of 'display-buffer-in-previous-window' again (Bug#36161) 552 Fix description of 'display-buffer-in-previous-window' again (Bug#36161)
@@ -65974,7 +66523,7 @@
65974 66523
65975This file records repository revisions from 66524This file records repository revisions from
65976commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to 66525commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
65977commit eca2677b1db94a126b6d2871526a1d6fce98353d (inclusive). 66526commit a6d0172e8330a5683517eba78356d4c70ad979d7 (inclusive).
65978See ChangeLog.1 for earlier changes. 66527See ChangeLog.1 for earlier changes.
65979 66528
65980;; Local Variables: 66529;; Local Variables:
diff --git a/GNUmakefile b/GNUmakefile
index a67624e1f73..274109ca484 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -32,6 +32,38 @@
32# But run 'autogen.sh' first, if the source was checked out directly 32# But run 'autogen.sh' first, if the source was checked out directly
33# from the repository. 33# from the repository.
34 34
35# Display help.
36
37ifeq (help,$(filter help,$(MAKECMDGOALS)))
38help:
39 @echo "NOTE: This is a brief summary of some common make targets."
40 @echo "For more detailed information, please read the files INSTALL,"
41 @echo "INSTALL.REPO, Makefile or visit this URL:"
42 @echo "http://www.gnu.org/prep/standards/html_node/Standard-Targets.html"
43 @echo ""
44 @echo "make all -- compile and build Emacs"
45 @echo "make install -- install Emacs"
46 @echo "make TAGS -- update tags tables"
47 @echo "make clean -- delete built files but preserve configuration"
48 @echo "make mostlyclean -- like 'make clean', but leave those files that"
49 @echo " usually do not need to be recompiled"
50 @echo "make distclean -- delete all build and configuration files,"
51 @echo " leave only files included in source distribution"
52 @echo "make maintainer-clean -- delete almost everything that can be regenerated"
53 @echo "make bootstrap -- delete all compiled files to force a new bootstrap"
54 @echo " from a clean slate, then build in the normal way"
55 @echo "make uninstall -- remove files installed by 'make install'"
56 @echo "make check -- run the Emacs test suite"
57 @echo "make docs -- generate Emacs documentation in info format"
58 @echo "make html -- generate documentation in html format"
59 @echo "make ps -- generate documentation in ps format"
60 @echo "make pdf -- generate documentation in pdf format "
61 @exit
62
63.PHONY: help
64
65else
66
35# If a Makefile already exists, just use it. 67# If a Makefile already exists, just use it.
36 68
37ifeq ($(wildcard Makefile),Makefile) 69ifeq ($(wildcard Makefile),Makefile)
@@ -82,3 +114,4 @@ bootstrap: Makefile
82 114
83endif 115endif
84endif 116endif
117endif
diff --git a/INSTALL b/INSTALL
index 6934022c4e5..86f9e0080c1 100644
--- a/INSTALL
+++ b/INSTALL
@@ -109,6 +109,9 @@ sections if you need to.
109 (provided you have the 'gzip' program) those installed Lisp source (.el) 109 (provided you have the 'gzip' program) those installed Lisp source (.el)
110 files that have corresponding .elc versions, as well as the Info files. 110 files that have corresponding .elc versions, as well as the Info files.
111 111
112 You can read a brief summary about common make targets:
113
114 make help
112 115
113ADDITIONAL DISTRIBUTION FILES 116ADDITIONAL DISTRIBUTION FILES
114 117
diff --git a/admin/admin.el b/admin/admin.el
index d3a477fde80..5968e32b05e 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -147,6 +147,10 @@ Root must be the root of an Emacs source tree."
147 (unless (> (length newversion) 2) ; pretest or release candidate? 147 (unless (> (length newversion) 2) ; pretest or release candidate?
148 (with-temp-buffer 148 (with-temp-buffer
149 (insert-file-contents newsfile) 149 (insert-file-contents newsfile)
150 (when (re-search-forward "^\\* [^\n]*\n+ " nil t)
151 (display-warning 'admin
152 "NEWS file contains empty sections - remove them?"))
153 (goto-char (point-min))
150 (if (re-search-forward "^\\(\\+\\+\\+ *\\|--- *\\)$" nil t) 154 (if (re-search-forward "^\\(\\+\\+\\+ *\\|--- *\\)$" nil t)
151 (display-warning 'admin 155 (display-warning 'admin
152 "NEWS file still contains temporary markup. 156 "NEWS file still contains temporary markup.
diff --git a/build-aux/install-sh b/build-aux/install-sh
index 8175c640fe6..20d8b2eaea9 100755
--- a/build-aux/install-sh
+++ b/build-aux/install-sh
@@ -451,7 +451,18 @@ do
451 trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 451 trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
452 452
453 # Copy the file name to the temp name. 453 # Copy the file name to the temp name.
454 (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && 454 (umask $cp_umask &&
455 { test -z "$stripcmd" || {
456 # Create $dsttmp read-write so that cp doesn't create it read-only,
457 # which would cause strip to fail.
458 if test -z "$doit"; then
459 : >"$dsttmp" # No need to fork-exec 'touch'.
460 else
461 $doit touch "$dsttmp"
462 fi
463 }
464 } &&
465 $doit_exec $cpprog "$src" "$dsttmp") &&
455 466
456 # and set any options; do chmod last to preserve setuid bits. 467 # and set any options; do chmod last to preserve setuid bits.
457 # 468 #
diff --git a/configure.ac b/configure.ac
index 6c83d61921e..e822b0b7b0f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1731,26 +1731,6 @@ if test "${with_sound}" != "no"; then
1731 ALSA_MODULES="alsa >= $ALSA_REQUIRED" 1731 ALSA_MODULES="alsa >= $ALSA_REQUIRED"
1732 EMACS_CHECK_MODULES([ALSA], [$ALSA_MODULES]) 1732 EMACS_CHECK_MODULES([ALSA], [$ALSA_MODULES])
1733 if test $HAVE_ALSA = yes; then 1733 if test $HAVE_ALSA = yes; then
1734 SAVE_CFLAGS="$CFLAGS"
1735 SAVE_LIBS="$LIBS"
1736 CFLAGS="$ALSA_CFLAGS $CFLAGS"
1737 LIBS="$ALSA_LIBS $LIBS"
1738 AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <asoundlib.h>]], [[snd_lib_error_set_handler (0);]])],
1739 emacs_alsa_normal=yes,
1740 emacs_alsa_normal=no)
1741 if test "$emacs_alsa_normal" != yes; then
1742 AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <alsa/asoundlib.h>]],
1743 [[snd_lib_error_set_handler (0);]])],
1744 emacs_alsa_subdir=yes,
1745 emacs_alsa_subdir=no)
1746 if test "$emacs_alsa_subdir" != yes; then
1747 AC_MSG_ERROR([pkg-config found alsa, but it does not compile. See config.log for error messages.])
1748 fi
1749 ALSA_CFLAGS="$ALSA_CFLAGS -DALSA_SUBDIR_INCLUDE"
1750 fi
1751
1752 CFLAGS="$SAVE_CFLAGS"
1753 LIBS="$SAVE_LIBS"
1754 LIBSOUND="$LIBSOUND $ALSA_LIBS" 1734 LIBSOUND="$LIBSOUND $ALSA_LIBS"
1755 CFLAGS_SOUND="$CFLAGS_SOUND $ALSA_CFLAGS" 1735 CFLAGS_SOUND="$CFLAGS_SOUND $ALSA_CFLAGS"
1756 AC_DEFINE(HAVE_ALSA, 1, [Define to 1 if ALSA is available.]) 1736 AC_DEFINE(HAVE_ALSA, 1, [Define to 1 if ALSA is available.])
@@ -3308,7 +3288,8 @@ fi
3308# Check for XRender 3288# Check for XRender
3309HAVE_XRENDER=no 3289HAVE_XRENDER=no
3310if test "${HAVE_X11}" = "yes"; then 3290if test "${HAVE_X11}" = "yes"; then
3311 AC_CHECK_LIB(Xrender, XRenderQueryExtension, HAVE_XRENDER=yes) 3291 AC_CHECK_HEADER([X11/extensions/Xrender.h],
3292 [AC_CHECK_LIB([Xrender], [XRenderQueryExtension], [HAVE_XRENDER=yes])])
3312 if test $HAVE_XRENDER = yes; then 3293 if test $HAVE_XRENDER = yes; then
3313 XRENDER_LIBS="-lXrender" 3294 XRENDER_LIBS="-lXrender"
3314 AC_SUBST(XRENDER_LIBS) 3295 AC_SUBST(XRENDER_LIBS)
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 990b82d10ed..f7809d4aa99 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
266the fringe, pointing to the current error message. If the window has 266the fringe, pointing to the current error message. If the window has
267no left fringe, such as on a text terminal, these commands scroll the 267no left fringe, such as on a text terminal, these commands scroll the
268window so that the current message is at the top of the window. If 268window so that the current message is at the top of the window. If
269you change the variable @code{compilation-context-lines} to an integer 269you change the variable @code{compilation-context-lines} to @code{t},
270value @var{n}, these commands scroll the window so that the current 270a visible arrow is inserted before column zero instead. If you change
271error message is @var{n} lines from the top, whether or not there is a 271the variable to an integer value @var{n}, these commands scroll the
272fringe; the default value, @code{nil}, gives the behavior described 272window so that the current error message is @var{n} lines from the
273above. 273top, whether or not there is a fringe; the default value, @code{nil},
274gives the behavior described above.
274 275
275@vindex compilation-error-regexp-alist 276@vindex compilation-error-regexp-alist
276@vindex grep-regexp-alist 277@vindex grep-regexp-alist
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 8fbc6c1ca08..0c2509e1cd6 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2220,28 +2220,18 @@ as a function from Lisp programs.
2220@cindex init file 2220@cindex init file
2221@cindex .emacs file 2221@cindex .emacs file
2222@cindex ~/.emacs file 2222@cindex ~/.emacs file
2223@cindex ~/.config/emacs file 2223@cindex ~/.config/emacs/init.el file
2224@cindex Emacs initialization file 2224@cindex Emacs initialization file
2225@cindex startup (init file) 2225@cindex startup (init file)
2226@cindex XDG_CONFIG_HOME
2226 2227
2227 When Emacs is started, it normally tries to load a Lisp program from 2228 When Emacs is started, it normally tries to load a Lisp program from
2228an @dfn{initialization file}, or @dfn{init file} for short. This 2229an @dfn{initialization file}, or @dfn{init file} for short. This
2229file, if it exists, specifies how to initialize Emacs for you. Emacs 2230file, if it exists, specifies how to initialize Emacs for you.
2230looks for your init file using the filenames 2231If the file @file{~/.config/emacs/init.el} exists, it is used as the
2231@file{~/.config/emacs},. @file{~/.emacs}, @file{~/.config/emacs.el}, 2232init file; otherwise Emacs may look at @file{~/.emacs.el},
2232@file{~/.emacs.el}, @file{~/.config/emacs.d/init.el} or 2233@file{~/.emacs}, @file{~/.emacs.d/init.el}, or other locations.
2233@file{~/.emacs.d/init.el}; you can choose to use any one of these 2234@xref{Find Init}.
2234names (@pxref{Find Init}). Here, @file{~/} stands for your home
2235directory.
2236
2237 While the @file{~/.emacs} and @file{~/.emacs.d/init.el} locations
2238are backward-compatible to older Emacs versions, and the rest of this
2239chapter will use them to name your initialization file, it is better practice
2240to group all of your dotfiles under @file{.config} so that if you have
2241to troubleshoot a problem that might be due to a bad init file, or
2242archive a collection of them, it can be done by renaming or
2243copying that directory. Note that the @file{.config} versions
2244don't have a leading dot on the basename part of the file.
2245 2235
2246 You can use the command line switch @samp{-q} to prevent loading 2236 You can use the command line switch @samp{-q} to prevent loading
2247your init file, and @samp{-u} (or @samp{--user}) to specify a 2237your 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}
2313 2303
2314 You can set any Lisp variable with @code{setq}, but with certain 2304 You can set any Lisp variable with @code{setq}, but with certain
2315variables @code{setq} won't do what you probably want in the 2305variables @code{setq} won't do what you probably want in the
2316@file{.emacs} file. Some variables automatically become buffer-local 2306init file. Some variables automatically become buffer-local
2317when set with @code{setq}; what you want in @file{.emacs} is to set 2307when set with @code{setq}; what you want in the init file is to set
2318the default value, using @code{setq-default}. Some customizable minor 2308the default value, using @code{setq-default}. Some customizable minor
2319mode variables do special things to enable the mode when you set them 2309mode variables do special things to enable the mode when you set them
2320with Customize, but ordinary @code{setq} won't do that; to enable the 2310with Customize, but ordinary @code{setq} won't do that; to enable the
2321mode in your @file{.emacs} file, call the minor mode command. The 2311mode in your init file, call the minor mode command. The
2322following section has examples of both of these methods. 2312following section has examples of both of these methods.
2323 2313
2324 The second argument to @code{setq} is an expression for the new 2314 The second argument to @code{setq} is an expression for the new
2325value of the variable. This can be a constant, a variable, or a 2315value of the variable. This can be a constant, a variable, or a
2326function call expression. In @file{.emacs}, constants are used most 2316function call expression. In the init file, constants are used most
2327of the time. They can be: 2317of the time. They can be:
2328 2318
2329@table @asis 2319@table @asis
@@ -2646,25 +2636,49 @@ library. @xref{Hooks}.
2646@node Find Init 2636@node Find Init
2647@subsection How Emacs Finds Your Init File 2637@subsection How Emacs Finds Your Init File
2648 2638
2649 Normally Emacs uses your home directory to find 2639 Emacs normally finds your init file in a location under your home
2650@file{~/.config/emacs} or @file{~/.emacs}; that's what @samp{~} means 2640directory. @xref{Init File}. By default this location is
2651in a file name. @xref{General Variables, HOME}. If none of 2641@file{~/.config/emacs/init.el} where @file{~/} stands for your home directory.
2652@file{~/.config/emacs}, @file{~/.emacs}, @file{~/.config/emacs.el} nor 2642This default can be overridden as described below.
2653@file{~/.emacs.el} is found, Emacs looks for 2643
2654@file{~/.config/emacs.d/init.el} or @file{~/.emacs.d/init.el} (these, 2644 If @env{XDG_CONFIG_HOME} is set in your environment, its
2655like @file{~/.emacs.el}, can be byte-compiled). 2645value replaces @file{~/.config} in the name of the default
2646init file.
2647
2648 If the default init file's parent directory does not exist but the
2649directory @file{~/.emacs.d} does exist, Emacs looks for your init file
2650using the filenames @file{~/.emacs.el}, @file{~/.emacs}, or
2651@file{~/.emacs.d/init.el}; you can choose to use any one of these
2652names. (Note that only the locations directly in your home directory
2653have a leading dot in the location's basename.) Although this is
2654backward-compatible with older Emacs versions, modern POSIX platforms
2655prefer putting your initialization files under @file{~/.config} so
2656that troubleshooting a problem that might be due to a bad init file,
2657or archiving a collection of init files, can be done by renaming that
2658directory. To help older Emacs versions find configuration files in
2659their current default locations, you can execute the following
2660Emacs Lisp code:
2661
2662@example
2663(make-symbolic-link ".config/emacs" "~/.emacs.d")
2664@end example
2656 2665
2657 However, if you run Emacs from a shell started by @code{su}, Emacs 2666 However, if you run Emacs from a shell started by @code{su} and
2667@env{XDG_CONFIG_HOME} is not set in your environment, Emacs
2658tries to find your own initialization files, not that of the user you are 2668tries to find your own initialization files, not that of the user you are
2659currently pretending to be. The idea is that you should get your own 2669currently pretending to be. The idea is that you should get your own
2660editor customizations even if you are running as the super user. 2670editor customizations even if you are running as the super user.
2661 2671
2662 More precisely, Emacs first determines which user's init file to use. 2672 More precisely, Emacs first determines which user's init file to use.
2663It gets your user name from the environment variables @env{LOGNAME} and 2673It gets your user name from the environment variables @env{LOGNAME} and
2664@env{USER}; if neither of those exists, it uses effective user-ID@. 2674@env{USER}; if neither of those exists, it uses the effective user-ID@.
2665If that user name matches the real user-ID, then Emacs uses @env{HOME}; 2675If that user name matches the real user-ID, then Emacs uses @env{HOME};
2666otherwise, it looks up the home directory corresponding to that user 2676otherwise, it looks up the home directory corresponding to that user
2667name in the system's data base of users. 2677name in the system's data base of users.
2678
2679 For brevity the rest of the Emacs documentation generally uses just
2680the current default location @file{~/.config/emacs/init.el} for the
2681init file.
2668@c LocalWords: backtab 2682@c LocalWords: backtab
2669 2683
2670@node Init Non-ASCII 2684@node Init Non-ASCII
@@ -2705,8 +2719,8 @@ Type @kbd{C-q}, followed by the key you want to bind, to insert @var{char}.
2705@subsection The Early Init File 2719@subsection The Early Init File
2706@cindex early init file 2720@cindex early init file
2707 2721
2708 Most customizations for Emacs should be put in the normal init file, 2722 Most customizations for Emacs should be put in the normal init file.
2709@file{.config/emacs} or @file{~/.config/emacs.d/init.el}. However, it is sometimes desirable 2723@xref{Init File}. However, it is sometimes desirable
2710to have customizations that take effect during Emacs startup earlier than the 2724to have customizations that take effect during Emacs startup earlier than the
2711normal init file is processed. Such customizations can be put in the early 2725normal init file is processed. Such customizations can be put in the early
2712init file, @file{~/.config/emacs.d/early-init.el} or @file{~/.emacs.d/early-init.el}. This file is loaded before the 2726init 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 c6fe29ed277..e92a959d99c 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}
679(@code{log-edit-show-diff}). 679(@code{log-edit-show-diff}).
680 680
681@kindex C-c C-w @r{(Log Edit mode)} 681@kindex C-c C-w @r{(Log Edit mode)}
682@findex log-edit-generate-changelog 682@findex log-edit-generate-changelog-from-diff
683 To help generate ChangeLog entries, type @kbd{C-c C-w} 683 To help generate ChangeLog entries, type @kbd{C-c C-w}
684(@code{log-edit-generate-changelog}), to generate skeleton ChangeLog 684(@code{log-edit-generate-changelog-from-diff}), to generate skeleton
685entries, listing all changed file and function names based on the diff 685ChangeLog entries, listing all changed file and function names based
686of the VC fileset. Consecutive entries left empty will be combined by 686on the diff of the VC fileset. Consecutive entries left empty will be
687@kbd{C-q} (@code{fill-paragraph}). 687combined by @kbd{C-q} (@code{fill-paragraph}).
688 688
689@kindex C-c C-a @r{(Log Edit mode)} 689@kindex C-c C-a @r{(Log Edit mode)}
690@findex log-edit-insert-changelog 690@findex log-edit-insert-changelog
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 5877c4b0de1..83fb8acf7c2 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -302,7 +302,10 @@ the Transport Layer Security (@acronym{TLS}) features.
302@vindex network-security-level 302@vindex network-security-level
303The @code{network-security-level} variable determines the security 303The @code{network-security-level} variable determines the security
304level that @acronym{NSM} enforces. If its value is @code{low}, no 304level that @acronym{NSM} enforces. If its value is @code{low}, no
305security checks are performed. 305security checks are performed. This is not recommended, and will
306basically mean that your network connections can't be trusted.
307However, the setting can be useful in limited circumstances, as when
308testing network issues.
306 309
307If this variable is @code{medium} (which is the default), a number of 310If this variable is @code{medium} (which is the default), a number of
308checks will be performed. If as result @acronym{NSM} determines that 311checks will be performed. If as result @acronym{NSM} determines that
@@ -325,13 +328,12 @@ The protocol network checks is controlled via the
325@code{network-security-protocol-checks} variable. 328@code{network-security-protocol-checks} variable.
326 329
327It's an alist where the first element of each association is the name 330It's an alist where the first element of each association is the name
328of the check, the second element is the security level where the check 331of the check, and the second element is the security level where the
329should be used, and the optional third element is a parameter supplied 332check should be used.
330to the check.
331 333
332An element like @code{(rc4 medium)} will result in the function 334An element like @code{(rc4 medium)} will result in the function
333@code{nsm-protocol-check--rc4} being called like thus: 335@code{nsm-protocol-check--rc4} being called like thus:
334@w{@code{(nsm-protocol-check--rc4 host port status optional-parameter)}}. 336@w{@code{(nsm-protocol-check--rc4 host port status settings)}}.
335The function should return non-@code{nil} if the connection should 337The function should return non-@code{nil} if the connection should
336proceed and @code{nil} otherwise. 338proceed and @code{nil} otherwise.
337 339
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index e4a500b069d..822066f3c54 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -418,7 +418,7 @@ already set or has been customized; otherwise, just use
418@code{set-default}. 418@code{set-default}.
419 419
420@item custom-initialize-delay 420@item custom-initialize-delay
421This functions behaves like @code{custom-initialize-set}, but it 421This function behaves like @code{custom-initialize-set}, but it
422delays the actual initialization to the next Emacs start. This should 422delays the actual initialization to the next Emacs start. This should
423be used in files that are preloaded (or for autoloaded variables), so 423be used in files that are preloaded (or for autoloaded variables), so
424that the initialization is done in the run-time context rather than 424that the initialization is done in the run-time context rather than
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index aa99b2b1a98..b25fb993990 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -140,8 +140,10 @@ emacs, The GNU Emacs Manual}.
140The message is @samp{Invalid function}. @xref{Function Indirection}. 140The message is @samp{Invalid function}. @xref{Function Indirection}.
141 141
142@item invalid-read-syntax 142@item invalid-read-syntax
143The message is @samp{Invalid read syntax}. @xref{Printed 143The message is usually @samp{Invalid read syntax}. @xref{Printed
144Representation}. 144Representation}. This error can also be raised by commands like
145@code{eval-expression} when there's text following an expression. In
146that case, the message is @samp{Trailing garbage following expression}.
145 147
146@item invalid-regexp 148@item invalid-regexp
147The message is @samp{Invalid regexp}. @xref{Regular Expressions}. 149The message is @samp{Invalid regexp}. @xref{Regular Expressions}.
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 6be5a528372..18a1f4908d6 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2822,8 +2822,10 @@ filter out a directory named @file{foo.elc}.
2822name for a particular use---typically, to hold configuration data 2822name for a particular use---typically, to hold configuration data
2823specified by the current user. Usually, such files should be located 2823specified by the current user. Usually, such files should be located
2824in the directory specified by @code{user-emacs-directory}, which is 2824in the directory specified by @code{user-emacs-directory}, which is
2825@file{~/.emacs.d} by default (@pxref{Init File}). For example, abbrev 2825typically @file{~/.config/emacs/} or @file{~/.emacs.d/} by default (@pxref{Find
2826definitions are stored by default in @file{~/.emacs.d/abbrev_defs}. 2826Init,,How Emacs Finds Your Init File, emacs, The GNU Emacs Manual}).
2827For example, abbrev definitions are stored by default in
2828@file{~/.config/emacs/abbrev_defs} or @file{~/.emacs.d/abbrev_defs}.
2827The easiest way to specify such a file name is to use the function 2829The easiest way to specify such a file name is to use the function
2828@code{locate-user-emacs-file}. 2830@code{locate-user-emacs-file}.
2829 2831
diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi
index f775aa4d4b0..4542db97306 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.).
160@item frame-auto-hide-function 160@item frame-auto-hide-function
161@xref{Quitting Windows}. 161@xref{Quitting Windows}.
162 162
163@item quit-window-hook
164@xref{Quitting Windows}.
165
163@item kill-buffer-hook 166@item kill-buffer-hook
164@itemx kill-buffer-query-functions 167@itemx kill-buffer-query-functions
165@xref{Killing Buffers}. 168@xref{Killing Buffers}.
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 764a67e3627..7185c243e24 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1783,12 +1783,12 @@ don't need any.
1783 (hungry-electric-delete t))))) 1783 (hungry-electric-delete t)))))
1784@end smallexample 1784@end smallexample
1785 1785
1786@defmac define-globalized-minor-mode global-mode mode turn-on keyword-args@dots{} 1786@defmac define-globalized-minor-mode global-mode mode turn-on keyword-args@dots{} body@dots{}
1787This defines a global toggle named @var{global-mode} whose meaning is 1787This defines a global toggle named @var{global-mode} whose meaning is
1788to enable or disable the buffer-local minor mode @var{mode} in all 1788to enable or disable the buffer-local minor mode @var{mode} in all
1789buffers. To turn on the minor mode in a buffer, it uses the function 1789buffers. It also executes the @var{body} forms. To turn on the minor
1790@var{turn-on}; to turn off the minor mode, it calls @var{mode} with 1790mode in a buffer, it uses the function @var{turn-on}; to turn off the
1791@minus{}1 as argument. 1791minor mode, it calls @var{mode} with @minus{}1 as argument.
1792 1792
1793Globally enabling the mode also affects buffers subsequently created 1793Globally enabling the mode also affects buffers subsequently created
1794by visiting files, and buffers that use a major mode other than 1794by visiting files, and buffers that use a major mode other than
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 49c07380c5f..c94e96bde82 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -473,8 +473,14 @@ the value refers to the corresponding source file.
473@end defvar 473@end defvar
474 474
475@defvar user-emacs-directory 475@defvar user-emacs-directory
476This variable holds the name of the @file{.emacs.d} directory. It is 476This variable holds the name of the Emacs default directory.
477@file{~/.emacs.d} on all platforms but MS-DOS. 477It defaults to @file{$@{XDG_CONFIG_HOME-'~/.config'@}/emacs/}
478if that directory exists and @file{~/.emacs.d/} does not exist,
479otherwise to @file{~/.emacs.d/} on all platforms but MS-DOS@.
480Here, @file{$@{XDG_CONFIG_HOME-'~/.config'@}}
481stands for the value of the environment variable @env{XDG_CONFIG_HOME}
482if that variable is set, and for @file{~/.config} otherwise.
483@xref{Find Init,,How Emacs Finds Your Init File, emacs, The GNU Emacs Manual}.
478@end defvar 484@end defvar
479 485
480@node Terminal-Specific 486@node Terminal-Specific
@@ -1346,6 +1352,8 @@ given, specifies a time to convert instead of the current time.
1346 1352
1347@emph{Warning}: Since the result is floating point, it may not be 1353@emph{Warning}: Since the result is floating point, it may not be
1348exact. Do not use this function if precise time stamps are required. 1354exact. Do not use this function if precise time stamps are required.
1355For example, on typical systems @code{(float-time '(1 . 10))} displays
1356as @samp{0.1} but is slightly greater than 1/10.
1349 1357
1350@code{time-to-seconds} is an alias for this function. 1358@code{time-to-seconds} is an alias for this function.
1351@end defun 1359@end defun
@@ -1432,8 +1440,6 @@ as traditional Gregorian years do; for example, the year number
1432 1440
1433@defun time-convert time &optional form 1441@defun time-convert time &optional form
1434This function converts a time value into a Lisp timestamp. 1442This function converts a time value into a Lisp timestamp.
1435If the time cannot be represented exactly, it is truncated
1436toward minus infinity.
1437 1443
1438The optional @var{form} argument specifies the timestamp form to be 1444The optional @var{form} argument specifies the timestamp form to be
1439returned. If @var{form} is the symbol @code{integer}, this function 1445returned. 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
1452@code{list}, this is planned to change in a future Emacs version, so 1458@code{list}, this is planned to change in a future Emacs version, so
1453callers requiring list timestamps should pass @code{list} explicitly. 1459callers requiring list timestamps should pass @code{list} explicitly.
1454 1460
1455If @var{time} already has the proper form, this function might yield 1461If @var{time} is infinite or a NaN, this function signals an error.
1456@var{time} rather than a copy. 1462Otherwise, if @var{time} cannot be represented exactly, conversion
1463truncates it toward minus infinity. When @var{form} is @code{t},
1464conversion is always exact so no truncation occurs, and the returned
1465clock resolution is no less than that of @var{time}. By way of
1466contrast, @code{float-time} can convert any Lisp time value without
1467signaling an error, although the result might not be exact.
1468@xref{Time of Day}.
1469
1470For efficiency this function might return a value that is @code{eq} to
1471@var{time}, or that otherwise shares structure with @var{time}.
1457 1472
1458Although @code{(time-convert nil nil)} is equivalent to 1473Although @code{(time-convert nil nil)} is equivalent to
1459@code{(current-time)}, the latter may be a bit faster. 1474@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.
1950 1965
1951@defun time-subtract t1 t2 1966@defun time-subtract t1 t2
1952This returns the time difference @var{t1} @minus{} @var{t2} between 1967This returns the time difference @var{t1} @minus{} @var{t2} between
1953two time values, as a time value. However, the result is a float 1968two time values, normally as a Lisp timestamp but as a float
1954if either argument is a float infinity or NaN@. 1969if either argument is infinite or a NaN@.
1970When the result is a timestamp, it is exact and its clock
1971resolution is no worse than the worse of its two arguments' resolutions.
1955If you need the difference in units 1972If you need the difference in units
1956of elapsed seconds, use @code{float-time} (@pxref{Time of Day, 1973of elapsed seconds, you can convert it with @code{time-convert} or
1957float-time}) to convert the result into seconds. 1974@code{float-time}. @xref{Time Conversion}.
1958@end defun 1975@end defun
1959 1976
1960@defun time-add t1 t2 1977@defun time-add t1 t2
1961This returns the sum of two time values, as a time value. 1978This returns the sum of two time values,
1962However, the result is a float if either argument is a float infinity or NaN@. 1979using the same conversion rules as @code{time-subtract}.
1963One argument should represent a time difference rather than a point in time, 1980One argument should represent a time difference rather than a point in time,
1964as a time value that is often just a single number of elapsed seconds. 1981as a time value that is often just a single number of elapsed seconds.
1965Here is how to add a number of seconds to a time value: 1982Here 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 21bc32e88b6..61de77d0662 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
3005@code{:@var{p}} suffix. 3005@code{:@var{p}} suffix.
3006@end defun 3006@end defun
3007 3007
3008@defun network-lookup-address-info name &optional family
3009This function is used to perform hostname lookups on @var{name}, which
3010is expected to be an ASCII-only string, otherwise an error is
3011signaled. Call @code{puny-encode-domain} on @var{name}
3012first if you wish to lookup internationalized hostnames.
3013
3014If successful it returns a list of Lisp representations of network
3015addresses, otherwise it returns @code{nil}.
3016
3017By default both IPv4 and IPv6 lookups are attempted. The optional
3018argument @var{family} controls this behavior, specifying the symbol
3019@code{ipv4} or @code{ipv6} restricts lookups to IPv4 and IPv6
3020respectively.
3021@end defun
3022
3008@node Serial Ports 3023@node Serial Ports
3009@section Communicating with Serial Ports 3024@section Communicating with Serial Ports
3010@cindex @file{/dev/tty} 3025@cindex @file{/dev/tty}
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 157f004cf3f..39d3960c9a2 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
4034With prefix argument @var{kill} non-@code{nil}, it kills the buffer 4034With prefix argument @var{kill} non-@code{nil}, it kills the buffer
4035instead of burying it. It calls the function @code{quit-restore-window} 4035instead of burying it. It calls the function @code{quit-restore-window}
4036described next to deal with the window and its buffer. 4036described next to deal with the window and its buffer.
4037
4038@vindex quit-window-hook
4039The functions in @code{quit-window-hook} are run before doing anything
4040else.
4037@end deffn 4041@end deffn
4038 4042
4039@defun quit-restore-window &optional window bury-or-kill 4043@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
4043elements of the list specified by @var{window}'s @code{quit-restore} 4047elements of the list specified by @var{window}'s @code{quit-restore}
4044parameter (@pxref{Window Parameters}). 4048parameter (@pxref{Window Parameters}).
4045 4049
4046@vindex quit-window-hook
4047The functions in @code{quit-window-hook} are run before doing anything
4048else.
4049
4050The first element of the @code{quit-restore} parameter is one of the 4050The first element of the @code{quit-restore} parameter is one of the
4051symbols @code{window}, meaning that the window has been specially 4051symbols @code{window}, meaning that the window has been specially
4052created by @code{display-buffer}; @code{frame}, a separate frame has 4052created by @code{display-buffer}; @code{frame}, a separate frame has
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 8fd3bf3a45e..e5673daf3a9 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
34itself allows free copying and redistribution. 34itself allows free copying and redistribution.
35 35
36[This version has been heavily edited since it was included in the Emacs 36[This version has been heavily edited since it was included in the Emacs
37distribution.] 37distribution in 1999.]
38@end quotation 38@end quotation
39@end copying 39@end copying
40 40
@@ -1687,11 +1687,21 @@ mode-line-format @key{RET}}) for more information on how to set and use
1687this variable. 1687this variable.
1688 1688
1689@cindex Set number capability in @code{vi} emulators 1689@cindex Set number capability in @code{vi} emulators
1690The @samp{linum} package (distributed with Emacs since version 23.1) 1690The @samp{display-line-numbers} package (added to Emacs in version
1691displays line numbers in the left margin, like the ``set number'' 169126.1) displays line numbers in the text area, before each line, like
1692capability of @code{vi}. The packages @samp{setnu} and 1692the ``set number'' capability of @samp{vi}. Customize the
1693@samp{wb-line-number} (not distributed with Emacs) also implement this 1693buffer-local variable @code{display-line-numbers} to activate this
1694feature. 1694optional display. Alternatively, you can use the
1695@code{display-line-numbers-mode} minor mode or the global
1696@code{global-display-line-numbers-mode}. When using these modes,
1697customize @code{display-line-numbers-type} with the same value as you
1698would use with @code{display-line-numbers}.
1699
1700There is also the @samp{linum} package (distributed with Emacs since
1701version 23.1) which will henceforth become obsolete. Users and
1702developers are encouraged to use @samp{display-line-numbers} instead.
1703The packages @samp{setnu} and @samp{wb-line-number} (not distributed
1704with Emacs) also implement this feature.
1695 1705
1696@node Displaying the current file name in the titlebar 1706@node Displaying the current file name in the titlebar
1697@section How can I modify the titlebar to contain the current file name? 1707@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 eb829b06124..131a358ba59 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:
1568 1568
1569(time-subtract '(905595714000000 . 1000000) 1569(time-subtract '(905595714000000 . 1000000)
1570 '(905595593000000000 . 1000000000)) 1570 '(905595593000000000 . 1000000000))
1571@result{} (121000000000 . 1000000000) 1571@result{} (121000000 . 1000000)
1572 1572
1573(days-between "Sat Sep 12 12:21:54 1998 +0200" 1573(days-between "Sat Sep 12 12:21:54 1998 +0200"
1574 "Sat Sep 07 12:21:54 1998 +0200") 1574 "Sat Sep 07 12:21:54 1998 +0200")
diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi
index 29a204cf9e2..a787b743430 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
108things with buffers and files. All the features are described here 108things with buffers and files. All the features are described here
109in detail. 109in detail.
110 110
111The @dfn{Ido} package can let you switch between buffers and visit 111The @dfn{Ido} package lets you switch between buffers and visit
112files and directories with a minimum of keystrokes. It is a superset 112files and directories with a minimum of keystrokes. It is a superset
113of Iswitchb, the interactive buffer switching package by Stephen 113of Iswitchb, the interactive buffer switching package by Stephen
114Eglen. 114Eglen.
@@ -211,7 +211,7 @@ do with various kinds of @emph{matching}: among buffers, files, and directories.
211 211
212@noindent 212@noindent
213As you type in a substring, the list of buffers or files currently 213As you type in a substring, the list of buffers or files currently
214matching the substring are displayed as you type. The list is 214matching the substring is displayed as you type. The list is
215ordered so that the most recent buffers or files visited come at 215ordered so that the most recent buffers or files visited come at
216the start of the list. 216the start of the list.
217 217
@@ -240,13 +240,13 @@ If you then press @kbd{2}:
240Buffer: 2[3]@{123456 | 123@} 240Buffer: 2[3]@{123456 | 123@}
241@end example 241@end example
242 242
243The list in @{...@} are the matching buffers, most recent first 243The items listed in @{...@} are the matching buffers, most recent
244(buffers visible in the current frame are put at the end of the list 244first (buffers visible in the current frame are put at the end of the
245by default). At any time you can select the item at the head of the 245list by default). At any time you can select the item at the head of
246list by pressing @key{RET}. You can also put the first element at the 246the list by pressing @key{RET}. You can also put the first element at
247end of the list by pressing @kbd{C-s} or @kbd{<right>}, or bring the 247the end of the list by pressing @kbd{C-s} or @key{RIGHT}, or bring
248last element to the head of the list by pressing @kbd{C-r} or 248the last element to the head of the list by pressing @kbd{C-r} or
249@kbd{<left>}. 249@key{LEFT}.
250 250
251@findex ido-complete 251@findex ido-complete
252The item in [...] indicates what can be added to your input by 252The item in [...] indicates what can be added to your input by
@@ -287,7 +287,7 @@ Buffer: 234a [No match]
287There are no matching buffers. If you press @key{RET} or @key{TAB}, 287There are no matching buffers. If you press @key{RET} or @key{TAB},
288you can be prompted to create a new buffer called @file{234a}. 288you can be prompted to create a new buffer called @file{234a}.
289 289
290Of course, where this function comes in really useful is when you can 290Of course, where this function really comes in handy is when you can
291specify the buffer using only a few keystrokes. In the above example, 291specify the buffer using only a few keystrokes. In the above example,
292the quickest way to get to the @file{123456} file would be just to 292the quickest way to get to the @file{123456} file would be just to
293type @kbd{4} and then @key{RET} (assuming there isn't any newer buffer 293type @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
305@kbd{<left>}, you can use @kbd{<up>} and @kbd{<down>} to quickly 305@kbd{<left>}, you can use @kbd{<up>} and @kbd{<down>} to quickly
306scroll the list to the next or previous subdirectory. 306scroll the list to the next or previous subdirectory.
307 307
308To go down into a subdirectory, and continue the file selection on 308To go down into a subdirectory and continue the file selection on
309the files in that directory, simply move the directory to the head 309the files in that directory, simply move the directory to the head
310of the list and hit @key{RET}. 310of the list and hit @key{RET}.
311 311
@@ -366,9 +366,9 @@ If for some reason you cannot specify the proper file using
366@noindent 366@noindent
367The standard way of completion with *nix shells and Emacs is to insert 367The standard way of completion with *nix shells and Emacs is to insert
368a @dfn{prefix} and then hitting @key{TAB} (or another completion key). 368a @dfn{prefix} and then hitting @key{TAB} (or another completion key).
369Cause of this behavior has become second nature to a lot of Emacs 369Because this behavior has become second nature to a lot of Emacs
370users Ido offers in addition to the default substring matching method 370users, Ido offers, in addition to the default substring matching method
371(look above) also the prefix matching method. The kind of matching is 371(see above), also the prefix matching method. The kind of matching is
372the only difference to the description of the substring matching 372the only difference to the description of the substring matching
373above. 373above.
374 374
@@ -425,7 +425,7 @@ matching. The value of this user option can be toggled within
425ido-mode using @code{ido-toggle-regexp}. 425ido-mode using @code{ido-toggle-regexp}.
426@end defopt 426@end defopt
427 427
428@strong{Please notice:} Ido-style completion is inhibited when you 428@strong{Please note:} Ido-style completion is inhibited when you
429enable regexp matching. 429enable regexp matching.
430 430
431@node Highlighting 431@node Highlighting
@@ -438,21 +438,21 @@ The highlighting of matching items is controlled via
438@code{ido-use-faces}. The faces used are @code{ido-first-match}, 438@code{ido-use-faces}. The faces used are @code{ido-first-match},
439@code{ido-only-match} and @code{ido-subdir}. 439@code{ido-only-match} and @code{ido-subdir}.
440 440
441Coloring of the matching item was suggested by Carsten Dominik. 441Coloring of the matching items was suggested by Carsten Dominik.
442 442
443@node Hidden Buffers and Files 443@node Hidden Buffers and Files
444@chapter Hidden Buffers and Files 444@chapter Hidden Buffers and Files
445@cindex hidden buffers and files 445@cindex hidden buffers and files
446 446
447Normally, Ido does not include hidden buffers (whose name starts with 447Normally, Ido does not include hidden buffers (whose names start with
448a space) and hidden files and directories (whose name starts with 448a space) and hidden files and directories (whose names start with
449@samp{.}) in the list of possible completions. However, if the 449@file{.}) in the list of possible completions. However, if the
450substring you enter does not match any of the visible buffers or 450substring you enter does not match any of the visible buffers or
451files, Ido will automatically look for completions among the hidden 451files, Ido will automatically look for completions among the hidden
452buffers or files. 452buffers or files.
453 453
454@findex ido-toggle-ignore 454@findex ido-toggle-ignore
455You can toggle display of the hidden buffers and files with @kbd{C-a} 455You can toggle the display of hidden buffers and files with @kbd{C-a}
456(@code{ido-toggle-ignore}). 456(@code{ido-toggle-ignore}).
457 457
458@c @deffn Command ido-toggle-ignore 458@c @deffn Command ido-toggle-ignore
@@ -525,7 +525,7 @@ deleting or rearranging elements.)
525 525
526@noindent 526@noindent
527Find File At Point, also known generally as ``ffap'', is an 527Find File At Point, also known generally as ``ffap'', is an
528intelligent system for opening files, and URLs. 528intelligent system for opening files and URLs.
529 529
530The following expression will make Ido guess the context: 530The following expression will make Ido guess the context:
531 531
@@ -552,7 +552,7 @@ a URL at point. If found, call @code{find-file-at-point} to visit it.
552 552
553@noindent 553@noindent
554Ido is capable of ignoring buffers, directories, files and extensions 554Ido is capable of ignoring buffers, directories, files and extensions
555using regular expression. 555using regular expressions.
556 556
557@defopt ido-ignore-buffers 557@defopt ido-ignore-buffers
558This variable takes a list of regular expressions for buffers to 558This variable takes a list of regular expressions for buffers to
@@ -590,7 +590,7 @@ Now you can customize @code{completion-ignored-extensions} as well.
590Go ahead and add all the useless object files, backup files, shared 590Go ahead and add all the useless object files, backup files, shared
591library files and other computing flotsam you don't want Ido to show. 591library files and other computing flotsam you don't want Ido to show.
592 592
593@strong{Please notice:} Ido will still complete the ignored elements 593@strong{Note:} Ido will still complete the ignored elements
594if it would otherwise not show any other matches. So if you type out 594if it would otherwise not show any other matches. So if you type out
595the name of an ignored file, Ido will still let you open it just fine. 595the name of an ignored file, Ido will still let you open it just fine.
596 596
@@ -718,7 +718,7 @@ packages.
718After @kbd{C-x b} (@code{ido-switch-buffer}), the buffer at the head 718After @kbd{C-x b} (@code{ido-switch-buffer}), the buffer at the head
719of the list can be killed by pressing @kbd{C-k}. If the buffer needs 719of the list can be killed by pressing @kbd{C-k}. If the buffer needs
720saving, you will be queried before the buffer is killed. @kbd{C-S-b} 720saving, you will be queried before the buffer is killed. @kbd{C-S-b}
721buries the buffer at the head of the list. 721buries the buffer at the end of the list.
722 722
723Likewise, after @kbd{C-x C-f}, you can delete (i.e., physically 723Likewise, after @kbd{C-x C-f}, you can delete (i.e., physically
724remove) the file at the head of the list with @kbd{C-k}. You will 724remove) 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.
726 726
727If you enter @kbd{C-x b} to switch to a buffer visiting a given file, 727If you enter @kbd{C-x b} to switch to a buffer visiting a given file,
728and you find that the file you are after is not in any buffer, you can 728and you find that the file you are after is not in any buffer, you can
729press @kbd{C-f} to immediately drop into @code{ido-find-file}. And 729press @kbd{C-f} to immediately drop into @code{ido-find-file}. You
730you can switch back to buffer selection with @kbd{C-b}. 730can switch back to buffer selection with @kbd{C-b}.
731 731
732@c @deffn Command ido-magic-forward-char 732@c @deffn Command ido-magic-forward-char
733@c @deffn Command ido-magic-backward-char 733@c @deffn Command ido-magic-backward-char
@@ -759,7 +759,7 @@ want Ido to behave differently from the default minibuffer resizing
759behavior, set the variable @code{ido-max-window-height}. 759behavior, set the variable @code{ido-max-window-height}.
760 760
761Also, to improve the responsiveness of Ido, the maximum number of 761Also, to improve the responsiveness of Ido, the maximum number of
762matching items is limited to 12, but you can increase or removed this 762matching items is limited to 12, but you can increase or remove this
763limit via the @code{ido-max-prospects} user option. 763limit via the @code{ido-max-prospects} user option.
764 764
765@c @defopt ido-max-prospects 765@c @defopt ido-max-prospects
@@ -774,7 +774,7 @@ this separate buffer.
774 774
775@noindent 775@noindent
776@code{ido-read-buffer} and @code{ido-read-file-name} have been written 776@code{ido-read-buffer} and @code{ido-read-file-name} have been written
777to be drop in replacements for the normal buffer and file name reading 777to be drop-in replacements for the normal buffer and file name reading
778functions @code{read-buffer} and @code{read-file-name}. 778functions @code{read-buffer} and @code{read-file-name}.
779 779
780To use ido for all buffer and file selections in Emacs, customize the 780To 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 e69779a03ca..077e83e3c90 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
886to revisit nodes in the history list in the forward direction, so that 886to revisit nodes in the history list in the forward direction, so that
887@kbd{r} will return you to the node you came from by typing @kbd{l}. 887@kbd{r} will return you to the node you came from by typing @kbd{l}.
888 888
889@cindex using tool-bar to navigate history
890 Clicking the mouse on the left arrow icon in the tool-bar while
891holding down the @key{CTRL} key in Emacs opens a menu of previously
892visited nodes: the same nodes that you can revisit by
893@code{Info-history-back}. Selecting a node after clicking on the
894right arrow icon revisits the same nodes as available by
895@code{Info-history-forward}.
896
889@kindex L @r{(Info mode)} 897@kindex L @r{(Info mode)}
890@findex Info-history 898@findex Info-history
891@cindex history list of visited nodes 899@cindex history list of visited nodes
@@ -929,10 +937,9 @@ is @code{Info-top-node}.
929@section Quitting Info 937@section Quitting Info
930 938
931@kindex q @r{(Info mode)} 939@kindex q @r{(Info mode)}
932@findex Info-exit
933@cindex quitting Info mode 940@cindex quitting Info mode
934 To get out of Info, back to what you were doing before, type @kbd{q} 941 To get out of Info, back to what you were doing before, type @kbd{q}
935for @dfn{Quit}. This runs @code{Info-exit} in Emacs. 942for @dfn{Quit}. This runs @code{quit-window} in Emacs.
936 943
937 This is the end of the basic course on using Info. You have learned 944 This is the end of the basic course on using Info. You have learned
938how to move in an Info document, and how to follow menus and cross 945how 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 ed3f0ee98f4..d2e895f3628 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -1,9 +1,9 @@
1% texinfo.tex -- TeX macros to handle Texinfo files. 1% texinfo.tex -- TeX macros to handle Texinfo files.
2% 2%
3% Load plain if necessary, i.e., if running under initex. 3% Load plain if necessary, i.e., if running under initex.
4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi 4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
5% 5%
6\def\texinfoversion{2019-06-01.23} 6\def\texinfoversion{2019-08-18.20}
7% 7%
8% Copyright 1985, 1986, 1988, 1990-2019 Free Software Foundation, Inc. 8% Copyright 1985, 1986, 1988, 1990-2019 Free Software Foundation, Inc.
9% 9%
@@ -218,7 +218,7 @@
218% @errormsg{MSG}. Do the index-like expansions on MSG, but if things 218% @errormsg{MSG}. Do the index-like expansions on MSG, but if things
219% aren't perfect, it's not the end of the world, being an error message, 219% aren't perfect, it's not the end of the world, being an error message,
220% after all. 220% after all.
221% 221%
222\def\errormsg{\begingroup \indexnofonts \doerrormsg} 222\def\errormsg{\begingroup \indexnofonts \doerrormsg}
223\def\doerrormsg#1{\errmessage{#1}} 223\def\doerrormsg#1{\errmessage{#1}}
224 224
@@ -323,9 +323,9 @@
323% the output routine. The saved contents are valid until we actually 323% the output routine. The saved contents are valid until we actually
324% \shipout a page. 324% \shipout a page.
325% 325%
326% (We used to run a short output routine to actually set \topmark and 326% (We used to run a short output routine to actually set \topmark and
327% \firstmark to the right values, but if this was called with an empty page 327% \firstmark to the right values, but if this was called with an empty page
328% containing whatsits for writing index entries, the whatsits would be thrown 328% containing whatsits for writing index entries, the whatsits would be thrown
329% away and the index auxiliary file would remain empty.) 329% away and the index auxiliary file would remain empty.)
330% 330%
331\newtoks\savedtopmark 331\newtoks\savedtopmark
@@ -365,7 +365,7 @@
365 \let\thischapterheading\thischapter 365 \let\thischapterheading\thischapter
366 \else 366 \else
367 % \thischapterheading is the same as \thischapter except it is blank 367 % \thischapterheading is the same as \thischapter except it is blank
368 % for the first page of a chapter. This is to prevent the chapter name 368 % for the first page of a chapter. This is to prevent the chapter name
369 % being shown twice. 369 % being shown twice.
370 \def\thischapterheading{}% 370 \def\thischapterheading{}%
371 \fi 371 \fi
@@ -448,7 +448,7 @@
448 }% 448 }%
449} 449}
450 450
451% First remove any @comment, then any @c comment. Pass the result on to 451% First remove any @comment, then any @c comment. Pass the result on to
452% \argcheckspaces. 452% \argcheckspaces.
453\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm} 453\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm}
454\def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm} 454\def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm}
@@ -1137,7 +1137,7 @@ where each line of input produces a line of output.}
1137% for display in the outlines, and in other places. Thus, we have to 1137% for display in the outlines, and in other places. Thus, we have to
1138% double any backslashes. Otherwise, a name like "\node" will be 1138% double any backslashes. Otherwise, a name like "\node" will be
1139% interpreted as a newline (\n), followed by o, d, e. Not good. 1139% interpreted as a newline (\n), followed by o, d, e. Not good.
1140% 1140%
1141% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and 1141% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and
1142% related messages. The final outcome is that it is up to the TeX user 1142% related messages. The final outcome is that it is up to the TeX user
1143% to double the backslashes and otherwise make the string valid, so 1143% to double the backslashes and otherwise make the string valid, so
@@ -1442,7 +1442,7 @@ output) for that.)}
1442 % their "best" equivalent, based on the @documentencoding. Too 1442 % their "best" equivalent, based on the @documentencoding. Too
1443 % much work for too little return. Just use the ASCII equivalents 1443 % much work for too little return. Just use the ASCII equivalents
1444 % we use for the index sort strings. 1444 % we use for the index sort strings.
1445 % 1445 %
1446 \indexnofonts 1446 \indexnofonts
1447 \setupdatafile 1447 \setupdatafile
1448 % We can have normal brace characters in the PDF outlines, unlike 1448 % We can have normal brace characters in the PDF outlines, unlike
@@ -2726,7 +2726,7 @@ end
2726} 2726}
2727 2727
2728% Commands to set the quote options. 2728% Commands to set the quote options.
2729% 2729%
2730\parseargdef\codequoteundirected{% 2730\parseargdef\codequoteundirected{%
2731 \def\temp{#1}% 2731 \def\temp{#1}%
2732 \ifx\temp\onword 2732 \ifx\temp\onword
@@ -2767,7 +2767,7 @@ end
2767% If we are in a monospaced environment, however, 1) always use \ttsl, 2767% If we are in a monospaced environment, however, 1) always use \ttsl,
2768% and 2) do not add an italic correction. 2768% and 2) do not add an italic correction.
2769\def\dosmartslant#1#2{% 2769\def\dosmartslant#1#2{%
2770 \ifusingtt 2770 \ifusingtt
2771 {{\ttsl #2}\let\next=\relax}% 2771 {{\ttsl #2}\let\next=\relax}%
2772 {\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}% 2772 {\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}%
2773 \next 2773 \next
@@ -2914,14 +2914,14 @@ end
2914 \gdef\codedash{\futurelet\next\codedashfinish} 2914 \gdef\codedash{\futurelet\next\codedashfinish}
2915 \gdef\codedashfinish{% 2915 \gdef\codedashfinish{%
2916 \normaldash % always output the dash character itself. 2916 \normaldash % always output the dash character itself.
2917 % 2917 %
2918 % Now, output a discretionary to allow a line break, unless 2918 % Now, output a discretionary to allow a line break, unless
2919 % (a) the next character is a -, or 2919 % (a) the next character is a -, or
2920 % (b) the preceding character is a -. 2920 % (b) the preceding character is a -.
2921 % E.g., given --posix, we do not want to allow a break after either -. 2921 % E.g., given --posix, we do not want to allow a break after either -.
2922 % Given --foo-bar, we do want to allow a break between the - and the b. 2922 % Given --foo-bar, we do want to allow a break between the - and the b.
2923 \ifx\next\codedash \else 2923 \ifx\next\codedash \else
2924 \ifx\codedashprev\codedash 2924 \ifx\codedashprev\codedash
2925 \else \discretionary{}{}{}\fi 2925 \else \discretionary{}{}{}\fi
2926 \fi 2926 \fi
2927 % we need the space after the = for the case when \next itself is a 2927 % we need the space after the = for the case when \next itself is a
@@ -3003,7 +3003,7 @@ end
3003 % For pdfTeX and LuaTeX 3003 % For pdfTeX and LuaTeX
3004 \ifurefurlonlylink 3004 \ifurefurlonlylink
3005 % PDF plus option to not display url, show just arg 3005 % PDF plus option to not display url, show just arg
3006 \unhbox0 3006 \unhbox0
3007 \else 3007 \else
3008 % PDF, normally display both arg and url for consistency, 3008 % PDF, normally display both arg and url for consistency,
3009 % visibility, if the pdf is eventually used to print, etc. 3009 % visibility, if the pdf is eventually used to print, etc.
@@ -3016,7 +3016,7 @@ end
3016 % For XeTeX 3016 % For XeTeX
3017 \ifurefurlonlylink 3017 \ifurefurlonlylink
3018 % PDF plus option to not display url, show just arg 3018 % PDF plus option to not display url, show just arg
3019 \unhbox0 3019 \unhbox0
3020 \else 3020 \else
3021 % PDF, normally display both arg and url for consistency, 3021 % PDF, normally display both arg and url for consistency,
3022 % visibility, if the pdf is eventually used to print, etc. 3022 % visibility, if the pdf is eventually used to print, etc.
@@ -3074,10 +3074,10 @@ end
3074 } 3074 }
3075} 3075}
3076 3076
3077% By default we'll break after the special characters, but some people like to 3077% By default we'll break after the special characters, but some people like to
3078% break before the special chars, so allow that. Also allow no breaking at 3078% break before the special chars, so allow that. Also allow no breaking at
3079% all, for manual control. 3079% all, for manual control.
3080% 3080%
3081\parseargdef\urefbreakstyle{% 3081\parseargdef\urefbreakstyle{%
3082 \def\txiarg{#1}% 3082 \def\txiarg{#1}%
3083 \ifx\txiarg\wordnone 3083 \ifx\txiarg\wordnone
@@ -3095,7 +3095,7 @@ end
3095\def\wordbefore{before} 3095\def\wordbefore{before}
3096\def\wordnone{none} 3096\def\wordnone{none}
3097 3097
3098% Allow a ragged right output to aid breaking long URL's. Putting stretch in 3098% Allow a ragged right output to aid breaking long URL's. Putting stretch in
3099% between characters of the URL doesn't look good. 3099% between characters of the URL doesn't look good.
3100\def\urefallowbreak{% 3100\def\urefallowbreak{%
3101 \hskip 0pt plus 4 em\relax 3101 \hskip 0pt plus 4 em\relax
@@ -3299,7 +3299,7 @@ end
3299% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}. 3299% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}.
3300% Ignore unless FMTNAME == tex; then it is like @iftex and @tex, 3300% Ignore unless FMTNAME == tex; then it is like @iftex and @tex,
3301% except specified as a normal braced arg, so no newlines to worry about. 3301% except specified as a normal braced arg, so no newlines to worry about.
3302% 3302%
3303\def\outfmtnametex{tex} 3303\def\outfmtnametex{tex}
3304% 3304%
3305\long\def\inlinefmt#1{\doinlinefmt #1,\finish} 3305\long\def\inlinefmt#1{\doinlinefmt #1,\finish}
@@ -3307,7 +3307,7 @@ end
3307 \def\inlinefmtname{#1}% 3307 \def\inlinefmtname{#1}%
3308 \ifx\inlinefmtname\outfmtnametex \ignorespaces #2\fi 3308 \ifx\inlinefmtname\outfmtnametex \ignorespaces #2\fi
3309} 3309}
3310% 3310%
3311% @inlinefmtifelse{FMTNAME,THEN-TEXT,ELSE-TEXT} expands THEN-TEXT if 3311% @inlinefmtifelse{FMTNAME,THEN-TEXT,ELSE-TEXT} expands THEN-TEXT if
3312% FMTNAME is tex, else ELSE-TEXT. 3312% FMTNAME is tex, else ELSE-TEXT.
3313\long\def\inlinefmtifelse#1{\doinlinefmtifelse #1,,,\finish} 3313\long\def\inlinefmtifelse#1{\doinlinefmtifelse #1,,,\finish}
@@ -3323,7 +3323,7 @@ end
3323% *right* brace they would have to use a command anyway, so they may as 3323% *right* brace they would have to use a command anyway, so they may as
3324% well use a command to get a left brace too. We could re-use the 3324% well use a command to get a left brace too. We could re-use the
3325% delimiter character idea from \verb, but it seems like overkill. 3325% delimiter character idea from \verb, but it seems like overkill.
3326% 3326%
3327\long\def\inlineraw{\tex \doinlineraw} 3327\long\def\inlineraw{\tex \doinlineraw}
3328\long\def\doinlineraw#1{\doinlinerawtwo #1,\finish} 3328\long\def\doinlineraw#1{\doinlinerawtwo #1,\finish}
3329\def\doinlinerawtwo#1,#2,\finish{% 3329\def\doinlinerawtwo#1,#2,\finish{%
@@ -3600,7 +3600,7 @@ end
3600% for non-CM glyphs. That is ec* for regular text and tc* for the text 3600% for non-CM glyphs. That is ec* for regular text and tc* for the text
3601% companion symbols (LaTeX TS1 encoding). Both are part of the ec 3601% companion symbols (LaTeX TS1 encoding). Both are part of the ec
3602% package and follow the same conventions. 3602% package and follow the same conventions.
3603% 3603%
3604\def\ecfont{\etcfont{e}} 3604\def\ecfont{\etcfont{e}}
3605\def\tcfont{\etcfont{t}} 3605\def\tcfont{\etcfont{t}}
3606% 3606%
@@ -3672,7 +3672,7 @@ end
3672 after the title page.}}% 3672 after the title page.}}%
3673\def\setshortcontentsaftertitlepage{% 3673\def\setshortcontentsaftertitlepage{%
3674 \errmessage{@setshortcontentsaftertitlepage has been removed as a Texinfo 3674 \errmessage{@setshortcontentsaftertitlepage has been removed as a Texinfo
3675 command; move your @shortcontents and @contents commands if you 3675 command; move your @shortcontents and @contents commands if you
3676 want the contents after the title page.}}% 3676 want the contents after the title page.}}%
3677 3677
3678\parseargdef\shorttitlepage{% 3678\parseargdef\shorttitlepage{%
@@ -3727,7 +3727,7 @@ end
3727% don't worry much about spacing, ragged right. This should be used 3727% don't worry much about spacing, ragged right. This should be used
3728% inside a \vbox, and fonts need to be set appropriately first. \par should 3728% inside a \vbox, and fonts need to be set appropriately first. \par should
3729% be specified before the end of the \vbox, since a vbox is a group. 3729% be specified before the end of the \vbox, since a vbox is a group.
3730% 3730%
3731\def\raggedtitlesettings{% 3731\def\raggedtitlesettings{%
3732 \rm 3732 \rm
3733 \hyphenpenalty=10000 3733 \hyphenpenalty=10000
@@ -4350,7 +4350,7 @@ end
4350} 4350}
4351 4351
4352% multitable-only commands. 4352% multitable-only commands.
4353% 4353%
4354% @headitem starts a heading row, which we typeset in bold. Assignments 4354% @headitem starts a heading row, which we typeset in bold. Assignments
4355% have to be global since we are inside the implicit group of an 4355% have to be global since we are inside the implicit group of an
4356% alignment entry. \everycr below resets \everytab so we don't have to 4356% alignment entry. \everycr below resets \everytab so we don't have to
@@ -4669,13 +4669,13 @@ end
4669% Like \expandablevalue, but completely expandable (the \message in the 4669% Like \expandablevalue, but completely expandable (the \message in the
4670% definition above operates at the execution level of TeX). Used when 4670% definition above operates at the execution level of TeX). Used when
4671% writing to auxiliary files, due to the expansion that \write does. 4671% writing to auxiliary files, due to the expansion that \write does.
4672% If flag is undefined, pass through an unexpanded @value command: maybe it 4672% If flag is undefined, pass through an unexpanded @value command: maybe it
4673% will be set by the time it is read back in. 4673% will be set by the time it is read back in.
4674% 4674%
4675% NB flag names containing - or _ may not work here. 4675% NB flag names containing - or _ may not work here.
4676\def\dummyvalue#1{% 4676\def\dummyvalue#1{%
4677 \expandafter\ifx\csname SET#1\endcsname\relax 4677 \expandafter\ifx\csname SET#1\endcsname\relax
4678 \noexpand\value{#1}% 4678 \string\value{#1}%
4679 \else 4679 \else
4680 \csname SET#1\endcsname 4680 \csname SET#1\endcsname
4681 \fi 4681 \fi
@@ -4693,7 +4693,7 @@ end
4693 4693
4694% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined 4694% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined
4695% with @set. 4695% with @set.
4696% 4696%
4697% To get the special treatment we need for `@end ifset,' we call 4697% To get the special treatment we need for `@end ifset,' we call
4698% \makecond and then redefine. 4698% \makecond and then redefine.
4699% 4699%
@@ -4726,7 +4726,7 @@ end
4726% without the @) is in fact defined. We can only feasibly check at the 4726% without the @) is in fact defined. We can only feasibly check at the
4727% TeX level, so something like `mathcode' is going to considered 4727% TeX level, so something like `mathcode' is going to considered
4728% defined even though it is not a Texinfo command. 4728% defined even though it is not a Texinfo command.
4729% 4729%
4730\makecond{ifcommanddefined} 4730\makecond{ifcommanddefined}
4731\def\ifcommanddefined{\parsearg{\doifcmddefined{\let\next=\ifcmddefinedfail}}} 4731\def\ifcommanddefined{\parsearg{\doifcmddefined{\let\next=\ifcmddefinedfail}}}
4732% 4732%
@@ -4834,8 +4834,8 @@ end
4834\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx} 4834\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx}
4835\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}} 4835\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}}
4836 4836
4837 4837
4838% Used for the aux, toc and index files to prevent expansion of Texinfo 4838% Used for the aux, toc and index files to prevent expansion of Texinfo
4839% commands. 4839% commands.
4840% 4840%
4841\def\atdummies{% 4841\def\atdummies{%
@@ -5180,7 +5180,7 @@ end
5180} 5180}
5181\def\defglyph#1#2{\def#1##1{#2}} % see above 5181\def\defglyph#1#2{\def#1##1{#2}} % see above
5182 5182
5183 5183
5184 5184
5185 5185
5186% #1 is the index name, #2 is the entry text. 5186% #1 is the index name, #2 is the entry text.
@@ -5207,7 +5207,7 @@ end
5207 \ifx\suffix\indexisfl\def\suffix{f1}\fi 5207 \ifx\suffix\indexisfl\def\suffix{f1}\fi
5208 % Open the file 5208 % Open the file
5209 \immediate\openout\csname#1indfile\endcsname \jobname.\suffix 5209 \immediate\openout\csname#1indfile\endcsname \jobname.\suffix
5210 % Using \immediate above here prevents an object entering into the current 5210 % Using \immediate above here prevents an object entering into the current
5211 % box, which could confound checks such as those in \safewhatsit for 5211 % box, which could confound checks such as those in \safewhatsit for
5212 % preceding skips. 5212 % preceding skips.
5213 \typeout{Writing index file \jobname.\suffix}% 5213 \typeout{Writing index file \jobname.\suffix}%
@@ -5259,7 +5259,7 @@ end
5259 \ifx\segment\isfinish 5259 \ifx\segment\isfinish
5260 \else 5260 \else
5261 % 5261 %
5262 % Fully expand the segment, throwing away any @sortas directives, and 5262 % Fully expand the segment, throwing away any @sortas directives, and
5263 % trim spaces. 5263 % trim spaces.
5264 \edef\trimmed{\segment}% 5264 \edef\trimmed{\segment}%
5265 \edef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}% 5265 \edef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}%
@@ -5317,12 +5317,12 @@ end
5317% the current value of \escapechar. 5317% the current value of \escapechar.
5318\def\escapeisbackslash{\escapechar=`\\} 5318\def\escapeisbackslash{\escapechar=`\\}
5319 5319
5320% Use \ in index files by default. texi2dvi didn't support @ as the escape 5320% Use \ in index files by default. texi2dvi didn't support @ as the escape
5321% character (as it checked for "\entry" in the files, and not "@entry"). When 5321% character (as it checked for "\entry" in the files, and not "@entry"). When
5322% the new version of texi2dvi has had a chance to become more prevalent, then 5322% the new version of texi2dvi has had a chance to become more prevalent, then
5323% the escape character can change back to @ again. This should be an easy 5323% the escape character can change back to @ again. This should be an easy
5324% change to make now because both @ and \ are only used as escape characters in 5324% change to make now because both @ and \ are only used as escape characters in
5325% index files, never standing for themselves. 5325% index files, never standing for themselves.
5326% 5326%
5327\set txiindexescapeisbackslash 5327\set txiindexescapeisbackslash
5328 5328
@@ -5342,7 +5342,7 @@ end
5342 \def\}{\rbracechar{}}% 5342 \def\}{\rbracechar{}}%
5343 \uccode`\~=`\\ \uppercase{\def~{\backslashchar{}}}% 5343 \uccode`\~=`\\ \uppercase{\def~{\backslashchar{}}}%
5344 % 5344 %
5345 % Split the entry into primary entry and any subentries, and get the index 5345 % Split the entry into primary entry and any subentries, and get the index
5346 % sort key. 5346 % sort key.
5347 \splitindexentry\indextext 5347 \splitindexentry\indextext
5348 % 5348 %
@@ -5523,18 +5523,18 @@ end
5523 \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1 5523 \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1
5524 \expandafter\ifx\csname SETtxiskipindexfileswithbackslash\endcsname\relax 5524 \expandafter\ifx\csname SETtxiskipindexfileswithbackslash\endcsname\relax
5525\errmessage{% 5525\errmessage{%
5526ERROR: A sorted index file in an obsolete format was skipped. 5526ERROR: A sorted index file in an obsolete format was skipped.
5527To fix this problem, please upgrade your version of 'texi2dvi' 5527To fix this problem, please upgrade your version of 'texi2dvi'
5528or 'texi2pdf' to that at <https://ftp.gnu.org/gnu/texinfo>. 5528or 'texi2pdf' to that at <https://ftp.gnu.org/gnu/texinfo>.
5529If you are using an old version of 'texindex' (part of the Texinfo 5529If you are using an old version of 'texindex' (part of the Texinfo
5530distribution), you may also need to upgrade to a newer version (at least 6.0). 5530distribution), you may also need to upgrade to a newer version (at least 6.0).
5531You may be able to typeset the index if you run 5531You may be able to typeset the index if you run
5532'texindex \jobname.\indexname' yourself. 5532'texindex \jobname.\indexname' yourself.
5533You could also try setting the 'txiindexescapeisbackslash' flag by 5533You could also try setting the 'txiindexescapeisbackslash' flag by
5534running a command like 5534running a command like
5535'texi2dvi -t "@set txiindexescapeisbackslash" \jobname.texi'. If you do 5535'texi2dvi -t "@set txiindexescapeisbackslash" \jobname.texi'. If you do
5536this, Texinfo will try to use index files in the old format. 5536this, Texinfo will try to use index files in the old format.
5537If you continue to have problems, deleting the index files and starting again 5537If you continue to have problems, deleting the index files and starting again
5538might help (with 'rm \jobname.?? \jobname.??s')% 5538might help (with 'rm \jobname.?? \jobname.??s')%
5539}% 5539}%
5540 \else 5540 \else
@@ -5603,7 +5603,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
5603 % bottom of a column to reduce an increase in inter-line spacing. 5603 % bottom of a column to reduce an increase in inter-line spacing.
5604 \nobreak 5604 \nobreak
5605 \vskip 0pt plus 5\baselineskip 5605 \vskip 0pt plus 5\baselineskip
5606 \penalty -300 5606 \penalty -300
5607 \vskip 0pt plus -5\baselineskip 5607 \vskip 0pt plus -5\baselineskip
5608 % 5608 %
5609 % Typeset the initial. Making this add up to a whole number of 5609 % Typeset the initial. Making this add up to a whole number of
@@ -5719,7 +5719,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
5719 \advance\dimen@ii by 1\dimen@i 5719 \advance\dimen@ii by 1\dimen@i
5720 \ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line 5720 \ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line
5721 \ifdim\dimen@ > 0.8\dimen@ii % due to long index text 5721 \ifdim\dimen@ > 0.8\dimen@ii % due to long index text
5722 % Try to split the text roughly evenly. \dimen@ will be the length of 5722 % Try to split the text roughly evenly. \dimen@ will be the length of
5723 % the first line. 5723 % the first line.
5724 \dimen@ = 0.7\dimen@ 5724 \dimen@ = 0.7\dimen@
5725 \dimen@ii = \hsize 5725 \dimen@ii = \hsize
@@ -5927,7 +5927,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
5927\newbox\balancedcolumns 5927\newbox\balancedcolumns
5928\setbox\balancedcolumns=\vbox{shouldnt see this}% 5928\setbox\balancedcolumns=\vbox{shouldnt see this}%
5929% 5929%
5930% Only called for the last of the double column material. \doublecolumnout 5930% Only called for the last of the double column material. \doublecolumnout
5931% does the others. 5931% does the others.
5932\def\balancecolumns{% 5932\def\balancecolumns{%
5933 \setbox0 = \vbox{\unvbox\PAGE}% like \box255 but more efficient, see p.120. 5933 \setbox0 = \vbox{\unvbox\PAGE}% like \box255 but more efficient, see p.120.
@@ -5955,7 +5955,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
5955 }% 5955 }%
5956 % Now the left column is in box 1, and the right column in box 3. 5956 % Now the left column is in box 1, and the right column in box 3.
5957 % 5957 %
5958 % Check whether the left column has come out higher than the page itself. 5958 % Check whether the left column has come out higher than the page itself.
5959 % (Note that we have doubled \vsize for the double columns, so 5959 % (Note that we have doubled \vsize for the double columns, so
5960 % the actual height of the page is 0.5\vsize). 5960 % the actual height of the page is 0.5\vsize).
5961 \ifdim2\ht1>\vsize 5961 \ifdim2\ht1>\vsize
@@ -6252,7 +6252,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
6252\let\top\unnumbered 6252\let\top\unnumbered
6253 6253
6254% Sections. 6254% Sections.
6255% 6255%
6256\outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz 6256\outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz
6257\def\seczzz#1{% 6257\def\seczzz#1{%
6258 \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 6258 \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1
@@ -6275,7 +6275,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
6275} 6275}
6276 6276
6277% Subsections. 6277% Subsections.
6278% 6278%
6279% normally calls numberedsubseczzz: 6279% normally calls numberedsubseczzz:
6280\outer\parseargdef\numberedsubsec{\numhead2{#1}} 6280\outer\parseargdef\numberedsubsec{\numhead2{#1}}
6281\def\numberedsubseczzz#1{% 6281\def\numberedsubseczzz#1{%
@@ -6300,7 +6300,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
6300} 6300}
6301 6301
6302% Subsubsections. 6302% Subsubsections.
6303% 6303%
6304% normally numberedsubsubseczzz: 6304% normally numberedsubsubseczzz:
6305\outer\parseargdef\numberedsubsubsec{\numhead3{#1}} 6305\outer\parseargdef\numberedsubsubsec{\numhead3{#1}}
6306\def\numberedsubsubseczzz#1{% 6306\def\numberedsubsubseczzz#1{%
@@ -7358,7 +7358,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
7358 7358
7359% @indentedblock is like @quotation, but indents only on the left and 7359% @indentedblock is like @quotation, but indents only on the left and
7360% has no optional argument. 7360% has no optional argument.
7361% 7361%
7362\makedispenvdef{indentedblock}{\indentedblockstart} 7362\makedispenvdef{indentedblock}{\indentedblockstart}
7363% 7363%
7364\def\indentedblockstart{% 7364\def\indentedblockstart{%
@@ -7658,7 +7658,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
7658% @deftypefnnewline on|off says whether the return type of typed functions 7658% @deftypefnnewline on|off says whether the return type of typed functions
7659% are printed on their own line. This affects @deftypefn, @deftypefun, 7659% are printed on their own line. This affects @deftypefn, @deftypefun,
7660% @deftypeop, and @deftypemethod. 7660% @deftypeop, and @deftypemethod.
7661% 7661%
7662\parseargdef\deftypefnnewline{% 7662\parseargdef\deftypefnnewline{%
7663 \def\temp{#1}% 7663 \def\temp{#1}%
7664 \ifx\temp\onword 7664 \ifx\temp\onword
@@ -7677,8 +7677,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
7677% \dosubind {index}{topic}{subtopic} 7677% \dosubind {index}{topic}{subtopic}
7678% 7678%
7679% If SUBTOPIC is present, precede it with a space, and call \doind. 7679% If SUBTOPIC is present, precede it with a space, and call \doind.
7680% (At some time during the 20th century, this made a two-level entry in an 7680% (At some time during the 20th century, this made a two-level entry in an
7681% index such as the operation index. Nobody seemed to notice the change in 7681% index such as the operation index. Nobody seemed to notice the change in
7682% behaviour though.) 7682% behaviour though.)
7683\def\dosubind#1#2#3{% 7683\def\dosubind#1#2#3{%
7684 \def\thirdarg{#3}% 7684 \def\thirdarg{#3}%
@@ -7853,7 +7853,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
7853 \tclose{\temp}% typeset the return type 7853 \tclose{\temp}% typeset the return type
7854 \ifrettypeownline 7854 \ifrettypeownline
7855 % put return type on its own line; prohibit line break following: 7855 % put return type on its own line; prohibit line break following:
7856 \hfil\vadjust{\nobreak}\break 7856 \hfil\vadjust{\nobreak}\break
7857 \else 7857 \else
7858 \space % type on same line, so just followed by a space 7858 \space % type on same line, so just followed by a space
7859 \fi 7859 \fi
@@ -8000,7 +8000,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8000 \scantokens{#1@comment}% 8000 \scantokens{#1@comment}%
8001 % 8001 %
8002 % The \comment is to remove the \newlinechar added by \scantokens, and 8002 % The \comment is to remove the \newlinechar added by \scantokens, and
8003 % can be noticed by \parsearg. Note \c isn't used because this means cedilla 8003 % can be noticed by \parsearg. Note \c isn't used because this means cedilla
8004 % in math mode. 8004 % in math mode.
8005} 8005}
8006 8006
@@ -8201,7 +8201,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8201% list to some hook where the argument is to be expanded. If there are 8201% list to some hook where the argument is to be expanded. If there are
8202% less than 10 arguments that hook is to be replaced by ##N where N 8202% less than 10 arguments that hook is to be replaced by ##N where N
8203% is the position in that list, that is to say the macro arguments are to be 8203% is the position in that list, that is to say the macro arguments are to be
8204% defined `a la TeX in the macro body. 8204% defined `a la TeX in the macro body.
8205% 8205%
8206% That gets used by \mbodybackslash (above). 8206% That gets used by \mbodybackslash (above).
8207% 8207%
@@ -8232,8 +8232,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8232% 8232%
8233% Read recursive and nonrecursive macro bodies. (They're different since 8233% Read recursive and nonrecursive macro bodies. (They're different since
8234% rec and nonrec macros end differently.) 8234% rec and nonrec macros end differently.)
8235% 8235%
8236% We are in \macrobodyctxt, and the \xdef causes backslashshes in the macro 8236% We are in \macrobodyctxt, and the \xdef causes backslashshes in the macro
8237% body to be transformed. 8237% body to be transformed.
8238% Set \macrobody to the body of the macro, and call \defmacro. 8238% Set \macrobody to the body of the macro, and call \defmacro.
8239% 8239%
@@ -8267,7 +8267,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8267% twice the \macarg.BLAH macros does not cost too much processing power. 8267% twice the \macarg.BLAH macros does not cost too much processing power.
8268\def\parsemmanyargdef@@#1,{% 8268\def\parsemmanyargdef@@#1,{%
8269 \if#1;\let\next=\relax 8269 \if#1;\let\next=\relax
8270 \else 8270 \else
8271 \let\next=\parsemmanyargdef@@ 8271 \let\next=\parsemmanyargdef@@
8272 \edef\tempb{\eatspaces{#1}}% 8272 \edef\tempb{\eatspaces{#1}}%
8273 \expandafter\def\expandafter\tempa 8273 \expandafter\def\expandafter\tempa
@@ -8352,7 +8352,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8352 8352
8353% Replace arguments by their values in the macro body, and place the result 8353% Replace arguments by their values in the macro body, and place the result
8354% in macro \@tempa. 8354% in macro \@tempa.
8355% 8355%
8356\def\macvalstoargs@{% 8356\def\macvalstoargs@{%
8357 % To do this we use the property that token registers that are \the'ed 8357 % To do this we use the property that token registers that are \the'ed
8358 % within an \edef expand only once. So we are going to place all argument 8358 % 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')%
8376 \expandafter\def\expandafter\@tempa\expandafter{\@tempc}% 8376 \expandafter\def\expandafter\@tempa\expandafter{\@tempc}%
8377 } 8377 }
8378 8378
8379% Define the named-macro outside of this group and then close this group. 8379% Define the named-macro outside of this group and then close this group.
8380% 8380%
8381\def\macargexpandinbody@{% 8381\def\macargexpandinbody@{%
8382 \expandafter 8382 \expandafter
8383 \endgroup 8383 \endgroup
8384 \macargdeflist@ 8384 \macargdeflist@
@@ -8416,7 +8416,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8416} 8416}
8417 8417
8418% Trailing missing arguments are set to empty. 8418% Trailing missing arguments are set to empty.
8419% 8419%
8420\def\setemptyargvalues@{% 8420\def\setemptyargvalues@{%
8421 \ifx\paramlist\nilm@ 8421 \ifx\paramlist\nilm@
8422 \let\next\macargexpandinbody@ 8422 \let\next\macargexpandinbody@
@@ -8493,7 +8493,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8493 \else % at most 9 8493 \else % at most 9
8494 \ifnum\paramno<10\relax 8494 \ifnum\paramno<10\relax
8495 % @MACNAME sets the context for reading the macro argument 8495 % @MACNAME sets the context for reading the macro argument
8496 % @MACNAME@@ gets the argument, processes backslashes and appends a 8496 % @MACNAME@@ gets the argument, processes backslashes and appends a
8497 % comma. 8497 % comma.
8498 % @MACNAME@@@ removes braces surrounding the argument list. 8498 % @MACNAME@@@ removes braces surrounding the argument list.
8499 % @MACNAME@@@@ scans the macro body with arguments substituted. 8499 % @MACNAME@@@@ scans the macro body with arguments substituted.
@@ -8537,11 +8537,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8537% Call #1 with a list of tokens #2, with any doubled backslashes in #2 8537% Call #1 with a list of tokens #2, with any doubled backslashes in #2
8538% compressed to one. 8538% compressed to one.
8539% 8539%
8540% This implementation works by expansion, and not execution (so we cannot use 8540% This implementation works by expansion, and not execution (so we cannot use
8541% \def or similar). This reduces the risk of this failing in contexts where 8541% \def or similar). This reduces the risk of this failing in contexts where
8542% complete expansion is done with no execution (for example, in writing out to 8542% complete expansion is done with no execution (for example, in writing out to
8543% an auxiliary file for an index entry). 8543% an auxiliary file for an index entry).
8544% 8544%
8545% State is kept in the input stream: the argument passed to 8545% State is kept in the input stream: the argument passed to
8546% @look_ahead, @gobble_and_check_finish and @add_segment is 8546% @look_ahead, @gobble_and_check_finish and @add_segment is
8547% 8547%
@@ -8563,11 +8563,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8563% #3 - NEXT_TOKEN 8563% #3 - NEXT_TOKEN
8564% #4 used to look ahead 8564% #4 used to look ahead
8565% 8565%
8566% If the next token is not a backslash, process the rest of the argument; 8566% If the next token is not a backslash, process the rest of the argument;
8567% otherwise, remove the next token. 8567% otherwise, remove the next token.
8568@gdef@look_ahead#1!#2#3#4{% 8568@gdef@look_ahead#1!#2#3#4{%
8569 @ifx#4\% 8569 @ifx#4\%
8570 @expandafter@gobble_and_check_finish 8570 @expandafter@gobble_and_check_finish
8571 @else 8571 @else
8572 @expandafter@add_segment 8572 @expandafter@add_segment
8573 @fi#1!{#2}#4#4% 8573 @fi#1!{#2}#4#4%
@@ -8591,9 +8591,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8591% #3 - NEXT_TOKEN 8591% #3 - NEXT_TOKEN
8592% #4 is input stream until next backslash 8592% #4 is input stream until next backslash
8593% 8593%
8594% Input stream is either at the start of the argument, or just after a 8594% Input stream is either at the start of the argument, or just after a
8595% backslash sequence, either a lone backslash, or a doubled backslash. 8595% backslash sequence, either a lone backslash, or a doubled backslash.
8596% NEXT_TOKEN contains the first token in the input stream: if it is \finish, 8596% NEXT_TOKEN contains the first token in the input stream: if it is \finish,
8597% finish; otherwise, append to ARG_RESULT the segment of the argument up until 8597% finish; otherwise, append to ARG_RESULT the segment of the argument up until
8598% the next backslash. PENDING_BACKSLASH contains a backslash to represent 8598% the next backslash. PENDING_BACKSLASH contains a backslash to represent
8599% a backslash just before the start of the input stream that has not been 8599% 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')%
8605 % append the pending backslash to the result, followed by the next segment 8605 % append the pending backslash to the result, followed by the next segment
8606 @expandafter@is_fi@look_ahead#1#2#4!{\}@fi 8606 @expandafter@is_fi@look_ahead#1#2#4!{\}@fi
8607 % this @fi is discarded by @look_ahead. 8607 % this @fi is discarded by @look_ahead.
8608 % we can't get rid of it with \expandafter because we don't know how 8608 % we can't get rid of it with \expandafter because we don't know how
8609 % long #4 is. 8609 % long #4 is.
8610} 8610}
8611 8611
8612% #1 - THE_MACRO 8612% #1 - THE_MACRO
8613% #2 - ARG_RESULT 8613% #2 - ARG_RESULT
8614% #3 discards the res of the conditional in @add_segment, and @is_fi ends the 8614% #3 discards the res of the conditional in @add_segment, and @is_fi ends the
8615% conditional. 8615% conditional.
8616@gdef@call_the_macro#1#2!#3@fi{@is_fi #1{#2}} 8616@gdef@call_the_macro#1#2!#3@fi{@is_fi #1{#2}}
8617 8617
@@ -8623,7 +8623,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8623% for reading the argument (slightly different in the two cases). Then, 8623% for reading the argument (slightly different in the two cases). Then,
8624% to read the argument, in the whole-line case, it then calls the regular 8624% to read the argument, in the whole-line case, it then calls the regular
8625% \parsearg MAC; in the lbrace case, it calls \passargtomacro MAC. 8625% \parsearg MAC; in the lbrace case, it calls \passargtomacro MAC.
8626% 8626%
8627\def\braceorline#1{\let\macnamexxx=#1\futurelet\nchar\braceorlinexxx} 8627\def\braceorline#1{\let\macnamexxx=#1\futurelet\nchar\braceorlinexxx}
8628\def\braceorlinexxx{% 8628\def\braceorlinexxx{%
8629 \ifx\nchar\bgroup 8629 \ifx\nchar\bgroup
@@ -8677,7 +8677,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8677 8677
8678% Used so that the @top node doesn't have to be wrapped in an @ifnottex 8678% Used so that the @top node doesn't have to be wrapped in an @ifnottex
8679% conditional. 8679% conditional.
8680% \doignore goes to more effort to skip nested conditionals but we don't need 8680% \doignore goes to more effort to skip nested conditionals but we don't need
8681% that here. 8681% that here.
8682\def\omittopnode{% 8682\def\omittopnode{%
8683 \ifx\lastnode\wordTop 8683 \ifx\lastnode\wordTop
@@ -8685,7 +8685,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8685} 8685}
8686\def\wordTop{Top} 8686\def\wordTop{Top}
8687 8687
8688% Until the next @node or @bye command, divert output to a box that is not 8688% Until the next @node or @bye command, divert output to a box that is not
8689% output. 8689% output.
8690\def\ignorenode{\setbox\dummybox\vbox\bgroup\def\node{\egroup\node}% 8690\def\ignorenode{\setbox\dummybox\vbox\bgroup\def\node{\egroup\node}%
8691\ignorenodebye 8691\ignorenodebye
@@ -8752,7 +8752,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8752% automatically in xrefs, if the third arg is not explicitly specified. 8752% automatically in xrefs, if the third arg is not explicitly specified.
8753% This was provided as a "secret" @set xref-automatic-section-title 8753% This was provided as a "secret" @set xref-automatic-section-title
8754% variable, now it's official. 8754% variable, now it's official.
8755% 8755%
8756\parseargdef\xrefautomaticsectiontitle{% 8756\parseargdef\xrefautomaticsectiontitle{%
8757 \def\temp{#1}% 8757 \def\temp{#1}%
8758 \ifx\temp\onword 8758 \ifx\temp\onword
@@ -8768,7 +8768,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8768 \fi\fi 8768 \fi\fi
8769} 8769}
8770 8770
8771% 8771%
8772% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is 8772% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is
8773% the node name, #2 the name of the Info cross-reference, #3 the printed 8773% the node name, #2 the name of the Info cross-reference, #3 the printed
8774% node name, #4 the name of the Info file, #5 the name of the printed 8774% 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')%
8921 \fi 8921 \fi
8922 \else 8922 \else
8923 % node/anchor (non-float) references. 8923 % node/anchor (non-float) references.
8924 % 8924 %
8925 % If we use \unhbox to print the node names, TeX does not insert 8925 % If we use \unhbox to print the node names, TeX does not insert
8926 % empty discretionaries after hyphens, which means that it will not 8926 % empty discretionaries after hyphens, which means that it will not
8927 % find a line break at a hyphen in a node names. Since some manuals 8927 % find a line break at a hyphen in a node names. Since some manuals
8928 % are best written with fairly long node names, containing hyphens, 8928 % are best written with fairly long node names, containing hyphens,
8929 % this is a loss. Therefore, we give the text of the node name 8929 % this is a loss. Therefore, we give the text of the node name
8930 % again, so it is as if TeX is seeing it for the first time. 8930 % again, so it is as if TeX is seeing it for the first time.
8931 % 8931 %
8932 \ifdim \wd\printedmanualbox > 0pt 8932 \ifdim \wd\printedmanualbox > 0pt
8933 % Cross-manual reference with a printed manual name. 8933 % Cross-manual reference with a printed manual name.
8934 % 8934 %
8935 \crossmanualxref{\cite{\printedmanual\unskip}}% 8935 \crossmanualxref{\cite{\printedmanual\unskip}}%
8936 % 8936 %
8937 \else\ifdim \wd\infofilenamebox > 0pt 8937 \else\ifdim \wd\infofilenamebox > 0pt
8938 % Cross-manual reference with only an info filename (arg 4), no 8938 % Cross-manual reference with only an info filename (arg 4), no
8939 % printed manual name (arg 5). This is essentially the same as 8939 % printed manual name (arg 5). This is essentially the same as
8940 % the case above; we output the filename, since we have nothing else. 8940 % the case above; we output the filename, since we have nothing else.
8941 % 8941 %
8942 \crossmanualxref{\code{\infofilename\unskip}}% 8942 \crossmanualxref{\code{\infofilename\unskip}}%
8943 % 8943 %
8944 \else 8944 \else
@@ -8978,20 +8978,20 @@ might help (with 'rm \jobname.?? \jobname.??s')%
8978\endgroup} 8978\endgroup}
8979 8979
8980% Output a cross-manual xref to #1. Used just above (twice). 8980% Output a cross-manual xref to #1. Used just above (twice).
8981% 8981%
8982% Only include the text "Section ``foo'' in" if the foo is neither 8982% Only include the text "Section ``foo'' in" if the foo is neither
8983% missing or Top. Thus, @xref{,,,foo,The Foo Manual} outputs simply 8983% missing or Top. Thus, @xref{,,,foo,The Foo Manual} outputs simply
8984% "see The Foo Manual", the idea being to refer to the whole manual. 8984% "see The Foo Manual", the idea being to refer to the whole manual.
8985% 8985%
8986% But, this being TeX, we can't easily compare our node name against the 8986% But, this being TeX, we can't easily compare our node name against the
8987% string "Top" while ignoring the possible spaces before and after in 8987% string "Top" while ignoring the possible spaces before and after in
8988% the input. By adding the arbitrary 7sp below, we make it much less 8988% the input. By adding the arbitrary 7sp below, we make it much less
8989% likely that a real node name would have the same width as "Top" (e.g., 8989% likely that a real node name would have the same width as "Top" (e.g.,
8990% in a monospaced font). Hopefully it will never happen in practice. 8990% in a monospaced font). Hopefully it will never happen in practice.
8991% 8991%
8992% For the same basic reason, we retypeset the "Top" at every 8992% For the same basic reason, we retypeset the "Top" at every
8993% reference, since the current font is indeterminate. 8993% reference, since the current font is indeterminate.
8994% 8994%
8995\def\crossmanualxref#1{% 8995\def\crossmanualxref#1{%
8996 \setbox\toprefbox = \hbox{Top\kern7sp}% 8996 \setbox\toprefbox = \hbox{Top\kern7sp}%
8997 \setbox2 = \hbox{\ignorespaces \printedrefname \unskip \kern7sp}% 8997 \setbox2 = \hbox{\ignorespaces \printedrefname \unskip \kern7sp}%
@@ -9038,7 +9038,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
9038 \fi\fi\fi 9038 \fi\fi\fi
9039} 9039}
9040 9040
9041% \refx{NAME}{SUFFIX} - reference a cross-reference string named NAME. SUFFIX 9041% \refx{NAME}{SUFFIX} - reference a cross-reference string named NAME. SUFFIX
9042% is output afterwards if non-empty. 9042% is output afterwards if non-empty.
9043\def\refx#1#2{% 9043\def\refx#1#2{%
9044 \requireauxfile 9044 \requireauxfile
@@ -9070,9 +9070,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
9070 #2% Output the suffix in any case. 9070 #2% Output the suffix in any case.
9071} 9071}
9072 9072
9073% This is the macro invoked by entries in the aux file. Define a control 9073% This is the macro invoked by entries in the aux file. Define a control
9074% sequence for a cross-reference target (we prepend XR to the control sequence 9074% sequence for a cross-reference target (we prepend XR to the control sequence
9075% name to avoid collisions). The value is the page number. If this is a float 9075% name to avoid collisions). The value is the page number. If this is a float
9076% type, we have more work to do. 9076% type, we have more work to do.
9077% 9077%
9078\def\xrdef#1#2{% 9078\def\xrdef#1#2{%
@@ -9088,10 +9088,10 @@ might help (with 'rm \jobname.?? \jobname.??s')%
9088 \bgroup 9088 \bgroup
9089 \expandafter\gdef\csname XR\safexrefname\endcsname{#2}% 9089 \expandafter\gdef\csname XR\safexrefname\endcsname{#2}%
9090 \egroup 9090 \egroup
9091 % We put the \gdef inside a group to avoid the definitions building up on 9091 % We put the \gdef inside a group to avoid the definitions building up on
9092 % TeX's save stack, which can cause it to run out of space for aux files with 9092 % TeX's save stack, which can cause it to run out of space for aux files with
9093 % thousands of lines. \gdef doesn't use the save stack, but \csname does 9093 % thousands of lines. \gdef doesn't use the save stack, but \csname does
9094 % when it defines an unknown control sequence as \relax. 9094 % when it defines an unknown control sequence as \relax.
9095 % 9095 %
9096 % Was that xref control sequence that we just defined for a float? 9096 % Was that xref control sequence that we just defined for a float?
9097 \expandafter\iffloat\csname XR\safexrefname\endcsname 9097 \expandafter\iffloat\csname XR\safexrefname\endcsname
@@ -9450,7 +9450,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
9450 % 9450 %
9451 \ifimagevmode 9451 \ifimagevmode
9452 \medskip % space after a standalone image 9452 \medskip % space after a standalone image
9453 \fi 9453 \fi
9454 \ifx\centersub\centerV \egroup \fi 9454 \ifx\centersub\centerV \egroup \fi
9455\endgroup} 9455\endgroup}
9456 9456
@@ -10281,7 +10281,7 @@ directory should work if nowhere else does.}
10281 \uppercase{.} 10281 \uppercase{.}
10282 \endgroup 10282 \endgroup
10283 \else 10283 \else
10284 \errhelp = \EMsimple 10284 \errhelp = \EMsimple
10285 \errmessage{Unicode character U+#1 not supported, sorry}% 10285 \errmessage{Unicode character U+#1 not supported, sorry}%
10286 \fi 10286 \fi
10287 \else 10287 \else
@@ -10314,7 +10314,7 @@ directory should work if nowhere else does.}
10314 \countUTFz = "#1\relax 10314 \countUTFz = "#1\relax
10315 \begingroup 10315 \begingroup
10316 \parseXMLCharref 10316 \parseXMLCharref
10317 10317
10318 % Give \u8:... its definition. The sequence of seven \expandafter's 10318 % Give \u8:... its definition. The sequence of seven \expandafter's
10319 % expands after the \gdef three times, e.g. 10319 % expands after the \gdef three times, e.g.
10320 % 10320 %
@@ -10326,7 +10326,7 @@ directory should work if nowhere else does.}
10326 \expandafter\expandafter 10326 \expandafter\expandafter
10327 \expandafter\expandafter 10327 \expandafter\expandafter
10328 \expandafter\gdef \UTFviiiTmp{#2}% 10328 \expandafter\gdef \UTFviiiTmp{#2}%
10329 % 10329 %
10330 \expandafter\ifx\csname uni:#1\endcsname \relax \else 10330 \expandafter\ifx\csname uni:#1\endcsname \relax \else
10331 \message{Internal error, already defined: #1}% 10331 \message{Internal error, already defined: #1}%
10332 \fi 10332 \fi
@@ -10365,7 +10365,7 @@ directory should work if nowhere else does.}
10365 \divide\countUTFz by 64 10365 \divide\countUTFz by 64
10366 \countUTFy = \countUTFz % Save to be the future value of \countUTFz. 10366 \countUTFy = \countUTFz % Save to be the future value of \countUTFz.
10367 \multiply\countUTFz by 64 10367 \multiply\countUTFz by 64
10368 10368
10369 % \countUTFz is now \countUTFx with the last 5 bits cleared. Subtract 10369 % \countUTFz is now \countUTFx with the last 5 bits cleared. Subtract
10370 % in order to get the last five bits. 10370 % in order to get the last five bits.
10371 \advance\countUTFx by -\countUTFz 10371 \advance\countUTFx by -\countUTFz
@@ -10400,7 +10400,7 @@ directory should work if nowhere else does.}
10400% U+0080..U+00FF = https://en.wikipedia.org/wiki/Latin-1_Supplement_(Unicode_block) 10400% U+0080..U+00FF = https://en.wikipedia.org/wiki/Latin-1_Supplement_(Unicode_block)
10401% U+0100..U+017F = https://en.wikipedia.org/wiki/Latin_Extended-A 10401% U+0100..U+017F = https://en.wikipedia.org/wiki/Latin_Extended-A
10402% U+0180..U+024F = https://en.wikipedia.org/wiki/Latin_Extended-B 10402% U+0180..U+024F = https://en.wikipedia.org/wiki/Latin_Extended-B
10403% 10403%
10404% Many of our renditions are less than wonderful, and all the missing 10404% Many of our renditions are less than wonderful, and all the missing
10405% characters are available somewhere. Loading the necessary fonts 10405% characters are available somewhere. Loading the necessary fonts
10406% awaits user request. We can't truly support Unicode without 10406% awaits user request. We can't truly support Unicode without
@@ -11438,9 +11438,9 @@ directory should work if nowhere else does.}
11438\def\texinfochars{% 11438\def\texinfochars{%
11439 \let< = \activeless 11439 \let< = \activeless
11440 \let> = \activegtr 11440 \let> = \activegtr
11441 \let~ = \activetilde 11441 \let~ = \activetilde
11442 \let^ = \activehat 11442 \let^ = \activehat
11443 \markupsetuplqdefault \markupsetuprqdefault 11443 \markupsetuplqdefault \markupsetuprqdefault
11444 \let\b = \strong 11444 \let\b = \strong
11445 \let\i = \smartitalic 11445 \let\i = \smartitalic
11446 % in principle, all other definitions in \tex have to be undone too. 11446 % 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 d48fa319fb2..e6a454be4c8 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -125,7 +125,7 @@ Configuring @value{tramp} for use
125* Connection types:: Types of connections to remote hosts. 125* Connection types:: Types of connections to remote hosts.
126* Inline methods:: Inline methods. 126* Inline methods:: Inline methods.
127* External methods:: External methods. 127* External methods:: External methods.
128* GVFS based methods:: GVFS based external methods. 128* GVFS-based methods:: @acronym{GVFS}-based external methods.
129* Default Method:: Selecting a default method. 129* Default Method:: Selecting a default method.
130* Default User:: Selecting a default user. 130* Default User:: Selecting a default user.
131* Default Host:: Selecting a default host. 131* Default Host:: Selecting a default host.
@@ -545,9 +545,9 @@ of the local file name is the share exported by the remote host,
545 545
546 546
547@anchor{Quick Start Guide: GVFS-based methods} 547@anchor{Quick Start Guide: GVFS-based methods}
548@section Using GVFS-based methods 548@section Using @acronym{GVFS}-based methods
549@cindex methods, gvfs 549@cindex methods, gvfs
550@cindex gvfs based methods 550@cindex gvfs-based methods
551@cindex method @option{sftp} 551@cindex method @option{sftp}
552@cindex @option{sftp} method 552@cindex @option{sftp} method
553@cindex method @option{afp} 553@cindex method @option{afp}
@@ -557,10 +557,9 @@ of the local file name is the share exported by the remote host,
557@cindex @option{dav} method 557@cindex @option{dav} method
558@cindex @option{davs} method 558@cindex @option{davs} method
559 559
560On systems, which have installed the virtual file system for the 560On systems, which have installed @acronym{GVFS, the GNOME Virtual File
561@acronym{GNOME} Desktop (GVFS), its offered methods could be used by 561System}, its offered methods could be used by @value{tramp}. Examples
562@value{tramp}. Examples are 562are @file{@trampfn{sftp,user@@host,/path/to/file}},
563@file{@trampfn{sftp,user@@host,/path/to/file}},
564@file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP 563@file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP
565file system), @file{@trampfn{dav,user@@host,/path/to/file}} and 564file system), @file{@trampfn{dav,user@@host,/path/to/file}} and
566@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares). 565@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
576@cindex @option{nextcloud} method 575@cindex @option{nextcloud} method
577@cindex nextcloud 576@cindex nextcloud
578 577
579GVFS-based methods include also @acronym{GNOME} Online Accounts, which 578@acronym{GVFS}-based methods include also @acronym{GNOME} Online
580support the @option{Files} service. These are the Google Drive file 579Accounts, which support the @option{Files} service. These are the
581system, and the OwnCloud/NextCloud file system. The file name syntax 580Google Drive file system, and the OwnCloud/NextCloud file system. The
582is here always 581file name syntax is here always
583@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}} 582@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}}
584(@samp{john.doe@@gmail.com} stands here for your Google Drive 583(@samp{john.doe@@gmail.com} stands here for your Google Drive
585account), or @file{@trampfn{nextcloud,user@@host#8081,/path/to/file}} 584account), or @file{@trampfn{nextcloud,user@@host#8081,/path/to/file}}
@@ -645,7 +644,7 @@ might be used in your init file:
645* Connection types:: Types of connections to remote hosts. 644* Connection types:: Types of connections to remote hosts.
646* Inline methods:: Inline methods. 645* Inline methods:: Inline methods.
647* External methods:: External methods. 646* External methods:: External methods.
648* GVFS based methods:: GVFS based external methods. 647* GVFS-based methods:: @acronym{GVFS}-based external methods.
649* Default Method:: Selecting a default method. 648* Default Method:: Selecting a default method.
650 Here we also try to help those who 649 Here we also try to help those who
651 don't have the foggiest which method 650 don't have the foggiest which method
@@ -1170,8 +1169,8 @@ information}. Supported properties are @samp{mount-args},
1170@samp{copyto-args} and @samp{moveto-args}. 1169@samp{copyto-args} and @samp{moveto-args}.
1171 1170
1172Access via @option{rclone} is slow. If you have an alternative method 1171Access via @option{rclone} is slow. If you have an alternative method
1173for accessing the system storage, you shall prefer this. @ref{GVFS 1172for accessing the system storage, you shall prefer this.
1174based methods} for example, methods @option{gdrive} and 1173@ref{GVFS-based methods} for example, methods @option{gdrive} and
1175@option{nextcloud}. 1174@option{nextcloud}.
1176 1175
1177@strong{Note}: The @option{rclone} method is experimental, don't use 1176@strong{Note}: The @option{rclone} method is experimental, don't use
@@ -1180,20 +1179,20 @@ it in production systems!
1180@end table 1179@end table
1181 1180
1182 1181
1183@node GVFS based methods 1182@node GVFS-based methods
1184@section GVFS based external methods 1183@section @acronym{GVFS}-based external methods
1185@cindex methods, gvfs 1184@cindex methods, gvfs
1186@cindex gvfs based methods 1185@cindex gvfs-based methods
1187@cindex dbus 1186@cindex dbus
1188 1187
1189GVFS is the virtual file system for the @acronym{GNOME} Desktop, 1188@acronym{GVFS} is the virtual file system for the @acronym{GNOME}
1190@uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are 1189Desktop, @uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on
1191mounted locally through FUSE and @value{tramp} uses this locally 1190@acronym{GVFS} are mounted locally through FUSE and @value{tramp} uses
1192mounted directory internally. 1191this locally mounted directory internally.
1193 1192
1194Emacs uses the D-Bus mechanism to communicate with GVFS@. Emacs must 1193Emacs uses the D-Bus mechanism to communicate with @acronym{GVFS}@.
1195have the message bus system, D-Bus integration active, @pxref{Top, , 1194Emacs must have the message bus system, D-Bus integration active,
1196D-Bus, dbus}. 1195@pxref{Top, , D-Bus, dbus}.
1197 1196
1198@table @asis 1197@table @asis
1199@item @option{afp} 1198@item @option{afp}
@@ -1216,9 +1215,10 @@ syntax requires a leading volume (share) name, for example:
1216based on standard protocols, such as HTTP@. @option{davs} does the same 1215based on standard protocols, such as HTTP@. @option{davs} does the same
1217but with SSL encryption. Both methods support the port numbers. 1216but with SSL encryption. Both methods support the port numbers.
1218 1217
1219Paths being part of the WebDAV volume to be mounted by GVFS, as it is 1218Paths being part of the WebDAV volume to be mounted by @acronym{GVFS},
1220common for OwnCloud or NextCloud file names, are not supported by 1219as it is common for OwnCloud or NextCloud file names, are not
1221these methods. See method @option{nextcloud} for handling them. 1220supported by these methods. See method @option{nextcloud} for
1221handling them.
1222 1222
1223@item @option{gdrive} 1223@item @option{gdrive}
1224@cindex method @option{gdrive} 1224@cindex method @option{gdrive}
@@ -1259,18 +1259,19 @@ that for security reasons refuse @command{ssh} connections.
1259@end table 1259@end table
1260 1260
1261@defopt tramp-gvfs-methods 1261@defopt tramp-gvfs-methods
1262This user option is a list of external methods for GVFS@. By default, 1262This user option is a list of external methods for @acronym{GVFS}@.
1263this list includes @option{afp}, @option{dav}, @option{davs}, 1263By default, this list includes @option{afp}, @option{dav},
1264@option{gdrive}, @option{nextcloud} and @option{sftp}. Other methods 1264@option{davs}, @option{gdrive}, @option{nextcloud} and @option{sftp}.
1265to include are @option{ftp}, @option{http}, @option{https} and 1265Other methods to include are @option{ftp}, @option{http},
1266@option{smb}. These methods are not intended to be used directly as 1266@option{https} and @option{smb}. These methods are not intended to be
1267GVFS based method. Instead, they are added here for the benefit of 1267used directly as @acronym{GVFS}-based method. Instead, they are added
1268@ref{Archive file names}. 1268here for the benefit of @ref{Archive file names}.
1269 1269
1270If you want to use GVFS-based @option{ftp} or @option{smb} methods, 1270If you want to use @acronym{GVFS}-based @option{ftp} or @option{smb}
1271you must add them to @code{tramp-gvfs-methods}, and you must disable 1271methods, you must add them to @code{tramp-gvfs-methods}, and you must
1272the corresponding Tramp package by setting @code{tramp-ftp-method} or 1272disable the corresponding Tramp package by setting
1273@code{tramp-smb-method} to @code{nil}, respectively: 1273@code{tramp-ftp-method} or @code{tramp-smb-method} to @code{nil},
1274respectively:
1274 1275
1275@lisp 1276@lisp
1276@group 1277@group
@@ -2937,9 +2938,10 @@ host when the variable @code{default-directory} is remote:
2937@end group 2938@end group
2938@end lisp 2939@end lisp
2939 2940
2940Remote processes do not apply to GVFS (see @ref{GVFS based methods}) 2941Remote processes do not apply to @acronym{GVFS} (see @ref{GVFS-based
2941because the remote file system is mounted on the local host and 2942methods}) because the remote file system is mounted on the local host
2942@value{tramp} just accesses by changing the @code{default-directory}. 2943and @value{tramp} just accesses by changing the
2944@code{default-directory}.
2943 2945
2944@value{tramp} starts a remote process when a command is executed in a 2946@value{tramp} starts a remote process when a command is executed in a
2945remote file or directory buffer. As of now, these packages have been 2947remote file or directory buffer. As of now, these packages have been
@@ -3323,10 +3325,10 @@ killing all buffers related to remote connections.
3323@cindex archive method 3325@cindex archive method
3324 3326
3325@value{tramp} offers also transparent access to files inside file 3327@value{tramp} offers also transparent access to files inside file
3326archives. This is possible only on machines which have installed the 3328archives. This is possible only on machines which have installed
3327virtual file system for the @acronym{GNOME} Desktop (GVFS), @ref{GVFS 3329@acronym{GVFS, the GNOME Virtual File System}, @ref{GVFS-based
3328based methods}. Internally, file archives are mounted via the GVFS 3330methods}. Internally, file archives are mounted via the
3329@option{archive} method. 3331@acronym{GVFS} @option{archive} method.
3330 3332
3331A file archive is a regular file of kind @file{/path/to/dir/file.EXT}. 3333A file archive is a regular file of kind @file{/path/to/dir/file.EXT}.
3332The extension @samp{.EXT} identifies the type of the file archive. A 3334The extension @samp{.EXT} identifies the type of the file archive. A
@@ -3349,9 +3351,9 @@ file names as well.
3349 3351
3350@vindex tramp-archive-suffixes 3352@vindex tramp-archive-suffixes
3351File archives are identified by the file name extension @samp{.EXT}. 3353File archives are identified by the file name extension @samp{.EXT}.
3352Since GVFS uses internally the library @code{libarchive(3)}, all 3354Since @acronym{GVFS} uses internally the library @code{libarchive(3)},
3353suffixes, which are accepted by this library, work also for archive 3355all suffixes, which are accepted by this library, work also for
3354file names. Accepted suffixes are listed in the constant 3356archive file names. Accepted suffixes are listed in the constant
3355@code{tramp-archive-suffixes}. They are 3357@code{tramp-archive-suffixes}. They are
3356 3358
3357@itemize 3359@itemize
@@ -3519,11 +3521,11 @@ row are possible, like @file{/path/to/dir/file.tar.gz.uu/dir/file}.
3519@vindex tramp-archive-all-gvfs-methods 3521@vindex tramp-archive-all-gvfs-methods
3520An archive file name could be a remote file name, as in 3522An archive file name could be a remote file name, as in
3521@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}. 3523@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.
3522Since all file operations are mapped internally to GVFS operations, 3524Since all file operations are mapped internally to @acronym{GVFS}
3523remote file names supported by @code{tramp-gvfs} perform better, 3525operations, remote file names supported by @code{tramp-gvfs} perform
3524because no local copy of the file archive must be downloaded first. 3526better, because no local copy of the file archive must be downloaded
3525For example, @samp{/sftp:user@@host:...} performs better than the 3527first. For example, @samp{/sftp:user@@host:...} performs better than
3526similar @samp{/scp:user@@host:...}. See the constant 3528the similar @samp{/scp:user@@host:...}. See the constant
3527@code{tramp-archive-all-gvfs-methods} for a complete list of 3529@code{tramp-archive-all-gvfs-methods} for a complete list of
3528@code{tramp-gvfs} supported method names. 3530@code{tramp-gvfs} supported method names.
3529 3531
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 0cdfcac24e8..bad7701daf1 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -1267,7 +1267,8 @@ files, etc.
1267 1267
1268The default value specifies a subdirectory named @file{url/} in the 1268The default value specifies a subdirectory named @file{url/} in the
1269standard Emacs user data directory specified by the variable 1269standard Emacs user data directory specified by the variable
1270@code{user-emacs-directory} (normally @file{~/.emacs.d}). However, 1270@code{user-emacs-directory} (normally @file{~/.config/emacs}
1271or @file{~/.emacs.d}). However,
1271the old default was @file{~/.url}, and this directory is used instead 1272the old default was @file{~/.url}, and this directory is used instead
1272if it exists. 1273if it exists.
1273@end defopt 1274@end defopt
diff --git a/etc/HISTORY b/etc/HISTORY
index bf03692d3ff..6cda28d15a6 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -218,6 +218,8 @@ GNU Emacs 26.1 (2018-05-28) emacs-26.1
218 218
219GNU Emacs 26.2 (2019-04-12) emacs-26.2 219GNU Emacs 26.2 (2019-04-12) emacs-26.2
220 220
221GNU Emacs 26.3 (2019-08-28) emacs-26.3
222
221 223
222---------------------------------------------------------------------- 224----------------------------------------------------------------------
223This file is part of GNU Emacs. 225This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index 7c329f0044a..87666740df6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -16,10 +16,10 @@ You can narrow news to a specific version by calling 'view-emacs-news'
16with a prefix argument or by typing 'C-u C-h C-n'. 16with a prefix argument or by typing 'C-u C-h C-n'.
17 17
18Temporary note: 18Temporary note:
19+++ indicates that all necessary documentation updates are complete. 19+++ indicates that all relevant manuals in doc/ have been updated.
20 (This means all relevant manuals in doc/ AND lisp doc-strings.)
21--- means no change in the manuals is needed. 20--- means no change in the manuals is needed.
22When you add a new item, use the appropriate mark if you are sure it applies, 21When you add a new item, use the appropriate mark if you are sure it
22applies, and please also update docstrings as needed.
23 23
24 24
25* Installation Changes in Emacs 27.1 25* Installation Changes in Emacs 27.1
@@ -129,10 +129,28 @@ This is intended mostly to help developers.
129** Emacs now requires GTK 2.24 and GTK 3.10 for the GTK 2 and GTK 3 129** Emacs now requires GTK 2.24 and GTK 3.10 for the GTK 2 and GTK 3
130builds respectively. 130builds respectively.
131 131
132** New make target 'help' shows a summary of common make targets.
133
132 134
133* Startup Changes in Emacs 27.1 135* Startup Changes in Emacs 27.1
134 136
135+++ 137+++
138** Emacs now uses the XDG convention for init files.
139For example, it looks for init.el in ~/.config/emacs/init.el, and
140similarly for other init files.
141
142The XDG_CONFIG_HOME environment variable (which defaults to ~/.config)
143specifies the parent directory of these and other configuration files,
144and will override their traditional locations (the home directory,
145~/.emacs.d, etc.).
146
147Emacs will still look for init files in their traditional locations if
148XDG_CONFIG_HOME does not exist, so invoking Emacs with
149XDG_CONFIG_HOME='/nowhere' might be useful if your new-location init
150files are scrambled, or if you want to force Emacs to ignore files
151under XDG_CONFIG_HOME for some other reason.
152
153+++
136** Emacs can now be configured using an early init file. 154** Emacs can now be configured using an early init file.
137The file is called 'early-init.el', in 'user-emacs-directory'. It is 155The file is called 'early-init.el', in 'user-emacs-directory'. It is
138loaded very early in the startup process: before graphical elements 156loaded very early in the startup process: before graphical elements
@@ -173,12 +191,6 @@ after Emacs has finished initialization and is ready for use.
173emacs.service file to eg "~/.config/systemd/user/", you will need to copy 191emacs.service file to eg "~/.config/systemd/user/", you will need to copy
174the new version of the file again.) 192the new version of the file again.)
175 193
176+++
177** New option 'help-enable-completion-auto-load'.
178This allows disabling the new feature introduced in Emacs 26.1 which
179loads files during completion of 'C-h f' and 'C-h v' according to
180'definition-prefixes'.
181
182 194
183* Changes in Emacs 27.1 195* Changes in Emacs 27.1
184 196
@@ -205,6 +217,9 @@ To get the old, less-secure behavior, you can set the
205*** When run by root, emacsclient no longer connects to non-root sockets. 217*** When run by root, emacsclient no longer connects to non-root sockets.
206(Instead you can use Tramp methods to run root commands in a non-root Emacs.) 218(Instead you can use Tramp methods to run root commands in a non-root Emacs.)
207 219
220** New function 'network-lookup-address-info'.
221This does IPv4 and/or IPv6 address lookups on hostnames.
222
208--- 223---
209** Control of the threshold for using the 'distant-foreground' color. 224** Control of the threshold for using the 'distant-foreground' color.
210The threshold for color distance below which the 'distant-foreground' 225The threshold for color distance below which the 'distant-foreground'
@@ -272,7 +287,8 @@ variable.
272+++ 287+++
273** TLS connections have their security tightened by default. 288** TLS connections have their security tightened by default.
274Most of the checks for outdated, believed-to-be-weak TLS algorithms 289Most of the checks for outdated, believed-to-be-weak TLS algorithms
275and ciphers are now switched on by default. By default, the NSM will 290and ciphers are now switched on by default. (In addition, several new
291TLS weaknesses are now warned about.) By default, the NSM will
276flag connections using these weak algorithms and ask users whether to 292flag connections using these weak algorithms and ask users whether to
277allow them. To get the old behavior back (where certificates are 293allow them. To get the old behavior back (where certificates are
278checked for validity, but no warnings about weak cryptography are 294checked for validity, but no warnings about weak cryptography are
@@ -280,6 +296,14 @@ issued), you can either set 'network-security-protocol-checks' to nil,
280or adjust the elements in that variable to only happen on the 'high' 296or adjust the elements in that variable to only happen on the 'high'
281security level (assuming you use the 'medium' level). 297security level (assuming you use the 'medium' level).
282 298
299---
300** New user option 'nsm-trust-local-network'.
301Allows skipping Network Security Manager checks for hosts on your
302local subnet(s). It defaults to nil. Usually, there should be no
303need to set this non-nil, and doing that risks opening your local
304network connections to attacks. So be sure you know what you are
305doing before changing the value.
306
283+++ 307+++
284** Native GnuTLS connections can now use client certificates. 308** Native GnuTLS connections can now use client certificates.
285Previously, this support was only available when using the external 309Previously, this support was only available when using the external
@@ -507,10 +531,19 @@ current and the previous or the next line, as before.
507 531
508* Changes in Specialized Modes and Packages in Emacs 27.1 532* Changes in Specialized Modes and Packages in Emacs 27.1
509 533
534---
535** 'autoconf-mode' is now used instead of 'm4-mode' for the
536acinclude.m4/aclocal.m4/acsite.m4 files.
537
538---
539** On GNU/Linux, 'M-x battery' will now list all batteries, no matter
540what they're named, and the 'battery-linux-sysfs-regexp' variable has
541been removed.
542
510** The 'list-processes' command now includes port numbers in the 543** The 'list-processes' command now includes port numbers in the
511network connection information (in addition to the host name). 544network connection information (in addition to the host name).
512 545
513** The 'cl' package is now officially deprecated in favor of `cl-lib`. 546** The 'cl' package is now officially deprecated in favor of 'cl-lib'.
514 547
515+++ 548+++
516** winner 549** winner
@@ -545,6 +578,11 @@ that it doesn't bring any measurable benefit.
545--- 578---
546*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can 579*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can
547be functions. 580be functions.
581+++
582*** 'compilation-context-lines' can now take the value t; this is like
583nil, but instead of scrolling the current line to the top of the
584screen when there is no left fringe, it inserts a visible arrow before
585column zero.
548 586
549** cl-lib.el 587** cl-lib.el
550+++ 588+++
@@ -690,7 +728,7 @@ The default value is 'find-dired-sort-by-filename'.
690** Change Logs and VC 728** Change Logs and VC
691 729
692+++ 730+++
693*** New command 'log-edit-generate-changelog', bound to C-c C-w. 731*** New command 'log-edit-generate-changelog-from-diff', bound to C-c C-w.
694This generates ChangeLog entries from the VC fileset diff. 732This generates ChangeLog entries from the VC fileset diff.
695 733
696*** Recording ChangeLog entries doesn't require an actual file. 734*** Recording ChangeLog entries doesn't require an actual file.
@@ -935,6 +973,11 @@ early init file.
935 973
936** Info 974** Info
937 975
976+++
977*** Clicking on the left/right arrow icon in the Info tool-bar while
978holding down the Ctrl key pops up a menu of previously visited Info nodes
979where you can select a node to go back (like in browsers).
980
938--- 981---
939*** Info can now follow 'file://' protocol URLs. 982*** Info can now follow 'file://' protocol URLs.
940The 'file://' URLs in Info documents can now be followed by passing 983The 'file://' URLs in Info documents can now be followed by passing
@@ -1793,6 +1836,16 @@ aliases of 'bookmark-default-file'.
1793When non-nil, watch whether the bookmark file has changed on disk. 1836When non-nil, watch whether the bookmark file has changed on disk.
1794 1837
1795--- 1838---
1839*** The old bookmark file format is no longer supported.
1840This bookmark file format has not been used in Emacs since at least
1841version 19.34, released in 1996, and will no longer be automatically
1842converted to the new bookmark file format.
1843
1844The following functions are now declared obsolete:
1845bookmark-grok-file-format-version, bookmark-maybe-upgrade-file-format,
1846bookmark-upgrade-file-format-from-0, bookmark-upgrade-version-0-alist
1847
1848---
1796** The mantemp.el library is now marked obsolete. 1849** The mantemp.el library is now marked obsolete.
1797This library generates manual C++ template instantiations. It should 1850This library generates manual C++ template instantiations. It should
1798no longer be useful on modern compilers, which do this automatically. 1851no longer be useful on modern compilers, which do this automatically.
@@ -1840,6 +1893,11 @@ and 'gravatar-force-default'.
1840*** The built-in ada-mode is now deleted. The Gnu ELPA package is a 1893*** The built-in ada-mode is now deleted. The Gnu ELPA package is a
1841good replacement, even in very large source files. 1894good replacement, even in very large source files.
1842 1895
1896** xref
1897
1898---
1899*** Imenu support has been added to 'xref--xref-buffer-mode'.
1900
1843 1901
1844* New Modes and Packages in Emacs 27.1 1902* New Modes and Packages in Emacs 27.1
1845 1903
@@ -2166,7 +2224,9 @@ end and duration).
2166+++ 2224+++
2167*** 'time-add', 'time-subtract', and 'time-less-p' now accept 2225*** 'time-add', 'time-subtract', and 'time-less-p' now accept
2168infinities and NaNs too, and propagate them or return nil like 2226infinities and NaNs too, and propagate them or return nil like
2169floating-point operators do. 2227floating-point operators do. If both arguments are finite, these
2228functions now return exact results instead of rounding in some cases,
2229and they also avoid excess precision when that is easy.
2170 2230
2171+++ 2231+++
2172*** New function 'time-equal-p' compares time values for equality. 2232*** 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
2569non-nil argument when the other is nil. Several duplicates of 'xor' 2629non-nil argument when the other is nil. Several duplicates of 'xor'
2570in other packages are now obsolete aliases of 'xor'. 2630in other packages are now obsolete aliases of 'xor'.
2571 2631
2632+++
2633** 'define-globalized-minor-mode' now takes BODY forms.
2634
2572 2635
2573* Changes in Emacs 27.1 on Non-Free Operating Systems 2636* Changes in Emacs 27.1 on Non-Free Operating Systems
2574 2637
@@ -2610,6 +2673,11 @@ is being used, except in Far Eastern locales. When this variable is
2610non-zero, Emacs at startup sets 'locale-coding-system' to the 2673non-zero, Emacs at startup sets 'locale-coding-system' to the
2611corresponding encoding, instead of using 'w32-ansi-code-page'. 2674corresponding encoding, instead of using 'w32-ansi-code-page'.
2612 2675
2676---
2677** The default value of 'inhibit-compacting-font-caches' is t on MS-Windows.
2678Experience shows that compacting font caches causes more trouble on
2679MS-Windows than it helps.
2680
2613+++ 2681+++
2614** On NS the behaviour of drag and drop can now be modified by use of 2682** On NS the behaviour of drag and drop can now be modified by use of
2615modifier keys in line with Apples guidelines. This makes the drag and 2683modifier keys in line with Apples guidelines. This makes the drag and
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index aa583f47c61..11c526c56ed 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'
16with a prefix argument or by typing 'C-u C-h C-n'. 16with a prefix argument or by typing 'C-u C-h C-n'.
17 17
18 18
19* Installation Changes in Emacs 26.3
20
21
22* Startup Changes in Emacs 26.3
23
24
25* Changes in Emacs 26.3 19* Changes in Emacs 26.3
26 20
27 21** New option 'help-enable-completion-auto-load'.
28* Editing Changes in Emacs 26.3 22This allows disabling the new feature introduced in Emacs 26.1 which
29 23loads files during completion of 'C-h f' and 'C-h v' according to
30 24'definition-prefixes'.
31* Changes in Specialized Modes and Packages in Emacs 26.3
32
33
34* New Modes and Packages in Emacs 26.3
35
36
37* Incompatible Lisp Changes in Emacs 26.3
38 25
39 26** Emacs now supports the new Japanese Era name.
40* Lisp Changes in Emacs 26.3 27The newly assigned codepoint U+32FF was added to the Unicode Character
41 28Database compiled into Emacs.
42
43* Changes in Emacs 26.3 on Non-Free Operating Systems
44 29
45 30
46* Installation Changes in Emacs 26.2 31* Installation Changes in Emacs 26.2
diff --git a/etc/tutorials/TUTORIAL.ru b/etc/tutorials/TUTORIAL.ru
index ba3a5c27c5a..a9bd90d28b0 100644
--- a/etc/tutorials/TUTORIAL.ru
+++ b/etc/tutorials/TUTORIAL.ru
@@ -985,7 +985,7 @@ Emacs также может создавать множество "фреймо
985представить все это здесь не представляется возможным. Однако, возможно вы 985представить все это здесь не представляется возможным. Однако, возможно вы
986захотите узнать больше о возможностях Emacs. Emacs предоставляет команды 986захотите узнать больше о возможностях Emacs. Emacs предоставляет команды
987для чтения документации о командах Emacs. Все команды "справки" (help) 987для чтения документации о командах Emacs. Все команды "справки" (help)
988начинаются с сочетания CONTROL-h, которы является "символом справки". 988начинаются с сочетания CONTROL-h, которе является "символом справки".
989 989
990Чтобы использовать справку, нажмите C-h, а затем -- символ, который 990Чтобы использовать справку, нажмите C-h, а затем -- символ, который
991расскажет, какой именно вид справки вы хотите получить. Если вы 991расскажет, какой именно вид справки вы хотите получить. Если вы
@@ -1130,5 +1130,6 @@ Copyright (C) 1985, 1996, 1998, 2001-2019 Free Software Foundation, Inc.
1130;;; Local Variables: 1130;;; Local Variables:
1131;;; coding: utf-8 1131;;; coding: utf-8
1132;;; sentence-end-double-space: nil 1132;;; sentence-end-double-space: nil
1133;;; mode: fundamental
1133;;; fill-column: 76 1134;;; fill-column: 76
1134;;; End: 1135;;; End:
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index ba2721e8bc9..e9469f77c5e 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -914,22 +914,38 @@ initialize_sockets (void)
914#endif /* WINDOWSNT */ 914#endif /* WINDOWSNT */
915 915
916 916
917/* If the home directory is HOME, return the configuration file with 917/* If the home directory is HOME, and XDG_CONFIG_HOME's value is XDG,
918 basename CONFIG_FILE. Fail if there is no home directory or if the 918 return the configuration file with basename CONFIG_FILE. Fail if
919 configuration file could not be opened. */ 919 the configuration file could not be opened. */
920 920
921static FILE * 921static FILE *
922open_config (char const *home, char const *config_file) 922open_config (char const *home, char const *xdg, char const *config_file)
923{ 923{
924 if (!home) 924 ptrdiff_t xdgsubdirsize = xdg ? strlen (xdg) + sizeof "/emacs/server/" : 0;
925 return NULL; 925 ptrdiff_t homesuffixsizemax = max (sizeof "/.config/emacs/server/",
926 ptrdiff_t homelen = strlen (home); 926 sizeof "/.emacs.d/server/");
927 static char const emacs_d_server[] = "/.emacs.d/server/"; 927 ptrdiff_t homesubdirsizemax = home ? strlen (home) + homesuffixsizemax : 0;
928 ptrdiff_t suffixsize = sizeof emacs_d_server + strlen (config_file); 928 char *configname = xmalloc (max (xdgsubdirsize, homesubdirsizemax)
929 char *configname = xmalloc (homelen + suffixsize); 929 + strlen (config_file));
930 strcpy (stpcpy (stpcpy (configname, home), emacs_d_server), config_file); 930 FILE *config;
931 931 if (xdg || home)
932 FILE *config = fopen (configname, "rb"); 932 {
933 strcpy ((xdg
934 ? stpcpy (stpcpy (configname, xdg), "/emacs/server/")
935 : stpcpy (stpcpy (configname, home), "/.config/emacs/server/")),
936 config_file);
937 config = fopen (configname, "rb");
938 }
939 else
940 config = NULL;
941
942 if (! config && home)
943 {
944 strcpy (stpcpy (stpcpy (configname, home), "/.emacs.d/server/"),
945 config_file);
946 config = fopen (configname, "rb");
947 }
948
933 free (configname); 949 free (configname);
934 return config; 950 return config;
935} 951}
@@ -949,10 +965,11 @@ get_server_config (const char *config_file, struct sockaddr_in *server,
949 config = fopen (config_file, "rb"); 965 config = fopen (config_file, "rb");
950 else 966 else
951 { 967 {
952 config = open_config (egetenv ("HOME"), config_file); 968 char const *xdg = egetenv ("XDG_CONFIG_HOME");
969 config = open_config (egetenv ("HOME"), xdg, config_file);
953#ifdef WINDOWSNT 970#ifdef WINDOWSNT
954 if (!config) 971 if (!config)
955 config = open_config (egetenv ("APPDATA"), config_file); 972 config = open_config (egetenv ("APPDATA"), xdg, config_file);
956#endif 973#endif
957 } 974 }
958 975
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 036c485d0bb..6409407e466 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -1146,7 +1146,6 @@ main (int argc, char **argv)
1146 { 1146 {
1147 error ("-o option may only be given once."); 1147 error ("-o option may only be given once.");
1148 suggest_asking_for_help (); 1148 suggest_asking_for_help ();
1149 /* NOTREACHED */
1150 } 1149 }
1151 tagfile = optarg; 1150 tagfile = optarg;
1152 break; 1151 break;
@@ -1208,7 +1207,6 @@ main (int argc, char **argv)
1208 case 'w': no_warnings = true; break; 1207 case 'w': no_warnings = true; break;
1209 default: 1208 default:
1210 suggest_asking_for_help (); 1209 suggest_asking_for_help ();
1211 /* NOTREACHED */
1212 } 1210 }
1213 1211
1214 /* No more options. Store the rest of arguments. */ 1212 /* No more options. Store the rest of arguments. */
@@ -1227,13 +1225,11 @@ main (int argc, char **argv)
1227 1225
1228 if (help_asked) 1226 if (help_asked)
1229 print_help (argbuffer); 1227 print_help (argbuffer);
1230 /* NOTREACHED */
1231 1228
1232 if (nincluded_files == 0 && file_count == 0) 1229 if (nincluded_files == 0 && file_count == 0)
1233 { 1230 {
1234 error ("no input files specified."); 1231 error ("no input files specified.");
1235 suggest_asking_for_help (); 1232 suggest_asking_for_help ();
1236 /* NOTREACHED */
1237 } 1233 }
1238 1234
1239 if (tagfile == NULL) 1235 if (tagfile == NULL)
diff --git a/lib-src/pop.c b/lib-src/pop.c
index e4bd6c04965..9a0dd8ca704 100644
--- a/lib-src/pop.c
+++ b/lib-src/pop.c
@@ -1275,7 +1275,7 @@ pop_getline (popserver server, char **line)
1275 server->buffer_index = 0; 1275 server->buffer_index = 0;
1276 } 1276 }
1277 1277
1278 while (1) 1278 while (true)
1279 { 1279 {
1280 /* There's a "- 1" here to leave room for the null that we put 1280 /* There's a "- 1" here to leave room for the null that we put
1281 at the end of the read data below. We put the null there so 1281 at the end of the read data below. We put the null there so
@@ -1288,7 +1288,7 @@ pop_getline (popserver server, char **line)
1288 { 1288 {
1289 strcpy (pop_error, "Out of memory in pop_getline"); 1289 strcpy (pop_error, "Out of memory in pop_getline");
1290 pop_trash (server); 1290 pop_trash (server);
1291 return (-1); 1291 break;
1292 } 1292 }
1293 } 1293 }
1294 ret = RECV (server->file, server->buffer + server->data, 1294 ret = RECV (server->file, server->buffer + server->data,
@@ -1298,13 +1298,13 @@ pop_getline (popserver server, char **line)
1298 snprintf (pop_error, ERROR_MAX, "%s%s", 1298 snprintf (pop_error, ERROR_MAX, "%s%s",
1299 GETLINE_ERROR, strerror (errno)); 1299 GETLINE_ERROR, strerror (errno));
1300 pop_trash (server); 1300 pop_trash (server);
1301 return (-1); 1301 break;
1302 } 1302 }
1303 else if (ret == 0) 1303 else if (ret == 0)
1304 { 1304 {
1305 strcpy (pop_error, "Unexpected EOF from server in pop_getline"); 1305 strcpy (pop_error, "Unexpected EOF from server in pop_getline");
1306 pop_trash (server); 1306 pop_trash (server);
1307 return (-1); 1307 break;
1308 } 1308 }
1309 else 1309 else
1310 { 1310 {
@@ -1332,7 +1332,7 @@ pop_getline (popserver server, char **line)
1332 } 1332 }
1333 } 1333 }
1334 1334
1335 /* NOTREACHED */ 1335 return -1;
1336} 1336}
1337 1337
1338/* 1338/*
diff --git a/lib/intprops.h b/lib/intprops.h
index fe67c1f305f..36c6359a21f 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -22,6 +22,18 @@
22 22
23#include <limits.h> 23#include <limits.h>
24 24
25/* If the compiler lacks __has_builtin, define it well enough for this
26 source file only. */
27#ifndef __has_builtin
28# define __has_builtin(x) _GL_HAS_##x
29# if 5 <= __GNUC__ && !defined __ICC
30# define _GL_HAS___builtin_add_overflow 1
31# else
32# define _GL_HAS___builtin_add_overflow 0
33# endif
34# define _GL_TEMPDEF___has_builtin
35#endif
36
25/* Return a value with the common real type of E and V and the value of V. 37/* Return a value with the common real type of E and V and the value of V.
26 Do not evaluate E. */ 38 Do not evaluate E. */
27#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v)) 39#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v))
@@ -220,14 +232,24 @@
220 ? (a) < (min) >> (b) \ 232 ? (a) < (min) >> (b) \
221 : (max) >> (b) < (a)) 233 : (max) >> (b) < (a))
222 234
223/* True if __builtin_add_overflow (A, B, P) works when P is non-null. */ 235/* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow
224#if 5 <= __GNUC__ && !defined __ICC 236 (A, B, P) work when P is non-null. */
225# define _GL_HAS_BUILTIN_OVERFLOW 1 237#if __has_builtin (__builtin_add_overflow)
238# define _GL_HAS_BUILTIN_ADD_OVERFLOW 1
239#else
240# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0
241#endif
242
243/* True if __builtin_mul_overflow (A, B, P) works when P is non-null. */
244#ifdef __clang__
245/* Work around Clang bug <https://bugs.llvm.org/show_bug.cgi?id=16404>. */
246# define _GL_HAS_BUILTIN_MUL_OVERFLOW 0
226#else 247#else
227# define _GL_HAS_BUILTIN_OVERFLOW 0 248# define _GL_HAS_BUILTIN_MUL_OVERFLOW _GL_HAS_BUILTIN_ADD_OVERFLOW
228#endif 249#endif
229 250
230/* True if __builtin_add_overflow_p (A, B, C) works. */ 251/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for
252 __builtin_mul_overflow_p and __builtin_mul_overflow_p. */
231#define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__) 253#define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__)
232 254
233/* The _GL*_OVERFLOW macros have the same restrictions as the 255/* The _GL*_OVERFLOW macros have the same restrictions as the
@@ -351,29 +373,33 @@
351 373
352/* Store the low-order bits of A + B, A - B, A * B, respectively, into *R. 374/* Store the low-order bits of A + B, A - B, A * B, respectively, into *R.
353 Return 1 if the result overflows. See above for restrictions. */ 375 Return 1 if the result overflows. See above for restrictions. */
354#define INT_ADD_WRAPV(a, b, r) \ 376#if _GL_HAS_BUILTIN_ADD_OVERFLOW
355 _GL_INT_OP_WRAPV (a, b, r, +, __builtin_add_overflow, \ 377# define INT_ADD_WRAPV(a, b, r) __builtin_add_overflow (a, b, r)
356 _GL_INT_ADD_RANGE_OVERFLOW) 378# define INT_SUBTRACT_WRAPV(a, b, r) __builtin_sub_overflow (a, b, r)
357#define INT_SUBTRACT_WRAPV(a, b, r) \ 379#else
358 _GL_INT_OP_WRAPV (a, b, r, -, __builtin_sub_overflow, \ 380# define INT_ADD_WRAPV(a, b, r) \
359 _GL_INT_SUBTRACT_RANGE_OVERFLOW) 381 _GL_INT_OP_WRAPV (a, b, r, +, _GL_INT_ADD_RANGE_OVERFLOW)
360#define INT_MULTIPLY_WRAPV(a, b, r) \ 382# define INT_SUBTRACT_WRAPV(a, b, r) \
361 _GL_INT_OP_WRAPV (a, b, r, *, _GL_BUILTIN_MUL_OVERFLOW, \ 383 _GL_INT_OP_WRAPV (a, b, r, -, _GL_INT_SUBTRACT_RANGE_OVERFLOW)
362 _GL_INT_MULTIPLY_RANGE_OVERFLOW) 384#endif
363 385#if _GL_HAS_BUILTIN_MUL_OVERFLOW
364/* Like __builtin_mul_overflow, but work around GCC bug 91450. */ 386/* Work around GCC bug 91450. */
365#define _GL_BUILTIN_MUL_OVERFLOW(a, b, r) \ 387# define INT_MULTIPLY_WRAPV(a, b, r) \
366 ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && EXPR_SIGNED (a) && EXPR_SIGNED (b) \ 388 ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && EXPR_SIGNED (a) && EXPR_SIGNED (b) \
367 && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \ 389 && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \
368 ? ((void) __builtin_mul_overflow (a, b, r), 1) \ 390 ? ((void) __builtin_mul_overflow (a, b, r), 1) \
369 : __builtin_mul_overflow (a, b, r)) 391 : __builtin_mul_overflow (a, b, r))
392#else
393# define INT_MULTIPLY_WRAPV(a, b, r) \
394 _GL_INT_OP_WRAPV (a, b, r, *, _GL_INT_MULTIPLY_RANGE_OVERFLOW)
395#endif
370 396
371/* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See: 397/* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See:
372 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193 398 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193
373 https://llvm.org/bugs/show_bug.cgi?id=25390 399 https://llvm.org/bugs/show_bug.cgi?id=25390
374 For now, assume all versions of GCC-like compilers generate bogus 400 For now, assume all versions of GCC-like compilers generate bogus
375 warnings for _Generic. This matters only for older compilers that 401 warnings for _Generic. This matters only for compilers that
376 lack __builtin_add_overflow. */ 402 lack relevant builtins. */
377#if __GNUC__ 403#if __GNUC__
378# define _GL__GENERIC_BOGUS 1 404# define _GL__GENERIC_BOGUS 1
379#else 405#else
@@ -381,13 +407,10 @@
381#endif 407#endif
382 408
383/* Store the low-order bits of A <op> B into *R, where OP specifies 409/* Store the low-order bits of A <op> B into *R, where OP specifies
384 the operation. BUILTIN is the builtin operation, and OVERFLOW the 410 the operation and OVERFLOW the overflow predicate. Return 1 if the
385 overflow predicate. Return 1 if the result overflows. See above 411 result overflows. See above for restrictions. */
386 for restrictions. */ 412#if 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS
387#if _GL_HAS_BUILTIN_OVERFLOW 413# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \
388# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) builtin (a, b, r)
389#elif 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS
390# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) \
391 (_Generic \ 414 (_Generic \
392 (*(r), \ 415 (*(r), \
393 signed char: \ 416 signed char: \
@@ -442,7 +465,7 @@
442 : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 0))) 465 : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 0)))
443# endif 466# endif
444 467
445# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) \ 468# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \
446 (sizeof *(r) == sizeof (signed char) \ 469 (sizeof *(r) == sizeof (signed char) \
447 ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ 470 ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \
448 signed char, SCHAR_MIN, SCHAR_MAX, \ 471 signed char, SCHAR_MIN, SCHAR_MAX, \
@@ -563,4 +586,10 @@
563 : (tmin) / (a) < (b)) \ 586 : (tmin) / (a) < (b)) \
564 : (tmax) / (b) < (a))) 587 : (tmax) / (b) < (a)))
565 588
589#ifdef _GL_TEMPDEF___has_builtin
590# undef __has_builtin
591# undef _GL_HAS___builtin_add_overflow
592# undef _GL_TEMPDEF___has_builtin
593#endif
594
566#endif /* _GL_INTPROPS_H */ 595#endif /* _GL_INTPROPS_H */
diff --git a/lib/regex_internal.c b/lib/regex_internal.c
index b592f06725c..0092cc2a468 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)
1311 first element separately to skip a check in the inner loop. */ 1311 first element separately to skip a check in the inner loop. */
1312 if (elem < set->elems[0]) 1312 if (elem < set->elems[0])
1313 { 1313 {
1314 idx = 0;
1315 for (idx = set->nelem; idx > 0; idx--) 1314 for (idx = set->nelem; idx > 0; idx--)
1316 set->elems[idx] = set->elems[idx - 1]; 1315 set->elems[idx] = set->elems[idx - 1];
1317 } 1316 }
@@ -1716,15 +1715,19 @@ create_cd_newstate (const re_dfa_t *dfa, const re_node_set *nodes,
1716 { 1715 {
1717 if (newstate->entrance_nodes == &newstate->nodes) 1716 if (newstate->entrance_nodes == &newstate->nodes)
1718 { 1717 {
1719 newstate->entrance_nodes = re_malloc (re_node_set, 1); 1718 re_node_set *entrance_nodes = re_malloc (re_node_set, 1);
1720 if (__glibc_unlikely (newstate->entrance_nodes == NULL)) 1719 if (__glibc_unlikely (entrance_nodes == NULL))
1721 { 1720 {
1722 free_state (newstate); 1721 free_state (newstate);
1723 return NULL; 1722 return NULL;
1724 } 1723 }
1724 newstate->entrance_nodes = entrance_nodes;
1725 if (re_node_set_init_copy (newstate->entrance_nodes, nodes) 1725 if (re_node_set_init_copy (newstate->entrance_nodes, nodes)
1726 != REG_NOERROR) 1726 != REG_NOERROR)
1727 return NULL; 1727 {
1728 free_state (newstate);
1729 return NULL;
1730 }
1728 nctx_nodes = 0; 1731 nctx_nodes = 0;
1729 newstate->has_constraint = 1; 1732 newstate->has_constraint = 1;
1730 } 1733 }
diff --git a/lib/verify.h b/lib/verify.h
index afdc1ad81f1..06e975ebf65 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -56,6 +56,16 @@
56# undef _Static_assert 56# undef _Static_assert
57#endif 57#endif
58 58
59/* If the compiler lacks __has_builtin, define it well enough for this
60 source file only. */
61#ifndef __has_builtin
62# define __has_builtin(x) _GL_HAS_##x
63# define _GL_HAS___builtin_unreachable (4 < __GNUC__ + (5 <= __GNUC_MINOR__))
64# define _GL_HAS___builtin_trap \
65 (3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)))
66# define _GL_TEMPDEF___has_builtin
67#endif
68
59/* Each of these macros verifies that its argument R is nonzero. To 69/* Each of these macros verifies that its argument R is nonzero. To
60 be portable, R should be an integer constant expression. Unlike 70 be portable, R should be an integer constant expression. Unlike
61 assert (R), there is no run-time overhead. 71 assert (R), there is no run-time overhead.
@@ -260,24 +270,17 @@ template <int w>
260# define verify(R) _GL_VERIFY (R, "verify (" #R ")", -) 270# define verify(R) _GL_VERIFY (R, "verify (" #R ")", -)
261#endif 271#endif
262 272
263#ifndef __has_builtin
264# define __has_builtin(x) 0
265#endif
266
267/* Assume that R always holds. Behavior is undefined if R is false, 273/* Assume that R always holds. Behavior is undefined if R is false,
268 fails to evaluate, or has side effects. Although assuming R can 274 fails to evaluate, or has side effects. Although assuming R can
269 help a compiler generate better code or diagnostics, performance 275 help a compiler generate better code or diagnostics, performance
270 can suffer if R uses hard-to-optimize features such as function 276 can suffer if R uses hard-to-optimize features such as function
271 calls not inlined by the compiler. */ 277 calls not inlined by the compiler. */
272 278
273#if (__has_builtin (__builtin_unreachable) \ 279#if __has_builtin (__builtin_unreachable)
274 || 4 < __GNUC__ + (5 <= __GNUC_MINOR__))
275# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) 280# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
276#elif 1200 <= _MSC_VER 281#elif 1200 <= _MSC_VER
277# define assume(R) __assume (R) 282# define assume(R) __assume (R)
278#elif ((defined GCC_LINT || defined lint) \ 283#elif (defined GCC_LINT || defined lint) && __has_builtin (__builtin_trap)
279 && (__has_builtin (__builtin_trap) \
280 || 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))))
281 /* Doing it this way helps various packages when configured with 284 /* Doing it this way helps various packages when configured with
282 --enable-gcc-warnings, which compiles with -Dlint. It's nicer 285 --enable-gcc-warnings, which compiles with -Dlint. It's nicer
283 when 'assume' silences warnings even with older GCCs. */ 286 when 'assume' silences warnings even with older GCCs. */
@@ -287,6 +290,13 @@ template <int w>
287# define assume(R) ((R) ? (void) 0 : /*NOTREACHED*/ (void) 0) 290# define assume(R) ((R) ? (void) 0 : /*NOTREACHED*/ (void) 0)
288#endif 291#endif
289 292
293#ifdef _GL_TEMPDEF___has_builtin
294# undef __has_builtin
295# undef _GL_HAS___builtin_unreachable
296# undef _GL_HAS___builtin_trap
297# undef _GL_TEMPDEF___has_builtin
298#endif
299
290/* @assert.h omit end@ */ 300/* @assert.h omit end@ */
291 301
292#endif 302#endif
diff --git a/lisp/battery.el b/lisp/battery.el
index 7037d07dcf0..0ef6d37b406 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -38,19 +38,21 @@
38 :prefix "battery-" 38 :prefix "battery-"
39 :group 'hardware) 39 :group 'hardware)
40 40
41(defcustom battery-linux-sysfs-regexp "[bB][aA][tT][0-9]?$"
42 "Regexp for folder names to be searched under
43 /sys/class/power_supply/ that contain battery information."
44 :version "26.1"
45 :type 'regexp
46 :group 'battery)
47
48(defcustom battery-upower-device "battery_BAT1" 41(defcustom battery-upower-device "battery_BAT1"
49 "Upower battery device name." 42 "Upower battery device name."
50 :version "26.1" 43 :version "26.1"
51 :type 'string 44 :type 'string
52 :group 'battery) 45 :group 'battery)
53 46
47(defun battery--find-linux-sysfs-batteries ()
48 (let ((dirs nil))
49 (dolist (file (directory-files "/sys/class/power_supply/" t))
50 (when (and (or (file-directory-p file)
51 (file-symlink-p file))
52 (file-exists-p (expand-file-name "capacity" file)))
53 (push file dirs)))
54 (nreverse dirs)))
55
54(defcustom battery-status-function 56(defcustom battery-status-function
55 (cond ((and (eq system-type 'gnu/linux) 57 (cond ((and (eq system-type 'gnu/linux)
56 (file-readable-p "/proc/apm")) 58 (file-readable-p "/proc/apm"))
@@ -60,8 +62,7 @@
60 #'battery-linux-proc-acpi) 62 #'battery-linux-proc-acpi)
61 ((and (eq system-type 'gnu/linux) 63 ((and (eq system-type 'gnu/linux)
62 (file-directory-p "/sys/class/power_supply/") 64 (file-directory-p "/sys/class/power_supply/")
63 (directory-files "/sys/class/power_supply/" nil 65 (battery--find-linux-sysfs-batteries))
64 battery-linux-sysfs-regexp))
65 #'battery-linux-sysfs) 66 #'battery-linux-sysfs)
66 ((and (eq system-type 'berkeley-unix) 67 ((and (eq system-type 'berkeley-unix)
67 (file-executable-p "/usr/sbin/apm")) 68 (file-executable-p "/usr/sbin/apm"))
@@ -449,9 +450,7 @@ The following %-sequences are provided:
449 ;; available information together. 450 ;; available information together.
450 (with-temp-buffer 451 (with-temp-buffer
451 (dolist (dir (ignore-errors 452 (dolist (dir (ignore-errors
452 (directory-files 453 (battery--find-linux-sysfs-batteries)))
453 "/sys/class/power_supply/" t
454 battery-linux-sysfs-regexp)))
455 (erase-buffer) 454 (erase-buffer)
456 (ignore-errors (insert-file-contents 455 (ignore-errors (insert-file-contents
457 (expand-file-name "uevent" dir))) 456 (expand-file-name "uevent" dir)))
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index f564cd6b431..e58e051a39b 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)'."
619;; was incorrect in Emacs 22 and Emacs 23.1.) 619;; was incorrect in Emacs 22 and Emacs 23.1.)
620;; 620;;
621;; To deal with the change from FIRST format to SECOND, conversion 621;; To deal with the change from FIRST format to SECOND, conversion
622;; code was added, and it is still in use. See 622;; code was added, which is no longer used and has been declared
623;; `bookmark-maybe-upgrade-file-format'. 623;; obsolete. See `bookmark-maybe-upgrade-file-format'.
624;; 624;;
625;; No conversion from SECOND to CURRENT is done. Instead, the code 625;; No conversion from SECOND to CURRENT is done. Instead, the code
626;; handles both formats OK. It must continue to do so. 626;; handles both formats OK. It must continue to do so.
@@ -640,7 +640,7 @@ You should never need to change this.")
640 640
641 641
642(defun bookmark-alist-from-buffer () 642(defun bookmark-alist-from-buffer ()
643 "Return a `bookmark-alist' (in any format) from the current buffer. 643 "Return a `bookmark-alist' from the current buffer.
644The buffer must of course contain bookmark format information. 644The buffer must of course contain bookmark format information.
645Does not care from where in the buffer it is called, and does not 645Does not care from where in the buffer it is called, and does not
646affect point." 646affect point."
@@ -648,19 +648,13 @@ affect point."
648 (goto-char (point-min)) 648 (goto-char (point-min))
649 (if (search-forward bookmark-end-of-version-stamp-marker nil t) 649 (if (search-forward bookmark-end-of-version-stamp-marker nil t)
650 (read (current-buffer)) 650 (read (current-buffer))
651 ;; Else we're dealing with format version 0 651 (if buffer-file-name
652 (if (search-forward "(" nil t) 652 (error "File not in bookmark format: %s" buffer-file-name)
653 (progn 653 (error "Buffer not in bookmark format: %s" (buffer-name))))))
654 (forward-char -1)
655 (read (current-buffer)))
656 ;; Else no hope of getting information here.
657 (if buffer-file-name
658 (error "File not in bookmark format: %s" buffer-file-name)
659 (error "Buffer not in bookmark format: %s" (buffer-name)))))))
660
661 654
662(defun bookmark-upgrade-version-0-alist (old-list) 655(defun bookmark-upgrade-version-0-alist (old-list)
663 "Upgrade a version 0 alist OLD-LIST to the current version." 656 "Upgrade a version 0 alist OLD-LIST to the current version."
657 (declare (obsolete nil "27.1"))
664 (mapcar 658 (mapcar
665 (lambda (bookmark) 659 (lambda (bookmark)
666 (let* ((name (car bookmark)) 660 (let* ((name (car bookmark))
@@ -683,11 +677,14 @@ affect point."
683(defun bookmark-upgrade-file-format-from-0 () 677(defun bookmark-upgrade-file-format-from-0 ()
684 "Upgrade a bookmark file of format 0 (the original format) to format 1. 678 "Upgrade a bookmark file of format 0 (the original format) to format 1.
685This expects to be called from `point-min' in a bookmark file." 679This expects to be called from `point-min' in a bookmark file."
680 (declare (obsolete nil "27.1"))
686 (let* ((reporter (make-progress-reporter 681 (let* ((reporter (make-progress-reporter
687 (format "Upgrading bookmark format from 0 to %d..." 682 (format "Upgrading bookmark format from 0 to %d..."
688 bookmark-file-format-version))) 683 bookmark-file-format-version)))
689 (old-list (bookmark-alist-from-buffer)) 684 (old-list (bookmark-alist-from-buffer))
690 (new-list (bookmark-upgrade-version-0-alist old-list))) 685 (new-list (with-suppressed-warnings
686 ((obsolete bookmark-upgrade-version-0-alist))
687 (bookmark-upgrade-version-0-alist old-list))))
691 (delete-region (point-min) (point-max)) 688 (delete-region (point-min) (point-max))
692 (bookmark-insert-file-format-version-stamp buffer-file-coding-system) 689 (bookmark-insert-file-format-version-stamp buffer-file-coding-system)
693 (pp new-list (current-buffer)) 690 (pp new-list (current-buffer))
@@ -699,6 +696,7 @@ This expects to be called from `point-min' in a bookmark file."
699(defun bookmark-grok-file-format-version () 696(defun bookmark-grok-file-format-version ()
700 "Return an integer which is the file-format version of this bookmark file. 697 "Return an integer which is the file-format version of this bookmark file.
701This expects to be called from `point-min' in a bookmark file." 698This expects to be called from `point-min' in a bookmark file."
699 (declare (obsolete nil "27.1"))
702 (if (looking-at "^;;;;") 700 (if (looking-at "^;;;;")
703 (save-excursion 701 (save-excursion
704 (save-match-data 702 (save-match-data
@@ -714,12 +712,18 @@ This expects to be called from `point-min' in a bookmark file."
714 "Check the file-format version of this bookmark file. 712 "Check the file-format version of this bookmark file.
715If the version is not up-to-date, upgrade it automatically. 713If the version is not up-to-date, upgrade it automatically.
716This expects to be called from `point-min' in a bookmark file." 714This expects to be called from `point-min' in a bookmark file."
717 (let ((version (bookmark-grok-file-format-version))) 715 (declare (obsolete nil "27.1"))
716 (let ((version
717 (with-suppressed-warnings
718 ((obsolete bookmark-grok-file-format-version))
719 (bookmark-grok-file-format-version))))
718 (cond 720 (cond
719 ((= version bookmark-file-format-version) 721 ((= version bookmark-file-format-version)
720 ) ; home free -- version is current 722 ) ; home free -- version is current
721 ((= version 0) 723 ((= version 0)
722 (bookmark-upgrade-file-format-from-0)) 724 (with-suppressed-warnings
725 ((obsolete bookmark-upgrade-file-format-from-0))
726 (bookmark-upgrade-file-format-from-0)))
723 (t 727 (t
724 (error "Bookmark file format version strangeness"))))) 728 (error "Bookmark file format version strangeness")))))
725 729
@@ -1541,7 +1545,6 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
1541 (with-current-buffer (let (enable-local-variables) 1545 (with-current-buffer (let (enable-local-variables)
1542 (find-file-noselect file)) 1546 (find-file-noselect file))
1543 (goto-char (point-min)) 1547 (goto-char (point-min))
1544 (bookmark-maybe-upgrade-file-format)
1545 (let ((blist (bookmark-alist-from-buffer))) 1548 (let ((blist (bookmark-alist-from-buffer)))
1546 (unless (listp blist) 1549 (unless (listp blist)
1547 (error "Invalid bookmark list in %s" file)) 1550 (error "Invalid bookmark list in %s" file))
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 3c46982c7b0..3ae0fcbe977 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -2095,7 +2095,9 @@ written into the buffer `*icalendar-errors*'."
2095 dtstart-zone)) 2095 dtstart-zone))
2096 (start-d (icalendar--datetime-to-diary-date 2096 (start-d (icalendar--datetime-to-diary-date
2097 dtstart-dec)) 2097 dtstart-dec))
2098 (start-t (icalendar--datetime-to-colontime dtstart-dec)) 2098 (start-t (and dtstart
2099 (> (length dtstart) 8)
2100 (icalendar--datetime-to-colontime dtstart-dec)))
2099 (dtend (icalendar--get-event-property e 'DTEND)) 2101 (dtend (icalendar--get-event-property e 'DTEND))
2100 (dtend-zone (icalendar--find-time-zone 2102 (dtend-zone (icalendar--find-time-zone
2101 (icalendar--get-event-property-attributes 2103 (icalendar--get-event-property-attributes
@@ -2148,8 +2150,7 @@ written into the buffer `*icalendar-errors*'."
2148 (icalendar--get-event-property-attributes 2150 (icalendar--get-event-property-attributes
2149 e 'DTEND)) 2151 e 'DTEND))
2150 "DATE"))) 2152 "DATE")))
2151 (icalendar--datetime-to-colontime dtend-dec) 2153 (icalendar--datetime-to-colontime dtend-dec)))
2152 start-t))
2153 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d) 2154 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
2154 (cond 2155 (cond
2155 ;; recurring event 2156 ;; recurring event
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index f3d252f03c6..11bd469ae3b 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."
421 ;; Do the time part, which is pretty simple (except for leap 421 ;; Do the time part, which is pretty simple (except for leap
422 ;; seconds, I guess). 422 ;; seconds, I guess).
423 ;; Time zone adjustments are basically the same as time adjustments. 423 ;; Time zone adjustments are basically the same as time adjustments.
424 (setq seconds (time-add (+ (* (or (decoded-time-hour delta) 0) 3600) 424 (setq seconds (time-convert (or (decoded-time-second delta) 0) t))
425 (* (or (decoded-time-minute delta) 0) 60) 425 (setq seconds
426 (or (decoded-time-zone delta) 0)) 426 (time-add seconds
427 (or (decoded-time-second delta) 0))) 427 (time-convert (+ (* (or (decoded-time-hour delta) 0) 3600)
428 (* (or (decoded-time-minute delta) 0) 60)
429 (or (decoded-time-zone delta) 0))
430 (cdr seconds))))
428 431
429 (decoded-time--alter-second time seconds) 432 (decoded-time--alter-second time seconds)
430 time)) 433 time))
@@ -461,11 +464,16 @@ changes in daylight saving time are not taken into account."
461 464
462(defun decoded-time--alter-second (time seconds) 465(defun decoded-time--alter-second (time seconds)
463 "Increase the time in TIME by SECONDS." 466 "Increase the time in TIME by SECONDS."
464 (let* ((secsperday 86400) 467 (let* ((time-sec (time-convert (or (decoded-time-second time) 0) t))
465 (old (time-add (+ (* 3600 (or (decoded-time-hour time) 0)) 468 (time-hz (cdr time-sec))
466 (* 60 (or (decoded-time-minute time) 0))) 469 (old (time-add time-sec
467 (or (decoded-time-second time) 0))) 470 (time-convert
468 (new (time-add old seconds))) 471 (+ (* 3600 (or (decoded-time-hour time) 0))
472 (* 60 (or (decoded-time-minute time) 0)))
473 time-hz)))
474 (new (time-convert (time-add old seconds) t))
475 (new-hz (cdr new))
476 (secsperday (time-convert 86400 new-hz)))
469 ;; Hm... DST... 477 ;; Hm... DST...
470 (while (time-less-p new 0) 478 (while (time-less-p new 0)
471 (decoded-time--alter-day time nil) 479 (decoded-time--alter-day time nil)
@@ -474,8 +482,10 @@ changes in daylight saving time are not taken into account."
474 (decoded-time--alter-day time t) 482 (decoded-time--alter-day time t)
475 (setq new (time-subtract new secsperday))) 483 (setq new (time-subtract new secsperday)))
476 (let ((sec (time-convert new 'integer))) 484 (let ((sec (time-convert new 'integer)))
477 (setf (decoded-time-second time) (time-add (% sec 60) 485 (setf (decoded-time-second time) (time-add
478 (time-subtract new sec)) 486 (time-convert (% sec 60) new-hz)
487 (time-subtract
488 new (time-convert sec new-hz)))
479 (decoded-time-minute time) (% (/ sec 60) 60) 489 (decoded-time-minute time) (% (/ sec 60) 60)
480 (decoded-time-hour time) (/ sec 3600))))) 490 (decoded-time-hour time) (/ sec 3600)))))
481 491
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 0774a4625b3..59ba3ffcf8c 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."
216 (setq ede-proj-target-alist 216 (setq ede-proj-target-alist
217 (cons (cons name class) ede-proj-target-alist))))) 217 (cons (cons name class) ede-proj-target-alist)))))
218 218
219(defclass ede-proj-project (eieio-persistent ede-project) 219(defclass ede-proj-project (eieio-persistent ede-project eieio-named)
220 ((extension :initform ".ede") 220 ((extension :initform ".ede")
221 (file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit") 221 (file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit")
222 (makefile-type :initarg :makefile-type 222 (makefile-type :initarg :makefile-type
diff --git a/lisp/composite.el b/lisp/composite.el
index d0f20949438..b3661cc2fa0 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -558,9 +558,9 @@ All non-spacing characters have this function in
558 ;; "Improper" base characters are of the following general 558 ;; "Improper" base characters are of the following general
559 ;; categories: 559 ;; categories:
560 ;; Mark (nonspacing, combining, enclosing) 560 ;; Mark (nonspacing, combining, enclosing)
561 ;; Separator (space, line, paragraph) 561 ;; Separator (line, paragraph)
562 ;; Other (control, format, surrogate) 562 ;; Other (control, format, surrogate)
563 '(Mn Mc Me Zs Zl Zp Cc Cf Cs)) 563 '(Mn Mc Me Zl Zp Cc Cf Cs))
564 nil) 564 nil)
565 565
566 ;; A base character and the following non-spacing characters. 566 ;; A base character and the following non-spacing characters.
diff --git a/lisp/custom.el b/lisp/custom.el
index 9bd9712b65c..2e42ea73c14 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\".
1137The command `customize-create-theme' writes theme files into this 1137The command `customize-create-theme' writes theme files into this
1138directory. By default, Emacs searches for custom themes in this 1138directory. By default, Emacs searches for custom themes in this
1139directory first---see `custom-theme-load-path'." 1139directory first---see `custom-theme-load-path'."
1140 :initialize #'custom-initialize-delay
1140 :type 'string 1141 :type 'string
1141 :group 'customize 1142 :group 'customize
1142 :version "22.1") 1143 :version "22.1")
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 72deb0c45e4..91f89e1705f 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -40,7 +40,7 @@
40;; * Frame/buffer killing hooks 40;; * Frame/buffer killing hooks
41;; * Mouse-3 position relative menu 41;; * Mouse-3 position relative menu
42;; * Mouse motion, help-echo hacks 42;; * Mouse motion, help-echo hacks
43;; * Mouse clicking, double clicking, & XEmacs image clicking hack 43;; * Mouse clicking & double clicking
44;; * Mode line hacking 44;; * Mode line hacking
45;; * Utilities for use in a program covering: 45;; * Utilities for use in a program covering:
46;; o keymap massage for some actions 46;; o keymap massage for some actions
@@ -56,7 +56,6 @@
56;; 1) (require 'dframe) 56;; 1) (require 'dframe)
57;; 2) Variable Setup: 57;; 2) Variable Setup:
58;; -frame-parameters -- Frame parameters for Emacs. 58;; -frame-parameters -- Frame parameters for Emacs.
59;; -frame-plist -- Frame parameters for XEmacs.
60;; -- Not on parameter lists: They can optionally include width 59;; -- Not on parameter lists: They can optionally include width
61;; and height. If width or height is not included, then it will 60;; and height. If width or height is not included, then it will
62;; be provided to match the originating frame. In general, 61;; be provided to match the originating frame. In general,
@@ -112,13 +111,9 @@
112 111
113;;; Code: 112;;; Code:
114 113
115;;; Compatibility functions 114
116;; 115(define-obsolete-function-alias 'dframe-frame-parameter
117(defalias 'dframe-frame-parameter 116 'frame-parameter "27.1")
118 (if (fboundp 'frame-parameter) 'frame-parameter
119 (lambda (frame parameter)
120 "Return FRAME's PARAMETER value."
121 (cdr (assoc parameter (frame-parameters frame))))))
122 117
123 118
124;;; Variables 119;;; Variables
@@ -322,8 +317,8 @@ CREATE-HOOK is a hook to run after creating a frame."
322 (if (frame-live-p (symbol-value frame-var)) 317 (if (frame-live-p (symbol-value frame-var))
323 (raise-frame (symbol-value frame-var)) 318 (raise-frame (symbol-value frame-var))
324 (set frame-var 319 (set frame-var
325 (let* ((mh (dframe-frame-parameter dframe-attached-frame 320 (let* ((mh (frame-parameter dframe-attached-frame
326 'menu-bar-lines)) 321 'menu-bar-lines))
327 (paramsa 322 (paramsa
328 ;; Only add a guessed height if one is not specified 323 ;; Only add a guessed height if one is not specified
329 ;; in the input parameters. 324 ;; in the input parameters.
@@ -377,8 +372,8 @@ a cons cell indicating a position of the form (LEFT . TOP)."
377 ;; Position dframe. 372 ;; Position dframe.
378 ;; Do no positioning if not on a windowing system, 373 ;; Do no positioning if not on a windowing system,
379 (unless (or (not window-system) (eq window-system 'pc)) 374 (unless (or (not window-system) (eq window-system 'pc))
380 (let* ((pfx (dframe-frame-parameter parent-frame 'left)) 375 (let* ((pfx (frame-parameter parent-frame 'left))
381 (pfy (dframe-frame-parameter parent-frame 'top)) 376 (pfy (frame-parameter parent-frame 'top))
382 (pfw (+ (tool-bar-pixel-width parent-frame) 377 (pfw (+ (tool-bar-pixel-width parent-frame)
383 (frame-pixel-width parent-frame))) 378 (frame-pixel-width parent-frame)))
384 (pfh (frame-pixel-height parent-frame)) 379 (pfh (frame-pixel-height parent-frame))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6c06d841e7d..a321247b0b6 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)."
992 ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -") 992 ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
993 ("\\.tgz\\'" "" "gzip -dc %i | tar -xf -") 993 ("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
994 ("\\.gz\\'" "" "gunzip") 994 ("\\.gz\\'" "" "gunzip")
995 ("\\.lz\\'" "" "lzip -d")
995 ("\\.Z\\'" "" "uncompress") 996 ("\\.Z\\'" "" "uncompress")
996 ;; For .z, try gunzip. It might be an old gzip file, 997 ;; For .z, try gunzip. It might be an old gzip file,
997 ;; or it might be from compact? pack? (which?) but gunzip handles both. 998 ;; 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 40b4e2f4671..2fab11c79df 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."
4071 ,condition '(fboundp functionp) 4071 ,condition '(fboundp functionp)
4072 byte-compile-unresolved-functions)) 4072 byte-compile-unresolved-functions))
4073 (bound-list (byte-compile-find-bound-condition 4073 (bound-list (byte-compile-find-bound-condition
4074 ,condition '(boundp default-boundp))) 4074 ,condition '(boundp default-boundp local-variable-p)))
4075 ;; Maybe add to the bound list. 4075 ;; Maybe add to the bound list.
4076 (byte-compile-bound-variables 4076 (byte-compile-bound-variables
4077 (append bound-list byte-compile-bound-variables))) 4077 (append bound-list byte-compile-bound-variables)))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 7b22fa8483a..ff096918173 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.")
110;; These macros are defined here so that they 110;; These macros are defined here so that they
111;; can safely be used in init files. 111;; can safely be used in init files.
112 112
113;;;###autoload
113(defmacro cl-incf (place &optional x) 114(defmacro cl-incf (place &optional x)
114 "Increment PLACE by X (1 by default). 115 "Increment PLACE by X (1 by default).
115PLACE may be a symbol, or any generalized variable allowed by `setf'. 116PLACE may be a symbol, or any generalized variable allowed by `setf'.
@@ -129,9 +130,12 @@ The return value is the decremented value of PLACE."
129 (list 'cl-callf '- place (or x 1)))) 130 (list 'cl-callf '- place (or x 1))))
130 131
131(defmacro cl-pushnew (x place &rest keys) 132(defmacro cl-pushnew (x place &rest keys)
132 "(cl-pushnew X PLACE): insert X at the head of the list if not already there. 133 "Add X to the list stored in PLACE unless X is already in the list.
133Like (push X PLACE), except that the list is unmodified if X is `eql' to 134PLACE is a generalized variable that stores a list.
134an element already on the list. 135
136Like (push X PLACE), except that PLACE is unmodified if X is `eql'
137to an element already in the list stored in PLACE.
138
135\nKeywords supported: :test :test-not :key 139\nKeywords supported: :test :test-not :key
136\n(fn X PLACE [KEYWORD VALUE]...)" 140\n(fn X PLACE [KEYWORD VALUE]...)"
137 (declare (debug 141 (declare (debug
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 05a4192dd9b..a02fae391bc 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2906,7 +2906,16 @@ Supported keywords for slots are:
2906 (error "Duplicate slots named %s in %s" slot name)) 2906 (error "Duplicate slots named %s in %s" slot name))
2907 (let ((accessor (intern (format "%s%s" conc-name slot))) 2907 (let ((accessor (intern (format "%s%s" conc-name slot)))
2908 (default-value (pop desc)) 2908 (default-value (pop desc))
2909 (doc (plist-get desc :documentation))) 2909 (doc (plist-get desc :documentation))
2910 (access-body
2911 `(progn
2912 ,@(and pred-check
2913 (list `(or ,pred-check
2914 (signal 'wrong-type-argument
2915 (list ',name cl-x)))))
2916 ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
2917 (if (= pos 0) '(car cl-x)
2918 `(nth ,pos cl-x))))))
2910 (push slot slots) 2919 (push slot slots)
2911 (push default-value defaults) 2920 (push default-value defaults)
2912 ;; The arg "cl-x" is referenced by name in eg pred-form 2921 ;; The arg "cl-x" is referenced by name in eg pred-form
@@ -2916,13 +2925,7 @@ Supported keywords for slots are:
2916 slot name 2925 slot name
2917 (if doc (concat "\n" doc) "")) 2926 (if doc (concat "\n" doc) ""))
2918 (declare (side-effect-free t)) 2927 (declare (side-effect-free t))
2919 ,@(and pred-check 2928 ,access-body)
2920 (list `(or ,pred-check
2921 (signal 'wrong-type-argument
2922 (list ',name cl-x)))))
2923 ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
2924 (if (= pos 0) '(car cl-x)
2925 `(nth ,pos cl-x))))
2926 forms) 2929 forms)
2927 (when (cl-oddp (length desc)) 2930 (when (cl-oddp (length desc))
2928 (push 2931 (push
@@ -2942,11 +2945,18 @@ Supported keywords for slots are:
2942 forms) 2945 forms)
2943 (push kw desc) 2946 (push kw desc)
2944 (setcar defaults nil)))) 2947 (setcar defaults nil))))
2945 (if (plist-get desc ':read-only) 2948 (cond
2946 (push `(gv-define-expander ,accessor 2949 ((eq defsym 'defun)
2947 (lambda (_cl-do _cl-x) 2950 (unless (plist-get desc ':read-only)
2948 (error "%s is a read-only slot" ',accessor))) 2951 (push `(defun ,(gv-setter accessor) (val cl-x)
2949 forms) 2952 (setf ,access-body val))
2953 forms)))
2954 ((plist-get desc ':read-only)
2955 (push `(gv-define-expander ,accessor
2956 (lambda (_cl-do _cl-x)
2957 (error "%s is a read-only slot" ',accessor)))
2958 forms))
2959 (t
2950 ;; For normal slots, we don't need to define a setf-expander, 2960 ;; For normal slots, we don't need to define a setf-expander,
2951 ;; since gv-get can use the compiler macro to get the 2961 ;; since gv-get can use the compiler macro to get the
2952 ;; same result. 2962 ;; same result.
@@ -2964,7 +2974,7 @@ Supported keywords for slots are:
2964 ;; ,(and pred-check `',pred-check) 2974 ;; ,(and pred-check `',pred-check)
2965 ;; ,pos))) 2975 ;; ,pos)))
2966 ;; forms) 2976 ;; forms)
2967 ) 2977 ))
2968 (if print-auto 2978 (if print-auto
2969 (nconc print-func 2979 (nconc print-func
2970 (list `(princ ,(format " %s" slot) cl-s) 2980 (list `(princ ,(format " %s" slot) cl-s)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index be531aab849..bbc3a27504c 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.
363;;;###autoload 363;;;###autoload
364(defalias 'define-global-minor-mode 'define-globalized-minor-mode) 364(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
365;;;###autoload 365;;;###autoload
366(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys) 366(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
367 "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE. 367 "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
368TURN-ON is a function that will be called with no args in every buffer 368TURN-ON is a function that will be called with no args in every buffer
369 and that should try to turn MODE on if applicable for that buffer. 369 and that should try to turn MODE on if applicable for that buffer.
370KEYS is a list of CL-style keyword arguments. As the minor mode 370Each of KEY VALUE is a pair of CL-style keyword arguments. As
371 defined by this function is always global, any :global keyword is 371 the minor mode defined by this function is always global, any
372 ignored. Other keywords have the same meaning as in `define-minor-mode', 372 :global keyword is ignored. Other keywords have the same
373 which see. In particular, :group specifies the custom group. 373 meaning as in `define-minor-mode', which see. In particular,
374 The most useful keywords are those that are passed on to the 374 :group specifies the custom group. The most useful keywords
375 `defcustom'. It normally makes no sense to pass the :lighter 375 are those that are passed on to the `defcustom'. It normally
376 or :keymap keywords to `define-globalized-minor-mode', since these 376 makes no sense to pass the :lighter or :keymap keywords to
377 are usually passed to the buffer-local version of the minor mode. 377 `define-globalized-minor-mode', since these are usually passed
378 to the buffer-local version of the minor mode.
379BODY contains code to execute each time the mode is enabled or disabled.
380 It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
378 381
379If MODE's set-up depends on the major mode in effect when it was 382If MODE's set-up depends on the major mode in effect when it was
380enabled, then disabling and reenabling MODE should make MODE work 383enabled, then disabling and reenabling MODE should make MODE work
@@ -384,7 +387,9 @@ call another major mode in their body.
384 387
385When a major mode is initialized, MODE is actually turned on just 388When a major mode is initialized, MODE is actually turned on just
386after running the major mode's hook. However, MODE is not turned 389after running the major mode's hook. However, MODE is not turned
387on if the hook has explicitly disabled it." 390on if the hook has explicitly disabled it.
391
392\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)"
388 (declare (doc-string 2)) 393 (declare (doc-string 2))
389 (let* ((global-mode-name (symbol-name global-mode)) 394 (let* ((global-mode-name (symbol-name global-mode))
390 (mode-name (symbol-name mode)) 395 (mode-name (symbol-name mode))
@@ -404,12 +409,12 @@ on if the hook has explicitly disabled it."
404 keyw) 409 keyw)
405 410
406 ;; Check keys. 411 ;; Check keys.
407 (while (keywordp (setq keyw (car keys))) 412 (while (keywordp (setq keyw (car body)))
408 (setq keys (cdr keys)) 413 (pop body)
409 (pcase keyw 414 (pcase keyw
410 (:group (setq group (nconc group (list :group (pop keys))))) 415 (:group (setq group (nconc group (list :group (pop body)))))
411 (:global (setq keys (cdr keys))) 416 (:global (pop body))
412 (_ (push keyw extra-keywords) (push (pop keys) extra-keywords)))) 417 (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
413 418
414 `(progn 419 `(progn
415 (progn 420 (progn
@@ -446,7 +451,8 @@ See `%s' for more information on %s."
446 ;; Go through existing buffers. 451 ;; Go through existing buffers.
447 (dolist (buf (buffer-list)) 452 (dolist (buf (buffer-list))
448 (with-current-buffer buf 453 (with-current-buffer buf
449 (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1)))))) 454 (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1)))))
455 ,@body)
450 456
451 ;; Autoloading define-globalized-minor-mode autoloads everything 457 ;; Autoloading define-globalized-minor-mode autoloads everything
452 ;; up-to-here. 458 ;; up-to-here.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 16b58632099..2892faae21d 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -207,7 +207,24 @@ expression point is on."
207(define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode 207(define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode
208 :group 'eldoc 208 :group 'eldoc
209 :initialize 'custom-initialize-delay 209 :initialize 'custom-initialize-delay
210 :init-value t) 210 :init-value t
211 ;; For `read--expression', the usual global mode mechanism of
212 ;; `change-major-mode-hook' runs in the minibuffer before
213 ;; `eldoc-documentation-function' is set, so `turn-on-eldoc-mode'
214 ;; does nothing. Configure and enable eldoc from
215 ;; `eval-expression-minibuffer-setup-hook' instead.
216 (if global-eldoc-mode
217 (add-hook 'eval-expression-minibuffer-setup-hook
218 #'eldoc--eval-expression-setup)
219 (remove-hook 'eval-expression-minibuffer-setup-hook
220 #'eldoc--eval-expression-setup)))
221
222(defun eldoc--eval-expression-setup ()
223 ;; Setup `eldoc', similar to `emacs-lisp-mode'. FIXME: Call
224 ;; `emacs-lisp-mode' itself?
225 (add-function :before-until (local 'eldoc-documentation-function)
226 #'elisp-eldoc-documentation-function)
227 (eldoc-mode +1))
211 228
212;;;###autoload 229;;;###autoload
213(defun turn-on-eldoc-mode () 230(defun turn-on-eldoc-mode ()
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9fc7e4a797d..142c99edd43 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."
285A library name is the filename of an Emacs Lisp library located 285A library name is the filename of an Emacs Lisp library located
286in a directory under `load-path' (or `find-function-source-path', 286in a directory under `load-path' (or `find-function-source-path',
287if non-nil)." 287if non-nil)."
288 (let* ((dirs (or find-function-source-path load-path)) 288 (let* ((suffix-regexp (mapconcat
289 (suffixes (find-library-suffixes)) 289 (lambda (suffix)
290 (table (apply-partially 'locate-file-completion-table 290 (concat (regexp-quote suffix) "\\'"))
291 dirs suffixes)) 291 (find-library-suffixes)
292 "\\|"))
293 (table (cl-loop for dir in (or find-function-source-path load-path)
294 when (file-readable-p dir)
295 append (mapcar
296 (lambda (file)
297 (replace-regexp-in-string suffix-regexp
298 "" file))
299 (directory-files dir nil
300 suffix-regexp))))
292 (def (if (eq (function-called-at-point) 'require) 301 (def (if (eq (function-called-at-point) 'require)
293 ;; `function-called-at-point' may return 'require 302 ;; `function-called-at-point' may return 'require
294 ;; with `point' anywhere on this line. So wrap the 303 ;; with `point' anywhere on this line. So wrap the
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a72522ad8f8..ef0c5171de6 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1028,6 +1028,7 @@ is wrapped around any parts requiring it."
1028 deps)))) 1028 deps))))
1029 1029
1030(declare-function lm-header "lisp-mnt" (header)) 1030(declare-function lm-header "lisp-mnt" (header))
1031(declare-function lm-header-multiline "lisp-mnt" (header))
1031(declare-function lm-homepage "lisp-mnt" (&optional file)) 1032(declare-function lm-homepage "lisp-mnt" (&optional file))
1032(declare-function lm-keywords-list "lisp-mnt" (&optional file)) 1033(declare-function lm-keywords-list "lisp-mnt" (&optional file))
1033(declare-function lm-maintainer "lisp-mnt" (&optional file)) 1034(declare-function lm-maintainer "lisp-mnt" (&optional file))
@@ -1054,8 +1055,7 @@ boundaries."
1054 (narrow-to-region start (point)) 1055 (narrow-to-region start (point))
1055 (require 'lisp-mnt) 1056 (require 'lisp-mnt)
1056 ;; Use some headers we've invented to drive the process. 1057 ;; Use some headers we've invented to drive the process.
1057 (let* ((requires-str (lm-header "package-requires")) 1058 (let* (;; Prefer Package-Version; if defined, the package author
1058 ;; Prefer Package-Version; if defined, the package author
1059 ;; probably wants us to use it. Otherwise try Version. 1059 ;; probably wants us to use it. Otherwise try Version.
1060 (pkg-version 1060 (pkg-version
1061 (or (package-strip-rcs-id (lm-header "package-version")) 1061 (or (package-strip-rcs-id (lm-header "package-version"))
@@ -1067,9 +1067,9 @@ boundaries."
1067 "Package lacks a \"Version\" or \"Package-Version\" header")) 1067 "Package lacks a \"Version\" or \"Package-Version\" header"))
1068 (package-desc-from-define 1068 (package-desc-from-define
1069 file-name pkg-version desc 1069 file-name pkg-version desc
1070 (if requires-str 1070 (and-let* ((require-lines (lm-header-multiline "package-requires")))
1071 (package--prepare-dependencies 1071 (package--prepare-dependencies
1072 (package-read-from-string requires-str))) 1072 (package-read-from-string (mapconcat #'identity require-lines " "))))
1073 :kind 'single 1073 :kind 'single
1074 :url homepage 1074 :url homepage
1075 :keywords keywords 1075 :keywords keywords
@@ -2894,7 +2894,7 @@ KEYWORDS should be nil or a list of keywords."
2894 (mapcar #'package-menu--print-info-simple info-list)))) 2894 (mapcar #'package-menu--print-info-simple info-list))))
2895 2895
2896(defun package-all-keywords () 2896(defun package-all-keywords ()
2897 "Collect all package keywords" 2897 "Collect all package keywords."
2898 (let ((key-list)) 2898 (let ((key-list))
2899 (package--mapc (lambda (desc) 2899 (package--mapc (lambda (desc)
2900 (setq key-list (append (package-desc--keywords desc) 2900 (setq key-list (append (package-desc--keywords desc)
@@ -2951,7 +2951,7 @@ When none are given, the package matches."
2951 2951
2952(defun package-menu--generate (remember-pos packages &optional keywords) 2952(defun package-menu--generate (remember-pos packages &optional keywords)
2953 "Populate the Package Menu. 2953 "Populate the Package Menu.
2954 If REMEMBER-POS is non-nil, keep point on the same entry. 2954If REMEMBER-POS is non-nil, keep point on the same entry.
2955PACKAGES should be t, which means to display all known packages, 2955PACKAGES should be t, which means to display all known packages,
2956or a list of package names (symbols) to display. 2956or a list of package names (symbols) to display.
2957 2957
@@ -3086,12 +3086,15 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
3086 "`package-archive-contents' before the latest refresh.") 3086 "`package-archive-contents' before the latest refresh.")
3087 3087
3088(defun package-menu-refresh () 3088(defun package-menu-refresh ()
3089 "Download the Emacs Lisp package archive. 3089 "In Package Menu, download the Emacs Lisp package archive.
3090This fetches the contents of each archive specified in 3090Fetch the contents of each archive specified in
3091`package-archives', and then refreshes the package menu." 3091`package-archives', and then refresh the package menu. Signal a
3092user-error if there is already a refresh running asynchronously."
3092 (interactive) 3093 (interactive)
3093 (unless (derived-mode-p 'package-menu-mode) 3094 (unless (derived-mode-p 'package-menu-mode)
3094 (user-error "The current buffer is not a Package Menu")) 3095 (user-error "The current buffer is not a Package Menu"))
3096 (when (and package-menu-async package--downloads-in-progress)
3097 (user-error "Package refresh is already in progress, please wait..."))
3095 (setq package-menu--old-archive-contents package-archive-contents) 3098 (setq package-menu--old-archive-contents package-archive-contents)
3096 (setq package-menu--new-package-list nil) 3099 (setq package-menu--new-package-list nil)
3097 (package-refresh-contents package-menu-async)) 3100 (package-refresh-contents package-menu-async))
@@ -3206,7 +3209,7 @@ The full list of keys can be viewed with \\[describe-mode]."
3206 "Return the priority of ARCHIVE. 3209 "Return the priority of ARCHIVE.
3207 3210
3208The archive priorities are specified in 3211The archive priorities are specified in
3209`package-archive-priorities'. If not given there, the priority 3212`package-archive-priorities'. If not given there, the priority
3210defaults to 0." 3213defaults to 0."
3211 (or (cdr (assoc archive package-archive-priorities)) 3214 (or (cdr (assoc archive package-archive-priorities))
3212 0)) 3215 0))
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 47f3b8dc9cf..13cd1c0f42a 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -106,7 +106,7 @@ Usage example:
106 (setq tchar 106 (setq tchar
107 (if (and (display-popup-menus-p) 107 (if (and (display-popup-menus-p)
108 last-input-event ; not during startup 108 last-input-event ; not during startup
109 (listp last-nonmenu-event) 109 (consp last-nonmenu-event)
110 use-dialog-box) 110 use-dialog-box)
111 (x-popup-dialog 111 (x-popup-dialog
112 t 112 t
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index f76409c4de8..bb2bf3dd5fa 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]+\"."
236 (string-trim-left (string-trim-right string trim-right) trim-left)) 236 (string-trim-left (string-trim-right string trim-right) trim-left))
237 237
238(defsubst string-blank-p (string) 238(defsubst string-blank-p (string)
239 "Check whether STRING is either empty or only whitespace." 239 "Check whether STRING is either empty or only whitespace.
240The following characters count as whitespace here: space, tab, newline and
241carriage return."
240 (string-match-p "\\`[ \t\n\r]*\\'" string)) 242 (string-match-p "\\`[ \t\n\r]*\\'" string))
241 243
242(defsubst string-remove-prefix (prefix string) 244(defsubst string-remove-prefix (prefix string)
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index d9886d3d67f..c43641aacf3 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -102,16 +102,15 @@ encryption is used."
102 (apply operation args))) 102 (apply operation args)))
103 103
104(defun epa-file-decode-and-insert (string file visit beg end replace) 104(defun epa-file-decode-and-insert (string file visit beg end replace)
105 (if (fboundp 'decode-coding-inserted-region) 105 (save-restriction
106 (save-restriction 106 (narrow-to-region (point) (point))
107 (narrow-to-region (point) (point)) 107 (insert string)
108 (insert string) 108 (decode-coding-inserted-region
109 (decode-coding-inserted-region 109 (point-min) (point-max)
110 (point-min) (point-max) 110 (substring file 0 (string-match epa-file-name-regexp file))
111 (substring file 0 (string-match epa-file-name-regexp file)) 111 visit beg end replace)
112 visit beg end replace)) 112 (goto-char (point-max))
113 (insert (epa-file--decode-coding-string string (or coding-system-for-read 113 (- (point-max) (point-min))))
114 'undecided)))))
115 114
116(defvar epa-file-error nil) 115(defvar epa-file-error nil)
117(defun epa-file--find-file-not-found-function () 116(defun epa-file--find-file-not-found-function ()
@@ -147,8 +146,6 @@ encryption is used."
147 (format "Decrypting %s" file))) 146 (format "Decrypting %s" file)))
148 (unwind-protect 147 (unwind-protect
149 (progn 148 (progn
150 (if replace
151 (goto-char (point-min)))
152 (condition-case error 149 (condition-case error
153 (setq string (epg-decrypt-file context local-file nil)) 150 (setq string (epg-decrypt-file context local-file nil))
154 (error 151 (error
@@ -187,12 +184,11 @@ encryption is used."
187 ;; really edit the buffer. 184 ;; really edit the buffer.
188 (let ((buffer-file-name 185 (let ((buffer-file-name
189 (if visit nil buffer-file-name))) 186 (if visit nil buffer-file-name)))
190 (save-restriction 187 (setq length
191 (narrow-to-region (point) (point)) 188 (if replace
192 (epa-file-decode-and-insert string file visit beg end replace) 189 (epa-file--replace-text string file visit beg end)
193 (setq length (- (point-max) (point-min)))) 190 (epa-file-decode-and-insert
194 (if replace 191 string file visit beg end replace))))
195 (delete-region (point) (point-max))))
196 (if visit 192 (if visit
197 (set-visited-file-modtime)))) 193 (set-visited-file-modtime))))
198 (if (and local-copy 194 (if (and local-copy
@@ -201,6 +197,38 @@ encryption is used."
201 (list file length))) 197 (list file length)))
202(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents) 198(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
203 199
200(defun epa-file--replace-text (string file visit beg end)
201 ;; The idea here is that we want to replace the text in the buffer
202 ;; (for instance, for a `revert-buffer'), but we want to touch as
203 ;; little of the text as possible. So we compare the new and the
204 ;; old text and only starts replacing when the text changes.
205 (let ((orig-point (point))
206 new-start length)
207 (goto-char (point-max))
208 (setq new-start (point))
209 (setq length
210 (epa-file-decode-and-insert
211 string file visit beg end t))
212 (if (equal (buffer-substring (point-min) new-start)
213 (buffer-substring new-start (point-max)))
214 ;; The new text is equal to the old, so just keep the old.
215 (delete-region new-start (point-max))
216 ;; Compute the region the hard way.
217 (let ((p1 (point-min))
218 (p2 new-start))
219 (while (and (< p1 new-start)
220 (< p2 (point-max))
221 (eql (char-after p1) (char-after p2)))
222 (cl-incf p1)
223 (cl-incf p2))
224 (delete-region new-start p2)
225 (delete-region p1 new-start)))
226 ;; Restore point, if possible.
227 (if (< orig-point (point-max))
228 (goto-char orig-point)
229 (goto-char (point-max)))
230 length))
231
204(defun epa-file-write-region (start end file &optional append visit lockname 232(defun epa-file-write-region (start end file &optional append visit lockname
205 mustbenew) 233 mustbenew)
206 (if append 234 (if append
diff --git a/lisp/epa.el b/lisp/epa.el
index 9e6edf463c6..b55a55fbb9a 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -440,12 +440,12 @@ If ARG is non-nil, mark the key."
440 (substitute-command-keys "\ 440 (substitute-command-keys "\
441- `\\[epa-mark-key]' to mark a key on the line 441- `\\[epa-mark-key]' to mark a key on the line
442- `\\[epa-unmark-key]' to unmark a key on the line\n")) 442- `\\[epa-unmark-key]' to unmark a key on the line\n"))
443 (widget-create 'link 443 (widget-create 'push-button
444 :notify (lambda (&rest _ignore) (abort-recursive-edit)) 444 :notify (lambda (&rest _ignore) (abort-recursive-edit))
445 :help-echo 445 :help-echo
446 "Click here or \\[abort-recursive-edit] to cancel" 446 "Click here or \\[abort-recursive-edit] to cancel"
447 "Cancel") 447 "Cancel")
448 (widget-create 'link 448 (widget-create 'push-button
449 :notify (lambda (&rest _ignore) (exit-recursive-edit)) 449 :notify (lambda (&rest _ignore) (exit-recursive-edit))
450 :help-echo 450 :help-echo
451 "Click here or \\[exit-recursive-edit] to finish" 451 "Click here or \\[exit-recursive-edit] to finish"
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 55490681698..4a9cc7744cb 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
148version requirement is met." 148version requirement is met."
149 (unless program-alist 149 (unless program-alist
150 (setq program-alist epg-config--program-alist)) 150 (setq program-alist epg-config--program-alist))
151 (let ((entry (assq protocol program-alist))) 151 (let ((entry (assq protocol program-alist))
152 ;; In many gnupg distributions (especially on Windows), the
153 ;; version string is "gpg (GnuPG) 2.2.15-unknown" or the like.
154 (version-regexp-alist (cons '("^[-._+ ]?unknown$" . -4)
155 version-regexp-alist)))
152 (unless entry 156 (unless entry
153 (error "Unknown protocol %S" protocol)) 157 (error "Unknown protocol %S" protocol))
154 (cl-destructuring-bind (symbol . alist) 158 (cl-destructuring-bind (symbol . alist)
@@ -262,6 +266,15 @@ a single minimum version string."
262 (throw 'version-ok t))) 266 (throw 'version-ok t)))
263 (error "Unsupported version: %s" version)))) 267 (error "Unsupported version: %s" version))))
264 268
269(defun epg-required-version-p (protocol required-version)
270 "Verify a sufficient version of GnuPG for specific protocol.
271PROTOCOL is symbol, either `OpenPGP' or `CMS'. REQUIRED-VERSION
272is a string containing the required version number. Return
273non-nil if that version or higher is installed."
274 (let ((version (cdr (assq 'version (epg-find-configuration protocol)))))
275 (and (stringp version)
276 (version<= required-version version))))
277
265;;;###autoload 278;;;###autoload
266(defun epg-expand-group (config group) 279(defun epg-expand-group (config group)
267 "Look at CONFIG and try to expand GROUP." 280 "Look at CONFIG and try to expand GROUP."
diff --git a/lisp/epg.el b/lisp/epg.el
index ce58c520f17..6d377d07e29 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1618,7 +1618,9 @@ If you are unsure, use synchronous version of this function
1618 (car (epg-key-sub-key-list signer))))) 1618 (car (epg-key-sub-key-list signer)))))
1619 (epg-context-signers context))) 1619 (epg-context-signers context)))
1620 (let ((sender (epg-context-sender context))) 1620 (let ((sender (epg-context-sender context)))
1621 (when (stringp sender) 1621 (when (and (eql 'OpenPGP (epg-context-protocol context))
1622 (epg-required-version-p 'OpenPGP "2.1.15")
1623 (stringp sender))
1622 (list "--sender" sender))) 1624 (list "--sender" sender)))
1623 (epg--args-from-sig-notations 1625 (epg--args-from-sig-notations
1624 (epg-context-sig-notations context)) 1626 (epg-context-sig-notations context))
@@ -1714,9 +1716,11 @@ If you are unsure, use synchronous version of this function
1714 (car (epg-key-sub-key-list 1716 (car (epg-key-sub-key-list
1715 signer))))) 1717 signer)))))
1716 (epg-context-signers context)))) 1718 (epg-context-signers context))))
1717 (if sign 1719 (if (and sign
1720 (eql 'OpenPGP (epg-context-protocol context)))
1718 (let ((sender (epg-context-sender context))) 1721 (let ((sender (epg-context-sender context)))
1719 (when (stringp sender) 1722 (when (and (epg-required-version-p 'OpenPGP "2.1.15")
1723 (stringp sender))
1720 (list "--sender" sender)))) 1724 (list "--sender" sender))))
1721 (if sign 1725 (if sign
1722 (epg--args-from-sig-notations 1726 (epg--args-from-sig-notations
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f5c9decc3a2..fd1bd5545da 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2594,6 +2594,8 @@ every `erc-lurker-cleanup-interval' updates to
2594consumption of lurker state during long Emacs sessions and/or ERC 2594consumption of lurker state during long Emacs sessions and/or ERC
2595sessions with large numbers of incoming PRIVMSGs.") 2595sessions with large numbers of incoming PRIVMSGs.")
2596 2596
2597(defvar erc-message-parsed)
2598
2597(defun erc-lurker-update-status (_message) 2599(defun erc-lurker-update-status (_message)
2598 "Update `erc-lurker-state' if necessary. 2600 "Update `erc-lurker-state' if necessary.
2599 2601
@@ -2603,18 +2605,20 @@ reflect the fact that its sender has issued a PRIVMSG at the
2603current time. Otherwise, take no action. 2605current time. Otherwise, take no action.
2604 2606
2605This function depends on the fact that `erc-display-message' 2607This function depends on the fact that `erc-display-message'
2606dynamically binds `parsed', which is used to check if the current 2608dynamically binds `erc-message-parsed', which is used to check if
2607message is a PRIVMSG and to determine its sender. See also 2609the current message is a PRIVMSG and to determine its sender.
2608`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'. 2610See also `erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
2609 2611
2610In order to limit memory consumption, this function also calls 2612In order to limit memory consumption, this function also calls
2611`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval' 2613`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
2612updates of `erc-lurker-state'." 2614updates of `erc-lurker-state'."
2613 (when (and (boundp 'parsed) (erc-response-p parsed)) 2615 (when (and (boundp 'erc-message-parsed)
2614 (let* ((command (erc-response.command parsed)) 2616 (erc-response-p erc-message-parsed))
2617 (let* ((command (erc-response.command erc-message-parsed))
2615 (sender 2618 (sender
2616 (erc-lurker-maybe-trim 2619 (erc-lurker-maybe-trim
2617 (car (erc-parse-user (erc-response.sender parsed))))) 2620 (car (erc-parse-user
2621 (erc-response.sender erc-message-parsed)))))
2618 (server 2622 (server
2619 (erc-canonicalize-server-name erc-server-announced-name))) 2623 (erc-canonicalize-server-name erc-server-announced-name)))
2620 (when (equal command "PRIVMSG") 2624 (when (equal command "PRIVMSG")
@@ -2704,7 +2708,8 @@ ARGS, PARSED, and TYPE are used to format MSG sensibly.
2704See also `erc-format-message' and `erc-display-line'." 2708See also `erc-format-message' and `erc-display-line'."
2705 (let ((string (if (symbolp msg) 2709 (let ((string (if (symbolp msg)
2706 (apply #'erc-format-message msg args) 2710 (apply #'erc-format-message msg args)
2707 msg))) 2711 msg))
2712 (erc-message-parsed parsed))
2708 (setq string 2713 (setq string
2709 (cond 2714 (cond
2710 ((null type) 2715 ((null type)
diff --git a/lisp/files.el b/lisp/files.el
index f76635017d5..ce4dd99bd53 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1043,7 +1043,7 @@ directory if it does not exist."
1043 (setq errtype "access")) 1043 (setq errtype "access"))
1044 (with-file-modes ?\700 1044 (with-file-modes ?\700
1045 (condition-case nil 1045 (condition-case nil
1046 (make-directory user-emacs-directory) 1046 (make-directory user-emacs-directory t)
1047 (error (setq errtype "create"))))) 1047 (error (setq errtype "create")))))
1048 (when (and errtype 1048 (when (and errtype
1049 user-emacs-directory-warning 1049 user-emacs-directory-warning
@@ -2719,6 +2719,8 @@ since only a single case-insensitive search through the alist is made."
2719 ("\\.bib\\'" . bibtex-mode) 2719 ("\\.bib\\'" . bibtex-mode)
2720 ("\\.bst\\'" . bibtex-style-mode) 2720 ("\\.bst\\'" . bibtex-style-mode)
2721 ("\\.sql\\'" . sql-mode) 2721 ("\\.sql\\'" . sql-mode)
2722 ;; These .m4 files are Autoconf files.
2723 ("\\(acinclude\\|aclocal\\|acsite\\)\\.m4\\'" . autoconf-mode)
2722 ("\\.m[4c]\\'" . m4-mode) 2724 ("\\.m[4c]\\'" . m4-mode)
2723 ("\\.mf\\'" . metafont-mode) 2725 ("\\.mf\\'" . metafont-mode)
2724 ("\\.mp\\'" . metapost-mode) 2726 ("\\.mp\\'" . metapost-mode)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index af8ec68ddd2..04cb087737f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3628,7 +3628,7 @@ possible values."
3628 (unless max-segments 3628 (unless max-segments
3629 (setq max-segments (length article-time-units))) 3629 (setq max-segments (length article-time-units)))
3630 (cond 3630 (cond
3631 ((zerop sec) 3631 ((< (abs sec) 1)
3632 "Now") 3632 "Now")
3633 (t 3633 (t
3634 (concat 3634 (concat
@@ -5059,7 +5059,10 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
5059 (list 5059 (list
5060 (read-file-name "Replace MIME part with file: " 5060 (read-file-name "Replace MIME part with file: "
5061 (or mm-default-directory default-directory) 5061 (or mm-default-directory default-directory)
5062 nil nil))) 5062 nil t)))
5063 (unless (file-regular-p (file-truename file))
5064 (error "Can't replace part with %s, which isn't a regular file"
5065 file))
5063 (gnus-mime-save-part-and-strip file)) 5066 (gnus-mime-save-part-and-strip file))
5064 5067
5065(defun gnus-mime-save-part-and-strip (&optional file) 5068(defun gnus-mime-save-part-and-strip (&optional file)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 930d522c41b..e8775c66673 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
738and not a positive number, Gnus will prompt the user for the name 738and not a positive number, Gnus will prompt the user for the name
739of an NNTP server to use. As opposed to \\[gnus], this command 739of an NNTP server to use. As opposed to \\[gnus], this command
740will not connect to the local server." 740will not connect to the local server."
741 (interactive "P")
742 (let ((val (or arg (1- gnus-level-default-subscribed)))) 741 (let ((val (or arg (1- gnus-level-default-subscribed))))
743 (gnus val t slave) 742 (gnus val t slave)
744 (make-local-variable 'gnus-group-use-permanent-levels) 743 (make-local-variable 'gnus-group-use-permanent-levels)
@@ -749,8 +748,6 @@ will not connect to the local server."
749If ARG is non-nil and a positive number, Gnus will use that as the 748If ARG is non-nil and a positive number, Gnus will use that as the
750startup level. If ARG is non-nil and not a positive number, Gnus will 749startup level. If ARG is non-nil and not a positive number, Gnus will
751prompt the user for the name of an NNTP server to use." 750prompt the user for the name of an NNTP server to use."
752 (interactive "P")
753
754 (if (gnus-alive-p) 751 (if (gnus-alive-p)
755 (progn 752 (progn
756 (gnus-run-hooks 'gnus-before-resume-hook) 753 (gnus-run-hooks 'gnus-before-resume-hook)
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 07d20285343..e0ec829617f 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. "
915 (when sign 915 (when sign
916 (setq signers (mml-secure-signers context signer-names)) 916 (setq signers (mml-secure-signers context signer-names))
917 (setf (epg-context-signers context) signers) 917 (setf (epg-context-signers context) signers)
918 (when mml-secure-openpgp-sign-with-sender 918 (when (and (eq 'OpenPGP protocol) mml-secure-openpgp-sign-with-sender)
919 (setf (epg-context-sender context) sender))) 919 (setf (epg-context-sender context) sender)))
920 (when (eq 'OpenPGP protocol) 920 (when (eq 'OpenPGP protocol)
921 (setf (epg-context-armor context) t) 921 (setf (epg-context-armor context) t)
@@ -945,10 +945,10 @@ If no one is selected, symmetric encryption will be performed. "
945 signature micalg) 945 signature micalg)
946 (when (eq 'OpenPGP protocol) 946 (when (eq 'OpenPGP protocol)
947 (setf (epg-context-armor context) t) 947 (setf (epg-context-armor context) t)
948 (setf (epg-context-textmode context) t)) 948 (setf (epg-context-textmode context) t)
949 (when mml-secure-openpgp-sign-with-sender
950 (setf (epg-context-sender context) sender)))
949 (setf (epg-context-signers context) signers) 951 (setf (epg-context-signers context) signers)
950 (when mml-secure-openpgp-sign-with-sender
951 (setf (epg-context-sender context) sender))
952 (when (mml-secure-cache-passphrase-p protocol) 952 (when (mml-secure-cache-passphrase-p protocol)
953 (epg-context-set-passphrase-callback 953 (epg-context-set-passphrase-callback
954 context 954 context
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 65465d3b4c8..b6b0e2a736e 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -447,7 +447,7 @@ highlighting will not update as you type."
447 (hi-lock-set-pattern 447 (hi-lock-set-pattern
448 ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? 448 ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
449 ;; or a trailing $ in REGEXP will be interpreted correctly. 449 ;; or a trailing $ in REGEXP will be interpreted correctly.
450 (concat "^.*\\(?:" regexp "\\).*$") face)) 450 (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face))
451 451
452 452
453;;;###autoload 453;;;###autoload
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 1b69574a392..06a2248d405 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."
1846 (stringp dired-directory) 1846 (stringp dired-directory)
1847 dired-directory))))) 1847 dired-directory)))))
1848 (when name 1848 (when name
1849 (string-match regexp name)))))) 1849 ;; Match on the displayed file name (which is abbreviated).
1850 (string-match regexp (abbreviate-file-name name)))))))
1850 1851
1851;;;###autoload 1852;;;###autoload
1852(defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers) 1853(defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers)
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 5c30f4085c3..9c7c91eb58a 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -720,11 +720,15 @@ was inserted."
720 archive-superior-buffer)) 720 archive-superior-buffer))
721 (not (and (boundp 'tar-superior-buffer) 721 (not (and (boundp 'tar-superior-buffer)
722 tar-superior-buffer)) 722 tar-superior-buffer))
723 ;; This means the buffer holds the contents
724 ;; of a file uncompressed by jka-compr.el.
725 (not (and (local-variable-p
726 'jka-compr-really-do-compress)
727 jka-compr-really-do-compress))
723 ;; This means the buffer holds the 728 ;; This means the buffer holds the
724 ;; decrypted content (bug#21870). 729 ;; decrypted content (bug#21870).
725 (not (and (boundp 'epa-file-encrypt-to) 730 (not (local-variable-p
726 (local-variable-p 731 'epa-file-encrypt-to)))))
727 'epa-file-encrypt-to))))))
728 (file-or-data 732 (file-or-data
729 (if data-p 733 (if data-p
730 (let ((str 734 (let ((str
diff --git a/lisp/info.el b/lisp/info.el
index 16909736f8d..02f3ea580b0 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -318,7 +318,7 @@ want to set `Info-refill-paragraphs'."
318 (set sym val) 318 (set sym val)
319 (dolist (buffer (buffer-list)) 319 (dolist (buffer (buffer-list))
320 (with-current-buffer buffer 320 (with-current-buffer buffer
321 (when (eq major-mode 'Info-mode) 321 (when (derived-mode-p 'Info-mode)
322 (revert-buffer t t))))) 322 (revert-buffer t t)))))
323 :group 'info) 323 :group 'info)
324 324
@@ -841,7 +841,7 @@ See a list of available Info commands in `Info-mode'."
841(defun info-standalone () 841(defun info-standalone ()
842 "Run Emacs as a standalone Info reader. 842 "Run Emacs as a standalone Info reader.
843Usage: emacs -f info-standalone [filename] 843Usage: emacs -f info-standalone [filename]
844In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself." 844In standalone mode, \\<Info-mode-map>\\[quit-window] exits Emacs itself."
845 (setq Info-standalone t) 845 (setq Info-standalone t)
846 (if (and command-line-args-left 846 (if (and command-line-args-left
847 (not (string-match "^-" (car command-line-args-left)))) 847 (not (string-match "^-" (car command-line-args-left))))
@@ -2948,12 +2948,7 @@ N is the digit argument used to invoke this command."
2948 (t 2948 (t
2949 (user-error "No pointer backward from this node"))))) 2949 (user-error "No pointer backward from this node")))))
2950 2950
2951(defun Info-exit () 2951(define-obsolete-function-alias 'Info-exit #'quit-window "27.1")
2952 "Exit Info by selecting some other buffer."
2953 (interactive)
2954 (if Info-standalone
2955 (save-buffers-kill-emacs)
2956 (quit-window)))
2957 2952
2958(defun Info-next-menu-item () 2953(defun Info-next-menu-item ()
2959 "Go to the node of the next menu item." 2954 "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'."
4045 (define-key map "m" 'Info-menu) 4040 (define-key map "m" 'Info-menu)
4046 (define-key map "n" 'Info-next) 4041 (define-key map "n" 'Info-next)
4047 (define-key map "p" 'Info-prev) 4042 (define-key map "p" 'Info-prev)
4048 (define-key map "q" 'Info-exit) 4043 (define-key map "q" 'quit-window)
4049 (define-key map "r" 'Info-history-forward) 4044 (define-key map "r" 'Info-history-forward)
4050 (define-key map "s" 'Info-search) 4045 (define-key map "s" 'Info-search)
4051 (define-key map "S" 'Info-search-case-sensitively) 4046 (define-key map "S" 'Info-search-case-sensitively)
@@ -4064,6 +4059,8 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
4064 (define-key map [follow-link] 'mouse-face) 4059 (define-key map [follow-link] 'mouse-face)
4065 (define-key map [XF86Back] 'Info-history-back) 4060 (define-key map [XF86Back] 'Info-history-back)
4066 (define-key map [XF86Forward] 'Info-history-forward) 4061 (define-key map [XF86Forward] 'Info-history-forward)
4062 (define-key map [tool-bar C-Back\ in\ history] 'Info-history-back-menu)
4063 (define-key map [tool-bar C-Forward\ in\ history] 'Info-history-forward-menu)
4067 map) 4064 map)
4068 "Keymap containing Info commands.") 4065 "Keymap containing Info commands.")
4069 4066
@@ -4123,7 +4120,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
4123 :help "Copy the name of the current node into the kill ring"] 4120 :help "Copy the name of the current node into the kill ring"]
4124 ["Clone Info buffer" clone-buffer 4121 ["Clone Info buffer" clone-buffer
4125 :help "Create a twin copy of the current Info buffer."] 4122 :help "Create a twin copy of the current Info buffer."]
4126 ["Exit" Info-exit :help "Stop reading Info"])) 4123 ["Exit" quit-window :help "Stop reading Info"]))
4127 4124
4128 4125
4129(defvar info-tool-bar-map 4126(defvar info-tool-bar-map
@@ -4152,10 +4149,40 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
4152 :label "Index") 4149 :label "Index")
4153 (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map 4150 (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map
4154 :vert-only t) 4151 :vert-only t)
4155 (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map 4152 (tool-bar-local-item-from-menu 'quit-window "exit" map Info-mode-map
4156 :vert-only t) 4153 :vert-only t)
4157 map)) 4154 map))
4158 4155
4156(defun Info-history-menu (e name history command)
4157 (let* ((i (length history))
4158 (map (make-sparse-keymap name)))
4159 (mapc (lambda (history)
4160 (let ((file (nth 0 history))
4161 (node (nth 1 history)))
4162 (when (stringp file)
4163 (setq file (file-name-sans-extension
4164 (file-name-nondirectory file))))
4165 (define-key map (vector (intern (format "history-%i" i)))
4166 `(menu-item ,(format "(%s) %s" file node)
4167 (lambda ()
4168 (interactive)
4169 (dotimes (_ ,i) (call-interactively ',command))))))
4170 (setq i (1- i)))
4171 (reverse history))
4172 (let* ((selection (x-popup-menu e map))
4173 (binding (and selection (lookup-key map (vector (car selection))))))
4174 (if binding (call-interactively binding)))))
4175
4176(defun Info-history-back-menu (e)
4177 "Pop up the menu with a list of previously visited Info nodes."
4178 (interactive "e")
4179 (Info-history-menu e "Back in history" Info-history 'Info-history-back))
4180
4181(defun Info-history-forward-menu (e)
4182 "Pop up the menu with a list of Info nodes visited with ‘Info-history-back’."
4183 (interactive "e")
4184 (Info-history-menu e "Forward in history" Info-history-forward 'Info-history-forward))
4185
4159(defvar Info-menu-last-node nil) 4186(defvar Info-menu-last-node nil)
4160;; Last node the menu was created for. 4187;; Last node the menu was created for.
4161;; Value is a list, (FILE-NAME NODE-NAME). 4188;; 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.
4280 4307
4281\\<Info-mode-map>\ 4308\\<Info-mode-map>\
4282\\[Info-help] Invoke the Info tutorial. 4309\\[Info-help] Invoke the Info tutorial.
4283\\[Info-exit] Quit Info: reselect previously selected buffer. 4310\\[quit-window] Quit Info: reselect previously selected buffer.
4284 4311
4285Selecting other nodes: 4312Selecting other nodes:
4286\\[Info-mouse-follow-nearest-node] 4313\\[Info-mouse-follow-nearest-node]
@@ -4353,6 +4380,8 @@ Advanced commands:
4353 (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t) 4380 (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
4354 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) 4381 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
4355 (add-hook 'isearch-mode-hook 'Info-isearch-start nil t) 4382 (add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
4383 (when Info-standalone
4384 (add-hook 'quit-window-hook 'save-buffers-kill-emacs nil t))
4356 (setq-local isearch-search-fun-function #'Info-isearch-search) 4385 (setq-local isearch-search-fun-function #'Info-isearch-search)
4357 (setq-local isearch-wrap-function #'Info-isearch-wrap) 4386 (setq-local isearch-wrap-function #'Info-isearch-wrap)
4358 (setq-local isearch-push-state-function #'Info-isearch-push-state) 4387 (setq-local isearch-push-state-function #'Info-isearch-push-state)
@@ -5303,7 +5332,7 @@ completion alternatives to currently visited manuals."
5303 found) 5332 found)
5304 (dolist (buffer blist) 5333 (dolist (buffer blist)
5305 (with-current-buffer buffer 5334 (with-current-buffer buffer
5306 (when (and (eq major-mode 'Info-mode) 5335 (when (and (derived-mode-p 'Info-mode)
5307 (stringp Info-current-file) 5336 (stringp Info-current-file)
5308 (string-match manual-re Info-current-file)) 5337 (string-match manual-re Info-current-file))
5309 (setq found buffer 5338 (setq found buffer
@@ -5318,7 +5347,7 @@ completion alternatives to currently visited manuals."
5318 (let (names) 5347 (let (names)
5319 (dolist (buffer (buffer-list)) 5348 (dolist (buffer (buffer-list))
5320 (with-current-buffer buffer 5349 (with-current-buffer buffer
5321 (and (eq major-mode 'Info-mode) 5350 (and (derived-mode-p 'Info-mode)
5322 (stringp Info-current-file) 5351 (stringp Info-current-file)
5323 (not (string= (substring (buffer-name) 0 1) " ")) 5352 (not (string= (substring (buffer-name) 0 1) " "))
5324 (push (file-name-sans-extension 5353 (push (file-name-sans-extension
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f42b594dc46..e91175fb832 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:
1329(defvar quail-conversion-str nil) 1329(defvar quail-conversion-str nil)
1330 1330
1331(defun quail-input-method (key) 1331(defun quail-input-method (key)
1332 (if (or (and buffer-read-only 1332 (if (or (and (or buffer-read-only
1333 (get-char-property (point) 'read-only))
1333 (not (or inhibit-read-only 1334 (not (or inhibit-read-only
1334 (get-char-property (point) 'inhibit-read-only)))) 1335 (get-char-property (point) 'inhibit-read-only))))
1335 (and overriding-terminal-local-map 1336 (and overriding-terminal-local-map
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index e925adbb110..7bac452a5ce 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.
59 59
60;;;*** 60;;;***
61 61
62;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (0 0 0 0))
63;;; Generated autoloads from progmodes/ada-mode.el
64(push (purecopy '(ada-mode 4 0)) package--builtin-versions)
65
66(autoload 'ada-add-extensions "ada-mode" "\
67Define SPEC and BODY as being valid extensions for Ada files.
68Going from body to spec with `ff-find-other-file' used these
69extensions.
70SPEC and BODY are two regular expressions that must match against
71the file name.
72
73\(fn SPEC BODY)" nil nil)
74
75(autoload 'ada-mode "ada-mode" "\
76Ada mode is the major mode for editing Ada code.
77
78\(fn)" t nil)
79
80(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-mode" '("ada-")))
81
82;;;***
83
84;;;### (autoloads nil "ada-prj" "progmodes/ada-prj.el" (0 0 0 0))
85;;; Generated autoloads from progmodes/ada-prj.el
86
87(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-prj" '("ada-")))
88
89;;;***
90
91;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (0 0 0 0))
92;;; Generated autoloads from progmodes/ada-stmt.el
93
94(autoload 'ada-header "ada-stmt" "\
95Insert a descriptive header at the top of the file." t nil)
96
97(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-stmt" '("ada-")))
98
99;;;***
100
101;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (0 0 0 0))
102;;; Generated autoloads from progmodes/ada-xref.el
103
104(autoload 'ada-find-file "ada-xref" "\
105Open FILENAME, from anywhere in the source path.
106Completion is available.
107
108\(fn FILENAME)" t nil)
109
110(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-xref" '("ada-")))
111
112;;;***
113
114;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0)) 62;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0))
115;;; Generated autoloads from vc/add-log.el 63;;; Generated autoloads from vc/add-log.el
116 64
@@ -1273,7 +1221,7 @@ Entering array mode calls the function `array-mode-hook'.
1273 1221
1274\(fn)" t nil) 1222\(fn)" t nil)
1275 1223
1276(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward" "xor"))) 1224(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward")))
1277 1225
1278;;;*** 1226;;;***
1279 1227
@@ -2490,7 +2438,9 @@ If the value is not a function it should be a list of pairs
2490\(REGEXP . FUNCTION). In this case the function called will be the one 2438\(REGEXP . FUNCTION). In this case the function called will be the one
2491associated with the first REGEXP which matches the current URL. The 2439associated with the first REGEXP which matches the current URL. The
2492function is passed the URL and any other args of `browse-url'. The last 2440function is passed the URL and any other args of `browse-url'. The last
2493regexp should probably be \".\" to specify a default browser.") 2441regexp should probably be \".\" to specify a default browser.
2442
2443Also see `browse-url-secondary-browser-function'.")
2494 2444
2495(custom-autoload 'browse-url-browser-function "browse-url" t) 2445(custom-autoload 'browse-url-browser-function "browse-url" t)
2496 2446
@@ -3026,8 +2976,15 @@ it won't work in an interactive Emacs." nil nil)
3026Run `byte-compile-file' on the files remaining on the command line. 2976Run `byte-compile-file' on the files remaining on the command line.
3027Use this from the command line, with `-batch'; 2977Use this from the command line, with `-batch';
3028it won't work in an interactive Emacs. 2978it won't work in an interactive Emacs.
3029Each file is processed even if an error occurred previously. 2979
2980Each file is processed even if an error occurred previously. If
2981a file name denotes a directory, all Emacs Lisp source files in
2982that directory (that have previously been compiled) will be
2983recompiled if newer than the compiled files. In this case,
2984NOFORCE is ignored.
2985
3030For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\". 2986For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
2987
3031If NOFORCE is non-nil, don't recompile a file that seems to be 2988If NOFORCE is non-nil, don't recompile a file that seems to be
3032already up-to-date. 2989already up-to-date.
3033 2990
@@ -4763,13 +4720,6 @@ and runs the normal hook `command-history-hook'." t nil)
4763 4720
4764;;;*** 4721;;;***
4765 4722
4766;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (0 0 0 0))
4767;;; Generated autoloads from emacs-lisp/cl.el
4768
4769(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl" '("cl-" "define-" "defsetf" "flet" "labels" "lexical-let")))
4770
4771;;;***
4772
4773;;;### (autoloads "actual autoloads are elsewhere" "cl-extra" "emacs-lisp/cl-extra.el" 4723;;;### (autoloads "actual autoloads are elsewhere" "cl-extra" "emacs-lisp/cl-extra.el"
4774;;;;;; (0 0 0 0)) 4724;;;;;; (0 0 0 0))
4775;;; Generated autoloads from emacs-lisp/cl-extra.el 4725;;; Generated autoloads from emacs-lisp/cl-extra.el
@@ -5250,9 +5200,8 @@ Otherwise, it saves all modified buffers without asking.")
5250 5200
5251(defvar compilation-search-path '(nil) "\ 5201(defvar compilation-search-path '(nil) "\
5252List of directories to search for source files named in error messages. 5202List of directories to search for source files named in error messages.
5253Elements should be directory names, not file names of 5203Elements should be directory names, not file names of directories.
5254directories. The value nil as an element means the error 5204The value nil as an element means to try the default directory.")
5255message buffer `default-directory'.")
5256 5205
5257(custom-autoload 'compilation-search-path "compile" t) 5206(custom-autoload 'compilation-search-path "compile" t)
5258 5207
@@ -5385,7 +5334,7 @@ This is the value of `next-error-function' in Compilation buffers.
5385 5334
5386\(fn N &optional RESET)" t nil) 5335\(fn N &optional RESET)" t nil)
5387 5336
5388(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile"))) 5337(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "overlay-arrow-overlay" "recompile")))
5389 5338
5390;;;*** 5339;;;***
5391 5340
@@ -8112,14 +8061,17 @@ For example, you could write
8112Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE. 8061Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
8113TURN-ON is a function that will be called with no args in every buffer 8062TURN-ON is a function that will be called with no args in every buffer
8114 and that should try to turn MODE on if applicable for that buffer. 8063 and that should try to turn MODE on if applicable for that buffer.
8115KEYS is a list of CL-style keyword arguments. As the minor mode 8064Each of KEY VALUE is a pair of CL-style keyword arguments. As
8116 defined by this function is always global, any :global keyword is 8065 the minor mode defined by this function is always global, any
8117 ignored. Other keywords have the same meaning as in `define-minor-mode', 8066 :global keyword is ignored. Other keywords have the same
8118 which see. In particular, :group specifies the custom group. 8067 meaning as in `define-minor-mode', which see. In particular,
8119 The most useful keywords are those that are passed on to the 8068 :group specifies the custom group. The most useful keywords
8120 `defcustom'. It normally makes no sense to pass the :lighter 8069 are those that are passed on to the `defcustom'. It normally
8121 or :keymap keywords to `define-globalized-minor-mode', since these 8070 makes no sense to pass the :lighter or :keymap keywords to
8122 are usually passed to the buffer-local version of the minor mode. 8071 `define-globalized-minor-mode', since these are usually passed
8072 to the buffer-local version of the minor mode.
8073BODY contains code to execute each time the mode is enabled or disabled.
8074 It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
8123 8075
8124If MODE's set-up depends on the major mode in effect when it was 8076If MODE's set-up depends on the major mode in effect when it was
8125enabled, then disabling and reenabling MODE should make MODE work 8077enabled, 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
8131after running the major mode's hook. However, MODE is not turned 8083after running the major mode's hook. However, MODE is not turned
8132on if the hook has explicitly disabled it. 8084on if the hook has explicitly disabled it.
8133 8085
8134\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t) 8086\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" nil t)
8135 8087
8136(function-put 'define-globalized-minor-mode 'doc-string-elt '2) 8088(function-put 'define-globalized-minor-mode 'doc-string-elt '2)
8137 8089
@@ -8207,6 +8159,17 @@ pairs:
8207 if the expression evaluates to a non-nil value. `:enable' is 8159 if the expression evaluates to a non-nil value. `:enable' is
8208 an alias for `:active'. 8160 an alias for `:active'.
8209 8161
8162 :label FORM
8163 FORM is an expression that is dynamically evaluated and whose
8164 value serves as the menu's label (the default is the first
8165 element of MENU).
8166
8167 :help HELP
8168 HELP is a string, the help to display for the menu.
8169 In a GUI this is a \"tooltip\" on the menu button. (Though
8170 in Lucid :help is not shown for the top-level menu bar, only
8171 for sub-menus.)
8172
8210The rest of the elements in MENU are menu items. 8173The rest of the elements in MENU are menu items.
8211A menu item can be a vector of three elements: 8174A menu item can be a vector of three elements:
8212 8175
@@ -12855,7 +12818,11 @@ to get the effect of a C-q.
12855\(fn &optional BUFFER)" nil nil) 12818\(fn &optional BUFFER)" nil nil)
12856 12819
12857(autoload 'fill-flowed "flow-fill" "\ 12820(autoload 'fill-flowed "flow-fill" "\
12821Apply RFC2646 decoding to BUFFER.
12822If BUFFER is nil, default to the current buffer.
12858 12823
12824If DELETE-SPACE, delete RFC2646 spaces padding at the end of
12825lines.
12859 12826
12860\(fn &optional BUFFER DELETE-SPACE)" nil nil) 12827\(fn &optional BUFFER DELETE-SPACE)" nil nil)
12861 12828
@@ -14762,24 +14729,6 @@ Add the window configuration CONF to `gnus-buffer-configuration'.
14762;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0)) 14729;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0))
14763;;; Generated autoloads from net/gnutls.el 14730;;; Generated autoloads from net/gnutls.el
14764 14731
14765(defvar gnutls-min-prime-bits 256 "\
14766Minimum number of prime bits accepted by GnuTLS for key exchange.
14767During a Diffie-Hellman handshake, if the server sends a prime
14768number with fewer than this number of bits, the handshake is
14769rejected. (The smaller the prime number, the less secure the
14770key exchange is against man-in-the-middle attacks.)
14771
14772A value of nil says to use the default GnuTLS value.
14773
14774The default value of this variable is such that virtually any
14775connection can be established, whether this connection can be
14776considered cryptographically \"safe\" or not. However, Emacs
14777network security is handled at a higher level via
14778`open-network-stream' and the Network Security Manager. See Info
14779node `(emacs) Network Security'.")
14780
14781(custom-autoload 'gnutls-min-prime-bits "gnutls" t)
14782
14783(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream"))) 14732(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream")))
14784 14733
14785;;;*** 14734;;;***
@@ -14863,11 +14812,11 @@ if ARG is `toggle'; disable the mode otherwise.
14863 14812
14864(autoload 'gravatar-retrieve "gravatar" "\ 14813(autoload 'gravatar-retrieve "gravatar" "\
14865Asynchronously retrieve a gravatar for MAIL-ADDRESS. 14814Asynchronously retrieve a gravatar for MAIL-ADDRESS.
14866When finished, call CB as (apply CB GRAVATAR CBARGS), 14815When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS),
14867where GRAVATAR is either an image descriptor, or the symbol 14816where GRAVATAR is either an image descriptor, or the symbol
14868`error' if the retrieval failed. 14817`error' if the retrieval failed.
14869 14818
14870\(fn MAIL-ADDRESS CB &optional CBARGS)" nil nil) 14819\(fn MAIL-ADDRESS CALLBACK &optional CBARGS)" nil nil)
14871 14820
14872(autoload 'gravatar-retrieve-synchronously "gravatar" "\ 14821(autoload 'gravatar-retrieve-synchronously "gravatar" "\
14873Synchronously retrieve a gravatar for MAIL-ADDRESS. 14822Synchronously retrieve a gravatar for MAIL-ADDRESS.
@@ -15107,9 +15056,15 @@ and source-file directory for your debugger.
15107\(fn COMMAND-LINE)" t nil) 15056\(fn COMMAND-LINE)" t nil)
15108 15057
15109(autoload 'pdb "gud" "\ 15058(autoload 'pdb "gud" "\
15110Run pdb on program FILE in buffer `*gud-FILE*'. 15059Run COMMAND-LINE in the `*gud-FILE*' buffer.
15111The directory containing FILE becomes the initial working directory 15060
15112and source-file directory for your debugger. 15061COMMAND-LINE should include the pdb executable
15062name (`gud-pdb-command-name') and the file to be debugged.
15063
15064If called interactively, the command line will be prompted for.
15065
15066The directory containing this file becomes the initial working
15067directory and source-file directory for your debugger.
15113 15068
15114\(fn COMMAND-LINE)" t nil) 15069\(fn COMMAND-LINE)" t nil)
15115 15070
@@ -17117,7 +17072,8 @@ RET Select the file at the front of the list of matches.
17117\\[ido-toggle-case] Toggle case-sensitive searching of file names. 17072\\[ido-toggle-case] Toggle case-sensitive searching of file names.
17118\\[ido-toggle-literal] Toggle literal reading of this file. 17073\\[ido-toggle-literal] Toggle literal reading of this file.
17119\\[ido-completion-help] Show list of matching files in separate window. 17074\\[ido-completion-help] Show list of matching files in separate window.
17120\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'." t nil) 17075\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
17076\\[ido-reread-directory] Reread the current directory." t nil)
17121 17077
17122(autoload 'ido-find-file-other-window "ido" "\ 17078(autoload 'ido-find-file-other-window "ido" "\
17123Switch to another file and show it in another window. 17079Switch 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)
17965(autoload 'info-standalone "info" "\ 17921(autoload 'info-standalone "info" "\
17966Run Emacs as a standalone Info reader. 17922Run Emacs as a standalone Info reader.
17967Usage: emacs -f info-standalone [filename] 17923Usage: emacs -f info-standalone [filename]
17968In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself." nil nil) 17924In standalone mode, \\<Info-mode-map>\\[quit-window] exits Emacs itself." nil nil)
17969 17925
17970(autoload 'Info-on-current-buffer "info" "\ 17926(autoload 'Info-on-current-buffer "info" "\
17971Use Info mode to browse the current Info buffer. 17927Use Info mode to browse the current Info buffer.
@@ -18007,7 +17963,7 @@ one topic and contains references to other nodes which discuss related
18007topics. Info has commands to follow the references and show you other nodes. 17963topics. Info has commands to follow the references and show you other nodes.
18008 17964
18009\\<Info-mode-map>\\[Info-help] Invoke the Info tutorial. 17965\\<Info-mode-map>\\[Info-help] Invoke the Info tutorial.
18010\\[Info-exit] Quit Info: reselect previously selected buffer. 17966\\[quit-window] Quit Info: reselect previously selected buffer.
18011 17967
18012Selecting other nodes: 17968Selecting other nodes:
18013\\[Info-mouse-follow-nearest-node] 17969\\[Info-mouse-follow-nearest-node]
@@ -20528,10 +20484,9 @@ OTHER-HEADERS is an alist specifying additional header fields.
20528Elements look like (HEADER . VALUE) where both HEADER and VALUE 20484Elements look like (HEADER . VALUE) where both HEADER and VALUE
20529are strings. 20485are strings.
20530 20486
20531CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and 20487Any additional arguments are IGNORED.
20532RETURN-ACTION and any additional arguments are IGNORED.
20533 20488
20534\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" nil nil) 20489\(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
20535 20490
20536(autoload 'mh-send-letter "mh-comp" "\ 20491(autoload 'mh-send-letter "mh-comp" "\
20537Save draft and send message. 20492Save draft and send message.
@@ -21787,8 +21742,38 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument.
21787 21742
21788This command uses `nslookup-program' for looking up the DNS information. 21743This command uses `nslookup-program' for looking up the DNS information.
21789 21744
21745See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
21746non-interactive versions of this function more suitable for use
21747in Lisp code.
21748
21790\(fn HOST &optional NAME-SERVER)" t nil) 21749\(fn HOST &optional NAME-SERVER)" t nil)
21791 21750
21751(autoload 'nslookup-host-ipv4 "net-utils" "\
21752Return the IPv4 address for HOST (name or IP address).
21753Optional argument NAME-SERVER says which server to use for DNS
21754resolution.
21755
21756If FORMAT is `string', returns the IP address as a
21757string (default). If FORMAT is `vector', returns a 4-integer
21758vector of octets.
21759
21760This command uses `nslookup-program' to look up DNS records.
21761
21762\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
21763
21764(autoload 'nslookup-host-ipv6 "net-utils" "\
21765Return the IPv6 address for HOST (name or IP address).
21766Optional argument NAME-SERVER says which server to use for DNS
21767resolution.
21768
21769If FORMAT is `string', returns the IP address as a
21770string (default). If FORMAT is `vector', returns a 8-integer
21771vector of hextets.
21772
21773This command uses `nslookup-program' to look up DNS records.
21774
21775\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
21776
21792(autoload 'nslookup "net-utils" "\ 21777(autoload 'nslookup "net-utils" "\
21793Run `nslookup-program'." t nil) 21778Run `nslookup-program'." t nil)
21794 21779
@@ -21845,7 +21830,7 @@ Open a network connection to HOST on PORT.
21845 21830
21846\(fn HOST PORT)" t nil) 21831\(fn HOST PORT)" t nil)
21847 21832
21848(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-"))) 21833(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-")))
21849 21834
21850;;;*** 21835;;;***
21851 21836
@@ -24268,7 +24253,7 @@ matching parenthesis is highlighted in `show-paren-style' after
24268(put 'parse-time-rules 'risky-local-variable t) 24253(put 'parse-time-rules 'risky-local-variable t)
24269 24254
24270(autoload 'parse-time-string "parse-time" "\ 24255(autoload 'parse-time-string "parse-time" "\
24271Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). 24256Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
24272STRING should be something resembling an RFC 822 (or later) date-time, e.g., 24257STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
24273\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is 24258\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
24274somewhat liberal in what format it accepts, and will attempt to 24259somewhat liberal in what format it accepts, and will attempt to
@@ -33258,7 +33243,7 @@ If DATE lacks timezone information, GMT is assumed.
33258 33243
33259(defalias 'time-to-seconds 'float-time) 33244(defalias 'time-to-seconds 'float-time)
33260 33245
33261(defalias 'seconds-to-time 'encode-time) 33246(defalias 'seconds-to-time 'time-convert)
33262 33247
33263(autoload 'days-to-time "time-date" "\ 33248(autoload 'days-to-time "time-date" "\
33264Convert DAYS into a time value. 33249Convert DAYS into a time value.
@@ -36411,7 +36396,7 @@ Usage:
36411 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l 36396 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
36412 vhdl-mode\") in a directory with an existing project setup file, it is 36397 vhdl-mode\") in a directory with an existing project setup file, it is
36413 automatically loaded and its project activated if option 36398 automatically loaded and its project activated if option
36414 `vhdl-project-auto-load' is non-nil. Names/paths of the project setup 36399 `vhdl-project-autoload' is non-nil. Names/paths of the project setup
36415 files can be specified in option `vhdl-project-file-name'. Multiple 36400 files can be specified in option `vhdl-project-file-name'. Multiple
36416 project setups can be automatically loaded from global directories. 36401 project setups can be automatically loaded from global directories.
36417 This is an alternative to specifying project setups with option 36402 This is an alternative to specifying project setups with option
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index e802c2408f7..8491181bbe1 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -517,7 +517,8 @@ If the \"..\" directory entry has nil attributes, the attributes
517are copied from the \".\" entry, if they are non-nil. Otherwise, 517are copied from the \".\" entry, if they are non-nil. Otherwise,
518the offending element is removed from the list, as are any 518the offending element is removed from the list, as are any
519elements for other directory entries with nil attributes." 519elements for other directory entries with nil attributes."
520 (if (and (null (cdr (assoc ".." file-alist))) 520 (if (and (consp (assoc ".." file-alist))
521 (null (cdr (assoc ".." file-alist)))
521 (cdr (assoc "." file-alist))) 522 (cdr (assoc "." file-alist)))
522 (setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist)))) 523 (setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist))))
523 (rassq-delete-all nil file-alist)) 524 (rassq-delete-all nil file-alist))
diff --git a/lisp/macros.el b/lisp/macros.el
index 4b38506d8a5..3470359c0ca 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -38,13 +38,13 @@
38 38
39(defun macros--insert-vector-macro (definition) 39(defun macros--insert-vector-macro (definition)
40 "Print DEFINITION, a vector, into the current buffer." 40 "Print DEFINITION, a vector, into the current buffer."
41 (dotimes (i (length definition)) 41 (insert ?\[
42 (let ((char (aref definition i))) 42 (mapconcat (lambda (event)
43 (insert (if (zerop i) ?\[ ?\s)) 43 (or (prin1-char event)
44 (if (characterp char) 44 (prin1-to-string event)))
45 (princ (prin1-char char) (current-buffer)) 45 definition
46 (prin1 char (current-buffer))))) 46 " ")
47 (insert ?\])) 47 ?\]))
48 48
49;;;###autoload 49;;;###autoload
50(defun insert-kbd-macro (macroname &optional keys) 50(defun insert-kbd-macro (macroname &optional keys)
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 7b50fcd96e0..4dbd4d7b086 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -33,8 +33,7 @@
33;; paragraph and we let `fill-region' fill the long line into several 33;; paragraph and we let `fill-region' fill the long line into several
34;; lines with the quote prefix as `fill-prefix'. 34;; lines with the quote prefix as `fill-prefix'.
35 35
36;; Todo: implement basic `fill-region' (Emacs and XEmacs 36;; Todo: implement basic `fill-region'
37;; implementations differ..)
38 37
39;;; History: 38;;; History:
40 39
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 3151dae0aa2..87a8248854f 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -781,7 +781,9 @@ as ARGS."
781 (interactive (browse-url-interactive-arg "URL: ")) 781 (interactive (browse-url-interactive-arg "URL: "))
782 (unless (called-interactively-p 'interactive) 782 (unless (called-interactively-p 'interactive)
783 (setq args (or args (list browse-url-new-window-flag)))) 783 (setq args (or args (list browse-url-new-window-flag))))
784 (when (and url-handler-mode (not (file-name-absolute-p url))) 784 (when (and url-handler-mode
785 (not (file-name-absolute-p url))
786 (not (string-match "\\`[a-z]+:" url)))
785 (setq url (expand-file-name url))) 787 (setq url (expand-file-name url)))
786 (let ((process-environment (copy-sequence process-environment)) 788 (let ((process-environment (copy-sequence process-environment))
787 (function (or (and (string-match "\\`mailto:" url) 789 (function (or (and (string-match "\\`mailto:" url)
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 61480f35877..da7665089ec 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -113,16 +113,14 @@ Security'."
113 "/etc/ssl/cert.pem" ; macOS 113 "/etc/ssl/cert.pem" ; macOS
114 ) 114 )
115 "List of CA bundle location filenames or a function returning said list. 115 "List of CA bundle location filenames or a function returning said list.
116If a file path contains glob wildcards, they will be expanded.
116The files may be in PEM or DER format, as per the GnuTLS documentation. 117The files may be in PEM or DER format, as per the GnuTLS documentation.
117The files may not exist, in which case they will be ignored." 118The files may not exist, in which case they will be ignored."
118 :group 'gnutls 119 :group 'gnutls
119 :type '(choice (function :tag "Function to produce list of bundle filenames") 120 :type '(choice (function :tag "Function to produce list of bundle filenames")
120 (repeat (file :tag "Bundle filename")))) 121 (repeat (file :tag "Bundle filename"))))
121 122
122;;;###autoload 123(defcustom gnutls-min-prime-bits nil
123(defcustom gnutls-min-prime-bits 256
124 ;; Several mail servers send fewer bits than the GnuTLS default.
125 ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
126 "Minimum number of prime bits accepted by GnuTLS for key exchange. 124 "Minimum number of prime bits accepted by GnuTLS for key exchange.
127During a Diffie-Hellman handshake, if the server sends a prime 125During a Diffie-Hellman handshake, if the server sends a prime
128number with fewer than this number of bits, the handshake is 126number with fewer than this number of bits, the handshake is
@@ -138,9 +136,22 @@ network security is handled at a higher level via
138`open-network-stream' and the Network Security Manager. See Info 136`open-network-stream' and the Network Security Manager. See Info
139node `(emacs) Network Security'." 137node `(emacs) Network Security'."
140 :type '(choice (const :tag "Use default value" nil) 138 :type '(choice (const :tag "Use default value" nil)
141 (integer :tag "Number of bits" 512)) 139 (integer :tag "Number of bits" 2048))
142 :group 'gnutls) 140 :group 'gnutls)
143 141
142(defcustom gnutls-crlfiles
143 '(
144 "/etc/grid-security/certificates/*.crl.pem"
145 )
146 "List of CRL file paths or a function returning said list.
147If a file path contains glob wildcards, they will be expanded.
148The files may be in PEM or DER format, as per the GnuTLS documentation.
149The files may not exist, in which case they will be ignored."
150 :group 'gnutls
151 :type '(choice (function :tag "Function to produce list of CRL filenames")
152 (repeat (file :tag "CRL filename")))
153 :version "27.1")
154
144(defun open-gnutls-stream (name buffer host service &optional parameters) 155(defun open-gnutls-stream (name buffer host service &optional parameters)
145 "Open a SSL/TLS connection for a service to a host. 156 "Open a SSL/TLS connection for a service to a host.
146Returns a subprocess-object to represent the connection. 157Returns a subprocess-object to represent the connection.
@@ -304,6 +315,7 @@ here's a recent version of the list.
304It must be omitted, a number, or nil; if omitted or nil it 315It must be omitted, a number, or nil; if omitted or nil it
305defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." 316defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
306 (let* ((trustfiles (or trustfiles (gnutls-trustfiles))) 317 (let* ((trustfiles (or trustfiles (gnutls-trustfiles)))
318 (crlfiles (or crlfiles (gnutls-crlfiles)))
307 (maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p)) 319 (maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p))
308 ":%DUMBFW" 320 ":%DUMBFW"
309 "")) 321 ""))
@@ -345,13 +357,18 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
345 :verify-error ,verify-error 357 :verify-error ,verify-error
346 :callbacks nil))) 358 :callbacks nil)))
347 359
360(defun gnutls--get-files (files)
361 (cl-loop for f in files
362 if f do (setq f (if (functionp f) (funcall f) f))
363 append (cl-delete-if-not #'file-exists-p (file-expand-wildcards f t))))
364
348(defun gnutls-trustfiles () 365(defun gnutls-trustfiles ()
349 "Return a list of usable trustfiles." 366 "Return a list of usable trustfiles."
350 (delq nil 367 (gnutls--get-files gnutls-trustfiles))
351 (mapcar (lambda (f) (and f (file-exists-p f) f)) 368
352 (if (functionp gnutls-trustfiles) 369(defun gnutls-crlfiles ()
353 (funcall gnutls-trustfiles) 370 "Return a list of usable CRL files."
354 gnutls-trustfiles)))) 371 (gnutls--get-files gnutls-crlfiles))
355 372
356(declare-function gnutls-error-string "gnutls.c" (error)) 373(declare-function gnutls-error-string "gnutls.c" (error))
357 374
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index dcc7e01b6b4..4f68e5db61d 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -43,6 +43,10 @@
43;; still use them for queries). Actually the trend these 43;; still use them for queries). Actually the trend these
44;; days is for /sbin to be a symlink to /usr/sbin, but we still need to 44;; days is for /sbin to be a symlink to /usr/sbin, but we still need to
45;; search both for older systems. 45;; search both for older systems.
46
47(require 'subr-x)
48(require 'cl-lib)
49
46(defun net-utils--executable-find-sbin (command) 50(defun net-utils--executable-find-sbin (command)
47 "Return absolute name of COMMAND if found in an sbin directory." 51 "Return absolute name of COMMAND if found in an sbin directory."
48 (let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin"))) 52 (let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin")))
@@ -514,7 +518,11 @@ Optional argument NAME-SERVER says which server to use for
514DNS resolution. 518DNS resolution.
515Interactively, prompt for NAME-SERVER if invoked with prefix argument. 519Interactively, prompt for NAME-SERVER if invoked with prefix argument.
516 520
517This command uses `nslookup-program' for looking up the DNS information." 521This command uses `nslookup-program' for looking up the DNS information.
522
523See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
524non-interactive versions of this function more suitable for use
525in Lisp code."
518 (interactive 526 (interactive
519 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)) 527 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
520 (if current-prefix-arg (read-from-minibuffer "Name server: ")))) 528 (if current-prefix-arg (read-from-minibuffer "Name server: "))))
@@ -531,6 +539,71 @@ This command uses `nslookup-program' for looking up the DNS information."
531 options))) 539 options)))
532 540
533;;;###autoload 541;;;###autoload
542(defun nslookup-host-ipv4 (host &optional name-server format)
543 "Return the IPv4 address for HOST (name or IP address).
544Optional argument NAME-SERVER says which server to use for DNS
545resolution.
546
547If FORMAT is `string', returns the IP address as a
548string (default). If FORMAT is `vector', returns a 4-integer
549vector of octets.
550
551This command uses `nslookup-program' to look up DNS records."
552 (let* ((args `(,nslookup-program "-type=A" ,host ,name-server))
553 (output (shell-command-to-string
554 (string-join (cl-remove nil args) " ")))
555 (ip (or (and (string-match
556 "Name:.*\nAddress: *\\(\\([0-9]\\{1,3\\}\\.?\\)\\{4\\}\\)"
557 output)
558 (match-string 1 output))
559 host)))
560 (cond ((memq format '(string nil))
561 ip)
562 ((eq format 'vector)
563 (apply #'vector (mapcar #'string-to-number (split-string ip "\\."))))
564 (t (error "Invalid format: %s" format)))))
565
566(defun ipv6-expand (ipv6-vector)
567 (let ((len (length ipv6-vector)))
568 (if (< len 8)
569 (let* ((pivot (cl-position 0 ipv6-vector))
570 (head (cl-subseq ipv6-vector 0 pivot))
571 (tail (cl-subseq ipv6-vector (1+ pivot) len)))
572 (vconcat head (make-vector (- 8 (1- len)) 0) tail))
573 ipv6-vector)))
574
575;;;###autoload
576(defun nslookup-host-ipv6 (host &optional name-server format)
577 "Return the IPv6 address for HOST (name or IP address).
578Optional argument NAME-SERVER says which server to use for DNS
579resolution.
580
581If FORMAT is `string', returns the IP address as a
582string (default). If FORMAT is `vector', returns a 8-integer
583vector of hextets.
584
585This command uses `nslookup-program' to look up DNS records."
586 (let* ((args `(,nslookup-program "-type=AAAA" ,host ,name-server))
587 (output (shell-command-to-string
588 (string-join (cl-remove nil args) " ")))
589 (hextet "[0-9a-fA-F]\\{1,4\\}")
590 (ip-regex (concat "\\(\\(" hextet "[:]\\)\\{1,6\\}\\([:]?\\(" hextet "\\)\\{1,6\\}\\)\\)"))
591 (ip (or (and (string-match
592 (if (eq system-type 'windows-nt)
593 (concat "Name:.*\nAddress: *" ip-regex)
594 (concat "has AAAA address " ip-regex))
595 output)
596 (match-string 1 output))
597 host)))
598 (cond ((memq format '(string nil))
599 ip)
600 ((eq format 'vector)
601 (ipv6-expand (apply #'vector
602 (cl-loop for hextet in (split-string ip "[:]")
603 collect (string-to-number hextet 16)))))
604 (t (error "Invalid format: %s" format)))))
605
606;;;###autoload
534(defun nslookup () 607(defun nslookup ()
535 "Run `nslookup-program'." 608 "Run `nslookup-program'."
536 (interactive) 609 (interactive)
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index dbfa2101f0c..11535a5a5a1 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -26,7 +26,9 @@
26 26
27(require 'cl-lib) 27(require 'cl-lib)
28(require 'rmc) ; read-multiple-choice 28(require 'rmc) ; read-multiple-choice
29(eval-when-compile (require 'subr-x)) 29(require 'subr-x)
30(require 'seq)
31(require 'map)
30 32
31(defvar nsm-permanent-host-settings nil) 33(defvar nsm-permanent-host-settings nil)
32(defvar nsm-temporary-host-settings nil) 34(defvar nsm-temporary-host-settings nil)
@@ -44,26 +46,43 @@ connection should be handled.
44 46
45The following values are possible: 47The following values are possible:
46 48
47`low': Absolutely no checks are performed. 49`low': No checks are performed: This is extremely insecure.
48`medium': This is the default level, should be reasonable for most usage. 50`medium': Default. Suitable for most circumstances.
49`high': This warns about additional things that many people would 51`high': Warns about additional issues not enabled in `medium' due to
50not find useful. 52compatibility concerns.
51`paranoid': On this level, the user is queried for most new connections. 53`paranoid': On this level, the user is queried for most new connections.
52 54
53See the Emacs manual for a description of all things that are 55See the Emacs manual for a description of all things that are
54checked and warned against." 56checked and warned against."
55 :version "25.1" 57 :version "25.1"
56 :group 'nsm
57 :type '(choice (const :tag "Low" low) 58 :type '(choice (const :tag "Low" low)
58 (const :tag "Medium" medium) 59 (const :tag "Medium" medium)
59 (const :tag "High" high) 60 (const :tag "High" high)
60 (const :tag "Paranoid" paranoid))) 61 (const :tag "Paranoid" paranoid)))
61 62
63(defcustom nsm-trust-local-network nil
64 "Disable warnings when visiting trusted hosts on local networks.
65
66The default suite of TLS checks in NSM is designed to follow the
67most current security best practices. Under some situations,
68such as attempting to connect to an email server that do not
69follow these practices inside a school or corporate network, NSM
70may produce warnings for such occasions. Setting this option to
71a non-nil value, or a zero-argument function that returns non-nil
72tells NSM to skip checking for potential TLS vulnerabilities when
73connecting to hosts on a local network.
74
75Make sure you know what you are doing before enabling this
76option."
77 :version "27.1"
78 :type '(choice (const :tag "On" t)
79 (const :tag "Off" nil)
80 (function :tag "Custom function")))
81
62(defcustom nsm-settings-file (expand-file-name "network-security.data" 82(defcustom nsm-settings-file (expand-file-name "network-security.data"
63 user-emacs-directory) 83 user-emacs-directory)
64 "The file the security manager settings will be stored in." 84 "The file the security manager settings will be stored in."
65 :version "25.1" 85 :version "25.1"
66 :group 'nsm
67 :type 'file) 86 :type 'file)
68 87
69(defcustom nsm-save-host-names nil 88(defcustom nsm-save-host-names nil
@@ -71,7 +90,6 @@ checked and warned against."
71By default, only hosts that have exceptions have their names 90By default, only hosts that have exceptions have their names
72stored in plain text." 91stored in plain text."
73 :version "25.1" 92 :version "25.1"
74 :group 'nsm
75 :type 'boolean) 93 :type 'boolean)
76 94
77(defvar nsm-noninteractive nil 95(defvar nsm-noninteractive nil
@@ -98,241 +116,673 @@ to keep track of the TLS status of STARTTLS servers.
98 116
99If WARN-UNENCRYPTED, query the user if the connection is 117If WARN-UNENCRYPTED, query the user if the connection is
100unencrypted." 118unencrypted."
101 (if (eq network-security-level 'low) 119 (let* ((status (gnutls-peer-status process))
102 process 120 (id (nsm-id host port))
103 (let* ((status (gnutls-peer-status process)) 121 (settings (nsm-host-settings id)))
104 (id (nsm-id host port)) 122 (cond
105 (settings (nsm-host-settings id))) 123 ((not (process-live-p process))
106 (cond 124 nil)
107 ((not (process-live-p process)) 125 ((not status)
108 nil) 126 ;; This is a non-TLS connection.
109 ((not status) 127 (nsm-check-plain-connection process host port settings
110 ;; This is a non-TLS connection. 128 warn-unencrypted))
111 (nsm-check-plain-connection process host port settings 129 (t
112 warn-unencrypted)) 130 (let ((process
113 (t 131 (nsm-check-tls-connection process host port status settings)))
114 (let ((process 132 (when (and process save-fingerprint
115 (nsm-check-tls-connection process host port status settings))) 133 (null (nsm-host-settings id)))
116 (when (and process save-fingerprint 134 (nsm-save-host host port status 'fingerprint nil 'always))
117 (null (nsm-host-settings id))) 135 process)))))
118 (nsm-save-host host port status 'fingerprint 'always)) 136
119 process)))))) 137(defcustom network-security-protocol-checks
138 '(;; Old Known Weaknesses.
139 (version medium)
140 (compression medium)
141 (renegotiation-info-ext medium)
142 (verify-cert medium)
143 (same-cert medium)
144 (null-suite medium)
145 (export-kx medium)
146 (anon-kx medium)
147 (md5-sig medium)
148 (rc4-cipher medium)
149 ;; Weaknesses made known after 2013.
150 (dhe-prime-kx medium)
151 (sha1-sig medium)
152 (ecdsa-cbc-cipher medium)
153 ;; Towards TLS 1.3
154 (dhe-kx high)
155 (rsa-kx high)
156 (3des-cipher high)
157 (cbc-cipher high))
158 "This variable specifies what TLS connection checks to perform.
159It's an alist where the key is the name of the check, and the
160value is the minimum security level the check should begin.
161
162Each check function is called with the parameters HOST PORT
163STATUS SETTINGS. HOST is the host domain, PORT is a TCP port
164number, STATUS is the peer status returned by
165`gnutls-peer-status', and SETTINGS is the persistent and session
166settings for the host HOST. Please refer to the contents of
167`nsm-setting-file' for details. If a problem is found, the check
168function is required to return an error message, and nil
169otherwise.
170
171See also: `nsm-check-tls-connection', `nsm-save-host-names',
172`nsm-settings-file'"
173 :version "27.1"
174 :type '(repeat (list (symbol :tag "Check function")
175 (choice :tag "Level"
176 :value medium
177 (const :tag "Low" low)
178 (const :tag "Medium" medium)
179 (const :tag "High" high)))))
180
181(defun nsm-save-fingerprint-maybe (host port status &rest _)
182 "Saves the certificate's fingerprint.
183
184In order to detect man-in-the-middle attacks, when
185`network-security-level' is `high', this function will save the
186fingerprint of the certificate for check functions to check."
187 (when (>= (nsm-level network-security-level) (nsm-level 'high))
188 ;; Save the host fingerprint so that we can check it the
189 ;; next time we connect.
190 (nsm-save-host host port status 'fingerprint nil 'always)))
191
192(defvar nsm-tls-post-check-functions '(nsm-save-fingerprint-maybe)
193 "Functions to run after checking a TLS session.
194
195Each function will be run with the parameters HOST PORT STATUS
196SETTINGS and RESULTS. The parameters HOST PORT STATUS and
197SETTINGS are the same as those supplied to each check function.
198RESULTS is an alist where the keys are the checks run and the
199values the results of the checks.")
200
201(defun nsm-network-same-subnet (local-ip mask ip)
202 "Returns t if IP is in the same subnet as LOCAL-IP/MASK.
203LOCAL-IP, MASK, and IP are specified as vectors of integers, and
204are expected to have the same length. Works for both IPv4 and
205IPv6 addresses."
206 (let ((matches t)
207 (length (length local-ip)))
208 (unless (memq length '(4 5 8 9))
209 (error "Unexpected length of IP address %S" local-ip))
210 (dotimes (i length)
211 (setq matches (and matches
212 (=
213 (logand (aref local-ip i)
214 (aref mask i))
215 (logand (aref ip i)
216 (aref mask i))))))
217 matches))
218
219(defun nsm-should-check (host)
220 "Determines whether NSM should check for TLS problems for HOST.
221
222If `nsm-trust-local-network' is or returns non-nil, and if the
223host address is a localhost address, or in the same subnet as one
224of the local interfaces, this function returns nil. Non-nil
225otherwise."
226 (let ((addresses (network-lookup-address-info host))
227 (network-interface-list (network-interface-list))
228 (off-net t))
229 (when
230 (or (and (functionp nsm-trust-local-network)
231 (funcall nsm-trust-local-network))
232 nsm-trust-local-network)
233 (mapc
234 (lambda (address)
235 (mapc
236 (lambda (iface)
237 (let ((info (network-interface-info (car iface))))
238 (when
239 (nsm-network-same-subnet (substring (car info) 0 -1)
240 (substring (car (cddr info)) 0 -1)
241 address)
242 (setq off-net nil))))
243 network-interface-list))
244 addresses))
245 off-net))
120 246
121(defun nsm-check-tls-connection (process host port status settings) 247(defun nsm-check-tls-connection (process host port status settings)
122 (when-let ((process 248 "Check TLS connection against potential security problems.
123 (nsm-check-certificate process host port status settings))) 249
124 ;; Do further protocol-level checks. 250This function runs each test defined in
125 (nsm-check-protocol process host port status settings))) 251`network-security-protocol-checks' in the order specified against
252the TLS connection's peer status STATUS for the host HOST and
253port PORT.
254
255If one or more problems are found, this function will collect all
256the error messages returned by the check functions, and confirm
257with the user in interactive mode whether to continue with the
258TLS session.
259
260If the user declines to continue, or problem(s) are found under
261non-interactive mode, the process PROCESS will be deleted, thus
262terminating the connection.
263
264This function returns the process PROCESS if no problems are
265found, and nil otherwise.
266
267See also: `network-security-protocol-checks' and `nsm-noninteractive'"
268 (when (nsm-should-check host)
269 (let* ((results
270 (cl-loop
271 for check in network-security-protocol-checks
272 for type = (intern (format ":%s" (car check)) obarray)
273 ;; Skip the check if the user has already said that this
274 ;; host is OK for this type of "error".
275 for result = (and (not (memq type
276 (plist-get settings :conditions)))
277 (>= (nsm-level network-security-level)
278 (nsm-level (cadr check)))
279 (funcall
280 (intern (format "nsm-protocol-check--%s"
281 (car check))
282 obarray)
283 host port status settings))
284 when result
285 collect (cons type result)))
286 (problems (nconc (plist-get status :warnings) (map-keys results))))
287
288 ;; We haven't seen this before, and we're paranoid.
289 (when (and (eq network-security-level 'paranoid)
290 (not (nsm-fingerprint-ok-p status settings)))
291 (push '(:not-seen . "Certificate not seen before") results))
292
293 (when (and results
294 (not (seq-set-equal-p (plist-get settings :conditions)
295 problems))
296 (not (nsm-query host port status
297 'conditions
298 problems
299 (format-message
300 "The TLS connection to %s:%s is insecure\nfor the following reason%s:\n\n%s"
301 host port
302 (if (> (length problems) 1)
303 "s" "")
304 (concat "* " (string-join
305 (split-string
306 (string-join
307 (map-values results)
308 "\n")
309 "\n")
310 "\n* ")))))
311 (delete-process process)
312 (setq process nil)))
313 (run-hook-with-args 'nsm-tls-post-check-functions
314 host port status settings results)))
315 process)
316
317
318
319;; Certificate checks
126 320
127(declare-function gnutls-peer-status-warning-describe "gnutls.c" 321(declare-function gnutls-peer-status-warning-describe "gnutls.c"
128 (status-symbol)) 322 (status-symbol))
323
324(defun nsm-protocol-check--verify-cert (host port status settings)
325 "Check for warnings from the certificate verification status.
129 326
130(defun nsm-check-certificate (process host port status settings) 327This is the most basic security check for a TLS connection. If
328 certificate verification fails, it means the server's identity
329 cannot be verified by the credentials received."
131 (let ((warnings (plist-get status :warnings))) 330 (let ((warnings (plist-get status :warnings)))
132 (cond 331 (and warnings
332 (not (nsm-warnings-ok-p status settings))
333 (mapconcat #'gnutls-peer-status-warning-describe warnings "\n"))))
133 334
134 ;; The certificate validated, but perhaps we want to do 335(defun nsm-protocol-check--same-cert (host port status settings)
135 ;; certificate pinning. 336 "Check for certificate fingerprint mismatch.
136 ((null warnings)
137 (cond
138 ((< (nsm-level network-security-level) (nsm-level 'high))
139 process)
140 ;; The certificate is fine, but if we're paranoid, we might
141 ;; want to check whether it's changed anyway.
142 ((and (>= (nsm-level network-security-level) (nsm-level 'high))
143 (not (nsm-fingerprint-ok-p host port status settings)))
144 (delete-process process)
145 nil)
146 ;; We haven't seen this before, and we're paranoid.
147 ((and (eq network-security-level 'paranoid)
148 (null settings)
149 (not (nsm-new-fingerprint-ok-p host port status)))
150 (delete-process process)
151 nil)
152 (t
153 process)))
154
155 ;; The certificate did not validate.
156 ((not (equal network-security-level 'low))
157 ;; We always want to pin the certificate of invalid connections
158 ;; to track man-in-the-middle or the like.
159 (if (not (nsm-fingerprint-ok-p host port status settings))
160 (progn
161 (delete-process process)
162 nil)
163 ;; We have a warning, so query the user.
164 (if (and (not (nsm-warnings-ok-p status settings))
165 (not (nsm-query
166 host port status 'conditions
167 "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s"
168 host port
169 (if (> (length warnings) 1)
170 "s" "")
171 (mapconcat #'gnutls-peer-status-warning-describe
172 warnings
173 "\n"))))
174 (progn
175 (delete-process process)
176 nil)
177 process))))))
178
179(defvar network-security-protocol-checks
180 '((diffie-hellman-prime-bits medium 1024)
181 (rc4 medium)
182 (signature-sha1 medium)
183 (intermediate-sha1 medium)
184 (3des high)
185 (ssl medium))
186 "This variable specifies what TLS connection checks to perform.
187It's an alist where the first element is the name of the check,
188the second is the security level where the check kicks in, and the
189optional third element is a parameter supplied to the check.
190
191An element like `(rc4 medium)' will result in the function
192`nsm-protocol-check--rc4' being called with the parameters
193HOST PORT STATUS OPTIONAL-PARAMETER.")
194
195(defun nsm-check-protocol (process host port status settings)
196 (cl-loop for check in network-security-protocol-checks
197 for type = (intern (format ":%s" (car check)) obarray)
198 while process
199 ;; Skip the check if the user has already said that this
200 ;; host is OK for this type of "error".
201 when (and (not (memq type (plist-get settings :conditions)))
202 (>= (nsm-level network-security-level)
203 (nsm-level (cadr check))))
204 do (let ((result
205 (funcall (intern (format "nsm-protocol-check--%s"
206 (car check))
207 obarray)
208 host port status (nth 2 check))))
209 (unless result
210 (delete-process process)
211 (setq process nil))))
212 ;; If a test failed we return nil, otherwise the process object.
213 process)
214 337
215(defun nsm--encryption (status) 338If the fingerprints saved do not match the fingerprint of the
216 (format "%s-%s-%s" 339certificate presented, the TLS session may be under a
217 (plist-get status :key-exchange) 340man-in-the-middle attack."
218 (plist-get status :cipher) 341 (and (not (nsm-fingerprint-ok-p status settings))
219 (plist-get status :mac))) 342 (format-message
343 "fingerprint has changed")))
344
345;; Key exchange checks
346
347(defun nsm-protocol-check--rsa-kx (host port status &optional settings)
348 "Check for static RSA key exchange.
349
350Static RSA key exchange methods do not offer perfect forward
351secrecy, therefore, the security of a TLS session is only as
352secure as the server's private key. Due to TLS' use of RSA key
353exchange to create a session key (the key negotiated between the
354client and the server to encrypt traffic), if the server's
355private key had been compromised, the attacker will be able to
356decrypt any past TLS session recorded, as opposed to just one TLS
357session if the key exchange was conducted via a key exchange
358method that offers perfect forward secrecy, such as ephemeral
359Diffie-Hellman key exchange.
220 360
221(defun nsm-protocol-check--diffie-hellman-prime-bits (host port status bits) 361By default, this check is only enabled when
362`network-security-level' is set to `high' for compatibility
363reasons.
364
365Reference:
366
367Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
368Use of Transport Layer Security (TLS) and Datagram Transport Layer
369Security (DTLS)\", \"(4.1. General Guidelines)\"
370`https://tools.ietf.org/html/rfc7525\#section-4.1'"
371 (let ((kx (plist-get status :key-exchange)))
372 (and (string-match "^\\bRSA\\b" kx)
373 (format-message
374 "RSA key exchange method (%s) does not offer perfect forward secrecy"
375 kx))))
376
377(defun nsm-protocol-check--dhe-prime-kx (host port status &optional settings)
378 "Check for the key strength of DH key exchange based on integer factorization.
379
380This check is a response to Logjam[1]. Logjam is an attack that
381allows an attacker with sufficient resource, and positioned
382between the user and the server, to downgrade vulnerable TLS
383connections to insecure 512-bit export grade crypotography.
384
385The Logjam paper suggests using 1024-bit prime on the client to
386mitigate some effects of this attack, and upgrade to 2048-bit as
387soon as server configurations allow. According to SSLLabs' SSL
388Pulse tracker, only about 75% of server support 2048-bit key
389exchange in June 2018[2]. To provide a balance between
390compatibility and security, this function only checks for a
391minimum key strength of 1024-bit.
392
393See also: `nsm-protocol-check--dhe-kx'
394
395Reference:
396
397[1]: Adrian et al (2014). \"Imperfect Forward Secrecy: How
398Diffie-Hellman Fails in Practice\", `https://weakdh.org/'
399[2]: SSL Pulse (June 03, 2018). \"Key Exchange Strength\",
400`https://www.ssllabs.com/ssl-pulse/'"
222 (let ((prime-bits (plist-get status :diffie-hellman-prime-bits))) 401 (let ((prime-bits (plist-get status :diffie-hellman-prime-bits)))
223 (or (not prime-bits) 402 (if (and (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
224 (>= prime-bits bits) 403 (< prime-bits 1024))
225 (nsm-query 404 (format-message
226 host port status :diffie-hellman-prime-bits 405 "Diffie-Hellman key strength (%s bits) too weak (%s bits)"
227 "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)." 406 prime-bits 1024))))
228 prime-bits host port bits)))) 407
229 408(defun nsm-protocol-check--dhe-kx (host port status &optional settings)
230(defun nsm-protocol-check--3des (host port status _) 409 "Check for existence of DH key exchange based on integer factorization.
231 (or (not (string-match "\\b3DES\\b" (plist-get status :cipher))) 410
232 (nsm-query 411In the years since the discovery of Logjam, it was discovered
233 host port status :rc4 412that there were rampant use of small subgroup prime or composite
234 "The connection to %s:%s uses the 3DES cipher (%s), which is believed to be unsafe." 413number for DHE by many servers, and thus allowed themselves to be
235 host port (plist-get status :cipher)))) 414vulnerable to backdoors[1]. Given the difficulty in validating
236 415Diffie-Hellman parameters, major browser vendors had started to
237(defun nsm-protocol-check--rc4 (host port status _) 416remove DHE since 2016[2]. Emacs stops short of banning DHE and
238 (or (not (string-match "\\bRC4\\b" (nsm--encryption status))) 417terminating connection, but prompts the user instead.
239 (nsm-query 418
240 host port status :rc4 419References:
241 "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe." 420
242 host port (nsm--encryption status)))) 421[1]: Dorey, Fong, and Essex (2016). \"Indiscreet Logs: Persistent
243 422Diffie-Hellman Backdoors in TLS.\",
244(defun nsm-protocol-check--signature-sha1 (host port status _) 423`https://eprint.iacr.org/2016/999.pdf'
245 (let ((signature-algorithm 424[2]: Chrome Platform Status (2017). \"Remove DHE-based ciphers\",
246 (plist-get (plist-get status :certificate) :signature-algorithm))) 425`https://www.chromestatus.com/feature/5128908798164992'"
247 (or (not (string-match "\\bSHA1\\b" signature-algorithm)) 426 (let ((kx (plist-get status :key-exchange)))
248 (nsm-query 427 (when (string-match "^\\bDHE\\b" kx)
249 host port status :signature-sha1 428 (format-message
250 "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." 429 "unable to verify Diffie-Hellman key exchange method (%s) parameters"
251 host port signature-algorithm)))) 430 kx))))
252 431
253(defun nsm-protocol-check--intermediate-sha1 (host port status _) 432(defun nsm-protocol-check--export-kx (host port status &optional settings)
254 ;; Skip the first certificate, because that's the host certificate. 433 "Check for RSA-EXPORT key exchange.
255 (cl-loop for certificate in (cdr (plist-get status :certificates)) 434
435EXPORT cipher suites are a family of 40-bit and 56-bit effective
436security algorithms legally exportable by the United States in
437the early 90s[1]. They can be broken in seconds on 2018 hardware.
438
439Prior to 3.2.0, GnuTLS had only supported RSA-EXPORT key
440exchange. Since 3.2.0, RSA-EXPORT had been removed, therefore,
441this check has no effect on GnuTLS >= 3.2.0.
442
443Reference:
444
445[1]: Schneier, Bruce (1996). Applied Cryptography (Second ed.). John
446Wiley & Sons. ISBN 0-471-11709-9.
447[2]: N. Mavrogiannopoulos, FSF (Apr 2015). \"GnuTLS NEWS -- History
448of user-visible changes.\" Version 3.4.0,
449`https://gitlab.com/gnutls/gnutls/blob/master/NEWS'"
450 (when (< libgnutls-version 30200)
451 (let ((kx (plist-get status :key-exchange)))
452 (and (string-match "\\bEXPORT\\b" kx)
453 (format-message
454 "EXPORT level key exchange (%s) is insecure"
455 kx)))))
456
457(defun nsm-protocol-check--anon-kx (host port status &optional settings)
458 "Check for anonymous key exchange.
459
460Anonymous key exchange exposes the connection to
461man-in-the-middle attacks.
462
463Reference:
464
465GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous
466authentication\",
467`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'"
468 (let ((kx (plist-get status :key-exchange)))
469 (and (string-match "\\bANON\\b" kx)
470 (format-message
471 "anonymous key exchange method (%s) can be unsafe"
472 kx))))
473
474;; Cipher checks
475
476(defun nsm-protocol-check--cbc-cipher (host port status &optional settings)
477 "Check for CBC mode ciphers.
478
479CBC mode cipher in TLS versions earlier than 1.3 are problematic
480because of MAC-then-encrypt. This construction is vulnerable to
481padding oracle attacks[1].
482
483Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[2] has
484been enabled by default[3]. If encrypt-then-MAC is negotiated,
485this check has no effect.
486
487Reference:
488
489[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
490CBC-mode cipher suites\",
491`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
492[2]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
493Security (TLS) and Datagram Transport Layer Security (DTLS)\",
494`https://tools.ietf.org/html/rfc7366'
495[3]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
4963.4.x\",
497`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
498 (when (not (plist-get status :encrypt-then-mac))
499 (let ((cipher (plist-get status :cipher)))
500 (and (string-match "\\bCBC\\b" cipher)
501 (format-message
502 "CBC mode cipher (%s) can be insecure"
503 cipher)))))
504
505(defun nsm-protocol-check--ecdsa-cbc-cipher (host port status &optional settings)
506 "Check for CBC mode cipher usage under ECDSA key exchange.
507
508CBC mode cipher in TLS versions earlier than 1.3 are problematic
509because of MAC-then-encrypt. This construction is vulnerable to
510padding oracle attacks[1].
511
512Due to current widespread use of CBC mode ciphers by servers,
513this function only checks for CBC mode cipher usage in
514combination with ECDSA key exchange, which is virtually
515non-existent[2].
516
517Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[3] has
518been enabled by default[4]. If encrypt-then-MAC is negotiated,
519this check has no effect.
520
521References:
522
523[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
524CBC-mode cipher suites\",
525`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
526[2]: Chrome Platform Status (2017). \"Remove CBC-mode ECDSA ciphers in
527TLS\", `https://www.chromestatus.com/feature/5740978103123968'
528[3]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
529Security (TLS) and Datagram Transport Layer Security (DTLS)\",
530`https://tools.ietf.org/html/rfc7366'
531[4]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
5323.4.x\",
533`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
534 (when (not (plist-get status :encrypt-then-mac))
535 (let ((kx (plist-get status :key-exchange))
536 (cipher (plist-get status :cipher)))
537 (and (string-match "\\bECDSA\\b" kx)
538 (string-match "\\bCBC\\b" cipher)
539 (format-message
540 "CBC mode cipher (%s) can be insecure"
541 cipher)))))
542
543(defun nsm-protocol-check--3des-cipher (host port status &optional settings)
544 "Check for 3DES ciphers.
545
546Due to its use of 64-bit block size, it is known that a
547ciphertext collision is highly likely when 2^32 blocks are
548encrypted with the same key bundle under 3-key 3DES. Practical
549birthday attacks of this kind have been demostrated by Sweet32[1].
550As such, NIST is in the process of disallowing its use in TLS[2].
551
552[1]: Bhargavan, Leurent (2016). \"On the Practical (In-)Security of
55364-bit Block Ciphers — Collision Attacks on HTTP over TLS and
554OpenVPN\", `https://sweet32.info/'
555[2]: NIST Information Technology Laboratory (Jul 2017). \"Update to
556Current Use and Deprecation of TDEA\",
557`https://csrc.nist.gov/News/2017/Update-to-Current-Use-and-Deprecation-of-TDEA'"
558 (let ((cipher (plist-get status :cipher)))
559 (and (string-match "\\b3DES\\b" cipher)
560 (format-message
561 "3DES cipher (%s) is weak"
562 cipher))))
563
564(defun nsm-protocol-check--rc4-cipher (host port status &optional settings)
565 "Check for RC4 ciphers.
566
567RC4 cipher has been prohibited by RFC 7465[1].
568
569Since GnuTLS 3.4.0, RC4 is not enabled by default[2], but can be
570enabled if requested. This check is mainly provided to secure
571Emacs built with older version of GnuTLS.
572
573Reference:
574
575[1]: Popov A (Feb 2015). \"Prohibiting RC4 Cipher Suites\",
576`https://tools.ietf.org/html/rfc7465'
577[2]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
5783.4.x\",
579`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
580 (let ((cipher (plist-get status :cipher)))
581 (and (string-match "\\bARCFOUR\\b" cipher)
582 (format-message
583 "RC4 cipher (%s) is insecure"
584 cipher))))
585
586;; Signature checks
587
588(defun nsm-protocol-check--sha1-sig (host port status &optional settings)
589 "Check for SHA1 signatures on certificates.
590
591The first SHA1 collision was found in 2017[1], as a precaution
592against the events following the discovery of cheap collisions in
593MD5, major browsers[2][3][4][5] have removed the use of SHA1
594signatures in certificates.
595
596References:
597
598[1]: Stevens M, Karpman P et al (2017). \"The first collision for
599full SHA-1\", `https://shattered.io/static/shattered.pdf'
600[2]: Chromium Security Education TLS/SSL. \"Deprecated and Removed
601Features (SHA-1 Certificate Signatures)\",
602`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures'
603[3]: Jones J.C (2017). \"The end of SHA-1 on the Public Web\",
604`https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/'
605[4]: Apple Support (2017). \"Move to SHA-256 signed certificates to
606avoid connection failures\",
607`https://support.apple.com/en-gb/HT207459'
608[5]: Microsoft Security Advisory 4010323 (2017). \"Deprecation of
609SHA-1 for SSL/TLS Certificates in Microsoft Edge and Internet Explorer
61011\",
611`https://docs.microsoft.com/en-us/security-updates/securityadvisories/2017/4010323'"
612 (cl-loop for certificate in (plist-get status :certificates)
613 for algo = (plist-get certificate :signature-algorithm)
614 ;; Don't check root certificates -- root is always trusted.
615 if (and (not (equal (plist-get certificate :issuer)
616 (plist-get certificate :subject)))
617 (string-match "\\bSHA1\\b" algo))
618 return (format-message
619 "SHA1 signature (%s) is prone to collisions"
620 algo)
621 end))
622
623(defun nsm-protocol-check--md5-sig (host port status &optional settings)
624 "Check for MD5 signatures on certificates.
625
626In 2008, a group of researchers were able to forge an
627intermediate CA certificate that appeared to be legitimate when
628checked by MD5[1]. RFC 6151[2] has recommended against the usage
629of MD5 for digital signatures, which includes TLS certificate
630signatures.
631
632Since GnuTLS 3.3.0, MD5 has been disabled by default, but can be
633enabled if requested.
634
635References:
636
637[1]: Sotirov A, Stevens M et al (2008). \"MD5 considered harmful today
638- Creating a rogue CA certificate\",
639`http://www.win.tue.nl/hashclash/rogue-ca/'
640[2]: Turner S, Chen L (2011). \"Updated Security Considerations for
641the MD5 Message-Digest and the HMAC-MD5 Algorithms\",
642`https://tools.ietf.org/html/rfc6151'"
643 (cl-loop for certificate in (plist-get status :certificates)
256 for algo = (plist-get certificate :signature-algorithm) 644 for algo = (plist-get certificate :signature-algorithm)
257 ;; Don't check root certificates -- SHA1 isn't dangerous 645 ;; Don't check root certificates -- root is always trusted.
258 ;; there. 646 if (and (not (equal (plist-get certificate :issuer)
259 when (and (not (equal (plist-get certificate :issuer) 647 (plist-get certificate :subject)))
260 (plist-get certificate :subject))) 648 (string-match "\\bMD5\\b" algo))
261 (string-match "\\bSHA1\\b" algo) 649 return (format-message
262 (not (nsm-query 650 "MD5 signature (%s) is very prone to collisions"
263 host port status :intermediate-sha1 651 algo)
264 "An intermediate certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." 652 end))
265 host port algo))) 653
266 do (cl-return nil) 654;; Extension checks
267 finally (cl-return t))) 655
268 656(defun nsm-protocol-check--renegotiation-info-ext (host port status
269(defun nsm-protocol-check--ssl (host port status _) 657 &optional settings)
658 "Check for renegotiation_info TLS extension status.
659
660If this TLS extension is not used, the connection established is
661vulnerable to an attack in which an impersonator can extract
662sensitive information such as HTTP session ID cookies or login
663passwords. Renegotiation was removed in TLS1.3, so this is only
664checked for earlier protocol versions.
665
666Reference:
667
668E. Rescorla, M. Ray, S. Dispensa, N. Oskov (Feb 2010). \"Transport
669Layer Security (TLS) Renegotiation Indication Extension\",
670`https://tools.ietf.org/html/rfc5746'"
671 (when (plist-member status :safe-renegotiation)
672 (let ((unsafe-renegotiation (not (plist-get status :safe-renegotiation))))
673 (and unsafe-renegotiation
674 (format-message
675 "safe renegotiation is not supported, connection not protected from impersonators")))))
676
677;; Compression checks
678
679(defun nsm-protocol-check--compression (host port status &optional settings)
680 "Check for TLS compression.
681
682TLS compression attacks such as CRIME would allow an attacker to
683decrypt ciphertext. As a result, RFC 7525 has recommended its
684disablement.
685
686Reference:
687
688Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
689Use of Transport Layer Security (TLS) and Datagram Transport Layer
690Security (DTLS)\", `https://tools.ietf.org/html/rfc7525'"
691 (let ((compression (plist-get status :compression)))
692 (and compression
693 (string-match "^\\bDEFLATE\\b" compression)
694 (format-message
695 "compression method (%s) may lead to leakage of sensitive information"
696 compression))))
697
698;; Protocol version checks
699
700(defun nsm-protocol-check--version (host port status &optional settings)
701 "Check for SSL/TLS protocol version.
702
703This function guards against the usage of SSL3.0, which has been
704deprecated by RFC7568[1], and TLS 1.0, which has been deprecated
705by PCI DSS[2].
706
707References:
708
709[1]: Barnes, Thomson, Pironti, Langley (2015). \"Deprecating Secure
710Sockets Layer Version 3.0\", `https://tools.ietf.org/html/rfc7568'
711[2]: PCI Security Standards Council (2016). \"Migrating from SSL and
712Early TLS\"
713`https://www.pcisecuritystandards.org/documents/Migrating-from-SSL-Early-TLS-Info-Supp-v1_1.pdf'"
270 (let ((protocol (plist-get status :protocol))) 714 (let ((protocol (plist-get status :protocol)))
271 (or (not protocol) 715 (and protocol
272 (not (string-match "SSL" protocol)) 716 (or (string-match "SSL" protocol)
273 (nsm-query 717 (and (string-match "TLS1.\\([0-9]+\\)" protocol)
274 host port status :ssl 718 (< (string-to-number (match-string 1 protocol)) 1)))
275 "The connection to %s:%s uses the %s protocol, which is believed to be unsafe." 719 (format-message
276 host port protocol)))) 720 "%s protocol is deprecated by standard bodies"
721 protocol))))
722
723;; Full suite checks
724
725(defun nsm-protocol-check--null-suite (host port status &optional settings)
726 "Check for NULL cipher suites.
727
728This function checks for NULL key exchange, cipher and message
729authentication code key derivation function. As the name
730suggests, a NULL assigned for any of the above disables an
731integral part of the security properties that makes up the TLS
732protocol."
733 (let ((suite (nsm-cipher-suite status)))
734 (and (string-match "\\bNULL\\b" suite)
735 (format-message
736 "NULL cipher suite (%s) violates authenticity, integrity, or confidentiality guarantees"
737 suite))))
738
739
277 740
278(defun nsm-fingerprint (status) 741(defun nsm-fingerprint (status)
279 (plist-get (plist-get status :certificate) :public-key-id)) 742 (plist-get (plist-get status :certificate) :public-key-id))
280 743
281(defun nsm-fingerprint-ok-p (host port status settings) 744(defun nsm-fingerprint-ok-p (status settings)
282 (let ((did-query nil)) 745 (let ((saved-fingerprints (plist-get settings :fingerprints)))
283 (if (and settings 746 ;; Haven't seen this host before or not pinning cert.
284 (not (eq (plist-get settings :fingerprint) :none)) 747 (or (null saved-fingerprints)
285 (not (equal (nsm-fingerprint status) 748 ;; Plain connection allowed.
286 (plist-get settings :fingerprint))) 749 (memq :none saved-fingerprints)
287 (not 750 ;; We are pinning certs, and we have seen this host before,
288 (setq did-query 751 ;; but the credientials for this host differs from the last
289 (nsm-query 752 ;; times we saw it.
290 host port status 'fingerprint 753 (member (nsm-fingerprint status) saved-fingerprints))))
291 "The fingerprint for the connection to %s:%s has changed from %s to %s"
292 host port
293 (plist-get settings :fingerprint)
294 (nsm-fingerprint status)))))
295 ;; Not OK.
296 nil
297 (when did-query
298 ;; Remove any exceptions that have been set on the previous
299 ;; certificate.
300 (plist-put settings :conditions nil))
301 t)))
302
303(defun nsm-new-fingerprint-ok-p (host port status)
304 (nsm-query
305 host port status 'fingerprint
306 "The fingerprint for the connection to %s:%s is new: %s"
307 host port
308 (nsm-fingerprint status)))
309 754
310(defun nsm-check-plain-connection (process host port settings warn-unencrypted) 755(defun nsm-check-plain-connection (process host port settings warn-unencrypted)
311 ;; If this connection used to be TLS, but is now plain, then it's 756 (if (nsm-should-check host)
312 ;; possible that we're being Man-In-The-Middled by a proxy that's 757 ;; If this connection used to be TLS, but is now plain, then it's
313 ;; stripping out STARTTLS announcements. 758 ;; possible that we're being Man-In-The-Middled by a proxy that's
314 (cond 759 ;; stripping out STARTTLS announcements.
315 ((and (plist-get settings :fingerprint) 760 (let ((fingerprints (plist-get settings :fingerprints)))
316 (not (eq (plist-get settings :fingerprint) :none)) 761 (cond
317 (not 762 ((and fingerprints
318 (nsm-query 763 (not (memq :none fingerprints))
319 host port nil 'conditions 764 (not
320 "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." 765 (nsm-query
321 host port))) 766 host port nil 'conditions '(:unencrypted)
322 (delete-process process) 767 (format-message
323 nil) 768 "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."
324 ((and warn-unencrypted 769 host port))))
325 (not (memq :unencrypted (plist-get settings :conditions))) 770 (delete-process process)
326 (not (nsm-query 771 nil)
327 host port nil 'conditions 772 ((and warn-unencrypted
328 "The connection to %s:%s is unencrypted." 773 (not (memq :unencrypted (plist-get settings :conditions)))
329 host port))) 774 (not (nsm-query
330 (delete-process process) 775 host port nil 'conditions '(:unencrypted)
331 nil) 776 (format-message
332 (t 777 "The connection to %s:%s is unencrypted."
333 process))) 778 host port))))
334 779 (delete-process process)
335(defun nsm-query (host port status what message &rest args) 780 nil)
781 (t
782 process)))
783 process))
784
785(defun nsm-query (host port status what problems message)
336 ;; If there is no user to answer queries, then say `no' to everything. 786 ;; If there is no user to answer queries, then say `no' to everything.
337 (if (or noninteractive 787 (if (or noninteractive
338 nsm-noninteractive) 788 nsm-noninteractive)
@@ -340,9 +790,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
340 (let ((response 790 (let ((response
341 (condition-case nil 791 (condition-case nil
342 (intern 792 (intern
343 (car (split-string 793 (car (split-string (nsm-query-user message status)))
344 (nsm-query-user message args
345 (nsm-format-certificate status))))
346 obarray) 794 obarray)
347 ;; Make sure we manage to close the process if the user hits 795 ;; Make sure we manage to close the process if the user hits
348 ;; `C-g'. 796 ;; `C-g'.
@@ -356,46 +804,111 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
356 "Accepting certificate for %s:%s this session only" 804 "Accepting certificate for %s:%s this session only"
357 "Permanently accepting certificate for %s:%s") 805 "Permanently accepting certificate for %s:%s")
358 host port) 806 host port)
359 (nsm-save-host host port status what response) 807 (nsm-save-host host port status what problems response)
360 t)))) 808 t))))
361 809
362(defun nsm-query-user (message args cert) 810(set-advertised-calling-convention
363 (catch 'return 811 'nsm-query '(host port status what problems message) "27.1")
364 (while t 812
365 (let ((buffer (get-buffer-create "*Network Security Manager*"))) 813(declare-function gnutls-format-certificate "gnutls.c" (cert))
366 (save-window-excursion 814
367 ;; First format the certificate and warnings. 815(defun nsm-query-user (message status)
368 (with-help-window buffer 816 (let ((buffer (get-buffer-create "*Network Security Manager*"))
369 (with-current-buffer buffer 817 (cert-buffer (get-buffer-create "*Certificate Details*"))
370 (erase-buffer) 818 (certs (plist-get status :certificates)))
371 (when (> (length cert) 0) 819 (save-window-excursion
372 (insert cert "\n")) 820 ;; First format the certificate and warnings.
373 (let ((start (point))) 821 (with-current-buffer-window
374 (insert (apply #'format-message message args)) 822 buffer nil nil
375 (goto-char start) 823 (when status (insert (nsm-format-certificate status)))
376 ;; Fill the first line of the message, which usually 824 (insert message)
377 ;; contains lots of explanatory text. 825 (goto-char (point-min))
378 (fill-region (point) (line-end-position))))) 826 ;; Fill the first line of the message, which usually
379 ;; Then ask the user what to do about it. 827 ;; contains lots of explanatory text.
380 (pcase (unwind-protect 828 (fill-region (point) (line-end-position)))
381 (cadr 829 ;; Then ask the user what to do about it.
382 (read-multiple-choice 830 (unwind-protect
383 "Continue connecting?" 831 (let* ((accept-choices '((?a "always" "Accept this certificate this session and for all future sessions.")
384 '((?a "always" "Accept this certificate this session and for all future sessions.") 832 (?s "session only" "Accept this certificate this session only.")
385 (?s "session only" "Accept this certificate this session only.") 833 (?n "no" "Refuse to use this certificate, and close the connection.")
386 (?n "no" "Refuse to use this certificate, and close the connection.") 834 (?d "details" "See certificate details")))
387 (?r "reshow" "Reshow certificate information.")))) 835 (details-choices '((?b "backward page" "See previous page")
388 (kill-buffer buffer)) 836 (?f "forward page" "See next page")
389 ("reshow") 837 (?n "next" "Next certificate")
390 (val (throw 'return val)))))))) 838 (?p "previous" "Previous certificate")
391 839 (?q "quit" "Quit details view")))
392(defun nsm-save-host (host port status what permanency) 840 (answer (read-multiple-choice "Continue connecting?"
841 accept-choices))
842 (show-details (char-equal (car answer) ?d))
843 (pems (cl-loop for cert in certs
844 collect (gnutls-format-certificate
845 (plist-get cert :pem))))
846 (cert-index 0))
847 (while show-details
848 (unless (get-buffer-window cert-buffer)
849 (set-window-buffer (get-buffer-window buffer) cert-buffer)
850 (with-current-buffer cert-buffer
851 (read-only-mode -1)
852 (insert (nth cert-index pems))
853 (goto-char (point-min))
854 (read-only-mode)))
855
856 (setq answer (read-multiple-choice "Viewing certificate:" details-choices))
857
858 (cond
859 ((char-equal (car answer) ?q)
860 (setq show-details (not show-details))
861 (set-window-buffer (get-buffer-window cert-buffer) buffer)
862 (setq show-details (char-equal
863 (car (setq answer
864 (read-multiple-choice
865 "Continue connecting?"
866 accept-choices)))
867 ?d)))
868
869 ((char-equal (car answer) ?b)
870 (with-selected-window (get-buffer-window cert-buffer)
871 (with-current-buffer cert-buffer
872 (ignore-errors (scroll-down)))))
873
874 ((char-equal (car answer) ?f)
875 (with-selected-window (get-buffer-window cert-buffer)
876 (with-current-buffer cert-buffer
877 (ignore-errors (scroll-up)))))
878
879 ((char-equal (car answer) ?n)
880 (with-current-buffer cert-buffer
881 (read-only-mode -1)
882 (erase-buffer)
883 (setq cert-index (mod (1+ cert-index) (length pems)))
884 (insert (nth cert-index pems))
885 (goto-char (point-min))
886 (read-only-mode)))
887
888 ((char-equal (car answer) ?p)
889 (with-current-buffer cert-buffer
890 (read-only-mode -1)
891 (erase-buffer)
892 (setq cert-index (mod (1- cert-index) (length pems)))
893 (insert (nth cert-index pems))
894 (goto-char (point-min))
895 (read-only-mode)))))
896 (cadr answer))
897 (kill-buffer cert-buffer)
898 (kill-buffer buffer)))))
899
900(set-advertised-calling-convention 'nsm-query-user '(message status) "27.1")
901
902(defun nsm-save-host (host port status what problems permanency)
393 (let* ((id (nsm-id host port)) 903 (let* ((id (nsm-id host port))
394 (saved 904 (saved-fingerprints (plist-get (nsm-host-settings id) :fingerprints))
395 (list :id id 905 (fingerprints (cl-delete-duplicates
396 :fingerprint (or (nsm-fingerprint status) 906 (append saved-fingerprints
397 ;; Plain connection. 907 (list (or (nsm-fingerprint status)
398 :none)))) 908 ;; Plain connection.
909 :none)))
910 :test #'string=))
911 (saved (list :id id :fingerprints fingerprints)))
399 (when (or (eq what 'conditions) 912 (when (or (eq what 'conditions)
400 nsm-save-host-names) 913 nsm-save-host-names)
401 (nconc saved (list :host (format "%s:%s" host port)))) 914 (nconc saved (list :host (format "%s:%s" host port))))
@@ -403,20 +916,19 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
403 ;; of the certificate/unencrypted connection. 916 ;; of the certificate/unencrypted connection.
404 (cond 917 (cond
405 ((eq what 'conditions) 918 ((eq what 'conditions)
406 (cond 919 (plist-put saved :conditions problems))
407 ((not status) 920 ;; Make sure the conditions are not erased when we save a
408 (nconc saved '(:conditions (:unencrypted)))) 921 ;; fingerprint
409 ((plist-get status :warnings) 922 ((eq what 'fingerprint)
410 (nconc saved
411 (list :conditions (plist-get status :warnings))))))
412 ((not (eq what 'fingerprint))
413 ;; Store additional protocol settings. 923 ;; Store additional protocol settings.
414 (let ((settings (nsm-host-settings id))) 924 (let ((settings (nsm-host-settings id)))
415 (when settings 925 (when settings
416 (setq saved settings)) 926 (setq saved settings))
417 (if (plist-get saved :conditions) 927 (if (plist-get saved :conditions)
418 (nconc (plist-get saved :conditions) (list what)) 928 (plist-put saved :conditions
419 (nconc saved (list :conditions (list what))))))) 929 (cl-delete-duplicates
930 (nconc (plist-get saved :conditions) problems)))
931 (plist-put saved :conditions problems)))))
420 (if (eq permanency 'always) 932 (if (eq permanency 'always)
421 (progn 933 (progn
422 (nsm-remove-temporary-setting id) 934 (nsm-remove-temporary-setting id)
@@ -426,6 +938,11 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
426 (nsm-remove-temporary-setting id) 938 (nsm-remove-temporary-setting id)
427 (push saved nsm-temporary-host-settings)))) 939 (push saved nsm-temporary-host-settings))))
428 940
941(set-advertised-calling-convention
942 'nsm-save-host
943 '(host port status what problems permanency)
944 "27.1")
945
429(defun nsm-write-settings () 946(defun nsm-write-settings ()
430 (with-temp-file nsm-settings-file 947 (with-temp-file nsm-settings-file
431 (insert "(\n") 948 (insert "(\n")
@@ -483,44 +1000,58 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
483 (let ((cert (plist-get status :certificate))) 1000 (let ((cert (plist-get status :certificate)))
484 (when cert 1001 (when cert
485 (with-temp-buffer 1002 (with-temp-buffer
486 (insert 1003 (insert
487 "Certificate information\n" 1004 (propertize "Certificate information" 'face 'underline) "\n"
488 "Issued by:" 1005 " Issued by:"
489 (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n" 1006 (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
490 "Issued to:" 1007 " Issued to:"
491 (or (nsm-certificate-part (plist-get cert :subject) "O") 1008 (or (nsm-certificate-part (plist-get cert :subject) "O")
492 (nsm-certificate-part (plist-get cert :subject) "OU" t)) 1009 (nsm-certificate-part (plist-get cert :subject) "OU" t))
493 "\n" 1010 "\n"
494 "Hostname:" 1011 " Hostname:"
495 (nsm-certificate-part (plist-get cert :subject) "CN" t) "\n") 1012 (nsm-certificate-part (plist-get cert :subject) "CN" t) "\n")
496 (when (and (plist-get cert :public-key-algorithm) 1013 (when (and (plist-get cert :public-key-algorithm)
497 (plist-get cert :signature-algorithm)) 1014 (plist-get cert :signature-algorithm))
498 (insert 1015 (insert
499 "Public key:" (plist-get cert :public-key-algorithm) 1016 " Public key:" (plist-get cert :public-key-algorithm)
500 ", signature: " (plist-get cert :signature-algorithm) "\n")) 1017 ", signature: " (plist-get cert :signature-algorithm) "\n"))
501 (when (and (plist-get status :key-exchange) 1018 (when (and (plist-get status :key-exchange)
502 (plist-get status :cipher) 1019 (plist-get status :cipher)
503 (plist-get status :mac) 1020 (plist-get status :mac)
504 (plist-get status :protocol)) 1021 (plist-get status :protocol))
505 (insert 1022 (insert
506 "Protocol:" (plist-get status :protocol) 1023 " Session:" (plist-get status :protocol)
507 ", key: " (plist-get status :key-exchange) 1024 ", key: " (plist-get status :key-exchange)
508 ", cipher: " (plist-get status :cipher) 1025 ", cipher: " (plist-get status :cipher)
509 ", mac: " (plist-get status :mac) "\n")) 1026 ", mac: " (plist-get status :mac) "\n"))
510 (when (plist-get cert :certificate-security-level) 1027 (when (plist-get cert :certificate-security-level)
511 (insert 1028 (insert
512 "Security level:" 1029 " Security level:"
513 (propertize (plist-get cert :certificate-security-level) 1030 (propertize (plist-get cert :certificate-security-level)
514 'face 'bold) 1031 'face 'bold)
515 "\n")) 1032 "\n"))
516 (insert 1033 (insert
517 "Valid:From " (plist-get cert :valid-from) 1034 " Valid:From " (plist-get cert :valid-from)
518 " to " (plist-get cert :valid-to) "\n\n") 1035 " to " (plist-get cert :valid-to) "\n")
519 (goto-char (point-min)) 1036 (insert "\n")
1037 (goto-char (point-min))
520 (while (re-search-forward "^[^:]+:" nil t) 1038 (while (re-search-forward "^[^:]+:" nil t)
521 (insert (make-string (- 20 (current-column)) ? ))) 1039 (insert (make-string (- 22 (current-column)) ? )))
522 (buffer-string))))) 1040 (buffer-string)))))
523 1041
1042(defun nsm-level (symbol)
1043 "Return a numerical level for SYMBOL for easier comparison."
1044 (cond
1045 ((eq symbol 'low) 0)
1046 ((eq symbol 'medium) 1)
1047 (t 2)))
1048
1049(defun nsm-cipher-suite (status)
1050 (format "%s-%s-%s"
1051 (plist-get status :key-exchange)
1052 (plist-get status :cipher)
1053 (plist-get status :mac)))
1054
524(defun nsm-certificate-part (string part &optional full) 1055(defun nsm-certificate-part (string part &optional full)
525 (let ((part (cadr (assoc part (nsm-parse-subject string))))) 1056 (let ((part (cadr (assoc part (nsm-parse-subject string)))))
526 (cond 1057 (cond
@@ -552,13 +1083,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
552 elem))) 1083 elem)))
553 (nreverse result))))) 1084 (nreverse result)))))
554 1085
555(defun nsm-level (symbol) 1086(define-obsolete-function-alias 'nsm--encryption #'nsm-cipher-suite "27.1")
556 "Return a numerical level for SYMBOL for easier comparison."
557 (cond
558 ((eq symbol 'low) 0)
559 ((eq symbol 'medium) 1)
560 ((eq symbol 'high) 2)
561 (t 3)))
562 1087
563(provide 'nsm) 1088(provide 'nsm)
564 1089
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index fbd1a9b7661..81c3fb4aa52 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -715,10 +715,15 @@ size, and full-buffer size."
715 ;; Success; continue. 715 ;; Success; continue.
716 (when (= (preceding-char) ?\s) 716 (when (= (preceding-char) ?\s)
717 (delete-char -1)) 717 (delete-char -1))
718 (let ((gap-start (point))) 718 (let ((gap-start (point))
719 (insert "\n") 719 (face (get-text-property (point) 'face)))
720 ;; Extend the background to the end of the line.
721 (if face
722 (insert (propertize "\n" 'face (shr-face-background face)))
723 (insert "\n"))
720 (shr-indent) 724 (shr-indent)
721 (when (and (> (1- gap-start) (point-min)) 725 (when (and (> (1- gap-start) (point-min))
726 (get-text-property (point) 'shr-url)
722 ;; The link on both sides of the newline are the 727 ;; The link on both sides of the newline are the
723 ;; same... 728 ;; same...
724 (equal (get-text-property (point) 'shr-url) 729 (equal (get-text-property (point) 'shr-url)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index f1f0abc6e5c..bcfac78ee65 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -719,7 +719,7 @@ for($i = 0; $i < $n; $i++)
719 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; 719 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
720 $filename =~ s/\"/\\\\\"/g; 720 $filename =~ s/\"/\\\\\"/g;
721 printf( 721 printf(
722 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\", 722 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\",
723 $filename, 723 $filename,
724 $type, 724 $type,
725 $stat[3], 725 $stat[3],
@@ -733,10 +733,7 @@ for($i = 0; $i < $n; $i++)
733 $stat[10] & 0xffff, 733 $stat[10] & 0xffff,
734 $stat[7], 734 $stat[7],
735 $stat[2], 735 $stat[2],
736 $stat[1] >> 16 & 0xffff, 736 $stat[1]);
737 $stat[1] & 0xffff,
738 $stat[0] >> 16 & 0xffff,
739 $stat[0] & 0xffff);
740} 737}
741printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null" 738printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
742 "Perl script implementing `directory-files-attributes' as Lisp `read'able 739 "Perl script implementing `directory-files-attributes' as Lisp `read'able
@@ -1762,11 +1759,14 @@ of."
1762 ;; We must care about file names with spaces, or starting with 1759 ;; We must care about file names with spaces, or starting with
1763 ;; "-"; this would confuse xargs. "ls -aQ" might be a 1760 ;; "-"; this would confuse xargs. "ls -aQ" might be a
1764 ;; solution, but it does not work on all remote systems. 1761 ;; solution, but it does not work on all remote systems.
1762 ;; Therefore, we use \000 as file separator.
1763 ;; `tramp-sh--quoting-style-options' do not work for file names
1764 ;; with spaces piped to "xargs".
1765 ;; Apostrophes in the stat output are masked as 1765 ;; Apostrophes in the stat output are masked as
1766 ;; `tramp-stat-marker', in order to make a proper shell escape 1766 ;; `tramp-stat-marker', in order to make a proper shell escape
1767 ;; of them in file names. 1767 ;; of them in file names.
1768 "cd %s && echo \"(\"; (%s %s -a | " 1768 "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
1769 "xargs %s -c " 1769 "xargs -0 %s -c "
1770 "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " 1770 "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
1771 "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")) 1771 "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\""))
1772 (tramp-shell-quote-argument localname) 1772 (tramp-shell-quote-argument localname)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d419f9d87d0..ed0f1def181 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
4211 (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event) 4211 (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
4212 (tramp-flush-connection-properties proc) 4212 (tramp-flush-connection-properties proc)
4213 (tramp-flush-directory-properties vec "")) 4213 (tramp-flush-directory-properties vec ""))
4214 (goto-char (point-max)) 4214 (with-current-buffer (process-buffer proc)
4215 (when (and prompt (re-search-backward (regexp-quote prompt) nil t)) 4215 (goto-char (point-max))
4216 (delete-region (point) (point-max)))))) 4216 (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
4217 (delete-region (point) (point-max)))))))
4217 4218
4218(defun tramp-get-inode (vec) 4219(defun tramp-get-inode (vec)
4219 "Returns the virtual inode number. 4220 "Returns the virtual inode number.
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 2d19c145b0a..be09a73a1f1 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -562,7 +562,8 @@ FILE is created there."
562 (gamegrid-shared-game-dir 562 (gamegrid-shared-game-dir
563 (not (zerop (logand #o6000 (or update-game-score-modes 0)))))) 563 (not (zerop (logand #o6000 (or update-game-score-modes 0))))))
564 (cond ((or (not update-game-score-modes) (file-name-absolute-p file)) 564 (cond ((or (not update-game-score-modes) (file-name-absolute-p file))
565 (gamegrid-add-score-insecure file score)) 565 (gamegrid-add-score-insecure file score
566 gamegrid-user-score-file-directory))
566 ((and gamegrid-shared-game-dir 567 ((and gamegrid-shared-game-dir
567 (file-exists-p (expand-file-name file shared-game-score-directory))) 568 (file-exists-p (expand-file-name file shared-game-score-directory)))
568 ;; Use the setgid (or setuid) "update-game-score" program 569 ;; Use the setgid (or setuid) "update-game-score" program
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4cc1daf4fa6..f0b34c702ca 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -701,9 +701,8 @@ of `my-compilation-root' here."
701;;;###autoload 701;;;###autoload
702(defcustom compilation-search-path '(nil) 702(defcustom compilation-search-path '(nil)
703 "List of directories to search for source files named in error messages. 703 "List of directories to search for source files named in error messages.
704Elements should be directory names, not file names of 704Elements should be directory names, not file names of directories.
705directories. The value nil as an element means the error 705The value nil as an element means to try the default directory."
706message buffer `default-directory'."
707 :type '(repeat (choice (const :tag "Default" nil) 706 :type '(repeat (choice (const :tag "Default" nil)
708 (string :tag "Directory")))) 707 (string :tag "Directory"))))
709 708
@@ -2575,28 +2574,94 @@ region and the first line of the next region."
2575 2574
2576(defcustom compilation-context-lines nil 2575(defcustom compilation-context-lines nil
2577 "Display this many lines of leading context before the current message. 2576 "Display this many lines of leading context before the current message.
2578If nil and the left fringe is displayed, don't scroll the 2577If nil or t, and the left fringe is displayed, don't scroll the
2579compilation output window; an arrow in the left fringe points to 2578compilation output window; an arrow in the left fringe points to
2580the current message. If nil and there is no left fringe, the message 2579the current message. With no left fringe, If nil, the message
2581displays at the top of the window; there is no arrow." 2580scrolls to the top of the window; there is no arrow. If t, don't
2582 :type '(choice integer (const :tag "No window scrolling" nil)) 2581scroll the compilation output window at all; an arrow before
2582column zero points to the current message."
2583 :type '(choice integer
2584 (const :tag "Scroll window when no fringe" nil)
2585 (const :tag "No window scrolling" t))
2583 :version "22.1") 2586 :version "22.1")
2584 2587
2585(defsubst compilation-set-window (w mk) 2588(defsubst compilation-set-window (w mk)
2586 "Align the compilation output window W with marker MK near top." 2589 "Maybe align the compilation output window W with marker MK near top."
2587 (if (integerp compilation-context-lines) 2590 (cond ((integerp compilation-context-lines)
2588 (set-window-start w (save-excursion 2591 (set-window-start w (save-excursion
2589 (goto-char mk) 2592 (goto-char mk)
2590 (compilation-beginning-of-line 2593 (compilation-beginning-of-line
2591 (- 1 compilation-context-lines)) 2594 (- 1 compilation-context-lines))
2592 (point))) 2595 (point))))
2596 ((eq compilation-context-lines t))
2593 ;; If there is no left fringe. 2597 ;; If there is no left fringe.
2594 (when (equal (car (window-fringes w)) 0) 2598 ((equal (car (window-fringes w)) 0)
2595 (set-window-start w (save-excursion 2599 (set-window-start w (save-excursion
2596 (goto-char mk) 2600 (goto-char mk)
2597 (beginning-of-line 1) 2601 (beginning-of-line 1)
2598 (point))))) 2602 (point)))
2599 (set-window-point w mk)) 2603 (set-window-point w mk))
2604 (t (set-window-point w mk))))
2605
2606(defvar-local compilation-arrow-overlay nil
2607 "Overlay with the before-string property of `overlay-arrow-string'.
2608
2609When non-nil, this overlay causes redisplay to display `overlay-arrow-string'
2610at the overlay's start position.")
2611
2612(defconst compilation--margin-string (propertize "=>" 'face 'default)
2613 "The string which will appear in the margin in compilation mode.")
2614
2615(defconst compilation--dummy-string
2616 (propertize ">" 'display
2617 `((margin left-margin) ,compilation--margin-string))
2618 "A string which is only a placeholder for `compilation--margin-string'.
2619Actual value is never used, only the text property.")
2620
2621(defun compilation-set-up-arrow-spec-in-margin ()
2622 "Set up compilation-arrow-overlay to display as an arrow in a margin."
2623 (setq overlay-arrow-string "")
2624 (setq compilation-arrow-overlay
2625 (make-overlay overlay-arrow-position overlay-arrow-position))
2626 (overlay-put compilation-arrow-overlay
2627 'before-string compilation--dummy-string)
2628 (set-window-margins (selected-window) (+ (or (car (window-margins)) 0) 2)))
2629
2630(defun compilation-tear-down-arrow-spec-in-margin ()
2631 "Restore compilation-arrow-overlay to not using the margin, which is removed."
2632 (overlay-put compilation-arrow-overlay 'before-string nil)
2633 (delete-overlay compilation-arrow-overlay)
2634 (setq compilation-arrow-overlay nil)
2635 (set-window-margins (selected-window) (- (car (window-margins)) 2)))
2636
2637(defun compilation-set-overlay-arrow (w)
2638 "Set up, or switch off, the overlay-arrow for window W."
2639 (with-selected-window w ; So the later `goto-char' will work.
2640 (if (and (eq compilation-context-lines t)
2641 (equal (car (window-fringes w)) 0)) ; No left fringe
2642 ;; Insert a before-string overlay at the beginning of the line
2643 ;; pointed to by `overlay-arrow-position', such that it will
2644 ;; display in a 2-character margin.
2645 (progn
2646 (cond
2647 ((overlayp compilation-arrow-overlay)
2648 (when (not (eq (overlay-start compilation-arrow-overlay)
2649 overlay-arrow-position))
2650 (if overlay-arrow-position
2651 (move-overlay compilation-arrow-overlay
2652 overlay-arrow-position overlay-arrow-position)
2653 (compilation-tear-down-arrow-spec-in-margin))))
2654
2655 (overlay-arrow-position
2656 (compilation-set-up-arrow-spec-in-margin)))
2657 ;; Ensure that the "=>" remains in the window by causing
2658 ;; the window to be scrolled, if needed.
2659 (goto-char (overlay-start compilation-arrow-overlay)))
2660
2661 ;; `compilation-context-lines' isn't t, or we've got a left
2662 ;; fringe, so remove any overlay arrow.
2663 (when (overlayp compilation-arrow-overlay)
2664 (compilation-tear-down-arrow-spec-in-margin)))))
2600 2665
2601(defvar next-error-highlight-timer) 2666(defvar next-error-highlight-timer)
2602 2667
@@ -2618,7 +2683,8 @@ and overlay is highlighted between MK and END-MK."
2618 (highlight-regexp (with-current-buffer (marker-buffer msg) 2683 (highlight-regexp (with-current-buffer (marker-buffer msg)
2619 ;; also do this while we change buffer 2684 ;; also do this while we change buffer
2620 (goto-char (marker-position msg)) 2685 (goto-char (marker-position msg))
2621 (and w (compilation-set-window w msg)) 2686 (and w (progn (compilation-set-window w msg)
2687 (compilation-set-overlay-arrow w)))
2622 compilation-highlight-regexp))) 2688 compilation-highlight-regexp)))
2623 ;; Ideally, the window-size should be passed to `display-buffer' 2689 ;; Ideally, the window-size should be passed to `display-buffer'
2624 ;; so it's only used when creating a new window. 2690 ;; 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)."
2739 '(nil (allow-no-window . t)))))) 2805 '(nil (allow-no-window . t))))))
2740 (with-current-buffer (marker-buffer marker) 2806 (with-current-buffer (marker-buffer marker)
2741 (goto-char marker) 2807 (goto-char marker)
2742 (and w (compilation-set-window w marker))) 2808 (and w (progn (compilation-set-window w marker)
2809 (compilation-set-overlay-arrow w))))
2743 (let* ((name (read-file-name 2810 (let* ((name (read-file-name
2744 (format "Find this %s in (default %s): " 2811 (format "Find this %s in (default %s): "
2745 compilation-error filename) 2812 compilation-error filename)
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 2d5a47a0797..f08ba2f3681 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -654,7 +654,14 @@ Create parent directories as needed."
654 (let ((cleanup-f (flymake-proc--get-cleanup-function 654 (let ((cleanup-f (flymake-proc--get-cleanup-function
655 (buffer-file-name)))) 655 (buffer-file-name))))
656 (flymake-log 3 "cleaning up using %s" cleanup-f) 656 (flymake-log 3 "cleaning up using %s" cleanup-f)
657 (funcall cleanup-f)))) 657 ;; Make cleanup-f see the temporary file names
658 ;; created by its corresponding init function
659 ;; (bug#31981).
660 (let ((flymake-proc--temp-source-file-name
661 (process-get proc 'flymake-proc--temp-source-file-name))
662 (flymake-proc--temp-master-file-name
663 (process-get proc 'flymake-proc--temp-master-file-name)))
664 (funcall cleanup-f)))))
658 (kill-buffer output-buffer))))))) 665 (kill-buffer output-buffer)))))))
659 666
660(defun flymake-proc--panic (problem explanation) 667(defun flymake-proc--panic (problem explanation)
@@ -824,6 +831,10 @@ can also be executed interactively independently of
824 (process-put proc 'flymake-proc--output-buffer 831 (process-put proc 'flymake-proc--output-buffer
825 (generate-new-buffer 832 (generate-new-buffer
826 (format " *flymake output for %s*" (current-buffer)))) 833 (format " *flymake output for %s*" (current-buffer))))
834 (process-put proc 'flymake-proc--temp-source-file-name
835 flymake-proc--temp-source-file-name)
836 (process-put proc 'flymake-proc--temp-master-file-name
837 flymake-proc--temp-master-file-name)
827 (setq flymake-proc--current-process proc) 838 (setq flymake-proc--current-process proc)
828 (flymake-log 2 "started process %d, command=%s, dir=%s" 839 (flymake-log 2 "started process %d, command=%s, dir=%s"
829 (process-id proc) (process-command proc) 840 (process-id proc) (process-command proc)
@@ -865,6 +876,7 @@ can also be executed interactively independently of
865 (let* ((ext (file-name-extension file-name)) 876 (let* ((ext (file-name-extension file-name))
866 (temp-name (file-truename 877 (temp-name (file-truename
867 (concat (file-name-sans-extension file-name) 878 (concat (file-name-sans-extension file-name)
879 "_" (format-time-string "%H%M%S%N")
868 "_" prefix 880 "_" prefix
869 (and ext (concat "." ext)))))) 881 (and ext (concat "." ext))))))
870 (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) 882 (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 30d4b199110..235546ef2e4 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1610,7 +1610,9 @@ and source-file directory for your debugger."
1610;; characters we match in the file name shown in the prompt. 1610;; characters we match in the file name shown in the prompt.
1611;; (Of course, this matches the "<string>" case too.) 1611;; (Of course, this matches the "<string>" case too.)
1612(defvar gud-pdb-marker-regexp 1612(defvar gud-pdb-marker-regexp
1613 "^> \\([[:graph:] \\]*\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]") 1613 (concat "^> \\([[:graph:] \\]*\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|"
1614 "<\\(?:module\\|listcomp\\|dictcomp\\|setcomp\\|genexpr\\|lambda\\|\\)>"
1615 "\\)()\\(->[^\n\r]*\\)?[\n\r]"))
1614 1616
1615(defvar gud-pdb-marker-regexp-file-group 1) 1617(defvar gud-pdb-marker-regexp-file-group 1)
1616(defvar gud-pdb-marker-regexp-line-group 2) 1618(defvar gud-pdb-marker-regexp-line-group 2)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 1b06077005c..9fea447e765 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -112,28 +112,23 @@
112 112
113(defcustom hide-ifdef-initially nil 113(defcustom hide-ifdef-initially nil
114 "Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated." 114 "Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
115 :type 'boolean 115 :type 'boolean)
116 :group 'hide-ifdef)
117 116
118(defcustom hide-ifdef-read-only nil 117(defcustom hide-ifdef-read-only nil
119 "Set to non-nil if you want buffer to be read-only while hiding text." 118 "Set to non-nil if you want buffer to be read-only while hiding text."
120 :type 'boolean 119 :type 'boolean)
121 :group 'hide-ifdef)
122 120
123(defcustom hide-ifdef-lines nil 121(defcustom hide-ifdef-lines nil
124 "Non-nil means hide the #ifX, #else, and #endif lines." 122 "Non-nil means hide the #ifX, #else, and #endif lines."
125 :type 'boolean 123 :type 'boolean)
126 :group 'hide-ifdef)
127 124
128(defcustom hide-ifdef-shadow nil 125(defcustom hide-ifdef-shadow nil
129 "Non-nil means shadow text instead of hiding it." 126 "Non-nil means shadow text instead of hiding it."
130 :type 'boolean 127 :type 'boolean
131 :group 'hide-ifdef
132 :version "23.1") 128 :version "23.1")
133 129
134(defface hide-ifdef-shadow '((t (:inherit shadow))) 130(defface hide-ifdef-shadow '((t (:inherit shadow)))
135 "Face for shadowing ifdef blocks." 131 "Face for shadowing ifdef blocks."
136 :group 'hide-ifdef
137 :version "23.1") 132 :version "23.1")
138 133
139(defcustom hide-ifdef-exclude-define-regexp nil 134(defcustom hide-ifdef-exclude-define-regexp nil
@@ -168,7 +163,6 @@ This behavior is generally undesirable. If this option is non-nil, the outermos
168 "C/C++ header file name patterns to determine if current buffer is a header. 163 "C/C++ header file name patterns to determine if current buffer is a header.
169Effective only if `hide-ifdef-expand-reinclusion-protection' is t." 164Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
170 :type 'string 165 :type 'string
171 :group 'hide-ifdef
172 :version "25.1") 166 :version "25.1")
173 167
174(defvar hide-ifdef-mode-submap 168(defvar hide-ifdef-mode-submap
@@ -196,8 +190,10 @@ Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
196 map) 190 map)
197 "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.") 191 "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
198 192
199(defconst hide-ifdef-mode-prefix-key "\C-c@" 193(defcustom hide-ifdef-mode-prefix-key "\C-c@"
200 "Prefix key for all Hide-Ifdef mode commands.") 194 "Prefix key for all Hide-Ifdef mode commands."
195 :type 'key-sequence
196 :version "27.1")
201 197
202(defvar hide-ifdef-mode-map 198(defvar hide-ifdef-mode-map
203 ;; Set up the mode's main map, which leads via the prefix key to the submap. 199 ;; 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 cb39e62265d..8d3513bad30 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -39,7 +39,8 @@
39(defcustom prog-mode-hook nil 39(defcustom prog-mode-hook nil
40 "Normal hook run when entering programming modes." 40 "Normal hook run when entering programming modes."
41 :type 'hook 41 :type 'hook
42 :options '(flyspell-prog-mode abbrev-mode flymake-mode linum-mode 42 :options '(flyspell-prog-mode abbrev-mode flymake-mode
43 display-line-numbers-mode
43 prettify-symbols-mode) 44 prettify-symbols-mode)
44 :group 'prog-mode) 45 :group 'prog-mode)
45 46
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index ae35766ecdc..eef2ca643f6 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -728,7 +728,11 @@ references displayed in the current *xref* buffer."
728 "Mode for displaying cross-references." 728 "Mode for displaying cross-references."
729 (setq buffer-read-only t) 729 (setq buffer-read-only t)
730 (setq next-error-function #'xref--next-error-function) 730 (setq next-error-function #'xref--next-error-function)
731 (setq next-error-last-buffer (current-buffer))) 731 (setq next-error-last-buffer (current-buffer))
732 (setq imenu-prev-index-position-function
733 #'xref--imenu-prev-index-position)
734 (setq imenu-extract-index-name-function
735 #'xref--imenu-extract-index-name))
732 736
733(defvar xref--transient-buffer-mode-map 737(defvar xref--transient-buffer-mode-map
734 (let ((map (make-sparse-keymap))) 738 (let ((map (make-sparse-keymap)))
@@ -740,6 +744,22 @@ references displayed in the current *xref* buffer."
740 xref--xref-buffer-mode 744 xref--xref-buffer-mode
741 "XREF Transient") 745 "XREF Transient")
742 746
747(defun xref--imenu-prev-index-position ()
748 "Move point to previous line in `xref' buffer.
749This function is used as a value for
750`imenu-prev-index-position-function'."
751 (if (bobp)
752 nil
753 (xref--search-property 'xref-group t)))
754
755(defun xref--imenu-extract-index-name ()
756 "Return imenu name for line at point.
757This function is used as a value for
758`imenu-extract-index-name-function'. Point should be at the
759beginning of the line."
760 (buffer-substring-no-properties (line-beginning-position)
761 (line-end-position)))
762
743(defun xref--next-error-function (n reset?) 763(defun xref--next-error-function (n reset?)
744 (when reset? 764 (when reset?
745 (goto-char (point-min))) 765 (goto-char (point-min)))
@@ -789,7 +809,8 @@ GROUP is a string for decoration purposes and XREF is an
789 for line-format = (and max-line-width 809 for line-format = (and max-line-width
790 (format "%%%dd: " max-line-width)) 810 (format "%%%dd: " max-line-width))
791 do 811 do
792 (xref--insert-propertized '(face xref-file-header) group "\n") 812 (xref--insert-propertized '(face xref-file-header 'xref-group t)
813 group "\n")
793 (cl-loop for (xref . more2) on xrefs do 814 (cl-loop for (xref . more2) on xrefs do
794 (with-slots (summary location) xref 815 (with-slots (summary location) xref
795 (let* ((line (xref-location-line location)) 816 (let* ((line (xref-location-line location))
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 8dd1d1e2bf2..5956c9f0811 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1320,29 +1320,18 @@ Please send all bug fixes and enhancements to
1320;; Known bugs and limitations of ps-print 1320;; Known bugs and limitations of ps-print
1321;; -------------------------------------- 1321;; --------------------------------------
1322;; 1322;;
1323;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
1324;; particular, bold or italic fonts don't print in the right background color.
1325;;
1326;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1327;;
1328;; Automatic font-attribute detection doesn't work well, especially with 1323;; Automatic font-attribute detection doesn't work well, especially with
1329;; hilit19 and older versions of get-create-face. Users having problems with 1324;; hilit19 and older versions of get-create-face. Users having problems with
1330;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces' 1325;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
1331;; and `ps-underlined-faces' and/or turn off automatic detection by setting 1326;; and `ps-underlined-faces' and/or turn off automatic detection by setting
1332;; `ps-auto-font-detect' to nil. 1327;; `ps-auto-font-detect' to nil.
1333;; 1328;;
1334;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
1335;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1336;; `ps-underlined-faces' instead.
1337;;
1338;; Still too slow; could use some hand-optimization. 1329;; Still too slow; could use some hand-optimization.
1339;; 1330;;
1340;; Default background color isn't working. 1331;; Default background color isn't working.
1341;; 1332;;
1342;; Faces are always treated as opaque. 1333;; Faces are always treated as opaque.
1343;; 1334;;
1344;; Epoch, Lucid and Emacs 22 not supported. At all.
1345;;
1346;; Fixed-pitch fonts work better for line folding, but are not required. 1335;; Fixed-pitch fonts work better for line folding, but are not required.
1347;; 1336;;
1348;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding 1337;; `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 4112b44e484..2720286814a 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1184,9 +1184,6 @@ IGNORE other arguments."
1184 :format "%[%t\n%]" 1184 :format "%[%t\n%]"
1185 :help-echo ,(concat "Open " (cdr menu-element)) 1185 :help-echo ,(concat "Open " (cdr menu-element))
1186 :action recentf-open-files-action 1186 :action recentf-open-files-action
1187 ;; Override the (problematic) follow-link property of the
1188 ;; `link' widget (bug#22434).
1189 :follow-link nil
1190 ,(cdr menu-element)))) 1187 ,(cdr menu-element))))
1191 1188
1192(defun recentf-open-files-items (files) 1189(defun recentf-open-files-items (files)
diff --git a/lisp/server.el b/lisp/server.el
index d491a260377..ac81cdbd483 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -926,12 +926,11 @@ This handles splitting the command if it would be bigger than
926 (isearch-cancel)))) 926 (isearch-cancel))))
927 ;; Signaled by isearch-cancel. 927 ;; Signaled by isearch-cancel.
928 (quit (message nil))) 928 (quit (message nil)))
929 (when (> (recursion-depth) 0) 929 (when (> (minibuffer-depth) 0)
930 ;; We're inside a minibuffer already, so if the emacs-client is trying 930 ;; We're inside a minibuffer already, so if the emacs-client is trying
931 ;; to open a frame on a new display, we might end up with an unusable 931 ;; to open a frame on a new display, we might end up with an unusable
932 ;; frame because input from that display will be blocked (until exiting 932 ;; frame because input from that display will be blocked (until exiting
933 ;; the minibuffer). Better exit this minibuffer right away. 933 ;; the minibuffer). Better exit this minibuffer right away.
934 ;; Similarly with recursive-edits such as the splash screen.
935 (run-with-timer 0 nil (lambda () (server-execute-continuation proc))) 934 (run-with-timer 0 nil (lambda () (server-execute-continuation proc)))
936 (top-level))) 935 (top-level)))
937 936
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 07e78506654..2778e583674 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -165,6 +165,9 @@ created by `shadow-define-regexp-group'.")
165(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file 165(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file
166(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file 166(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file
167 167
168(defvar shadow-debug nil
169 "Use for debug messages.")
170
168;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 171;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169;;; Syntactic sugar; General list and string manipulation 172;;; Syntactic sugar; General list and string manipulation
170;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 173;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -631,6 +634,10 @@ Consider them as regular expressions if third arg REGEXP is true."
631 (let ((shadows (shadow-shadows-of 634 (let ((shadows (shadow-shadows-of
632 (shadow-expand-file-name 635 (shadow-expand-file-name
633 (buffer-file-name (current-buffer)))))) 636 (buffer-file-name (current-buffer))))))
637 (when shadow-debug
638 (message
639 "shadow-add-to-todo: %s %s\n%s"
640 shadows shadow-files-to-copy (with-output-to-string (backtrace))))
634 (when shadows 641 (when shadows
635 (setq shadow-files-to-copy 642 (setq shadow-files-to-copy
636 (shadow-union shadows shadow-files-to-copy)) 643 (shadow-union shadows shadow-files-to-copy))
@@ -644,6 +651,10 @@ Consider them as regular expressions if third arg REGEXP is true."
644(defun shadow-remove-from-todo (pair) 651(defun shadow-remove-from-todo (pair)
645 "Remove PAIR from `shadow-files-to-copy'. 652 "Remove PAIR from `shadow-files-to-copy'.
646PAIR must be `eq' to one of the elements of that list." 653PAIR must be `eq' to one of the elements of that list."
654 (when shadow-debug
655 (message
656 "shadow-remove-from-todo: %s %s\n%s"
657 pair shadow-files-to-copy (with-output-to-string (backtrace))))
647 (setq shadow-files-to-copy 658 (setq shadow-files-to-copy
648 (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) 659 (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy)))
649 660
@@ -673,7 +684,7 @@ Return t unless files were locked; then return nil."
673 (eval-buffer)) 684 (eval-buffer))
674 (when shadow-todo-file 685 (when shadow-todo-file
675 (set-buffer (setq shadow-todo-buffer 686 (set-buffer (setq shadow-todo-buffer
676 (find-file-noselect shadow-todo-file))) 687 (find-file-noselect shadow-todo-file 'nowarn)))
677 (when (and (not (buffer-modified-p)) 688 (when (and (not (buffer-modified-p))
678 (file-newer-than-file-p (make-auto-save-file-name) 689 (file-newer-than-file-p (make-auto-save-file-name)
679 shadow-todo-file)) 690 shadow-todo-file))
@@ -714,6 +725,8 @@ With non-nil argument also saves the buffer."
714 (if save (shadow-save-todo-file)))) 725 (if save (shadow-save-todo-file))))
715 726
716(defun shadow-save-todo-file () 727(defun shadow-save-todo-file ()
728 (when shadow-debug
729 (message "shadow-save-todo-file:\n%s" (with-output-to-string (backtrace))))
717 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) 730 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
718 (with-current-buffer shadow-todo-buffer 731 (with-current-buffer shadow-todo-buffer
719 (condition-case nil ; have to continue even in case of 732 (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."
769 (buffer-list)))) 782 (buffer-list))))
770 (yes-or-no-p "Modified buffers exist; exit anyway? ")) 783 (yes-or-no-p "Modified buffers exist; exit anyway? "))
771 (or (not (fboundp 'process-list)) 784 (or (not (fboundp 'process-list))
772 ;; process-list is not defined on MSDOS. 785 ;; `process-list' is not defined on MSDOS.
773 (let ((processes (process-list)) 786 (let ((processes (process-list))
774 active) 787 active)
775 (while processes 788 (while processes
diff --git a/lisp/shell.el b/lisp/shell.el
index 2914d1d2c81..fb2c36fa733 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."
184 shell-environment-variable-completion 184 shell-environment-variable-completion
185 shell-command-completion 185 shell-command-completion
186 shell-c-a-p-replace-by-expanded-directory 186 shell-c-a-p-replace-by-expanded-directory
187 pcomplete-completions-at-point
188 shell-filename-completion 187 shell-filename-completion
189 comint-filename-completion) 188 comint-filename-completion
189 ;; Put `pcomplete-completions-at-point' last so that other
190 ;; functions can run before it does, see bug#34330.
191 pcomplete-completions-at-point)
190 "List of functions called to perform completion. 192 "List of functions called to perform completion.
191This variable is used to initialize `comint-dynamic-complete-functions' in the 193This variable is used to initialize `comint-dynamic-complete-functions' in the
192shell buffer." 194shell buffer."
193 :type '(repeat function) 195 :type '(repeat function)
196 :version "27.1"
194 :group 'shell) 197 :group 'shell)
195 198
196(defcustom shell-command-regexp "[^;&|\n]+" 199(defcustom shell-command-regexp "[^;&|\n]+"
@@ -553,6 +556,8 @@ Variables `comint-output-filter-functions', a hook, and
553`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output' 556`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
554control whether input and output cause the window to scroll to the end of the 557control whether input and output cause the window to scroll to the end of the
555buffer." 558buffer."
559 (when (called-interactively-p 'any)
560 (error "Can't be called interactively; did you mean `shell-script-mode' instead?"))
556 (setq comint-prompt-regexp shell-prompt-pattern) 561 (setq comint-prompt-regexp shell-prompt-pattern)
557 (shell-completion-vars) 562 (shell-completion-vars)
558 (setq-local paragraph-separate "\\'") 563 (setq-local paragraph-separate "\\'")
diff --git a/lisp/simple.el b/lisp/simple.el
index 84497c31b25..358b6a4f200 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1587,10 +1587,8 @@ display the result of expression evaluation."
1587 (let ((minibuffer-completing-symbol t)) 1587 (let ((minibuffer-completing-symbol t))
1588 (minibuffer-with-setup-hook 1588 (minibuffer-with-setup-hook
1589 (lambda () 1589 (lambda ()
1590 ;; FIXME: call emacs-lisp-mode? 1590 ;; FIXME: call emacs-lisp-mode (see also
1591 (add-function :before-until (local 'eldoc-documentation-function) 1591 ;; `eldoc--eval-expression-setup')?
1592 #'elisp-eldoc-documentation-function)
1593 (eldoc-mode 1)
1594 (add-hook 'completion-at-point-functions 1592 (add-hook 'completion-at-point-functions
1595 #'elisp-completion-at-point nil t) 1593 #'elisp-completion-at-point nil t)
1596 (run-hooks 'eval-expression-minibuffer-setup-hook)) 1594 (run-hooks 'eval-expression-minibuffer-setup-hook))
@@ -3946,15 +3944,14 @@ interactively, this is t."
3946 (when (and error-file (file-exists-p error-file)) 3944 (when (and error-file (file-exists-p error-file))
3947 (if (< 0 (file-attribute-size (file-attributes error-file))) 3945 (if (< 0 (file-attribute-size (file-attributes error-file)))
3948 (with-current-buffer (get-buffer-create error-buffer) 3946 (with-current-buffer (get-buffer-create error-buffer)
3949 (let ((pos-from-end (- (point-max) (point)))) 3947 (goto-char (point-max))
3950 (or (bobp) 3948 ;; Insert a separator if there's already text here.
3951 (insert "\f\n")) 3949 (unless (bobp)
3952 ;; Do no formatting while reading error file, 3950 (insert "\f\n"))
3953 ;; because that can run a shell command, and we 3951 ;; Do no formatting while reading error file,
3954 ;; don't want that to cause an infinite recursion. 3952 ;; because that can run a shell command, and we
3955 (format-insert-file error-file nil) 3953 ;; don't want that to cause an infinite recursion.
3956 ;; Put point after the inserted errors. 3954 (format-insert-file error-file nil)
3957 (goto-char (- (point-max) pos-from-end)))
3958 (and display-error-buffer 3955 (and display-error-buffer
3959 (display-buffer (current-buffer))))) 3956 (display-buffer (current-buffer)))))
3960 (delete-file error-file)) 3957 (delete-file error-file))
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index bce73d6bfef..67fc4aae151 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.")
105(defvar skeleton-regions) 105(defvar skeleton-regions)
106 106
107(def-edebug-spec skeleton-edebug-spec 107(def-edebug-spec skeleton-edebug-spec
108 ([&or null stringp (stringp &rest stringp) [[&not atom] def-form]] 108 ([&or null stringp (stringp &rest stringp) [[&not atom] sexp]]
109 &rest &or "n" "_" "-" ">" "@" "&" "!" "resume:" 109 &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:"
110 ("quote" def-form) skeleton-edebug-spec def-form)) 110 ("quote" def-form) skeleton-edebug-spec def-form))
111;;;###autoload 111;;;###autoload
112(defmacro define-skeleton (command documentation &rest skeleton) 112(defmacro define-skeleton (command documentation &rest skeleton)
diff --git a/lisp/sort.el b/lisp/sort.el
index 6ea1c440605..6ceda8e448c 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -225,11 +225,17 @@ the sort order."
225 (narrow-to-region beg end) 225 (narrow-to-region beg end)
226 (goto-char (point-min)) 226 (goto-char (point-min))
227 (sort-subr reverse 227 (sort-subr reverse
228 (function 228 (lambda ()
229 (lambda () 229 (while (and (not (eobp)) (looking-at paragraph-separate))
230 (while (and (not (eobp)) (looking-at paragraph-separate)) 230 (forward-line 1)))
231 (forward-line 1)))) 231 (lambda ()
232 'forward-paragraph)))) 232 (forward-paragraph)
233 ;; If the buffer doesn't end with a newline, add a
234 ;; newline to avoid having paragraphs being
235 ;; concatenated after sorting.
236 (when (and (eobp)
237 (not (bolp)))
238 (insert "\n")))))))
233 239
234;;;###autoload 240;;;###autoload
235(defun sort-pages (reverse beg end) 241(defun sort-pages (reverse beg end)
diff --git a/lisp/startup.el b/lisp/startup.el
index 564428580b1..a16db242da0 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,4 +1,4 @@
1;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*- 1;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985-1986, 1992, 1994-2019 Free Software Foundation, 3;; Copyright (C) 1985-1986, 1992, 1994-2019 Free Software Foundation,
4;; Inc. 4;; Inc.
@@ -490,6 +490,27 @@ DIRS are relative."
490 (when tail 490 (when tail
491 (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))) 491 (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
492 492
493;; The default location for XDG-convention Emacs init files.
494(defconst startup--xdg-config-default "~/.config/emacs/")
495;; The location for XDG-convention Emacs init files.
496(defvar startup--xdg-config-home-emacs)
497
498;; Return the name of the init file directory for Emacs, assuming
499;; XDG-DIR is the XDG location and USER-NAME is the user name.
500;; If USER-NAME is nil or "", use the current user.
501;; Prefer the XDG location unless it does does not exist and the
502;; .emacs.d location does exist.
503(defun startup--xdg-or-homedot (xdg-dir user-name)
504 (if (file-exists-p xdg-dir)
505 xdg-dir
506 (let ((emacs-d-dir (concat "~" user-name
507 (if (eq system-type 'ms-dos)
508 "/_emacs.d/"
509 "/.emacs.d/"))))
510 (if (file-exists-p emacs-d-dir)
511 emacs-d-dir
512 xdg-dir))))
513
493(defun normal-top-level () 514(defun normal-top-level ()
494 "Emacs calls this function when it first starts up. 515 "Emacs calls this function when it first starts up.
495It sets `command-line-processed', processes the command-line, 516It sets `command-line-processed', processes the command-line,
@@ -499,6 +520,14 @@ It is the default value of the variable `top-level'."
499 (message internal--top-level-message) 520 (message internal--top-level-message)
500 (setq command-line-processed t) 521 (setq command-line-processed t)
501 522
523 (setq startup--xdg-config-home-emacs
524 (let ((xdg-config-home (getenv-internal "XDG_CONFIG_HOME")))
525 (if xdg-config-home
526 (concat xdg-config-home "/emacs/")
527 startup--xdg-config-default)))
528 (setq user-emacs-directory
529 (startup--xdg-or-homedot startup--xdg-config-home-emacs nil))
530
502 ;; Look in each dir in load-path for a subdirs.el file. If we 531 ;; Look in each dir in load-path for a subdirs.el file. If we
503 ;; find one, load it, which will add the appropriate subdirs of 532 ;; find one, load it, which will add the appropriate subdirs of
504 ;; that dir into load-path. This needs to be done before setting 533 ;; 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."
906 ;; the name of the file that it loads into 935 ;; the name of the file that it loads into
907 ;; `user-init-file'. 936 ;; `user-init-file'.
908 (setq user-init-file t) 937 (setq user-init-file t)
909 (load (if (equal (file-name-extension init-file-name) 938 (when init-file-name
910 "el") 939 (load (if (equal (file-name-extension init-file-name)
911 (file-name-sans-extension init-file-name) 940 "el")
912 init-file-name) 941 (file-name-sans-extension init-file-name)
913 'noerror 'nomessage) 942 init-file-name)
943 'noerror 'nomessage))
914 944
915 (when (and (eq user-init-file t) alternate-filename-function) 945 (when (and (eq user-init-file t) alternate-filename-function)
916 (let ((alt-file (funcall alternate-filename-function))) 946 (let ((alt-file (funcall alternate-filename-function)))
917 (and (equal (file-name-extension alt-file) "el") 947 (and (equal (file-name-extension alt-file) "el")
918 (setq alt-file (file-name-sans-extension alt-file))) 948 (setq alt-file (file-name-sans-extension alt-file)))
949 (unless init-file-name
950 (setq init-file-name alt-file))
919 (load alt-file 'noerror 'nomessage))) 951 (load alt-file 'noerror 'nomessage)))
920 952
921 ;; If we did not find the user's init file, set 953 ;; 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."
971 (when debug-on-error-should-be-set 1003 (when debug-on-error-should-be-set
972 (setq debug-on-error debug-on-error-from-init-file)))) 1004 (setq debug-on-error debug-on-error-from-init-file))))
973 1005
974(defun find-init-path (fn)
975 "Look in ~/.config/FOO or ~/.FOO for the dotfile or dot directory FOO.
976It is expected that the output will undergo ~ expansion. Implements the
977XDG convention for dotfiles."
978 (let* ((xdg-path (concat "~" init-file-user "/.config/" fn))
979 (oldstyle-path (concat "~" init-file-user "/." fn))
980 (found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path)))
981 found-path))
982
983(defun command-line () 1006(defun command-line ()
984 "A subroutine of `normal-top-level'. 1007 "A subroutine of `normal-top-level'.
985Amongst another things, it parses the command-line arguments." 1008Amongst another things, it parses the command-line arguments."
1009 (let (xdg-dir startup-init-directory)
986 (setq before-init-time (current-time) 1010 (setq before-init-time (current-time)
987 after-init-time nil 1011 after-init-time nil
988 command-line-default-directory default-directory) 1012 command-line-default-directory default-directory)
@@ -1171,6 +1195,19 @@ please check its value")
1171 init-file-user)) 1195 init-file-user))
1172 :error)))) 1196 :error))))
1173 1197
1198 ;; Calculate the name of the Emacs init directory.
1199 ;; This is typically ~INIT-FILE-USER/.config/emacs unless the user
1200 ;; is following the ~INIT-FILE-USER/.emacs.d convention.
1201 (setq xdg-dir startup--xdg-config-home-emacs)
1202 (setq startup-init-directory
1203 (if (or (zerop (length init-file-user))
1204 (and (eq xdg-dir user-emacs-directory)
1205 (not (eq xdg-dir startup--xdg-config-default))))
1206 user-emacs-directory
1207 ;; The name is not obvious, so access more directories to calculate it.
1208 (setq xdg-dir (concat "~" init-file-user "/.config/emacs/"))
1209 (startup--xdg-or-homedot xdg-dir init-file-user)))
1210
1174 ;; Load the early init file, if found. 1211 ;; Load the early init file, if found.
1175 (startup--load-user-init-file 1212 (startup--load-user-init-file
1176 (lambda () 1213 (lambda ()
@@ -1180,8 +1217,7 @@ please check its value")
1180 ;; with the .el extension, if the file doesn't exist, not just 1217 ;; with the .el extension, if the file doesn't exist, not just
1181 ;; "early-init" without an extension, as it does for ".emacs". 1218 ;; "early-init" without an extension, as it does for ".emacs".
1182 "early-init.el" 1219 "early-init.el"
1183 (file-name-as-directory 1220 startup-init-directory)))
1184 (find-init-path "emacs.d")))))
1185 (setq early-init-file user-init-file) 1221 (setq early-init-file user-init-file)
1186 1222
1187 ;; If any package directory exists, initialize the package system. 1223 ;; If any package directory exists, initialize the package system.
@@ -1319,10 +1355,11 @@ please check its value")
1319 (startup--load-user-init-file 1355 (startup--load-user-init-file
1320 (lambda () 1356 (lambda ()
1321 (cond 1357 (cond
1358 ((eq startup-init-directory xdg-dir) nil)
1322 ((eq system-type 'ms-dos) 1359 ((eq system-type 'ms-dos)
1323 (concat "~" init-file-user "/_emacs")) 1360 (concat "~" init-file-user "/_emacs"))
1324 ((not (eq system-type 'windows-nt)) 1361 ((not (eq system-type 'windows-nt))
1325 (find-init-path "emacs")) 1362 (concat "~" init-file-user "/.emacs"))
1326 ;; Else deal with the Windows situation. 1363 ;; Else deal with the Windows situation.
1327 ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") 1364 ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
1328 ;; Prefer .emacs on Windows. 1365 ;; Prefer .emacs on Windows.
@@ -1339,8 +1376,7 @@ please check its value")
1339 (lambda () 1376 (lambda ()
1340 (expand-file-name 1377 (expand-file-name
1341 "init" 1378 "init"
1342 (file-name-as-directory 1379 startup-init-directory))
1343 (find-init-path "emacs.d"))))
1344 (not inhibit-default-init)) 1380 (not inhibit-default-init))
1345 1381
1346 (when (and deactivate-mark transient-mark-mode) 1382 (when (and deactivate-mark transient-mark-mode)
@@ -1456,7 +1492,7 @@ Consider using a subdirectory instead, e.g.: %s"
1456 (if (and (boundp 'x-session-previous-id) 1492 (if (and (boundp 'x-session-previous-id)
1457 (stringp x-session-previous-id)) 1493 (stringp x-session-previous-id))
1458 (with-no-warnings 1494 (with-no-warnings
1459 (emacs-session-restore x-session-previous-id)))) 1495 (emacs-session-restore x-session-previous-id)))))
1460 1496
1461(defun x-apply-session-resources () 1497(defun x-apply-session-resources ()
1462 "Apply X resources which specify initial values for Emacs variables. 1498 "Apply X resources which specify initial values for Emacs variables.
diff --git a/lisp/subr.el b/lisp/subr.el
index b22db65bb64..0d7bffb35f3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2937,11 +2937,9 @@ When the hook runs, the temporary buffer is current.
2937This hook is normally set up with a function to put the buffer in Help 2937This hook is normally set up with a function to put the buffer in Help
2938mode.") 2938mode.")
2939 2939
2940(defconst user-emacs-directory 2940(defvar user-emacs-directory
2941 (if (eq system-type 'ms-dos) 2941 ;; The value does not matter since Emacs sets this at startup.
2942 ;; MS-DOS cannot have initial dot. 2942 nil
2943 "~/_emacs.d/"
2944 "~/.emacs.d/")
2945 "Directory beneath which additional per-user Emacs-specific files are placed. 2943 "Directory beneath which additional per-user Emacs-specific files are placed.
2946Various programs in Emacs store information in this directory. 2944Various programs in Emacs store information in this directory.
2947Note that this should end with a directory separator. 2945Note that this should end with a directory separator.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 713f3d944bc..8e7e1945cbc 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -450,6 +450,7 @@ checksum before doing the check."
450 (progn (beep) (message "Invalid checksum for file %s!" file-name)))) 450 (progn (beep) (message "Invalid checksum for file %s!" file-name))))
451 451
452(defun tar-clip-time-string (time) 452(defun tar-clip-time-string (time)
453 (declare (obsolete format-time-string "27.1"))
453 (let ((str (current-time-string time))) 454 (let ((str (current-time-string time)))
454 (concat " " (substring str 4 16) (format-time-string " %Y" time)))) 455 (concat " " (substring str 4 16) (format-time-string " %Y" time))))
455 456
@@ -508,7 +509,9 @@ MODE should be an integer which is a file mode value."
508 (if (= 0 (length uname)) uid uname) 509 (if (= 0 (length uname)) uid uname)
509 (if (= 0 (length gname)) gid gname) 510 (if (= 0 (length gname)) gid gname)
510 size 511 size
511 (if tar-mode-show-date (tar-clip-time-string time) "") 512 (if tar-mode-show-date
513 (format-time-string " %Y-%m-%d %H:%M" time)
514 "")
512 (propertize name 515 (propertize name
513 'mouse-face 'highlight 516 'mouse-face 'highlight
514 'help-echo "mouse-2: extract this file into a buffer") 517 'help-echo "mouse-2: extract this file into a buffer")
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 9dfa9f3c448..5c77e03b0b2 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -394,7 +394,12 @@ for language-specific arguments."
394 "Indicates whether ispell should skip spell checking of SGML markup. 394 "Indicates whether ispell should skip spell checking of SGML markup.
395If t, always skip SGML markup; if nil, never skip; if non-t and non-nil, 395If t, always skip SGML markup; if nil, never skip; if non-t and non-nil,
396guess whether SGML markup should be skipped according to the name of the 396guess whether SGML markup should be skipped according to the name of the
397buffer's major mode." 397buffer's major mode.
398
399SGML markup is any text inside the brackets \"<>\" or entities
400such as \"&amp;\". See `ispell-html-skip-alists' for more details.
401
402This variable affects spell-checking of HTML, XML, and SGML files."
398 :type '(choice (const :tag "always" t) (const :tag "never" nil) 403 :type '(choice (const :tag "always" t) (const :tag "never" nil)
399 (const :tag "use-mode-name" use-mode-name)) 404 (const :tag "use-mode-name" use-mode-name))
400 :group 'ispell) 405 :group 'ispell)
diff --git a/lisp/tmm.el b/lisp/tmm.el
index bf76652f401..c1c863876b5 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -240,8 +240,6 @@ instead of executing it."
240 (car elt))) 240 (car elt)))
241 tmm-km-list))))) 241 tmm-km-list)))))
242 (setq history-len (length tmm--history)) 242 (setq history-len (length tmm--history))
243 (setq tmm--history (append tmm--history tmm--history
244 tmm--history tmm--history))
245 (setq tmm-c-prompt (nth (- history-len 1 index-of-default) 243 (setq tmm-c-prompt (nth (- history-len 1 index-of-default)
246 tmm--history)) 244 tmm--history))
247 (setq out 245 (setq out
@@ -249,18 +247,17 @@ instead of executing it."
249 (car (nth index-of-default tmm-km-list)) 247 (car (nth index-of-default tmm-km-list))
250 (minibuffer-with-setup-hook #'tmm-add-prompt 248 (minibuffer-with-setup-hook #'tmm-add-prompt
251 ;; tmm-km-list is reversed, because history 249 ;; tmm-km-list is reversed, because history
252 ;; needs it in LIFO order. But completion 250 ;; needs it in LIFO order. But default list
253 ;; needs it in non-reverse order, so that the 251 ;; needs it in non-reverse order, so that the
254 ;; menu items are displayed as completion 252 ;; menu items are displayed by M-n as default
255 ;; candidates in the order they are shown on 253 ;; values in the order they are shown on
256 ;; the menu bar. So pass completing-read the 254 ;; the menu bar. So pass the DEFAULT arg the
257 ;; reversed copy of the list. 255 ;; reversed copy of the list.
258 (completing-read-default 256 (completing-read-default
259 (concat gl-str 257 (concat gl-str
260 " (up/down to change, PgUp to menu): ") 258 " (up/down to change, PgUp to menu): ")
261 (tmm--completion-table (reverse tmm-km-list)) nil t nil 259 (tmm--completion-table tmm-km-list) nil t nil
262 (cons 'tmm--history 260 'tmm--history (reverse tmm--history)))))))
263 (- (* 2 history-len) index-of-default))))))))
264 (setq choice (cdr (assoc out tmm-km-list))) 261 (setq choice (cdr (assoc out tmm-km-list)))
265 (and (null choice) 262 (and (null choice)
266 (string-prefix-p tmm-c-prompt out) 263 (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'."
404 ;; Try to show everything just inserted and preserve height of 401 ;; Try to show everything just inserted and preserve height of
405 ;; *Completions* window. This should fix a behavior described 402 ;; *Completions* window. This should fix a behavior described
406 ;; in Bug#1291. 403 ;; in Bug#1291.
407 (fit-window-to-buffer window nil nil nil nil t))))) 404 (fit-window-to-buffer window nil nil nil nil t))))))
408 (insert tmm-c-prompt))
409 405
410(defun tmm-shortcut () 406(defun tmm-shortcut ()
411 "Choose the shortcut that the user typed." 407 "Choose the shortcut that the user typed."
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index f287adf2423..c2a5a6f70c6 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1359,6 +1359,8 @@ commands, which only operated on marked files."
1359 (mapcar (lambda (arg) (list "-r" arg)) marked-list))) 1359 (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
1360 (let* ((root (vc-hg-root default-directory)) 1360 (let* ((root (vc-hg-root default-directory))
1361 (buffer (format "*vc-hg : %s*" (expand-file-name root))) 1361 (buffer (format "*vc-hg : %s*" (expand-file-name root)))
1362 ;; Disable pager.
1363 (process-environment (cons "HGPLAIN=1" process-environment))
1362 (hg-program vc-hg-program) 1364 (hg-program vc-hg-program)
1363 args) 1365 args)
1364 ;; If necessary, prompt for the exact command. 1366 ;; If necessary, prompt for the exact command.
@@ -1431,7 +1433,9 @@ call \"hg push -r REVS\" to push the specified revisions REVS."
1431 "Merge incoming changes into the current working directory. 1433 "Merge incoming changes into the current working directory.
1432This runs the command \"hg merge\"." 1434This runs the command \"hg merge\"."
1433 (let* ((root (vc-hg-root default-directory)) 1435 (let* ((root (vc-hg-root default-directory))
1434 (buffer (format "*vc-hg : %s*" (expand-file-name root)))) 1436 (buffer (format "*vc-hg : %s*" (expand-file-name root)))
1437 ;; Disable pager.
1438 (process-environment (cons "HGPLAIN=1" process-environment)))
1435 (apply 'vc-do-async-command buffer root vc-hg-program '("merge")) 1439 (apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
1436 (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg))) 1440 (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
1437 (vc-set-async-update buffer))) 1441 (vc-set-async-update buffer)))
@@ -1442,11 +1446,13 @@ This runs the command \"hg merge\"."
1442 "A wrapper around `vc-do-command' for use in vc-hg.el. 1446 "A wrapper around `vc-do-command' for use in vc-hg.el.
1443This function differs from vc-do-command in that it invokes 1447This function differs from vc-do-command in that it invokes
1444`vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS." 1448`vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS."
1445 (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list 1449 ;; Disable pager.
1446 (if (stringp vc-hg-global-switches) 1450 (let ((process-environment (cons "HGPLAIN=1" process-environment)))
1447 (cons vc-hg-global-switches flags) 1451 (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list
1448 (append vc-hg-global-switches 1452 (if (stringp vc-hg-global-switches)
1449 flags)))) 1453 (cons vc-hg-global-switches flags)
1454 (append vc-hg-global-switches
1455 flags)))))
1450 1456
1451(defun vc-hg-root (file) 1457(defun vc-hg-root (file)
1452 (vc-find-root file ".hg")) 1458 (vc-find-root file ".hg"))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index dd03a24bb36..9bc7a076eec 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."
1790 :type 'string 1790 :type 'string
1791 :group 'widget-button) 1791 :group 'widget-button)
1792 1792
1793(defvar widget-link-keymap
1794 (let ((map (copy-keymap widget-keymap)))
1795 ;; Only bind mouse-2, since mouse-1 will be translated accordingly to
1796 ;; the customization of `mouse-1-click-follows-link'.
1797 (define-key map [down-mouse-1] (lookup-key widget-global-map [down-mouse-1]))
1798 (define-key map [down-mouse-2] 'widget-button-click)
1799 (define-key map [mouse-2] 'widget-button-click)
1800 map)
1801 "Keymap used inside a link widget.")
1802
1793(define-widget 'link 'item 1803(define-widget 'link 'item
1794 "An embedded link." 1804 "An embedded link."
1795 :button-prefix 'widget-link-prefix 1805 :button-prefix 'widget-link-prefix
1796 :button-suffix 'widget-link-suffix 1806 :button-suffix 'widget-link-suffix
1797 ;; The `follow-link' property should only be used in those contexts where the 1807 :follow-link 'mouse-face
1798 ;; mouse-1 event normally doesn't follow the link, yet the `link' widget 1808 :keymap widget-link-keymap
1799 ;; seems to almost always be used in contexts where (down-)mouse-1 is bound
1800 ;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is
1801 ;; not necessary (and can even be harmful). So let's not add a :follow-link
1802 ;; by default. See (bug#22434).
1803 ;; :follow-link 'mouse-face
1804 :help-echo "Follow the link." 1809 :help-echo "Follow the link."
1805 :format "%[%t%]") 1810 :format "%[%t%]")
1806 1811
@@ -3078,7 +3083,9 @@ as the value."
3078(define-widget 'file 'string 3083(define-widget 'file 'string
3079 "A file widget. 3084 "A file widget.
3080It reads a file name from an editable text field." 3085It reads a file name from an editable text field."
3081 :completions #'completion-file-name-table 3086 :completions (completion-table-case-fold
3087 #'completion-file-name-table
3088 (not read-file-name-completion-ignore-case))
3082 :prompt-value 'widget-file-prompt-value 3089 :prompt-value 'widget-file-prompt-value
3083 :format "%{%t%}: %v" 3090 :format "%{%t%}: %v"
3084 ;; Doesn't work well with terminating newline. 3091 ;; Doesn't work well with terminating newline.
@@ -3113,6 +3120,11 @@ It reads a file name from an editable text field."
3113(define-widget 'directory 'file 3120(define-widget 'directory 'file
3114 "A directory widget. 3121 "A directory widget.
3115It reads a directory name from an editable text field." 3122It reads a directory name from an editable text field."
3123 :completions (apply-partially #'completion-table-with-predicate
3124 (completion-table-case-fold
3125 #'completion-file-name-table
3126 (not read-file-name-completion-ignore-case))
3127 #'directory-name-p 'strict)
3116 :tag "Directory") 3128 :tag "Directory")
3117 3129
3118(defvar widget-symbol-prompt-value-history nil 3130(defvar widget-symbol-prompt-value-history nil
@@ -3328,13 +3340,13 @@ It reads a directory name from an editable text field."
3328 (condition-case data ;Note: We get a spurious byte-compile warning here. 3340 (condition-case data ;Note: We get a spurious byte-compile warning here.
3329 (progn 3341 (progn
3330 ;; Avoid a confusing end-of-file error. 3342 ;; Avoid a confusing end-of-file error.
3331 (skip-syntax-forward "\\s-") 3343 (skip-syntax-forward "-")
3332 (if (eobp) 3344 (if (eobp)
3333 (setq err "Empty sexp -- use nil?") 3345 (setq err "Empty sexp -- use nil?")
3334 (unless (widget-apply widget :match (read (current-buffer))) 3346 (unless (widget-apply widget :match (read (current-buffer)))
3335 (setq err (widget-get widget :type-error)))) 3347 (setq err (widget-get widget :type-error))))
3336 ;; Allow whitespace after expression. 3348 ;; Allow whitespace after expression.
3337 (skip-syntax-forward "\\s-") 3349 (skip-syntax-forward "-")
3338 (if (and (not (eobp)) 3350 (if (and (not (eobp))
3339 (not err)) 3351 (not err))
3340 (setq err (format "Junk at end of expression: %s" 3352 (setq err (format "Junk at end of expression: %s"
diff --git a/lisp/window.el b/lisp/window.el
index 80dbd64f18a..cf733153b89 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -4849,7 +4849,7 @@ all window-local buffer lists."
4849 (unrecord-window-buffer window buffer))))) 4849 (unrecord-window-buffer window buffer)))))
4850 4850
4851(defcustom quit-window-hook nil 4851(defcustom quit-window-hook nil
4852 "Hook run before performing any other actions in the `quit-buffer' command." 4852 "Hook run before performing any other actions in the `quit-window' command."
4853 :type 'hook 4853 :type 'hook
4854 :version "27.1" 4854 :version "27.1"
4855 :group 'windows) 4855 :group 'windows)
@@ -4882,11 +4882,7 @@ nil means to not handle the buffer in a particular way. This
4882 most reliable remedy to not have `switch-to-prev-buffer' switch 4882 most reliable remedy to not have `switch-to-prev-buffer' switch
4883 to this buffer again without killing the buffer. 4883 to this buffer again without killing the buffer.
4884 4884
4885`kill' means to kill WINDOW's buffer. 4885`kill' means to kill WINDOW's buffer."
4886
4887The functions in `quit-window-hook' will be run before doing
4888anything else."
4889 (run-hooks 'quit-window-hook)
4890 (setq window (window-normalize-window window t)) 4886 (setq window (window-normalize-window window t))
4891 (let* ((buffer (window-buffer window)) 4887 (let* ((buffer (window-buffer window))
4892 (quit-restore (window-parameter window 'quit-restore)) 4888 (quit-restore (window-parameter window 'quit-restore))
@@ -4986,6 +4982,10 @@ one. If non-nil, reset `quit-restore' parameter to nil.
4986The functions in `quit-window-hook' will be run before doing 4982The functions in `quit-window-hook' will be run before doing
4987anything else." 4983anything else."
4988 (interactive "P") 4984 (interactive "P")
4985 ;; Run the hook from the buffer implied to get any buffer-local
4986 ;; values.
4987 (with-current-buffer (window-buffer (window-normalize-window window))
4988 (run-hooks 'quit-window-hook))
4989 (quit-restore-window window (if kill 'kill 'bury))) 4989 (quit-restore-window window (if kill 'kill 'bury)))
4990 4990
4991(defun quit-windows-on (&optional buffer-or-name kill frame) 4991(defun quit-windows-on (&optional buffer-or-name kill frame)
diff --git a/src/alloc.c b/src/alloc.c
index bb8e97f8737..be98cfd5f53 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -297,20 +297,20 @@ static ptrdiff_t pure_bytes_used_non_lisp;
297 297
298static intptr_t garbage_collection_inhibited; 298static intptr_t garbage_collection_inhibited;
299 299
300/* The GC threshold in bytes, the last time it was calculated
301 from gc-cons-threshold and gc-cons-percentage. */
302static intmax_t gc_threshold;
303
300/* If nonzero, this is a warning delivered by malloc and not yet 304/* If nonzero, this is a warning delivered by malloc and not yet
301 displayed. */ 305 displayed. */
302 306
303const char *pending_malloc_warning; 307const char *pending_malloc_warning;
304 308
305#if 0 /* Normally, pointer sanity only on request... */ 309/* Pointer sanity only on request. FIXME: Code depending on
310 SUSPICIOUS_OBJECT_CHECKING is obsolete; remove it entirely. */
306#ifdef ENABLE_CHECKING 311#ifdef ENABLE_CHECKING
307#define SUSPICIOUS_OBJECT_CHECKING 1 312#define SUSPICIOUS_OBJECT_CHECKING 1
308#endif 313#endif
309#endif
310
311/* ... but unconditionally use SUSPICIOUS_OBJECT_CHECKING while the GC
312 bug is unresolved. */
313#define SUSPICIOUS_OBJECT_CHECKING 1
314 314
315#ifdef SUSPICIOUS_OBJECT_CHECKING 315#ifdef SUSPICIOUS_OBJECT_CHECKING
316struct suspicious_free_record 316struct suspicious_free_record
@@ -327,8 +327,8 @@ static int suspicious_free_history_index;
327static void *find_suspicious_object_in_range (void *begin, void *end); 327static void *find_suspicious_object_in_range (void *begin, void *end);
328static void detect_suspicious_free (void *ptr); 328static void detect_suspicious_free (void *ptr);
329#else 329#else
330# define find_suspicious_object_in_range(begin, end) NULL 330# define find_suspicious_object_in_range(begin, end) ((void *) NULL)
331# define detect_suspicious_free(ptr) (void) 331# define detect_suspicious_free(ptr) ((void) 0)
332#endif 332#endif
333 333
334/* Maximum amount of C stack to save when a GC happens. */ 334/* Maximum amount of C stack to save when a GC happens. */
@@ -4621,11 +4621,11 @@ mark_maybe_pointer (void *p)
4621 4621
4622 if (pdumper_object_p (p)) 4622 if (pdumper_object_p (p))
4623 { 4623 {
4624 enum Lisp_Type type = pdumper_find_object_type (p); 4624 int type = pdumper_find_object_type (p);
4625 if (type != PDUMPER_NO_OBJECT) 4625 if (pdumper_valid_object_type_p (type))
4626 mark_object ((type == Lisp_Symbol) 4626 mark_object (type == Lisp_Symbol
4627 ? make_lisp_symbol(p) 4627 ? make_lisp_symbol (p)
4628 : make_lisp_ptr(p, type)); 4628 : make_lisp_ptr (p, type));
4629 /* See mark_maybe_object for why we can confidently return. */ 4629 /* See mark_maybe_object for why we can confidently return. */
4630 return; 4630 return;
4631 } 4631 }
@@ -5290,9 +5290,10 @@ make_pure_float (double num)
5290 space. */ 5290 space. */
5291 5291
5292static Lisp_Object 5292static Lisp_Object
5293make_pure_bignum (struct Lisp_Bignum *value) 5293make_pure_bignum (Lisp_Object value)
5294{ 5294{
5295 size_t i, nlimbs = mpz_size (value->value); 5295 mpz_t const *n = xbignum_val (value);
5296 size_t i, nlimbs = mpz_size (*n);
5296 size_t nbytes = nlimbs * sizeof (mp_limb_t); 5297 size_t nbytes = nlimbs * sizeof (mp_limb_t);
5297 mp_limb_t *pure_limbs; 5298 mp_limb_t *pure_limbs;
5298 mp_size_t new_size; 5299 mp_size_t new_size;
@@ -5303,10 +5304,10 @@ make_pure_bignum (struct Lisp_Bignum *value)
5303 int limb_alignment = alignof (mp_limb_t); 5304 int limb_alignment = alignof (mp_limb_t);
5304 pure_limbs = pure_alloc (nbytes, - limb_alignment); 5305 pure_limbs = pure_alloc (nbytes, - limb_alignment);
5305 for (i = 0; i < nlimbs; ++i) 5306 for (i = 0; i < nlimbs; ++i)
5306 pure_limbs[i] = mpz_getlimbn (value->value, i); 5307 pure_limbs[i] = mpz_getlimbn (*n, i);
5307 5308
5308 new_size = nlimbs; 5309 new_size = nlimbs;
5309 if (mpz_sgn (value->value) < 0) 5310 if (mpz_sgn (*n) < 0)
5310 new_size = -new_size; 5311 new_size = -new_size;
5311 5312
5312 mpz_roinit_n (b->value, pure_limbs, new_size); 5313 mpz_roinit_n (b->value, pure_limbs, new_size);
@@ -5456,7 +5457,7 @@ purecopy (Lisp_Object obj)
5456 return obj; 5457 return obj;
5457 } 5458 }
5458 else if (BIGNUMP (obj)) 5459 else if (BIGNUMP (obj))
5459 obj = make_pure_bignum (XBIGNUM (obj)); 5460 obj = make_pure_bignum (obj);
5460 else 5461 else
5461 { 5462 {
5462 AUTO_STRING (fmt, "Don't know how to purify: %S"); 5463 AUTO_STRING (fmt, "Don't know how to purify: %S");
@@ -5784,6 +5785,77 @@ mark_and_sweep_weak_table_contents (void)
5784 } 5785 }
5785} 5786}
5786 5787
5788/* Return the number of bytes to cons between GCs, assuming
5789 gc-cons-threshold is THRESHOLD and gc-cons-percentage is
5790 PERCENTAGE. */
5791static intmax_t
5792consing_threshold (intmax_t threshold, Lisp_Object percentage)
5793{
5794 if (!NILP (Vmemory_full))
5795 return memory_full_cons_threshold;
5796 else
5797 {
5798 threshold = max (threshold, GC_DEFAULT_THRESHOLD / 10);
5799 if (FLOATP (percentage))
5800 {
5801 double tot = (XFLOAT_DATA (percentage)
5802 * total_bytes_of_live_objects ());
5803 if (threshold < tot)
5804 {
5805 if (tot < INTMAX_MAX)
5806 threshold = tot;
5807 else
5808 threshold = INTMAX_MAX;
5809 }
5810 }
5811 return threshold;
5812 }
5813}
5814
5815/* Adjust consing_until_gc, assuming gc-cons-threshold is THRESHOLD and
5816 gc-cons-percentage is PERCENTAGE. */
5817static Lisp_Object
5818bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage)
5819{
5820 /* If consing_until_gc is negative leave it alone, since this prevents
5821 negative integer overflow and a GC would have been done soon anyway. */
5822 if (0 <= consing_until_gc)
5823 {
5824 threshold = consing_threshold (threshold, percentage);
5825 intmax_t sum;
5826 if (INT_ADD_WRAPV (consing_until_gc, threshold - gc_threshold, &sum))
5827 {
5828 /* Scale the threshold down so that consing_until_gc does
5829 not overflow. */
5830 sum = INTMAX_MAX;
5831 threshold = INTMAX_MAX - consing_until_gc + gc_threshold;
5832 }
5833 consing_until_gc = sum;
5834 gc_threshold = threshold;
5835 }
5836
5837 return Qnil;
5838}
5839
5840/* Watch changes to gc-cons-threshold. */
5841static Lisp_Object
5842watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object newval,
5843 Lisp_Object operation, Lisp_Object where)
5844{
5845 intmax_t threshold;
5846 if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold)))
5847 return Qnil;
5848 return bump_consing_until_gc (threshold, Vgc_cons_percentage);
5849}
5850
5851/* Watch changes to gc-cons-percentage. */
5852static Lisp_Object
5853watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
5854 Lisp_Object operation, Lisp_Object where)
5855{
5856 return bump_consing_until_gc (gc_cons_threshold, newval);
5857}
5858
5787/* Subroutine of Fgarbage_collect that does most of the work. */ 5859/* Subroutine of Fgarbage_collect that does most of the work. */
5788static bool 5860static bool
5789garbage_collect_1 (struct gcstat *gcst) 5861garbage_collect_1 (struct gcstat *gcst)
@@ -5926,25 +5998,8 @@ garbage_collect_1 (struct gcstat *gcst)
5926 5998
5927 unblock_input (); 5999 unblock_input ();
5928 6000
5929 if (!NILP (Vmemory_full)) 6001 consing_until_gc = gc_threshold
5930 consing_until_gc = memory_full_cons_threshold; 6002 = consing_threshold (gc_cons_threshold, Vgc_cons_percentage);
5931 else
5932 {
5933 intmax_t threshold = max (gc_cons_threshold, GC_DEFAULT_THRESHOLD / 10);
5934 if (FLOATP (Vgc_cons_percentage))
5935 {
5936 double tot = (XFLOAT_DATA (Vgc_cons_percentage)
5937 * total_bytes_of_live_objects ());
5938 if (threshold < tot)
5939 {
5940 if (tot < INTMAX_MAX)
5941 threshold = tot;
5942 else
5943 threshold = INTMAX_MAX;
5944 }
5945 }
5946 consing_until_gc = threshold;
5947 }
5948 6003
5949 if (garbage_collection_messages && NILP (Vmemory_full)) 6004 if (garbage_collection_messages && NILP (Vmemory_full))
5950 { 6005 {
@@ -7365,6 +7420,7 @@ do hash-consing of the objects allocated to pure space. */);
7365 DEFSYM (Qheap, "heap"); 7420 DEFSYM (Qheap, "heap");
7366 DEFSYM (QAutomatic_GC, "Automatic GC"); 7421 DEFSYM (QAutomatic_GC, "Automatic GC");
7367 7422
7423 DEFSYM (Qgc_cons_percentage, "gc-cons-percentage");
7368 DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); 7424 DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
7369 DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); 7425 DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
7370 7426
@@ -7398,6 +7454,22 @@ N should be nonnegative. */);
7398 defsubr (&Smemory_info); 7454 defsubr (&Smemory_info);
7399 defsubr (&Smemory_use_counts); 7455 defsubr (&Smemory_use_counts);
7400 defsubr (&Ssuspicious_object); 7456 defsubr (&Ssuspicious_object);
7457
7458 Lisp_Object watcher;
7459
7460 static union Aligned_Lisp_Subr Swatch_gc_cons_threshold =
7461 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
7462 { .a4 = watch_gc_cons_threshold },
7463 4, 4, "watch_gc_cons_threshold", 0, 0}};
7464 XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
7465 Fadd_variable_watcher (Qgc_cons_threshold, watcher);
7466
7467 static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
7468 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
7469 { .a4 = watch_gc_cons_percentage },
7470 4, 4, "watch_gc_cons_percentage", 0, 0}};
7471 XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
7472 Fadd_variable_watcher (Qgc_cons_percentage, watcher);
7401} 7473}
7402 7474
7403#ifdef HAVE_X_WINDOWS 7475#ifdef HAVE_X_WINDOWS
diff --git a/src/bignum.c b/src/bignum.c
index 3883d3a3944..167b73eee02 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/>. */
31 storage is exhausted. Admittedly this is not ideal. An mpz value 31 storage is exhausted. Admittedly this is not ideal. An mpz value
32 in a temporary is made permanent by mpz_swapping it with a bignum's 32 in a temporary is made permanent by mpz_swapping it with a bignum's
33 value. Although typically at most two temporaries are needed, 33 value. Although typically at most two temporaries are needed,
34 time_arith, rounddiv_q and rounding_driver each need four. */ 34 rounddiv_q and rounding_driver both need four and time_arith needs
35 five. */
35 36
36mpz_t mpz[4]; 37mpz_t mpz[5];
37 38
38static void * 39static void *
39xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) 40xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
@@ -62,7 +63,7 @@ init_bignum (void)
62double 63double
63bignum_to_double (Lisp_Object n) 64bignum_to_double (Lisp_Object n)
64{ 65{
65 return mpz_get_d_rounded (XBIGNUM (n)->value); 66 return mpz_get_d_rounded (*xbignum_val (n));
66} 67}
67 68
68/* Return D, converted to a Lisp integer. Discard any fraction. 69/* Return D, converted to a Lisp integer. Discard any fraction.
@@ -263,13 +264,13 @@ intmax_t
263bignum_to_intmax (Lisp_Object x) 264bignum_to_intmax (Lisp_Object x)
264{ 265{
265 intmax_t i; 266 intmax_t i;
266 return mpz_to_intmax (XBIGNUM (x)->value, &i) ? i : 0; 267 return mpz_to_intmax (*xbignum_val (x), &i) ? i : 0;
267} 268}
268uintmax_t 269uintmax_t
269bignum_to_uintmax (Lisp_Object x) 270bignum_to_uintmax (Lisp_Object x)
270{ 271{
271 uintmax_t i; 272 uintmax_t i;
272 return mpz_to_uintmax (XBIGNUM (x)->value, &i) ? i : 0; 273 return mpz_to_uintmax (*xbignum_val (x), &i) ? i : 0;
273} 274}
274 275
275/* Yield an upper bound on the buffer size needed to contain a C 276/* 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)
283ptrdiff_t 284ptrdiff_t
284bignum_bufsize (Lisp_Object num, int base) 285bignum_bufsize (Lisp_Object num, int base)
285{ 286{
286 return mpz_bufsize (XBIGNUM (num)->value, base); 287 return mpz_bufsize (*xbignum_val (num), base);
287} 288}
288 289
289/* Convert NUM to a nearest double, as opposed to mpz_get_d which 290/* Convert NUM to a nearest double, as opposed to mpz_get_d which
@@ -317,7 +318,7 @@ ptrdiff_t
317bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base) 318bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base)
318{ 319{
319 eassert (bignum_bufsize (num, abs (base)) == size); 320 eassert (bignum_bufsize (num, abs (base)) == size);
320 mpz_get_str (buf, base, XBIGNUM (num)->value); 321 mpz_get_str (buf, base, *xbignum_val (num));
321 ptrdiff_t n = size - 2; 322 ptrdiff_t n = size - 2;
322 return !buf[n - 1] ? n - 1 : n + !!buf[n]; 323 return !buf[n - 1] ? n - 1 : n + !!buf[n];
323} 324}
diff --git a/src/bignum.h b/src/bignum.h
index a9c7a0a09a8..bf7b3669537 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -41,7 +41,7 @@ struct Lisp_Bignum
41 mpz_t value; 41 mpz_t value;
42} GCALIGNED_STRUCT; 42} GCALIGNED_STRUCT;
43 43
44extern mpz_t mpz[4]; 44extern mpz_t mpz[5];
45 45
46extern void init_bignum (void); 46extern void init_bignum (void);
47extern Lisp_Object make_integer_mpz (void); 47extern Lisp_Object make_integer_mpz (void);
@@ -80,6 +80,19 @@ mpz_set_uintmax (mpz_t result, uintmax_t v)
80 mpz_set_uintmax_slow (result, v); 80 mpz_set_uintmax_slow (result, v);
81} 81}
82 82
83/* Return a pointer to the mpz_t value represented by the bignum I.
84 It is const because the value should not change. */
85INLINE mpz_t const *
86bignum_val (struct Lisp_Bignum const *i)
87{
88 return &i->value;
89}
90INLINE mpz_t const *
91xbignum_val (Lisp_Object i)
92{
93 return bignum_val (XBIGNUM (i));
94}
95
83/* Return a pointer to an mpz_t that is equal to the Lisp integer I. 96/* Return a pointer to an mpz_t that is equal to the Lisp integer I.
84 If I is a bignum this returns a pointer to I's representation; 97 If I is a bignum this returns a pointer to I's representation;
85 otherwise this sets *TMP to I's value and returns TMP. */ 98 otherwise this sets *TMP to I's value and returns TMP. */
@@ -91,7 +104,7 @@ bignum_integer (mpz_t *tmp, Lisp_Object i)
91 mpz_set_intmax (*tmp, XFIXNUM (i)); 104 mpz_set_intmax (*tmp, XFIXNUM (i));
92 return tmp; 105 return tmp;
93 } 106 }
94 return &XBIGNUM (i)->value; 107 return xbignum_val (i);
95} 108}
96 109
97/* Set RESULT to the value stored in the Lisp integer I. If I is a 110/* 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)
103 if (FIXNUMP (i)) 116 if (FIXNUMP (i))
104 mpz_set_intmax (result, XFIXNUM (i)); 117 mpz_set_intmax (result, XFIXNUM (i));
105 else 118 else
106 mpz_set (result, XBIGNUM (i)->value); 119 mpz_set (result, *xbignum_val (i));
107} 120}
108 121
109INLINE_HEADER_END 122INLINE_HEADER_END
diff --git a/src/buffer.c b/src/buffer.c
index ea785bbcd70..77e8b6bb779 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -105,7 +105,7 @@ static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
105 105
106/* Number of per-buffer variables used. */ 106/* Number of per-buffer variables used. */
107 107
108int last_per_buffer_idx; 108static int last_per_buffer_idx;
109 109
110static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, 110static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
111 bool after, Lisp_Object arg1, 111 bool after, Lisp_Object arg1,
@@ -655,6 +655,12 @@ set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
655 b->overlays_after = o; 655 b->overlays_after = o;
656} 656}
657 657
658bool
659valid_per_buffer_idx (int idx)
660{
661 return 0 <= idx && idx < last_per_buffer_idx;
662}
663
658/* Clone per-buffer values of buffer FROM. 664/* Clone per-buffer values of buffer FROM.
659 665
660 Buffer TO gets the same per-buffer values as FROM, with the 666 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,
4568 prop_i = copy[i++]; 4574 prop_i = copy[i++];
4569 overlay_i = copy[i++]; 4575 overlay_i = copy[i++];
4570 /* It is possible that the recorded overlay has been deleted 4576 /* It is possible that the recorded overlay has been deleted
4571 (which makes it's markers' buffers be nil), or that (due to 4577 (which makes its markers' buffers be nil), or that (due to
4572 some bug) it belongs to a different buffer. Only run this 4578 some bug) it belongs to a different buffer. Only run this
4573 hook if the overlay belongs to the current buffer. */ 4579 hook if the overlay belongs to the current buffer. */
4574 if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer) 4580 if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer)
diff --git a/src/buffer.h b/src/buffer.h
index 2080a6f40b7..82d9350bfc2 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -31,12 +31,11 @@ INLINE_HEADER_BEGIN
31 31
32/* Accessing the parameters of the current buffer. */ 32/* Accessing the parameters of the current buffer. */
33 33
34/* These macros come in pairs, one for the char position 34/* These constants and macros come in pairs, one for the char position
35 and one for the byte position. */ 35 and one for the byte position. */
36 36
37/* Position of beginning of buffer. */ 37/* Position of beginning of buffer. */
38#define BEG (1) 38enum { BEG = 1, BEG_BYTE = BEG };
39#define BEG_BYTE (BEG)
40 39
41/* Position of beginning of accessible range of buffer. */ 40/* Position of beginning of accessible range of buffer. */
42#define BEGV (current_buffer->begv) 41#define BEGV (current_buffer->begv)
@@ -96,59 +95,7 @@ INLINE_HEADER_BEGIN
96 95
97/* Modification count as of last visit or save. */ 96/* Modification count as of last visit or save. */
98#define SAVE_MODIFF (current_buffer->text->save_modiff) 97#define SAVE_MODIFF (current_buffer->text->save_modiff)
99
100/* BUFFER_CEILING_OF (resp. BUFFER_FLOOR_OF), when applied to n, return
101 the max (resp. min) p such that
102
103 BYTE_POS_ADDR (p) - BYTE_POS_ADDR (n) == p - n */
104
105#define BUFFER_CEILING_OF(BYTEPOS) \
106 (((BYTEPOS) < GPT_BYTE && GPT < ZV ? GPT_BYTE : ZV_BYTE) - 1)
107#define BUFFER_FLOOR_OF(BYTEPOS) \
108 (BEGV <= GPT && GPT_BYTE <= (BYTEPOS) ? GPT_BYTE : BEGV_BYTE)
109 98
110/* Similar macros to operate on a specified buffer.
111 Note that many of these evaluate the buffer argument more than once. */
112
113/* Position of beginning of buffer. */
114#define BUF_BEG(buf) (BEG)
115#define BUF_BEG_BYTE(buf) (BEG_BYTE)
116
117/* The BUF_BEGV[_BYTE], BUF_ZV[_BYTE], and BUF_PT[_BYTE] macros cannot
118 be used for assignment; use SET_BUF_* macros below for that. */
119
120/* Position of beginning of accessible range of buffer. */
121#define BUF_BEGV(buf) \
122 (buf == current_buffer ? BEGV \
123 : NILP (BVAR (buf, begv_marker)) ? buf->begv \
124 : marker_position (BVAR (buf, begv_marker)))
125
126#define BUF_BEGV_BYTE(buf) \
127 (buf == current_buffer ? BEGV_BYTE \
128 : NILP (BVAR (buf, begv_marker)) ? buf->begv_byte \
129 : marker_byte_position (BVAR (buf, begv_marker)))
130
131/* Position of point in buffer. */
132#define BUF_PT(buf) \
133 (buf == current_buffer ? PT \
134 : NILP (BVAR (buf, pt_marker)) ? buf->pt \
135 : marker_position (BVAR (buf, pt_marker)))
136
137#define BUF_PT_BYTE(buf) \
138 (buf == current_buffer ? PT_BYTE \
139 : NILP (BVAR (buf, pt_marker)) ? buf->pt_byte \
140 : marker_byte_position (BVAR (buf, pt_marker)))
141
142/* Position of end of accessible range of buffer. */
143#define BUF_ZV(buf) \
144 (buf == current_buffer ? ZV \
145 : NILP (BVAR (buf, zv_marker)) ? buf->zv \
146 : marker_position (BVAR (buf, zv_marker)))
147
148#define BUF_ZV_BYTE(buf) \
149 (buf == current_buffer ? ZV_BYTE \
150 : NILP (BVAR (buf, zv_marker)) ? buf->zv_byte \
151 : marker_byte_position (BVAR (buf, zv_marker)))
152 99
153/* Position of gap in buffer. */ 100/* Position of gap in buffer. */
154#define BUF_GPT(buf) ((buf)->text->gpt) 101#define BUF_GPT(buf) ((buf)->text->gpt)
@@ -161,15 +108,6 @@ INLINE_HEADER_BEGIN
161/* Address of beginning of buffer. */ 108/* Address of beginning of buffer. */
162#define BUF_BEG_ADDR(buf) ((buf)->text->beg) 109#define BUF_BEG_ADDR(buf) ((buf)->text->beg)
163 110
164/* Address of beginning of gap of buffer. */
165#define BUF_GPT_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte - BEG_BYTE)
166
167/* Address of end of buffer. */
168#define BUF_Z_ADDR(buf) ((buf)->text->beg + (buf)->text->gap_size + (buf)->text->z_byte - BEG_BYTE)
169
170/* Address of end of gap in buffer. */
171#define BUF_GAP_END_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte + (buf)->text->gap_size - BEG_BYTE)
172
173/* Size of gap. */ 111/* Size of gap. */
174#define BUF_GAP_SIZE(buf) ((buf)->text->gap_size) 112#define BUF_GAP_SIZE(buf) ((buf)->text->gap_size)
175 113
@@ -209,43 +147,8 @@ INLINE_HEADER_BEGIN
209 BUF_OVERLAY_UNCHANGED_MODIFIED (current_buffer) 147 BUF_OVERLAY_UNCHANGED_MODIFIED (current_buffer)
210#define BEG_UNCHANGED BUF_BEG_UNCHANGED (current_buffer) 148#define BEG_UNCHANGED BUF_BEG_UNCHANGED (current_buffer)
211#define END_UNCHANGED BUF_END_UNCHANGED (current_buffer) 149#define END_UNCHANGED BUF_END_UNCHANGED (current_buffer)
212
213/* Compute how many characters at the top and bottom of BUF are
214 unchanged when the range START..END is modified. This computation
215 must be done each time BUF is modified. */
216
217#define BUF_COMPUTE_UNCHANGED(buf, start, end) \
218 do \
219 { \
220 if (BUF_UNCHANGED_MODIFIED (buf) == BUF_MODIFF (buf) \
221 && (BUF_OVERLAY_UNCHANGED_MODIFIED (buf) \
222 == BUF_OVERLAY_MODIFF (buf))) \
223 { \
224 BUF_BEG_UNCHANGED (buf) = (start) - BUF_BEG (buf); \
225 BUF_END_UNCHANGED (buf) = BUF_Z (buf) - (end); \
226 } \
227 else \
228 { \
229 if (BUF_Z (buf) - (end) < BUF_END_UNCHANGED (buf)) \
230 BUF_END_UNCHANGED (buf) = BUF_Z (buf) - (end); \
231 if ((start) - BUF_BEG (buf) < BUF_BEG_UNCHANGED (buf)) \
232 BUF_BEG_UNCHANGED (buf) = (start) - BUF_BEG (buf); \
233 } \
234 } \
235 while (false)
236
237 150
238/* Macros to set PT in the current buffer, or another buffer. */ 151/* Functions to set PT in the current buffer, or another buffer. */
239
240#define SET_PT(position) (set_point (position))
241#define TEMP_SET_PT(position) (temp_set_point (current_buffer, (position)))
242
243#define SET_PT_BOTH(position, byte) (set_point_both (position, byte))
244#define TEMP_SET_PT_BOTH(position, byte) \
245 (temp_set_point_both (current_buffer, (position), (byte)))
246
247#define BUF_TEMP_SET_PT(buffer, position) \
248 (temp_set_point ((buffer), (position)))
249 152
250extern void set_point (ptrdiff_t); 153extern void set_point (ptrdiff_t);
251extern void temp_set_point (struct buffer *, ptrdiff_t); 154extern void temp_set_point (struct buffer *, ptrdiff_t);
@@ -255,39 +158,32 @@ extern void temp_set_point_both (struct buffer *,
255extern void set_point_from_marker (Lisp_Object); 158extern void set_point_from_marker (Lisp_Object);
256extern void enlarge_buffer_text (struct buffer *, ptrdiff_t); 159extern void enlarge_buffer_text (struct buffer *, ptrdiff_t);
257 160
161INLINE void
162SET_PT (ptrdiff_t position)
163{
164 set_point (position);
165}
166INLINE void
167TEMP_SET_PT (ptrdiff_t position)
168{
169 temp_set_point (current_buffer, position);
170}
171INLINE void
172SET_PT_BOTH (ptrdiff_t position, ptrdiff_t byte)
173{
174 set_point_both (position, byte);
175}
176INLINE void
177TEMP_SET_PT_BOTH (ptrdiff_t position, ptrdiff_t byte)
178{
179 temp_set_point_both (current_buffer, position, byte);
180}
181INLINE void
182BUF_TEMP_SET_PT (struct buffer *buffer, ptrdiff_t position)
183{
184 temp_set_point (buffer, position);
185}
258 186
259/* Macros for setting the BEGV, ZV or PT of a given buffer.
260
261 The ..._BOTH macros take both a charpos and a bytepos,
262 which must correspond to each other.
263
264 The macros without ..._BOTH take just a charpos,
265 and compute the bytepos from it. */
266
267#define SET_BUF_BEGV(buf, charpos) \
268 ((buf)->begv_byte = buf_charpos_to_bytepos ((buf), (charpos)), \
269 (buf)->begv = (charpos))
270
271#define SET_BUF_ZV(buf, charpos) \
272 ((buf)->zv_byte = buf_charpos_to_bytepos ((buf), (charpos)), \
273 (buf)->zv = (charpos))
274
275#define SET_BUF_BEGV_BOTH(buf, charpos, byte) \
276 ((buf)->begv = (charpos), \
277 (buf)->begv_byte = (byte))
278
279#define SET_BUF_ZV_BOTH(buf, charpos, byte) \
280 ((buf)->zv = (charpos), \
281 (buf)->zv_byte = (byte))
282
283#define SET_BUF_PT_BOTH(buf, charpos, byte) \
284 ((buf)->pt = (charpos), \
285 (buf)->pt_byte = (byte))
286
287/* Macros to access a character or byte in the current buffer,
288 or convert between a byte position and an address.
289 These macros do not check that the position is in range. */
290
291/* Maximum number of bytes in a buffer. 187/* Maximum number of bytes in a buffer.
292 A buffer cannot contain more bytes than a 1-origin fixnum can represent, 188 A buffer cannot contain more bytes than a 1-origin fixnum can represent,
293 nor can it be so large that C pointer arithmetic stops working. 189 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);
298/* Maximum gap size after compact_buffer, in bytes. Also 194/* Maximum gap size after compact_buffer, in bytes. Also
299 used in make_gap_larger to get some extra reserved space. */ 195 used in make_gap_larger to get some extra reserved space. */
300 196
301#define GAP_BYTES_DFL 2000 197enum { GAP_BYTES_DFL = 2000 };
302 198
303/* Minimum gap size after compact_buffer, in bytes. Also 199/* Minimum gap size after compact_buffer, in bytes. Also
304 used in make_gap_smaller to avoid too small gap size. */ 200 used in make_gap_smaller to avoid too small gap size. */
305 201
306#define GAP_BYTES_MIN 20 202enum { GAP_BYTES_MIN = 20 };
307
308/* Return the address of byte position N in current buffer. */
309
310#define BYTE_POS_ADDR(n) \
311 (((n) >= GPT_BYTE ? GAP_SIZE : 0) + (n) + BEG_ADDR - BEG_BYTE)
312
313/* Return the address of char position N. */
314
315#define CHAR_POS_ADDR(n) \
316 (((n) >= GPT ? GAP_SIZE : 0) \
317 + buf_charpos_to_bytepos (current_buffer, n) \
318 + BEG_ADDR - BEG_BYTE)
319
320/* Convert a character position to a byte position. */
321
322#define CHAR_TO_BYTE(charpos) \
323 (buf_charpos_to_bytepos (current_buffer, charpos))
324
325/* Convert a byte position to a character position. */
326
327#define BYTE_TO_CHAR(bytepos) \
328 (buf_bytepos_to_charpos (current_buffer, bytepos))
329 203
330/* For those very rare cases where you may have a "random" pointer into 204/* For those very rare cases where you may have a "random" pointer into
331 the middle of a multibyte char, this moves to the next boundary. */ 205 the middle of a multibyte char, this moves to the next boundary. */
332extern ptrdiff_t advance_to_char_boundary (ptrdiff_t byte_pos); 206extern ptrdiff_t advance_to_char_boundary (ptrdiff_t byte_pos);
333 207
334/* Convert PTR, the address of a byte in the buffer, into a byte position. */ 208/* Return the byte at byte position N.
335 209 Do not check that the position is in range. */
336#define PTR_BYTE_POS(ptr) \
337 ((ptr) - (current_buffer)->text->beg \
338 - (ptr - (current_buffer)->text->beg <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE) \
339 + BEG_BYTE)
340
341/* Return character at byte position POS. See the caveat WARNING for
342 FETCH_MULTIBYTE_CHAR below. */
343
344#define FETCH_CHAR(pos) \
345 (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \
346 ? FETCH_MULTIBYTE_CHAR ((pos)) \
347 : FETCH_BYTE ((pos)))
348
349/* Return the byte at byte position N. */
350 210
351#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n))) 211#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n)))
352
353/* Return character at byte position POS. If the current buffer is unibyte
354 and the character is not ASCII, make the returning character
355 multibyte. */
356
357#define FETCH_CHAR_AS_MULTIBYTE(pos) \
358 (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \
359 ? FETCH_MULTIBYTE_CHAR ((pos)) \
360 : UNIBYTE_TO_CHAR (FETCH_BYTE ((pos))))
361
362
363/* Macros for accessing a character or byte,
364 or converting between byte positions and addresses,
365 in a specified buffer. */
366
367/* Return the address of character at byte position POS in buffer BUF.
368 Note that both arguments can be computed more than once. */
369
370#define BUF_BYTE_ADDRESS(buf, pos) \
371 ((buf)->text->beg + (pos) - BEG_BYTE \
372 + ((pos) >= (buf)->text->gpt_byte ? (buf)->text->gap_size : 0))
373
374/* Return the address of character at char position POS in buffer BUF.
375 Note that both arguments can be computed more than once. */
376
377#define BUF_CHAR_ADDRESS(buf, pos) \
378 ((buf)->text->beg + buf_charpos_to_bytepos ((buf), (pos)) - BEG_BYTE \
379 + ((pos) >= (buf)->text->gpt ? (buf)->text->gap_size : 0))
380
381/* Convert PTR, the address of a char in buffer BUF,
382 into a character position. */
383
384#define BUF_PTR_BYTE_POS(buf, ptr) \
385 ((ptr) - (buf)->text->beg \
386 - (ptr - (buf)->text->beg <= BUF_GPT_BYTE (buf) - BEG_BYTE \
387 ? 0 : BUF_GAP_SIZE ((buf))) \
388 + BEG_BYTE)
389
390/* Return the character at byte position POS in buffer BUF. */
391
392#define BUF_FETCH_CHAR(buf, pos) \
393 (!NILP (buf->enable_multibyte_characters) \
394 ? BUF_FETCH_MULTIBYTE_CHAR ((buf), (pos)) \
395 : BUF_FETCH_BYTE ((buf), (pos)))
396
397/* Return character at byte position POS in buffer BUF. If BUF is
398 unibyte and the character is not ASCII, make the returning
399 character multibyte. */
400
401#define BUF_FETCH_CHAR_AS_MULTIBYTE(buf, pos) \
402 (! NILP (BVAR ((buf), enable_multibyte_characters)) \
403 ? BUF_FETCH_MULTIBYTE_CHAR ((buf), (pos)) \
404 : UNIBYTE_TO_CHAR (BUF_FETCH_BYTE ((buf), (pos))))
405
406/* Return the byte at byte position N in buffer BUF. */
407
408#define BUF_FETCH_BYTE(buf, n) \
409 *(BUF_BYTE_ADDRESS ((buf), (n)))
410 212
411/* Define the actual buffer data structures. */ 213/* Define the actual buffer data structures. */
412 214
@@ -482,6 +284,13 @@ struct buffer_text
482 284
483#define BVAR(buf, field) ((buf)->field ## _) 285#define BVAR(buf, field) ((buf)->field ## _)
484 286
287/* Max number of builtin per-buffer variables. */
288enum { MAX_PER_BUFFER_VARS = 50 };
289
290/* Special values for struct buffer.modtime. */
291enum { NONEXISTENT_MODTIME_NSECS = -1 };
292enum { UNKNOWN_MODTIME_NSECS = -2 };
293
485/* This is the structure that the buffer Lisp object points to. */ 294/* This is the structure that the buffer Lisp object points to. */
486 295
487struct buffer 296struct buffer
@@ -796,7 +605,6 @@ struct buffer
796 for a buffer-local variable is stored in that variable's slot 605 for a buffer-local variable is stored in that variable's slot
797 in buffer_local_flags as a Lisp integer. If the index is -1, 606 in buffer_local_flags as a Lisp integer. If the index is -1,
798 this means the variable is always local in all buffers. */ 607 this means the variable is always local in all buffers. */
799#define MAX_PER_BUFFER_VARS 50
800 char local_flags[MAX_PER_BUFFER_VARS]; 608 char local_flags[MAX_PER_BUFFER_VARS];
801 609
802 /* Set to the modtime of the visited file when read or written. 610 /* Set to the modtime of the visited file when read or written.
@@ -804,8 +612,6 @@ struct buffer
804 visited file was nonexistent. modtime.tv_nsec == 612 visited file was nonexistent. modtime.tv_nsec ==
805 UNKNOWN_MODTIME_NSECS means visited file modtime unknown; 613 UNKNOWN_MODTIME_NSECS means visited file modtime unknown;
806 in no case complain about any mismatch on next save attempt. */ 614 in no case complain about any mismatch on next save attempt. */
807#define NONEXISTENT_MODTIME_NSECS (-1)
808#define UNKNOWN_MODTIME_NSECS (-2)
809 struct timespec modtime; 615 struct timespec modtime;
810 616
811 /* Size of the file when modtime was set. This is used to detect the 617 /* 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)
1018 b->width_table_ = val; 824 b->width_table_ = val;
1019} 825}
1020 826
827/* BUFFER_CEILING_OF (resp. BUFFER_FLOOR_OF), when applied to n, return
828 the max (resp. min) p such that
829
830 BYTE_POS_ADDR (p) - BYTE_POS_ADDR (n) == p - n */
831
832INLINE ptrdiff_t
833BUFFER_CEILING_OF (ptrdiff_t bytepos)
834{
835 return (bytepos < GPT_BYTE && GPT < ZV ? GPT_BYTE : ZV_BYTE) - 1;
836}
837
838INLINE ptrdiff_t
839BUFFER_FLOOR_OF (ptrdiff_t bytepos)
840{
841 return BEGV <= GPT && GPT_BYTE <= bytepos ? GPT_BYTE : BEGV_BYTE;
842}
843
844/* The BUF_BEGV[_BYTE], BUF_ZV[_BYTE], and BUF_PT[_BYTE] functions cannot
845 be used for assignment; use SET_BUF_* functions below for that. */
846
847/* Position of beginning of accessible range of buffer. */
848INLINE ptrdiff_t
849BUF_BEGV (struct buffer *buf)
850{
851 return (buf == current_buffer ? BEGV
852 : NILP (BVAR (buf, begv_marker)) ? buf->begv
853 : marker_position (BVAR (buf, begv_marker)));
854}
855
856INLINE ptrdiff_t
857BUF_BEGV_BYTE (struct buffer *buf)
858{
859 return (buf == current_buffer ? BEGV_BYTE
860 : NILP (BVAR (buf, begv_marker)) ? buf->begv_byte
861 : marker_byte_position (BVAR (buf, begv_marker)));
862}
863
864/* Position of point in buffer. */
865INLINE ptrdiff_t
866BUF_PT (struct buffer *buf)
867{
868 return (buf == current_buffer ? PT
869 : NILP (BVAR (buf, pt_marker)) ? buf->pt
870 : marker_position (BVAR (buf, pt_marker)));
871}
872
873INLINE ptrdiff_t
874BUF_PT_BYTE (struct buffer *buf)
875{
876 return (buf == current_buffer ? PT_BYTE
877 : NILP (BVAR (buf, pt_marker)) ? buf->pt_byte
878 : marker_byte_position (BVAR (buf, pt_marker)));
879}
880
881/* Position of end of accessible range of buffer. */
882INLINE ptrdiff_t
883BUF_ZV (struct buffer *buf)
884{
885 return (buf == current_buffer ? ZV
886 : NILP (BVAR (buf, zv_marker)) ? buf->zv
887 : marker_position (BVAR (buf, zv_marker)));
888}
889
890INLINE ptrdiff_t
891BUF_ZV_BYTE (struct buffer *buf)
892{
893 return (buf == current_buffer ? ZV_BYTE
894 : NILP (BVAR (buf, zv_marker)) ? buf->zv_byte
895 : marker_byte_position (BVAR (buf, zv_marker)));
896}
897
898/* Similar functions to operate on a specified buffer. */
899
900/* Position of beginning of buffer. */
901INLINE ptrdiff_t
902BUF_BEG (struct buffer *buf)
903{
904 return BEG;
905}
906
907INLINE ptrdiff_t
908BUF_BEG_BYTE (struct buffer *buf)
909{
910 return BEG_BYTE;
911}
912
913/* Address of beginning of gap of buffer. */
914INLINE unsigned char *
915BUF_GPT_ADDR (struct buffer *buf)
916{
917 return buf->text->beg + buf->text->gpt_byte - BEG_BYTE;
918}
919
920/* Address of end of buffer. */
921INLINE unsigned char *
922BUF_Z_ADDR (struct buffer *buf)
923{
924 return buf->text->beg + buf->text->gap_size + buf->text->z_byte - BEG_BYTE;
925}
926
927/* Address of end of gap in buffer. */
928INLINE unsigned char *
929BUF_GAP_END_ADDR (struct buffer *buf)
930{
931 return buf->text->beg + buf->text->gpt_byte + buf->text->gap_size - BEG_BYTE;
932}
933
934/* Compute how many characters at the top and bottom of BUF are
935 unchanged when the range START..END is modified. This computation
936 must be done each time BUF is modified. */
937
938INLINE void
939BUF_COMPUTE_UNCHANGED (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
940{
941 if (BUF_UNCHANGED_MODIFIED (buf) == BUF_MODIFF (buf)
942 && (BUF_OVERLAY_UNCHANGED_MODIFIED (buf)
943 == BUF_OVERLAY_MODIFF (buf)))
944 {
945 buf->text->beg_unchanged = start - BUF_BEG (buf);
946 buf->text->end_unchanged = BUF_Z (buf) - (end);
947 }
948 else
949 {
950 if (BUF_Z (buf) - end < BUF_END_UNCHANGED (buf))
951 buf->text->end_unchanged = BUF_Z (buf) - end;
952 if (start - BUF_BEG (buf) < BUF_BEG_UNCHANGED (buf))
953 buf->text->beg_unchanged = start - BUF_BEG (buf);
954 }
955}
956
957/* Functions for setting the BEGV, ZV or PT of a given buffer.
958
959 The ..._BOTH functions take both a charpos and a bytepos,
960 which must correspond to each other.
961
962 The functions without ..._BOTH take just a charpos,
963 and compute the bytepos from it. */
964
965INLINE void
966SET_BUF_BEGV (struct buffer *buf, ptrdiff_t charpos)
967{
968 buf->begv_byte = buf_charpos_to_bytepos (buf, charpos);
969 buf->begv = charpos;
970}
971
972INLINE void
973SET_BUF_ZV (struct buffer *buf, ptrdiff_t charpos)
974{
975 buf->zv_byte = buf_charpos_to_bytepos (buf, charpos);
976 buf->zv = charpos;
977}
978
979INLINE void
980SET_BUF_BEGV_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
981{
982 buf->begv = charpos;
983 buf->begv_byte = byte;
984}
985
986INLINE void
987SET_BUF_ZV_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
988{
989 buf->zv = charpos;
990 buf->zv_byte = byte;
991}
992
993INLINE void
994SET_BUF_PT_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
995{
996 buf->pt = charpos;
997 buf->pt_byte = byte;
998}
999
1000/* Functions to access a character or byte in the current buffer,
1001 or convert between a byte position and an address.
1002 These functions do not check that the position is in range. */
1003
1004/* Return the address of byte position N in current buffer. */
1005
1006INLINE unsigned char *
1007BYTE_POS_ADDR (ptrdiff_t n)
1008{
1009 return (n < GPT_BYTE ? 0 : GAP_SIZE) + n + BEG_ADDR - BEG_BYTE;
1010}
1011
1012/* Return the address of char position N. */
1013
1014INLINE unsigned char *
1015CHAR_POS_ADDR (ptrdiff_t n)
1016{
1017 return ((n < GPT ? 0 : GAP_SIZE)
1018 + buf_charpos_to_bytepos (current_buffer, n)
1019 + BEG_ADDR - BEG_BYTE);
1020}
1021
1022/* Convert a character position to a byte position. */
1023
1024INLINE ptrdiff_t
1025CHAR_TO_BYTE (ptrdiff_t charpos)
1026{
1027 return buf_charpos_to_bytepos (current_buffer, charpos);
1028}
1029
1030/* Convert a byte position to a character position. */
1031
1032INLINE ptrdiff_t
1033BYTE_TO_CHAR (ptrdiff_t bytepos)
1034{
1035 return buf_bytepos_to_charpos (current_buffer, bytepos);
1036}
1037
1038/* Convert PTR, the address of a byte in the buffer, into a byte position. */
1039
1040INLINE ptrdiff_t
1041PTR_BYTE_POS (unsigned char const *ptr)
1042{
1043 ptrdiff_t byte = ptr - current_buffer->text->beg;
1044 return byte - (byte <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE) + BEG_BYTE;
1045}
1046
1021/* Number of Lisp_Objects at the beginning of struct buffer. 1047/* Number of Lisp_Objects at the beginning of struct buffer.
1022 If you add, remove, or reorder Lisp_Objects within buffer 1048 If you add, remove, or reorder Lisp_Objects within buffer
1023 structure, make sure that this is still correct. */ 1049 structure, make sure that this is still correct. */
1024 1050
1025#define BUFFER_LISP_SIZE \ 1051enum { BUFFER_LISP_SIZE = PSEUDOVECSIZE (struct buffer,
1026 PSEUDOVECSIZE (struct buffer, cursor_in_non_selected_windows_) 1052 cursor_in_non_selected_windows_) };
1027 1053
1028/* Allocated size of the struct buffer part beyond leading 1054/* Allocated size of the struct buffer part beyond leading
1029 Lisp_Objects, in word_size units. */ 1055 Lisp_Objects, in word_size units. */
1030 1056
1031#define BUFFER_REST_SIZE (VECSIZE (struct buffer) - BUFFER_LISP_SIZE) 1057enum { BUFFER_REST_SIZE = VECSIZE (struct buffer) - BUFFER_LISP_SIZE };
1032 1058
1033/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE 1059/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE
1034 is required for GC, but BUFFER_REST_SIZE is set up just to be consistent 1060 is required for GC, but BUFFER_REST_SIZE is set up just to be consistent
1035 with other pseudovectors. */ 1061 with other pseudovectors. */
1036 1062
1037#define BUFFER_PVEC_INIT(b) \ 1063INLINE void
1038 XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE) 1064BUFFER_PVEC_INIT (struct buffer *b)
1065{
1066 XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE);
1067}
1039 1068
1040/* Convenient check whether buffer B is live. */ 1069/* Convenient check whether buffer B is live. */
1041 1070
1042#define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name))) 1071INLINE bool
1072BUFFER_LIVE_P (struct buffer *b)
1073{
1074 return !NILP (BVAR (b, name));
1075}
1043 1076
1044/* Convenient check whether buffer B is hidden (i.e. its name 1077/* Convenient check whether buffer B is hidden (i.e. its name
1045 starts with a space). Caller must ensure that B is live. */ 1078 starts with a space). Caller must ensure that B is live. */
1046 1079
1047#define BUFFER_HIDDEN_P(b) (SREF (BVAR (b, name), 0) == ' ') 1080INLINE bool
1081BUFFER_HIDDEN_P (struct buffer *b)
1082{
1083 return SREF (BVAR (b, name), 0) == ' ';
1084}
1048 1085
1049/* Verify indirection counters. */ 1086/* Verify indirection counters. */
1050 1087
1051#define BUFFER_CHECK_INDIRECTION(b) \ 1088INLINE void
1052 do { \ 1089BUFFER_CHECK_INDIRECTION (struct buffer *b)
1053 if (BUFFER_LIVE_P (b)) \ 1090{
1054 { \ 1091 if (BUFFER_LIVE_P (b))
1055 if (b->base_buffer) \ 1092 {
1056 { \ 1093 if (b->base_buffer)
1057 eassert (b->indirections == -1); \ 1094 {
1058 eassert (b->base_buffer->indirections > 0); \ 1095 eassert (b->indirections == -1);
1059 } \ 1096 eassert (b->base_buffer->indirections > 0);
1060 else \ 1097 }
1061 eassert (b->indirections >= 0); \ 1098 else
1062 } \ 1099 eassert (b->indirections >= 0);
1063 } while (false) 1100 }
1101}
1064 1102
1065/* Chain of all buffers, including killed ones. */ 1103/* Chain of all buffers, including killed ones. */
1066 1104
@@ -1157,7 +1195,9 @@ record_unwind_current_buffer (void)
1157 1195
1158/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements. 1196/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements.
1159 If NEXTP is non-NULL, return next overlay there. 1197 If NEXTP is non-NULL, return next overlay there.
1160 See overlay_at arg CHANGE_REQ for meaning of CHRQ arg. */ 1198 See overlay_at arg CHANGE_REQ for meaning of CHRQ arg.
1199 This macro might evaluate its args multiple times,
1200 and it treat some args as lvalues. */
1161 1201
1162#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \ 1202#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \
1163 do { \ 1203 do { \
@@ -1207,6 +1247,10 @@ buffer_has_overlays (void)
1207{ 1247{
1208 return current_buffer->overlays_before || current_buffer->overlays_after; 1248 return current_buffer->overlays_before || current_buffer->overlays_after;
1209} 1249}
1250
1251/* Functions for accessing a character or byte,
1252 or converting between byte positions and addresses,
1253 in a specified buffer. */
1210 1254
1211/* Return character code of multi-byte form at byte position POS. If POS 1255/* Return character code of multi-byte form at byte position POS. If POS
1212 doesn't point the head of valid multi-byte form, only the byte at 1256 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)
1232 return STRING_CHAR (p); 1276 return STRING_CHAR (p);
1233} 1277}
1234 1278
1279/* Return character at byte position POS.
1280 If the current buffer is unibyte and the character is not ASCII,
1281 make the returning character multibyte. */
1282
1283INLINE int
1284FETCH_CHAR_AS_MULTIBYTE (ptrdiff_t pos)
1285{
1286 return (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1287 ? FETCH_MULTIBYTE_CHAR (pos)
1288 : UNIBYTE_TO_CHAR (FETCH_BYTE (pos)));
1289}
1290
1291/* Return character at byte position POS.
1292 See the caveat WARNING for FETCH_MULTIBYTE_CHAR above. */
1293
1294INLINE int
1295FETCH_CHAR (ptrdiff_t pos)
1296{
1297 return (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1298 ? FETCH_MULTIBYTE_CHAR (pos)
1299 : FETCH_BYTE (pos));
1300}
1301
1302/* Return the address of character at byte position POS in buffer BUF.
1303 Note that both arguments can be computed more than once. */
1304
1305INLINE unsigned char *
1306BUF_BYTE_ADDRESS (struct buffer *buf, ptrdiff_t pos)
1307{
1308 return (buf->text->beg + pos - BEG_BYTE
1309 + (pos < buf->text->gpt_byte ? 0 : buf->text->gap_size));
1310}
1311
1312/* Return the address of character at char position POS in buffer BUF.
1313 Note that both arguments can be computed more than once. */
1314
1315INLINE unsigned char *
1316BUF_CHAR_ADDRESS (struct buffer *buf, ptrdiff_t pos)
1317{
1318 return (buf->text->beg + buf_charpos_to_bytepos (buf, pos) - BEG_BYTE
1319 + (pos < buf->text->gpt ? 0 : buf->text->gap_size));
1320}
1321
1322/* Convert PTR, the address of a char in buffer BUF,
1323 into a character position. */
1324
1325INLINE ptrdiff_t
1326BUF_PTR_BYTE_POS (struct buffer *buf, unsigned char *ptr)
1327{
1328 ptrdiff_t byte = ptr - buf->text->beg;
1329 return (byte - (byte <= BUF_GPT_BYTE (buf) - BEG_BYTE ? 0 : BUF_GAP_SIZE (buf))
1330 + BEG_BYTE);
1331}
1332
1333/* Return the byte at byte position N in buffer BUF. */
1334
1335INLINE unsigned char
1336BUF_FETCH_BYTE (struct buffer *buf, ptrdiff_t n)
1337{
1338 return *BUF_BYTE_ADDRESS (buf, n);
1339}
1340
1341/* Return character at byte position POS in buffer BUF. If BUF is
1342 unibyte and the character is not ASCII, make the returning
1343 character multibyte. */
1344
1345INLINE int
1346BUF_FETCH_CHAR_AS_MULTIBYTE (struct buffer *buf, ptrdiff_t pos)
1347{
1348 return (! NILP (BVAR (buf, enable_multibyte_characters))
1349 ? BUF_FETCH_MULTIBYTE_CHAR (buf, pos)
1350 : UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (buf, pos)));
1351}
1352
1235/* Return number of windows showing B. */ 1353/* Return number of windows showing B. */
1236 1354
1237INLINE int 1355INLINE int
@@ -1260,18 +1378,17 @@ buffer_window_count (struct buffer *b)
1260/* Return the actual buffer position for the marker P. 1378/* Return the actual buffer position for the marker P.
1261 We assume you know which buffer it's pointing into. */ 1379 We assume you know which buffer it's pointing into. */
1262 1380
1263#define OVERLAY_POSITION(P) \ 1381INLINE ptrdiff_t
1264 (MARKERP (P) ? marker_position (P) : (emacs_abort (), 0)) 1382OVERLAY_POSITION (Lisp_Object p)
1383{
1384 return marker_position (p);
1385}
1265 1386
1266 1387
1267/*********************************************************************** 1388/***********************************************************************
1268 Buffer-local Variables 1389 Buffer-local Variables
1269 ***********************************************************************/ 1390 ***********************************************************************/
1270 1391
1271/* Number of per-buffer variables used. */
1272
1273extern int last_per_buffer_idx;
1274
1275/* Return the offset in bytes of member VAR of struct buffer 1392/* Return the offset in bytes of member VAR of struct buffer
1276 from the start of a buffer structure. */ 1393 from the start of a buffer structure. */
1277 1394
@@ -1296,23 +1413,27 @@ extern int last_per_buffer_idx;
1296#define PER_BUFFER_VAR_IDX(VAR) \ 1413#define PER_BUFFER_VAR_IDX(VAR) \
1297 PER_BUFFER_IDX (PER_BUFFER_VAR_OFFSET (VAR)) 1414 PER_BUFFER_IDX (PER_BUFFER_VAR_OFFSET (VAR))
1298 1415
1416extern bool valid_per_buffer_idx (int);
1417
1299/* Value is true if the variable with index IDX has a local value 1418/* Value is true if the variable with index IDX has a local value
1300 in buffer B. */ 1419 in buffer B. */
1301 1420
1302#define PER_BUFFER_VALUE_P(B, IDX) \ 1421INLINE bool
1303 (((IDX) < 0 || IDX >= last_per_buffer_idx) \ 1422PER_BUFFER_VALUE_P (struct buffer *b, int idx)
1304 ? (emacs_abort (), false) \ 1423{
1305 : ((B)->local_flags[IDX] != 0)) 1424 eassert (valid_per_buffer_idx (idx));
1425 return b->local_flags[idx];
1426}
1306 1427
1307/* Set whether per-buffer variable with index IDX has a buffer-local 1428/* Set whether per-buffer variable with index IDX has a buffer-local
1308 value in buffer B. VAL zero means it hasn't. */ 1429 value in buffer B. VAL zero means it hasn't. */
1309 1430
1310#define SET_PER_BUFFER_VALUE_P(B, IDX, VAL) \ 1431INLINE void
1311 do { \ 1432SET_PER_BUFFER_VALUE_P (struct buffer *b, int idx, bool val)
1312 if ((IDX) < 0 || (IDX) >= last_per_buffer_idx) \ 1433{
1313 emacs_abort (); \ 1434 eassert (valid_per_buffer_idx (idx));
1314 (B)->local_flags[IDX] = (VAL); \ 1435 b->local_flags[idx] = val;
1315 } while (false) 1436}
1316 1437
1317/* Return the index value of the per-buffer variable at offset OFFSET 1438/* Return the index value of the per-buffer variable at offset OFFSET
1318 in the buffer structure. 1439 in the buffer structure.
@@ -1332,11 +1453,13 @@ extern int last_per_buffer_idx;
1332 new buffer. 1453 new buffer.
1333 1454
1334 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is 1455 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
1335 zero, that is a bug */ 1456 zero, that is a bug. */
1336 1457
1337 1458INLINE int
1338#define PER_BUFFER_IDX(OFFSET) \ 1459PER_BUFFER_IDX (ptrdiff_t offset)
1339 XFIXNUM (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags)) 1460{
1461 return XFIXNUM (*(Lisp_Object *) (offset + (char *) &buffer_local_flags));
1462}
1340 1463
1341/* Functions to get and set default value of the per-buffer 1464/* Functions to get and set default value of the per-buffer
1342 variable at offset OFFSET in the buffer structure. */ 1465 variable at offset OFFSET in the buffer structure. */
diff --git a/src/coding.c b/src/coding.c
index 2ddd34eb7b6..c0408fbce48 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9842,7 +9842,10 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer,
9842 If BUFFER is Qnil, return a multibyte string from the decoded result. 9842 If BUFFER is Qnil, return a multibyte string from the decoded result.
9843 As a special case, return STRING itself in the following cases: 9843 As a special case, return STRING itself in the following cases:
9844 1. STRING contains only ASCII characters. 9844 1. STRING contains only ASCII characters.
9845 2. NOCOPY, and STRING contains only valid UTF-8 sequences. 9845 2. NOCOPY is true, and STRING contains only valid UTF-8 sequences.
9846
9847 For maximum speed, always specify NOCOPY true when STRING is
9848 guaranteed to contain only valid UTF-8 sequences.
9846 9849
9847 HANDLE-8-BIT and HANDLE-OVER-UNI specify how to handle a invalid 9850 HANDLE-8-BIT and HANDLE-OVER-UNI specify how to handle a invalid
9848 byte sequence. The former is for an 1-byte invalid sequence that 9851 byte sequence. The former is for an 1-byte invalid sequence that
diff --git a/src/composite.c b/src/composite.c
index a6606d5fc45..efbd055cef2 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -919,16 +919,17 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
919} 919}
920 920
921/* 1 iff the character C is composable. Characters of general 921/* 1 iff the character C is composable. Characters of general
922 category Z? or C? are not composable except for ZWNJ and ZWJ. */ 922 category Z? or C? are not composable except for ZWNJ and ZWJ,
923 and characters of category Zs. */
923 924
924static bool 925static bool
925char_composable_p (int c) 926char_composable_p (int c)
926{ 927{
927 Lisp_Object val; 928 Lisp_Object val;
928 return (c > ' ' 929 return (c >= ' '
929 && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER 930 && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER
930 || (val = CHAR_TABLE_REF (Vunicode_category_table, c), 931 || (val = CHAR_TABLE_REF (Vunicode_category_table, c),
931 (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_So))))); 932 (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs)))));
932} 933}
933 934
934/* Update cmp_it->stop_pos to the next position after CHARPOS (and 935/* 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 4af1ba9331f..43f98620a4b 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -373,8 +373,13 @@ extern int emacs_setenv_TZ (char const *);
373#undef noinline 373#undef noinline
374#endif 374#endif
375 375
376/* Use Gnulib's extern-inline module for extern inline functions. 376/* INLINE marks functions defined in Emacs-internal C headers.
377 An include file foo.h should prepend FOO_INLINE to function 377 INLINE is implemented via C99-style 'extern inline' if Emacs is built
378 with -DEMACS_EXTERN_INLINE; otherwise it is implemented via 'static'.
379 EMACS_EXTERN_INLINE is no longer the default, as 'static' seems to
380 have better performance with GCC.
381
382 An include file foo.h should prepend INLINE to function
378 definitions, with the following overall pattern: 383 definitions, with the following overall pattern:
379 384
380 [#include any other .h files first.] 385 [#include any other .h files first.]
@@ -399,20 +404,40 @@ extern int emacs_setenv_TZ (char const *);
399 For Emacs, this is done by having emacs.c first '#define INLINE 404 For Emacs, this is done by having emacs.c first '#define INLINE
400 EXTERN_INLINE' and then include every .h file that uses INLINE. 405 EXTERN_INLINE' and then include every .h file that uses INLINE.
401 406
402 The INLINE_HEADER_BEGIN and INLINE_HEADER_END suppress bogus 407 The INLINE_HEADER_BEGIN and INLINE_HEADER_END macros suppress bogus
403 warnings in some GCC versions; see ../m4/extern-inline.m4. 408 warnings in some GCC versions; see ../m4/extern-inline.m4. */
409
410#ifdef EMACS_EXTERN_INLINE
411
412/* Use Gnulib's extern-inline module for extern inline functions.
404 413
405 C99 compilers compile functions like 'incr' as C99-style extern 414 C99 compilers compile functions like 'incr' as C99-style extern
406 inline functions. Buggy GCC implementations do something similar with 415 inline functions. Buggy GCC implementations do something similar with
407 GNU-specific keywords. Buggy non-GCC compilers use static 416 GNU-specific keywords. Buggy non-GCC compilers use static
408 functions, which bloats the code but is good enough. */ 417 functions, which bloats the code but is good enough. */
409 418
410#ifndef INLINE 419# ifndef INLINE
411# define INLINE _GL_INLINE 420# define INLINE _GL_INLINE
421# endif
422# define EXTERN_INLINE _GL_EXTERN_INLINE
423# define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
424# define INLINE_HEADER_END _GL_INLINE_HEADER_END
425
426#else
427
428/* Use 'static' instead of 'extern inline' because 'static' typically
429 has better performance for Emacs. Do not use the 'inline' keyword,
430 as modern compilers inline automatically. ATTRIBUTE_UNUSED
431 pacifies gcc -Wunused-function. */
432
433# ifndef INLINE
434# define INLINE EXTERN_INLINE
435# endif
436# define EXTERN_INLINE static ATTRIBUTE_UNUSED
437# define INLINE_HEADER_BEGIN
438# define INLINE_HEADER_END
439
412#endif 440#endif
413#define EXTERN_INLINE _GL_EXTERN_INLINE
414#define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
415#define INLINE_HEADER_END _GL_INLINE_HEADER_END
416 441
417/* 'int x UNINIT;' is equivalent to 'int x;', except it cajoles GCC 442/* 'int x UNINIT;' is equivalent to 'int x;', except it cajoles GCC
418 into not warning incorrectly about use of an uninitialized variable. */ 443 into not warning incorrectly about use of an uninitialized variable. */
diff --git a/src/data.c b/src/data.c
index cf9f8e56133..1d9222e75a7 100644
--- a/src/data.c
+++ b/src/data.c
@@ -525,7 +525,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
525 (Lisp_Object object) 525 (Lisp_Object object)
526{ 526{
527 return ((FIXNUMP (object) ? 0 <= XFIXNUM (object) 527 return ((FIXNUMP (object) ? 0 <= XFIXNUM (object)
528 : BIGNUMP (object) && 0 <= mpz_sgn (XBIGNUM (object)->value)) 528 : BIGNUMP (object) && 0 <= mpz_sgn (*xbignum_val (object)))
529 ? Qt : Qnil); 529 ? Qt : Qnil);
530} 530}
531 531
@@ -771,10 +771,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
771 if (AUTOLOADP (function)) 771 if (AUTOLOADP (function))
772 Fput (symbol, Qautoload, XCDR (function)); 772 Fput (symbol, Qautoload, XCDR (function));
773 773
774 /* Convert to eassert or remove after GC bug is found. In the 774 eassert (valid_lisp_object_p (definition));
775 meantime, check unconditionally, at a slight perf hit. */
776 if (! valid_lisp_object_p (definition))
777 emacs_abort ();
778 775
779 set_symbol_function (symbol, definition); 776 set_symbol_function (symbol, definition);
780 777
@@ -2481,7 +2478,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2481 else if (isnan (f1)) 2478 else if (isnan (f1))
2482 lt = eq = gt = false; 2479 lt = eq = gt = false;
2483 else 2480 else
2484 i2 = mpz_cmp_d (XBIGNUM (num2)->value, f1); 2481 i2 = mpz_cmp_d (*xbignum_val (num2), f1);
2485 } 2482 }
2486 else if (FIXNUMP (num1)) 2483 else if (FIXNUMP (num1))
2487 { 2484 {
@@ -2502,7 +2499,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2502 i2 = XFIXNUM (num2); 2499 i2 = XFIXNUM (num2);
2503 } 2500 }
2504 else 2501 else
2505 i2 = mpz_sgn (XBIGNUM (num2)->value); 2502 i2 = mpz_sgn (*xbignum_val (num2));
2506 } 2503 }
2507 else if (FLOATP (num2)) 2504 else if (FLOATP (num2))
2508 { 2505 {
@@ -2510,12 +2507,12 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2510 if (isnan (f2)) 2507 if (isnan (f2))
2511 lt = eq = gt = false; 2508 lt = eq = gt = false;
2512 else 2509 else
2513 i1 = mpz_cmp_d (XBIGNUM (num1)->value, f2); 2510 i1 = mpz_cmp_d (*xbignum_val (num1), f2);
2514 } 2511 }
2515 else if (FIXNUMP (num2)) 2512 else if (FIXNUMP (num2))
2516 i1 = mpz_sgn (XBIGNUM (num1)->value); 2513 i1 = mpz_sgn (*xbignum_val (num1));
2517 else 2514 else
2518 i1 = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value); 2515 i1 = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2));
2519 2516
2520 if (eq) 2517 if (eq)
2521 { 2518 {
@@ -3005,7 +3002,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
3005 return make_int (-XFIXNUM (a)); 3002 return make_int (-XFIXNUM (a));
3006 if (FLOATP (a)) 3003 if (FLOATP (a))
3007 return make_float (-XFLOAT_DATA (a)); 3004 return make_float (-XFLOAT_DATA (a));
3008 mpz_neg (mpz[0], XBIGNUM (a)->value); 3005 mpz_neg (mpz[0], *xbignum_val (a));
3009 return make_integer_mpz (); 3006 return make_integer_mpz ();
3010 } 3007 }
3011 return arith_driver (Asub, nargs, args, a); 3008 return arith_driver (Asub, nargs, args, a);
@@ -3058,58 +3055,67 @@ usage: (/ NUMBER &rest DIVISORS) */)
3058 return arith_driver (Adiv, nargs, args, a); 3055 return arith_driver (Adiv, nargs, args, a);
3059} 3056}
3060 3057
3061DEFUN ("%", Frem, Srem, 2, 2, 0, 3058/* Return NUM % DEN (or NUM mod DEN, if MODULO). NUM and DEN must be
3062 doc: /* Return remainder of X divided by Y. 3059 integers. */
3063Both must be integers or markers. */) 3060static Lisp_Object
3064 (register Lisp_Object x, Lisp_Object y) 3061integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
3065{
3066 CHECK_INTEGER_COERCE_MARKER (x);
3067 CHECK_INTEGER_COERCE_MARKER (y);
3068
3069 /* A bignum can never be 0, so don't check that case. */
3070 if (EQ (y, make_fixnum (0)))
3071 xsignal0 (Qarith_error);
3072
3073 if (FIXNUMP (x) && FIXNUMP (y))
3074 return make_fixnum (XFIXNUM (x) % XFIXNUM (y));
3075 else
3076 {
3077 mpz_tdiv_r (mpz[0],
3078 *bignum_integer (&mpz[0], x),
3079 *bignum_integer (&mpz[1], y));
3080 return make_integer_mpz ();
3081 }
3082}
3083
3084/* Return X mod Y. Both must be integers and Y must be nonzero. */
3085Lisp_Object
3086integer_mod (Lisp_Object x, Lisp_Object y)
3087{ 3062{
3088 if (FIXNUMP (x) && FIXNUMP (y)) 3063 if (FIXNUMP (den))
3089 { 3064 {
3090 EMACS_INT i1 = XFIXNUM (x), i2 = XFIXNUM (y); 3065 EMACS_INT d = XFIXNUM (den);
3066 if (d == 0)
3067 xsignal0 (Qarith_error);
3091 3068
3092 i1 %= i2; 3069 EMACS_INT r;
3070 bool have_r = false;
3071 if (FIXNUMP (num))
3072 {
3073 r = XFIXNUM (num) % d;
3074 have_r = true;
3075 }
3076 else if (eabs (d) <= ULONG_MAX)
3077 {
3078 mpz_t const *n = xbignum_val (num);
3079 bool neg_n = mpz_sgn (*n) < 0;
3080 r = mpz_tdiv_ui (*n, eabs (d));
3081 if (neg_n)
3082 r = -r;
3083 have_r = true;
3084 }
3093 3085
3094 /* If the "remainder" comes out with the wrong sign, fix it. */ 3086 if (have_r)
3095 if (i2 < 0 ? i1 > 0 : i1 < 0) 3087 {
3096 i1 += i2; 3088 /* If MODULO and the remainder has the wrong sign, fix it. */
3089 if (modulo && (d < 0 ? r > 0 : r < 0))
3090 r += d;
3097 3091
3098 return make_fixnum (i1); 3092 return make_fixnum (r);
3093 }
3099 } 3094 }
3100 else
3101 {
3102 mpz_t const *ym = bignum_integer (&mpz[1], y);
3103 bool neg_y = mpz_sgn (*ym) < 0;
3104 mpz_mod (mpz[0], *bignum_integer (&mpz[0], x), *ym);
3105 3095
3106 /* Fix the sign if needed. */ 3096 mpz_t const *d = bignum_integer (&mpz[1], den);
3107 int sgn_r = mpz_sgn (mpz[0]); 3097 mpz_t *r = &mpz[0];
3108 if (neg_y ? sgn_r > 0 : sgn_r < 0) 3098 mpz_tdiv_r (*r, *bignum_integer (&mpz[0], num), *d);
3109 mpz_add (mpz[0], mpz[0], *ym);
3110 3099
3111 return make_integer_mpz (); 3100 if (modulo)
3101 {
3102 /* If the remainder has the wrong sign, fix it. */
3103 int sgn_r = mpz_sgn (*r);
3104 if (mpz_sgn (*d) < 0 ? sgn_r > 0 : sgn_r < 0)
3105 mpz_add (*r, *r, *d);
3112 } 3106 }
3107
3108 return make_integer_mpz ();
3109}
3110
3111DEFUN ("%", Frem, Srem, 2, 2, 0,
3112 doc: /* Return remainder of X divided by Y.
3113Both must be integers or markers. */)
3114 (register Lisp_Object x, Lisp_Object y)
3115{
3116 CHECK_INTEGER_COERCE_MARKER (x);
3117 CHECK_INTEGER_COERCE_MARKER (y);
3118 return integer_remainder (x, y, false);
3113} 3119}
3114 3120
3115DEFUN ("mod", Fmod, Smod, 2, 2, 0, 3121DEFUN ("mod", Fmod, Smod, 2, 2, 0,
@@ -3120,12 +3126,9 @@ Both X and Y must be numbers or markers. */)
3120{ 3126{
3121 CHECK_NUMBER_COERCE_MARKER (x); 3127 CHECK_NUMBER_COERCE_MARKER (x);
3122 CHECK_NUMBER_COERCE_MARKER (y); 3128 CHECK_NUMBER_COERCE_MARKER (y);
3123 3129 if (FLOATP (x) || FLOATP (y))
3124 /* A bignum can never be 0, so don't check that case. */ 3130 return fmod_float (x, y);
3125 if (EQ (y, make_fixnum (0))) 3131 return integer_remainder (x, y, true);
3126 xsignal0 (Qarith_error);
3127
3128 return (FLOATP (x) || FLOATP (y) ? fmod_float : integer_mod) (x, y);
3129} 3132}
3130 3133
3131static Lisp_Object 3134static Lisp_Object
@@ -3214,7 +3217,7 @@ representation. */)
3214 3217
3215 if (BIGNUMP (value)) 3218 if (BIGNUMP (value))
3216 { 3219 {
3217 mpz_t *nonneg = &XBIGNUM (value)->value; 3220 mpz_t const *nonneg = xbignum_val (value);
3218 if (mpz_sgn (*nonneg) < 0) 3221 if (mpz_sgn (*nonneg) < 0)
3219 { 3222 {
3220 mpz_com (mpz[0], *nonneg); 3223 mpz_com (mpz[0], *nonneg);
@@ -3245,10 +3248,10 @@ In this case, the sign bit is duplicated. */)
3245 { 3248 {
3246 if (EQ (value, make_fixnum (0))) 3249 if (EQ (value, make_fixnum (0)))
3247 return value; 3250 return value;
3248 if (mpz_sgn (XBIGNUM (count)->value) < 0) 3251 if (mpz_sgn (*xbignum_val (count)) < 0)
3249 { 3252 {
3250 EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value) 3253 EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value)
3251 : mpz_sgn (XBIGNUM (value)->value)); 3254 : mpz_sgn (*xbignum_val (value)));
3252 return make_fixnum (v < 0 ? -1 : 0); 3255 return make_fixnum (v < 0 ? -1 : 0);
3253 } 3256 }
3254 overflow_error (); 3257 overflow_error ();
@@ -3291,8 +3294,8 @@ expt_integer (Lisp_Object x, Lisp_Object y)
3291 if (TYPE_RANGED_FIXNUMP (unsigned long, y)) 3294 if (TYPE_RANGED_FIXNUMP (unsigned long, y))
3292 exp = XFIXNUM (y); 3295 exp = XFIXNUM (y);
3293 else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y) 3296 else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y)
3294 && mpz_fits_ulong_p (XBIGNUM (y)->value)) 3297 && mpz_fits_ulong_p (*xbignum_val (y)))
3295 exp = mpz_get_ui (XBIGNUM (y)->value); 3298 exp = mpz_get_ui (*xbignum_val (y));
3296 else 3299 else
3297 overflow_error (); 3300 overflow_error ();
3298 3301
@@ -3311,7 +3314,7 @@ Markers are converted to integers. */)
3311 return make_int (XFIXNUM (number) + 1); 3314 return make_int (XFIXNUM (number) + 1);
3312 if (FLOATP (number)) 3315 if (FLOATP (number))
3313 return (make_float (1.0 + XFLOAT_DATA (number))); 3316 return (make_float (1.0 + XFLOAT_DATA (number)));
3314 mpz_add_ui (mpz[0], XBIGNUM (number)->value, 1); 3317 mpz_add_ui (mpz[0], *xbignum_val (number), 1);
3315 return make_integer_mpz (); 3318 return make_integer_mpz ();
3316} 3319}
3317 3320
@@ -3326,7 +3329,7 @@ Markers are converted to integers. */)
3326 return make_int (XFIXNUM (number) - 1); 3329 return make_int (XFIXNUM (number) - 1);
3327 if (FLOATP (number)) 3330 if (FLOATP (number))
3328 return (make_float (-1.0 + XFLOAT_DATA (number))); 3331 return (make_float (-1.0 + XFLOAT_DATA (number)));
3329 mpz_sub_ui (mpz[0], XBIGNUM (number)->value, 1); 3332 mpz_sub_ui (mpz[0], *xbignum_val (number), 1);
3330 return make_integer_mpz (); 3333 return make_integer_mpz ();
3331} 3334}
3332 3335
@@ -3337,7 +3340,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
3337 CHECK_INTEGER (number); 3340 CHECK_INTEGER (number);
3338 if (FIXNUMP (number)) 3341 if (FIXNUMP (number))
3339 return make_fixnum (~XFIXNUM (number)); 3342 return make_fixnum (~XFIXNUM (number));
3340 mpz_com (mpz[0], XBIGNUM (number)->value); 3343 mpz_com (mpz[0], *xbignum_val (number));
3341 return make_integer_mpz (); 3344 return make_integer_mpz ();
3342} 3345}
3343 3346
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 90ba461c6bc..7f4c8717f42 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -728,22 +728,27 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
728 strcpy (signature, DBUS_TYPE_STRING_AS_STRING); 728 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
729 729
730 else 730 else
731 /* If the element type is DBUS_TYPE_SIGNATURE, and this is 731 {
732 the only element, the value of this element is used as 732 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
733 the array's element signature. */ 733 the only element, the value of this element is used as
734 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)) 734 the array's element signature. */
735 == DBUS_TYPE_SIGNATURE) 735 if (CONSP (object) && (XD_OBJECT_TO_DBUS_TYPE (XCAR (object))
736 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object))) 736 == DBUS_TYPE_SIGNATURE))
737 && NILP (CDR_SAFE (XD_NEXT_VALUE (object)))) 737 {
738 { 738 Lisp_Object val = XD_NEXT_VALUE (object);
739 lispstpcpy (signature, CAR_SAFE (XD_NEXT_VALUE (object))); 739 if (CONSP (val) && STRINGP (XCAR (val)) && NILP (XCDR (val))
740 object = CDR_SAFE (XD_NEXT_VALUE (object)); 740 && SBYTES (XCAR (val)) < DBUS_MAXIMUM_SIGNATURE_LENGTH)
741 } 741 {
742 742 lispstpcpy (signature, XCAR (val));
743 else 743 object = Qnil;
744 xd_signature (signature, 744 }
745 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)), 745 }
746 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 746
747 if (!NILP (object))
748 xd_signature (signature,
749 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
750 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
751 }
747 752
748 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 753 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
749 XD_OBJECT_TO_STRING (object)); 754 XD_OBJECT_TO_STRING (object));
diff --git a/src/emacs.c b/src/emacs.c
index cc5818393a3..53572d7f0c8 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
2084 2084
2085 /* Enter editor command loop. This never returns. */ 2085 /* Enter editor command loop. This never returns. */
2086 Frecursive_edit (); 2086 Frecursive_edit ();
2087 /* NOTREACHED */ 2087 eassume (false);
2088 return 0;
2089} 2088}
2090 2089
2091/* Sort the args so we can find the most important ones 2090/* Sort the args so we can find the most important ones
diff --git a/src/floatfns.c b/src/floatfns.c
index a913aad5aac..9049185307c 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/>. */
48 48
49#include <count-leading-zeros.h> 49#include <count-leading-zeros.h>
50 50
51/* Emacs needs proper handling of +/-inf; correct printing as well as
52 important packages depend on it. Make sure the user didn't specify
53 -ffinite-math-only, either directly or implicitly with -Ofast or
54 -ffast-math. */
55#if defined __FINITE_MATH_ONLY__ && __FINITE_MATH_ONLY__
56 #error Emacs cannot be built with -ffinite-math-only
57#endif
58
51/* Check that X is a floating point number. */ 59/* Check that X is a floating point number. */
52 60
53static void 61static void
@@ -268,9 +276,9 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
268 } 276 }
269 else 277 else
270 { 278 {
271 if (mpz_sgn (XBIGNUM (arg)->value) < 0) 279 if (mpz_sgn (*xbignum_val (arg)) < 0)
272 { 280 {
273 mpz_neg (mpz[0], XBIGNUM (arg)->value); 281 mpz_neg (mpz[0], *xbignum_val (arg));
274 arg = make_integer_mpz (); 282 arg = make_integer_mpz ();
275 } 283 }
276 } 284 }
@@ -315,7 +323,7 @@ This is the same as the exponent of a float. */)
315 value = ivalue - 1; 323 value = ivalue - 1;
316 } 324 }
317 else if (!FIXNUMP (arg)) 325 else if (!FIXNUMP (arg))
318 value = mpz_sizeinbase (XBIGNUM (arg)->value, 2) - 1; 326 value = mpz_sizeinbase (*xbignum_val (arg), 2) - 1;
319 else 327 else
320 { 328 {
321 EMACS_INT i = XFIXNUM (arg); 329 EMACS_INT i = XFIXNUM (arg);
diff --git a/src/fns.c b/src/fns.c
index 920addeaf13..df921e28f3b 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -47,7 +47,6 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
47enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; 47enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
48static bool internal_equal (Lisp_Object, Lisp_Object, 48static bool internal_equal (Lisp_Object, Lisp_Object,
49 enum equal_kind, int, Lisp_Object); 49 enum equal_kind, int, Lisp_Object);
50static EMACS_UINT sxhash_bignum (struct Lisp_Bignum *);
51 50
52DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, 51DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
53 doc: /* Return the argument unchanged. */ 52 doc: /* Return the argument unchanged. */
@@ -1444,7 +1443,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1444 } 1443 }
1445 else 1444 else
1446 { 1445 {
1447 if (mpz_sgn (XBIGNUM (n)->value) < 0) 1446 if (mpz_sgn (*xbignum_val (n)) < 0)
1448 return tail; 1447 return tail;
1449 num = large_num; 1448 num = large_num;
1450 } 1449 }
@@ -1482,11 +1481,11 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1482 CYCLE_LENGTH. */ 1481 CYCLE_LENGTH. */
1483 /* Add N mod CYCLE_LENGTH to NUM. */ 1482 /* Add N mod CYCLE_LENGTH to NUM. */
1484 if (cycle_length <= ULONG_MAX) 1483 if (cycle_length <= ULONG_MAX)
1485 num += mpz_tdiv_ui (XBIGNUM (n)->value, cycle_length); 1484 num += mpz_tdiv_ui (*xbignum_val (n), cycle_length);
1486 else 1485 else
1487 { 1486 {
1488 mpz_set_intmax (mpz[0], cycle_length); 1487 mpz_set_intmax (mpz[0], cycle_length);
1489 mpz_tdiv_r (mpz[0], XBIGNUM (n)->value, mpz[0]); 1488 mpz_tdiv_r (mpz[0], *xbignum_val (n), mpz[0]);
1490 intptr_t iz; 1489 intptr_t iz;
1491 mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]); 1490 mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]);
1492 num += iz; 1491 num += iz;
@@ -1595,7 +1594,7 @@ The value is actually the tail of LIST whose car is ELT. */)
1595 { 1594 {
1596 Lisp_Object tem = XCAR (tail); 1595 Lisp_Object tem = XCAR (tail);
1597 if (BIGNUMP (tem) 1596 if (BIGNUMP (tem)
1598 && mpz_cmp (XBIGNUM (elt)->value, XBIGNUM (tem)->value) == 0) 1597 && mpz_cmp (*xbignum_val (elt), *xbignum_val (tem)) == 0)
1599 return tail; 1598 return tail;
1600 } 1599 }
1601 } 1600 }
@@ -2307,7 +2306,7 @@ This differs from numeric comparison: (eql 0.0 -0.0) returns nil and
2307 return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil; 2306 return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil;
2308 else if (BIGNUMP (obj1)) 2307 else if (BIGNUMP (obj1))
2309 return ((BIGNUMP (obj2) 2308 return ((BIGNUMP (obj2)
2310 && mpz_cmp (XBIGNUM (obj1)->value, XBIGNUM (obj2)->value) == 0) 2309 && mpz_cmp (*xbignum_val (obj1), *xbignum_val (obj2)) == 0)
2311 ? Qt : Qnil); 2310 ? Qt : Qnil);
2312 else 2311 else
2313 return EQ (obj1, obj2) ? Qt : Qnil; 2312 return EQ (obj1, obj2) ? Qt : Qnil;
@@ -2437,7 +2436,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
2437 if (ASIZE (o2) != size) 2436 if (ASIZE (o2) != size)
2438 return false; 2437 return false;
2439 if (BIGNUMP (o1)) 2438 if (BIGNUMP (o1))
2440 return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0; 2439 return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
2441 if (OVERLAYP (o1)) 2440 if (OVERLAYP (o1))
2442 { 2441 {
2443 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2), 2442 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
@@ -2951,9 +2950,12 @@ suppressed. */)
2951 But not more than once in any file, 2950 But not more than once in any file,
2952 and not when we aren't loading or reading from a file. */ 2951 and not when we aren't loading or reading from a file. */
2953 if (!from_file) 2952 if (!from_file)
2954 for (tem = Vcurrent_load_list; CONSP (tem); tem = XCDR (tem)) 2953 {
2955 if (NILP (XCDR (tem)) && STRINGP (XCAR (tem))) 2954 Lisp_Object tail = Vcurrent_load_list;
2956 from_file = 1; 2955 FOR_EACH_TAIL_SAFE (tail)
2956 if (NILP (XCDR (tail)) && STRINGP (XCAR (tail)))
2957 from_file = true;
2958 }
2957 2959
2958 if (from_file) 2960 if (from_file)
2959 { 2961 {
@@ -3278,11 +3280,11 @@ static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool,
3278static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool, 3280static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
3279 bool, ptrdiff_t *); 3281 bool, ptrdiff_t *);
3280 3282
3281Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool, 3283static Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool,
3282 bool, bool); 3284 bool, bool);
3283 3285
3284Lisp_Object base64_encode_string_1(Lisp_Object, bool, 3286static Lisp_Object base64_encode_string_1 (Lisp_Object, bool,
3285 bool, bool); 3287 bool, bool);
3286 3288
3287 3289
3288DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region, 3290DEFUN ("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
3293into shorter lines. */) 3295into shorter lines. */)
3294 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break) 3296 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
3295{ 3297{
3296 return base64_encode_region_1(beg, end, NILP (no_line_break), true, false); 3298 return base64_encode_region_1 (beg, end, NILP (no_line_break), true, false);
3297} 3299}
3298 3300
3299 3301
@@ -3306,10 +3308,10 @@ Optional second argument NO-PAD means do not add padding char =.
3306This produces the URL variant of base 64 encoding defined in RFC 4648. */) 3308This produces the URL variant of base 64 encoding defined in RFC 4648. */)
3307 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_pad) 3309 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_pad)
3308{ 3310{
3309 return base64_encode_region_1(beg, end, false, NILP(no_pad), true); 3311 return base64_encode_region_1 (beg, end, false, NILP(no_pad), true);
3310} 3312}
3311 3313
3312Lisp_Object 3314static Lisp_Object
3313base64_encode_region_1 (Lisp_Object beg, Lisp_Object end, bool line_break, 3315base64_encode_region_1 (Lisp_Object beg, Lisp_Object end, bool line_break,
3314 bool pad, bool base64url) 3316 bool pad, bool base64url)
3315{ 3317{
@@ -3374,11 +3376,11 @@ into shorter lines. */)
3374 (Lisp_Object string, Lisp_Object no_line_break) 3376 (Lisp_Object string, Lisp_Object no_line_break)
3375{ 3377{
3376 3378
3377 return base64_encode_string_1(string, NILP (no_line_break), true, false); 3379 return base64_encode_string_1 (string, NILP (no_line_break), true, false);
3378} 3380}
3379 3381
3380DEFUN ("base64url-encode-string", Fbase64url_encode_string, Sbase64url_encode_string, 3382DEFUN ("base64url-encode-string", Fbase64url_encode_string,
3381 1, 2, 0, 3383 Sbase64url_encode_string, 1, 2, 0,
3382 doc: /* Base64url-encode STRING and return the result. 3384 doc: /* Base64url-encode STRING and return the result.
3383Optional second argument NO-PAD means do not add padding char =. 3385Optional second argument NO-PAD means do not add padding char =.
3384 3386
@@ -3386,12 +3388,12 @@ This produces the URL variant of base 64 encoding defined in RFC 4648. */)
3386 (Lisp_Object string, Lisp_Object no_pad) 3388 (Lisp_Object string, Lisp_Object no_pad)
3387{ 3389{
3388 3390
3389 return base64_encode_string_1(string, false, NILP(no_pad), true); 3391 return base64_encode_string_1 (string, false, NILP(no_pad), true);
3390} 3392}
3391 3393
3392Lisp_Object 3394static Lisp_Object
3393base64_encode_string_1(Lisp_Object string, bool line_break, 3395base64_encode_string_1 (Lisp_Object string, bool line_break,
3394 bool pad, bool base64url) 3396 bool pad, bool base64url)
3395{ 3397{
3396 ptrdiff_t allength, length, encoded_length; 3398 ptrdiff_t allength, length, encoded_length;
3397 char *encoded; 3399 char *encoded;
@@ -3508,9 +3510,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
3508 { 3510 {
3509 *e++ = b64_value_to_char[value]; 3511 *e++ = b64_value_to_char[value];
3510 if (pad) 3512 if (pad)
3511 { 3513 *e++ = '=';
3512 *e++ = '=';
3513 }
3514 break; 3514 break;
3515 } 3515 }
3516 3516
@@ -4196,21 +4196,20 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
4196 new_size); 4196 new_size);
4197 ptrdiff_t next_size = ASIZE (next); 4197 ptrdiff_t next_size = ASIZE (next);
4198 for (ptrdiff_t i = old_size; i < next_size - 1; i++) 4198 for (ptrdiff_t i = old_size; i < next_size - 1; i++)
4199 gc_aset (next, i, make_fixnum (i + 1)); 4199 ASET (next, i, make_fixnum (i + 1));
4200 gc_aset (next, next_size - 1, make_fixnum (-1)); 4200 ASET (next, next_size - 1, make_fixnum (-1));
4201 ptrdiff_t index_size = hash_index_size (h, next_size);
4202 4201
4203 /* Build the new&larger key_and_value vector, making sure the new 4202 /* Build the new&larger key_and_value vector, making sure the new
4204 fields are initialized to `unbound`. */ 4203 fields are initialized to `unbound`. */
4205 Lisp_Object key_and_value 4204 Lisp_Object key_and_value
4206 = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size), 4205 = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size),
4207 2 * next_size); 4206 2 * next_size);
4208 for (ptrdiff_t i = ASIZE (h->key_and_value); 4207 for (ptrdiff_t i = 2 * old_size; i < 2 * next_size; i++)
4209 i < ASIZE (key_and_value); i++)
4210 ASET (key_and_value, i, Qunbound); 4208 ASET (key_and_value, i, Qunbound);
4211 4209
4212 Lisp_Object hash = larger_vector (h->hash, next_size - old_size, 4210 Lisp_Object hash = larger_vector (h->hash, next_size - old_size,
4213 next_size); 4211 next_size);
4212 ptrdiff_t index_size = hash_index_size (h, next_size);
4214 h->index = make_vector (index_size, make_fixnum (-1)); 4213 h->index = make_vector (index_size, make_fixnum (-1));
4215 h->key_and_value = key_and_value; 4214 h->key_and_value = key_and_value;
4216 h->hash = hash; 4215 h->hash = hash;
@@ -4402,17 +4401,17 @@ hash_clear (struct Lisp_Hash_Table *h)
4402{ 4401{
4403 if (h->count > 0) 4402 if (h->count > 0)
4404 { 4403 {
4405 ptrdiff_t i, size = HASH_TABLE_SIZE (h); 4404 ptrdiff_t size = HASH_TABLE_SIZE (h);
4406 4405 if (!hash_rehash_needed_p (h))
4407 for (i = 0; i < size; ++i) 4406 memclear (XVECTOR (h->hash)->contents, size * word_size);
4407 for (ptrdiff_t i = 0; i < size; i++)
4408 { 4408 {
4409 set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); 4409 set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
4410 set_hash_key_slot (h, i, Qunbound); 4410 set_hash_key_slot (h, i, Qunbound);
4411 set_hash_value_slot (h, i, Qnil); 4411 set_hash_value_slot (h, i, Qnil);
4412 set_hash_hash_slot (h, i, Qnil);
4413 } 4412 }
4414 4413
4415 for (i = 0; i < ASIZE (h->index); ++i) 4414 for (ptrdiff_t i = 0; i < ASIZE (h->index); i++)
4416 ASET (h->index, i, make_fixnum (-1)); 4415 ASET (h->index, i, make_fixnum (-1));
4417 4416
4418 h->next_free = 0; 4417 h->next_free = 0;
@@ -4640,13 +4639,14 @@ sxhash_bool_vector (Lisp_Object vec)
4640/* Return a hash for a bignum. */ 4639/* Return a hash for a bignum. */
4641 4640
4642static EMACS_UINT 4641static EMACS_UINT
4643sxhash_bignum (struct Lisp_Bignum *bignum) 4642sxhash_bignum (Lisp_Object bignum)
4644{ 4643{
4645 size_t i, nlimbs = mpz_size (bignum->value); 4644 mpz_t const *n = xbignum_val (bignum);
4645 size_t i, nlimbs = mpz_size (*n);
4646 EMACS_UINT hash = 0; 4646 EMACS_UINT hash = 0;
4647 4647
4648 for (i = 0; i < nlimbs; ++i) 4648 for (i = 0; i < nlimbs; ++i)
4649 hash = sxhash_combine (hash, mpz_getlimbn (bignum->value, i)); 4649 hash = sxhash_combine (hash, mpz_getlimbn (*n, i));
4650 4650
4651 return SXHASH_REDUCE (hash); 4651 return SXHASH_REDUCE (hash);
4652} 4652}
@@ -4680,7 +4680,7 @@ sxhash (Lisp_Object obj, int depth)
4680 /* This can be everything from a vector to an overlay. */ 4680 /* This can be everything from a vector to an overlay. */
4681 case Lisp_Vectorlike: 4681 case Lisp_Vectorlike:
4682 if (BIGNUMP (obj)) 4682 if (BIGNUMP (obj))
4683 hash = sxhash_bignum (XBIGNUM (obj)); 4683 hash = sxhash_bignum (obj);
4684 else if (VECTORP (obj) || RECORDP (obj)) 4684 else if (VECTORP (obj) || RECORDP (obj))
4685 /* According to the CL HyperSpec, two arrays are equal only if 4685 /* According to the CL HyperSpec, two arrays are equal only if
4686 they are `eq', except for strings and bit-vectors. In 4686 they are `eq', except for strings and bit-vectors. In
diff --git a/src/font.c b/src/font.c
index ce85e0bb4ad..935dd64e648 100644
--- a/src/font.c
+++ b/src/font.c
@@ -5509,7 +5509,14 @@ and cannot switch to a smaller font for those characters, set
5509this variable non-nil. 5509this variable non-nil.
5510Disabling compaction of font caches might enlarge the Emacs memory 5510Disabling compaction of font caches might enlarge the Emacs memory
5511footprint in sessions that use lots of different fonts. */); 5511footprint in sessions that use lots of different fonts. */);
5512
5513#ifdef WINDOWSNT
5514 /* Compacting font caches causes slow redisplay on Windows with many
5515 large fonts, so we disable it by default. */
5516 inhibit_compacting_font_caches = 1;
5517#else
5512 inhibit_compacting_font_caches = 0; 5518 inhibit_compacting_font_caches = 0;
5519#endif
5513 5520
5514 DEFVAR_BOOL ("xft-ignore-color-fonts", 5521 DEFVAR_BOOL ("xft-ignore-color-fonts",
5515 Vxft_ignore_color_fonts, 5522 Vxft_ignore_color_fonts,
diff --git a/src/frame.c b/src/frame.c
index 50a7f138b81..1d42d0cb4de 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3492,7 +3492,7 @@ DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_widt
3492} 3492}
3493 3493
3494DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 3494DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4,
3495 "(list (selected-frame) current-prefix-arg)", 3495 "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
3496 doc: /* Set text height of frame FRAME to HEIGHT lines. 3496 doc: /* Set text height of frame FRAME to HEIGHT lines.
3497Optional third arg PRETEND non-nil means that redisplay should use 3497Optional third arg PRETEND non-nil means that redisplay should use
3498HEIGHT lines but that the idea of the actual height of the frame should 3498HEIGHT 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. */)
3521} 3521}
3522 3522
3523DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4, 3523DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4,
3524 "(list (selected-frame) current-prefix-arg)", 3524 "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
3525 doc: /* Set text width of frame FRAME to WIDTH columns. 3525 doc: /* Set text width of frame FRAME to WIDTH columns.
3526Optional third arg PRETEND non-nil means that redisplay should use WIDTH 3526Optional third arg PRETEND non-nil means that redisplay should use WIDTH
3527columns but that the idea of the actual width of the frame should not 3527columns 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.
5327On Nextstep, this just calls `ns-parse-geometry'. */) 5327On Nextstep, this just calls `ns-parse-geometry'. */)
5328 (Lisp_Object string) 5328 (Lisp_Object string)
5329{ 5329{
5330 int geometry, x, y; 5330 /* x and y don't need initialization, as they are not accessed
5331 unless XParseGeometry sets them, in which case it always returns
5332 a non-zero value. */
5333 int x UNINIT, y UNINIT;
5331 unsigned int width, height; 5334 unsigned int width, height;
5332 Lisp_Object result;
5333 5335
5334 CHECK_STRING (string); 5336 CHECK_STRING (string);
5335 5337
@@ -5337,9 +5339,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
5337 if (strchr (SSDATA (string), ' ') != NULL) 5339 if (strchr (SSDATA (string), ' ') != NULL)
5338 return call1 (Qns_parse_geometry, string); 5340 return call1 (Qns_parse_geometry, string);
5339#endif 5341#endif
5340 geometry = XParseGeometry (SSDATA (string), 5342 int geometry = XParseGeometry (SSDATA (string),
5341 &x, &y, &width, &height); 5343 &x, &y, &width, &height);
5342 result = Qnil; 5344 Lisp_Object result = Qnil;
5343 if (geometry & XValue) 5345 if (geometry & XValue)
5344 { 5346 {
5345 Lisp_Object element; 5347 Lisp_Object element;
diff --git a/src/ftfont.c b/src/ftfont.c
index 16b18de6867..77a4cf5de5c 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)
433 return cache; 433 return cache;
434} 434}
435 435
436FcCharSet * 436static FcCharSet *
437ftfont_get_fc_charset (Lisp_Object entity) 437ftfont_get_fc_charset (Lisp_Object entity)
438{ 438{
439 Lisp_Object val, cache; 439 Lisp_Object val, cache;
diff --git a/src/ftfont.h b/src/ftfont.h
index b2280e9aab9..f771dc159b0 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/>. */
41#endif /* HAVE_M17N_FLT */ 41#endif /* HAVE_M17N_FLT */
42#endif /* HAVE_LIBOTF */ 42#endif /* HAVE_LIBOTF */
43 43
44extern FcCharSet *ftfont_get_fc_charset (Lisp_Object);
45extern void ftfont_fix_match (FcPattern *, FcPattern *); 44extern void ftfont_fix_match (FcPattern *, FcPattern *);
46extern void ftfont_add_rendering_parameters (FcPattern *, Lisp_Object); 45extern void ftfont_add_rendering_parameters (FcPattern *, Lisp_Object);
47extern FcPattern *ftfont_entity_pattern (Lisp_Object, int); 46extern FcPattern *ftfont_entity_pattern (Lisp_Object, int);
diff --git a/src/gnutls.c b/src/gnutls.c
index 267ba9aba35..d43534b5ae1 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/>. */
44# define HAVE_GNUTLS_EXT__DUMBFW 44# define HAVE_GNUTLS_EXT__DUMBFW
45#endif 45#endif
46 46
47#if GNUTLS_VERSION_NUMBER >= 0x030400
48# define HAVE_GNUTLS_ETM_STATUS
49#endif
50
51#if GNUTLS_VERSION_NUMBER < 0x030600
52# define HAVE_GNUTLS_COMPRESSION_GET
53#endif
54
47/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was 55/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was
48 exported only since 3.3.0. */ 56 exported only since 3.3.0. */
49#if GNUTLS_VERSION_NUMBER >= 0x030300 57#if GNUTLS_VERSION_NUMBER >= 0x030300
@@ -159,6 +167,8 @@ DEF_DLL_FN (int, gnutls_x509_crt_check_hostname,
159DEF_DLL_FN (int, gnutls_x509_crt_check_issuer, 167DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
160 (gnutls_x509_crt_t, gnutls_x509_crt_t)); 168 (gnutls_x509_crt_t, gnutls_x509_crt_t));
161DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t)); 169DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
170DEF_DLL_FN (int, gnutls_x509_crt_export,
171 (gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
162DEF_DLL_FN (int, gnutls_x509_crt_import, 172DEF_DLL_FN (int, gnutls_x509_crt_import,
163 (gnutls_x509_crt_t, const gnutls_datum_t *, 173 (gnutls_x509_crt_t, const gnutls_datum_t *,
164 gnutls_x509_crt_fmt_t)); 174 gnutls_x509_crt_fmt_t));
@@ -180,6 +190,9 @@ DEF_DLL_FN (int, gnutls_x509_crt_get_dn,
180 (gnutls_x509_crt_t, char *, size_t *)); 190 (gnutls_x509_crt_t, char *, size_t *));
181DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm, 191DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm,
182 (gnutls_x509_crt_t, unsigned int *)); 192 (gnutls_x509_crt_t, unsigned int *));
193DEF_DLL_FN (int, gnutls_x509_crt_print,
194 (gnutls_x509_crt_t, gnutls_certificate_print_formats_t,
195 gnutls_datum_t *));
183DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name, 196DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name,
184 (gnutls_pk_algorithm_t)); 197 (gnutls_pk_algorithm_t));
185DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param, 198DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param,
@@ -208,6 +221,13 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
208 (gnutls_cipher_algorithm_t)); 221 (gnutls_cipher_algorithm_t));
209DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); 222DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
210DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); 223DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
224#ifdef HAVE_GNUTLS_COMPRESSION_GET
225DEF_DLL_FN (gnutls_compression_method_t, gnutls_compression_get,
226 (gnutls_session_t));
227DEF_DLL_FN (const char *, gnutls_compression_get_name,
228 (gnutls_compression_method_t));
229#endif
230DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
211 231
212# ifdef HAVE_GNUTLS3 232# ifdef HAVE_GNUTLS3
213DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); 233DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
@@ -250,6 +270,9 @@ DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
250 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, 270 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
251 size_t, size_t, const void *, size_t, void *, size_t *)); 271 size_t, size_t, const void *, size_t, void *, size_t *));
252# endif 272# endif
273# ifdef HAVE_GNUTLS_ETM_STATUS
274DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
275# endif
253DEF_DLL_FN (int, gnutls_hmac_init, 276DEF_DLL_FN (int, gnutls_hmac_init,
254 (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); 277 (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
255DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); 278DEF_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));
267# endif 290# endif
268# endif /* HAVE_GNUTLS3 */ 291# endif /* HAVE_GNUTLS3 */
269 292
293static gnutls_free_function *gnutls_free_func;
270 294
271static bool 295static bool
272init_gnutls_functions (void) 296init_gnutls_functions (void)
@@ -322,6 +346,7 @@ init_gnutls_functions (void)
322 LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname); 346 LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname);
323 LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer); 347 LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
324 LOAD_DLL_FN (library, gnutls_x509_crt_deinit); 348 LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
349 LOAD_DLL_FN (library, gnutls_x509_crt_export);
325 LOAD_DLL_FN (library, gnutls_x509_crt_import); 350 LOAD_DLL_FN (library, gnutls_x509_crt_import);
326 LOAD_DLL_FN (library, gnutls_x509_crt_init); 351 LOAD_DLL_FN (library, gnutls_x509_crt_init);
327 LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint); 352 LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint);
@@ -332,6 +357,7 @@ init_gnutls_functions (void)
332 LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time); 357 LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time);
333 LOAD_DLL_FN (library, gnutls_x509_crt_get_dn); 358 LOAD_DLL_FN (library, gnutls_x509_crt_get_dn);
334 LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm); 359 LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm);
360 LOAD_DLL_FN (library, gnutls_x509_crt_print);
335 LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name); 361 LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name);
336 LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param); 362 LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param);
337 LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id); 363 LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id);
@@ -349,6 +375,11 @@ init_gnutls_functions (void)
349 LOAD_DLL_FN (library, gnutls_cipher_get_name); 375 LOAD_DLL_FN (library, gnutls_cipher_get_name);
350 LOAD_DLL_FN (library, gnutls_mac_get); 376 LOAD_DLL_FN (library, gnutls_mac_get);
351 LOAD_DLL_FN (library, gnutls_mac_get_name); 377 LOAD_DLL_FN (library, gnutls_mac_get_name);
378# ifdef HAVE_GNUTLS_COMPRESSION_GET
379 LOAD_DLL_FN (library, gnutls_compression_get);
380 LOAD_DLL_FN (library, gnutls_compression_get_name);
381# endif
382 LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
352# ifdef HAVE_GNUTLS3 383# ifdef HAVE_GNUTLS3
353 LOAD_DLL_FN (library, gnutls_rnd); 384 LOAD_DLL_FN (library, gnutls_rnd);
354 LOAD_DLL_FN (library, gnutls_mac_list); 385 LOAD_DLL_FN (library, gnutls_mac_list);
@@ -380,6 +411,9 @@ init_gnutls_functions (void)
380 LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); 411 LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
381 LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); 412 LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
382# endif 413# endif
414# ifdef HAVE_GNUTLS_ETM_STATUS
415 LOAD_DLL_FN (library, gnutls_session_etm_status);
416# endif
383 LOAD_DLL_FN (library, gnutls_hmac_init); 417 LOAD_DLL_FN (library, gnutls_hmac_init);
384 LOAD_DLL_FN (library, gnutls_hmac_get_len); 418 LOAD_DLL_FN (library, gnutls_hmac_get_len);
385 LOAD_DLL_FN (library, gnutls_hmac); 419 LOAD_DLL_FN (library, gnutls_hmac);
@@ -395,6 +429,13 @@ init_gnutls_functions (void)
395# endif 429# endif
396# endif /* HAVE_GNUTLS3 */ 430# endif /* HAVE_GNUTLS3 */
397 431
432 /* gnutls_free is a variable inside GnuTLS, whose value is the
433 "free" function. So it needs special handling. */
434 gnutls_free_func = (gnutls_free_function *) GetProcAddress (library,
435 "gnutls_free");
436 if (!gnutls_free_func)
437 return false;
438
398 max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX); 439 max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
399 { 440 {
400 Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from)); 441 Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
@@ -437,6 +478,11 @@ init_gnutls_functions (void)
437# define gnutls_kx_get_name fn_gnutls_kx_get_name 478# define gnutls_kx_get_name fn_gnutls_kx_get_name
438# define gnutls_mac_get fn_gnutls_mac_get 479# define gnutls_mac_get fn_gnutls_mac_get
439# define gnutls_mac_get_name fn_gnutls_mac_get_name 480# define gnutls_mac_get_name fn_gnutls_mac_get_name
481# ifdef HAVE_GNUTLS_COMPRESSION_GET
482# define gnutls_compression_get fn_gnutls_compression_get
483# define gnutls_compression_get_name fn_gnutls_compression_get_name
484# endif
485# define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status
440# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name 486# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
441# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param 487# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
442# define gnutls_priority_set_direct fn_gnutls_priority_set_direct 488# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
@@ -456,6 +502,7 @@ init_gnutls_functions (void)
456# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname 502# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
457# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer 503# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
458# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit 504# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
505# define gnutls_x509_crt_export fn_gnutls_x509_crt_export
459# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time 506# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
460# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn 507# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
461# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time 508# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
@@ -464,6 +511,7 @@ init_gnutls_functions (void)
464# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id 511# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
465# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id 512# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
466# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm 513# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
514# define gnutls_x509_crt_print fn_gnutls_x509_crt_print
467# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial 515# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
468# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm 516# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
469# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id 517# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
@@ -501,6 +549,9 @@ init_gnutls_functions (void)
501# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init 549# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
502# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit 550# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
503# endif 551# endif
552# ifdef HAVE_GNUTLS_ETM_STATUS
553# define gnutls_session_etm_status fn_gnutls_session_etm_status
554# endif
504# define gnutls_hmac_init fn_gnutls_hmac_init 555# define gnutls_hmac_init fn_gnutls_hmac_init
505# define gnutls_hmac_get_len fn_gnutls_hmac_get_len 556# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
506# define gnutls_hmac fn_gnutls_hmac 557# define gnutls_hmac fn_gnutls_hmac
@@ -516,6 +567,11 @@ init_gnutls_functions (void)
516# endif 567# endif
517# endif /* HAVE_GNUTLS3 */ 568# endif /* HAVE_GNUTLS3 */
518 569
570/* gnutls_free_func is a data pointer to a variable which holds an
571 address of a function. We use #undef because MinGW64 defines
572 gnutls_free as a macro as well in the GnuTLS headers. */
573# undef gnutls_free
574# define gnutls_free (*gnutls_free_func)
519 575
520/* This wrapper is called from fns.c, which doesn't know about the 576/* This wrapper is called from fns.c, which doesn't know about the
521 LOAD_DLL_FN stuff above. */ 577 LOAD_DLL_FN stuff above. */
@@ -1041,7 +1097,35 @@ gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
1041} 1097}
1042 1098
1043static Lisp_Object 1099static Lisp_Object
1044gnutls_certificate_details (gnutls_x509_crt_t cert) 1100emacs_gnutls_certificate_export_pem (gnutls_x509_crt_t cert)
1101{
1102 size_t size = 0;
1103 int err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, NULL, &size);
1104 check_memory_full (err);
1105
1106 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1107 {
1108 USE_SAFE_ALLOCA;
1109 char *buf = SAFE_ALLOCA (size);
1110 err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
1111 check_memory_full (err);
1112
1113 if (err < GNUTLS_E_SUCCESS)
1114 error ("GnuTLS certificate export error: %s",
1115 emacs_gnutls_strerror (err));
1116
1117 Lisp_Object result = build_string (buf);
1118 SAFE_FREE ();
1119 return result;
1120 }
1121 else if (err < GNUTLS_E_SUCCESS)
1122 error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));
1123
1124 return Qnil;
1125}
1126
1127static Lisp_Object
1128emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
1045{ 1129{
1046 Lisp_Object res = Qnil; 1130 Lisp_Object res = Qnil;
1047 int err; 1131 int err;
@@ -1209,6 +1293,10 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
1209 xfree (buf); 1293 xfree (buf);
1210 } 1294 }
1211 1295
1296 /* PEM */
1297 res = nconc2 (res, list2 (intern (":pem"),
1298 emacs_gnutls_certificate_export_pem(cert)));
1299
1212 return res; 1300 return res;
1213} 1301}
1214 1302
@@ -1246,6 +1334,29 @@ DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_descri
1246 if (EQ (status_symbol, intern (":no-host-match"))) 1334 if (EQ (status_symbol, intern (":no-host-match")))
1247 return build_string ("certificate host does not match hostname"); 1335 return build_string ("certificate host does not match hostname");
1248 1336
1337 if (EQ (status_symbol, intern (":signature-failure")))
1338 return build_string ("certificate signature could not be verified");
1339
1340 if (EQ (status_symbol, intern (":revocation-data-superseded")))
1341 return build_string ("certificate revocation data are old and have been "
1342 "superseded");
1343
1344 if (EQ (status_symbol, intern (":revocation-data-issued-in-future")))
1345 return build_string ("certificate revocation data have a future issue date");
1346
1347 if (EQ (status_symbol, intern (":signer-constraints-failure")))
1348 return build_string ("certificate signer constraints were violated");
1349
1350 if (EQ (status_symbol, intern (":purpose-mismatch")))
1351 return build_string ("certificate does not match the intended purpose");
1352
1353 if (EQ (status_symbol, intern (":missing-ocsp-status")))
1354 return build_string ("certificate requires the server to send a OCSP "
1355 "certificate status, but no status was received");
1356
1357 if (EQ (status_symbol, intern (":invalid-ocsp-status")))
1358 return build_string ("the received OCSP certificate status is invalid");
1359
1249 return Qnil; 1360 return Qnil;
1250} 1361}
1251 1362
@@ -1297,6 +1408,35 @@ returned as the :certificate entry. */)
1297 if (verification & GNUTLS_CERT_EXPIRED) 1408 if (verification & GNUTLS_CERT_EXPIRED)
1298 warnings = Fcons (intern (":expired"), warnings); 1409 warnings = Fcons (intern (":expired"), warnings);
1299 1410
1411#if GNUTLS_VERSION_NUMBER >= 0x030100
1412 if (verification & GNUTLS_CERT_SIGNATURE_FAILURE)
1413 warnings = Fcons (intern (":signature-failure"), warnings);
1414
1415# if GNUTLS_VERSION_NUMBER >= 0x030114
1416 if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED)
1417 warnings = Fcons (intern (":revocation-data-superseded"), warnings);
1418
1419 if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE)
1420 warnings = Fcons (intern (":revocation-data-issued-in-future"), warnings);
1421
1422 if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE)
1423 warnings = Fcons (intern (":signer-constraints-failure"), warnings);
1424
1425# if GNUTLS_VERSION_NUMBER >= 0x030400
1426 if (verification & GNUTLS_CERT_PURPOSE_MISMATCH)
1427 warnings = Fcons (intern (":purpose-mismatch"), warnings);
1428
1429# if GNUTLS_VERSION_NUMBER >= 0x030501
1430 if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS)
1431 warnings = Fcons (intern (":missing-ocsp-status"), warnings);
1432
1433 if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS)
1434 warnings = Fcons (intern (":invalid-ocsp-status"), warnings);
1435# endif
1436# endif
1437# endif
1438#endif
1439
1300 if (XPROCESS (proc)->gnutls_extra_peer_verification & 1440 if (XPROCESS (proc)->gnutls_extra_peer_verification &
1301 CERTIFICATE_NOT_MATCHING) 1441 CERTIFICATE_NOT_MATCHING)
1302 warnings = Fcons (intern (":no-host-match"), warnings); 1442 warnings = Fcons (intern (":no-host-match"), warnings);
@@ -1319,7 +1459,7 @@ returned as the :certificate entry. */)
1319 1459
1320 /* Return all the certificates in a list. */ 1460 /* Return all the certificates in a list. */
1321 for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++) 1461 for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++)
1322 certs = nconc2 (certs, list1 (gnutls_certificate_details 1462 certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details
1323 (XPROCESS (proc)->gnutls_certificates[i]))); 1463 (XPROCESS (proc)->gnutls_certificates[i])));
1324 1464
1325 result = nconc2 (result, list2 (intern (":certificates"), certs)); 1465 result = nconc2 (result, list2 (intern (":certificates"), certs));
@@ -1347,10 +1487,10 @@ returned as the :certificate entry. */)
1347 (gnutls_kx_get (state))))); 1487 (gnutls_kx_get (state)))));
1348 1488
1349 /* Protocol name. */ 1489 /* Protocol name. */
1490 gnutls_protocol_t proto = gnutls_protocol_get_version (state);
1350 result = nconc2 1491 result = nconc2
1351 (result, list2 (intern (":protocol"), 1492 (result, list2 (intern (":protocol"),
1352 build_string (gnutls_protocol_get_name 1493 build_string (gnutls_protocol_get_name (proto))));
1353 (gnutls_protocol_get_version (state)))));
1354 1494
1355 /* Cipher name. */ 1495 /* Cipher name. */
1356 result = nconc2 1496 result = nconc2
@@ -1364,6 +1504,26 @@ returned as the :certificate entry. */)
1364 build_string (gnutls_mac_get_name 1504 build_string (gnutls_mac_get_name
1365 (gnutls_mac_get (state))))); 1505 (gnutls_mac_get (state)))));
1366 1506
1507 /* Compression name. */
1508#ifdef HAVE_GNUTLS_COMPRESSION_GET
1509 result = nconc2
1510 (result, list2 (intern (":compression"),
1511 build_string (gnutls_compression_get_name
1512 (gnutls_compression_get (state)))));
1513#endif
1514
1515 /* Encrypt-then-MAC. */
1516#ifdef HAVE_GNUTLS_ETM_STATUS
1517 result = nconc2
1518 (result, list2 (intern (":encrypt-then-mac"),
1519 gnutls_session_etm_status (state) ? Qt : Qnil));
1520#endif
1521
1522 /* Renegotiation Indication */
1523 if (proto <= GNUTLS_TLS1_2)
1524 result = nconc2
1525 (result, list2 (intern (":safe-renegotiation"),
1526 gnutls_safe_renegotiation_status (state) ? Qt : Qnil));
1367 1527
1368 return result; 1528 return result;
1369} 1529}
@@ -1425,6 +1585,52 @@ boot_error (struct Lisp_Process *p, const char *m, ...)
1425 va_end (ap); 1585 va_end (ap);
1426} 1586}
1427 1587
1588DEFUN ("gnutls-format-certificate", Fgnutls_format_certificate,
1589 Sgnutls_format_certificate, 1, 1, 0,
1590 doc: /* Format a X.509 certificate to a string.
1591
1592Given a PEM-encoded X.509 certificate CERT, returns a human-readable
1593string representation. */)
1594 (Lisp_Object cert)
1595{
1596 CHECK_STRING (cert);
1597
1598 int err;
1599 gnutls_x509_crt_t crt;
1600
1601 err = gnutls_x509_crt_init (&crt);
1602 check_memory_full (err);
1603 if (err < GNUTLS_E_SUCCESS)
1604 error ("gnutls-format-certificate error: %s", emacs_gnutls_strerror (err));
1605
1606 gnutls_datum_t crt_data = { SDATA (cert), strlen (SSDATA (cert)) };
1607 err = gnutls_x509_crt_import (crt, &crt_data, GNUTLS_X509_FMT_PEM);
1608 check_memory_full (err);
1609 if (err < GNUTLS_E_SUCCESS)
1610 {
1611 gnutls_x509_crt_deinit (crt);
1612 error ("gnutls-format-certificate error: %s",
1613 emacs_gnutls_strerror (err));
1614 }
1615
1616 gnutls_datum_t out;
1617 err = gnutls_x509_crt_print (crt, GNUTLS_CRT_PRINT_FULL, &out);
1618 check_memory_full (err);
1619 if (err < GNUTLS_E_SUCCESS)
1620 {
1621 gnutls_x509_crt_deinit (crt);
1622 error ("gnutls-format-certificate error: %s",
1623 emacs_gnutls_strerror (err));
1624 }
1625
1626 Lisp_Object result = make_string_from_bytes ((char *) out.data, out.size,
1627 out.size);
1628 gnutls_free (out.data);
1629 gnutls_x509_crt_deinit (crt);
1630
1631 return result;
1632}
1633
1428Lisp_Object 1634Lisp_Object
1429gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) 1635gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
1430{ 1636{
@@ -2706,6 +2912,7 @@ syms_of_gnutls (void)
2706 defsubr (&Sgnutls_bye); 2912 defsubr (&Sgnutls_bye);
2707 defsubr (&Sgnutls_peer_status); 2913 defsubr (&Sgnutls_peer_status);
2708 defsubr (&Sgnutls_peer_status_warning_describe); 2914 defsubr (&Sgnutls_peer_status_warning_describe);
2915 defsubr (&Sgnutls_format_certificate);
2709 2916
2710#ifdef HAVE_GNUTLS3 2917#ifdef HAVE_GNUTLS3
2711 defsubr (&Sgnutls_ciphers); 2918 defsubr (&Sgnutls_ciphers);
diff --git a/src/image.c b/src/image.c
index 81d8cb4e2b2..fe7bd90b051 100644
--- a/src/image.c
+++ b/src/image.c
@@ -6234,7 +6234,10 @@ DEF_DLL_FN (void, png_read_info, (png_structp, png_infop));
6234DEF_DLL_FN (png_uint_32, png_get_IHDR, 6234DEF_DLL_FN (png_uint_32, png_get_IHDR,
6235 (png_structp, png_infop, png_uint_32 *, png_uint_32 *, 6235 (png_structp, png_infop, png_uint_32 *, png_uint_32 *,
6236 int *, int *, int *, int *, int *)); 6236 int *, int *, int *, int *, int *));
6237DEF_DLL_FN (png_uint_32, png_get_valid, (png_structp, png_infop, png_uint_32)); 6237# ifdef PNG_tRNS_SUPPORTED
6238DEF_DLL_FN (png_uint_32, png_get_tRNS, (png_structp, png_infop, png_bytep *,
6239 int *, png_color_16p *));
6240# endif
6238DEF_DLL_FN (void, png_set_strip_16, (png_structp)); 6241DEF_DLL_FN (void, png_set_strip_16, (png_structp));
6239DEF_DLL_FN (void, png_set_expand, (png_structp)); 6242DEF_DLL_FN (void, png_set_expand, (png_structp));
6240DEF_DLL_FN (void, png_set_gray_to_rgb, (png_structp)); 6243DEF_DLL_FN (void, png_set_gray_to_rgb, (png_structp));
@@ -6273,7 +6276,9 @@ init_png_functions (void)
6273 LOAD_DLL_FN (library, png_set_sig_bytes); 6276 LOAD_DLL_FN (library, png_set_sig_bytes);
6274 LOAD_DLL_FN (library, png_read_info); 6277 LOAD_DLL_FN (library, png_read_info);
6275 LOAD_DLL_FN (library, png_get_IHDR); 6278 LOAD_DLL_FN (library, png_get_IHDR);
6276 LOAD_DLL_FN (library, png_get_valid); 6279# ifdef PNG_tRNS_SUPPORTED
6280 LOAD_DLL_FN (library, png_get_tRNS);
6281# endif
6277 LOAD_DLL_FN (library, png_set_strip_16); 6282 LOAD_DLL_FN (library, png_set_strip_16);
6278 LOAD_DLL_FN (library, png_set_expand); 6283 LOAD_DLL_FN (library, png_set_expand);
6279 LOAD_DLL_FN (library, png_set_gray_to_rgb); 6284 LOAD_DLL_FN (library, png_set_gray_to_rgb);
@@ -6304,7 +6309,7 @@ init_png_functions (void)
6304# undef png_get_IHDR 6309# undef png_get_IHDR
6305# undef png_get_io_ptr 6310# undef png_get_io_ptr
6306# undef png_get_rowbytes 6311# undef png_get_rowbytes
6307# undef png_get_valid 6312# undef png_get_tRNS
6308# undef png_longjmp 6313# undef png_longjmp
6309# undef png_read_end 6314# undef png_read_end
6310# undef png_read_image 6315# undef png_read_image
@@ -6329,7 +6334,7 @@ init_png_functions (void)
6329# define png_get_IHDR fn_png_get_IHDR 6334# define png_get_IHDR fn_png_get_IHDR
6330# define png_get_io_ptr fn_png_get_io_ptr 6335# define png_get_io_ptr fn_png_get_io_ptr
6331# define png_get_rowbytes fn_png_get_rowbytes 6336# define png_get_rowbytes fn_png_get_rowbytes
6332# define png_get_valid fn_png_get_valid 6337# define png_get_tRNS fn_png_get_tRNS
6333# define png_longjmp fn_png_longjmp 6338# define png_longjmp fn_png_longjmp
6334# define png_read_end fn_png_read_end 6339# define png_read_end fn_png_read_end
6335# define png_read_image fn_png_read_image 6340# 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)
6589 6594
6590 /* If image contains simply transparency data, we prefer to 6595 /* If image contains simply transparency data, we prefer to
6591 construct a clipping mask. */ 6596 construct a clipping mask. */
6592 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS)) 6597 transparent_p = false;
6593 transparent_p = 1; 6598# ifdef PNG_tRNS_SUPPORTED
6594 else 6599 png_bytep trans_alpha;
6595 transparent_p = 0; 6600 int num_trans;
6601 if (png_get_tRNS (png_ptr, info_ptr, &trans_alpha, &num_trans, NULL))
6602 {
6603 transparent_p = true;
6604 if (trans_alpha)
6605 for (int i = 0; i < num_trans; i++)
6606 if (0 < trans_alpha[i] && trans_alpha[i] < 255)
6607 {
6608 transparent_p = false;
6609 break;
6610 }
6611 }
6612# endif
6596 6613
6597 /* This function is easier to write if we only have to handle 6614 /* This function is easier to write if we only have to handle
6598 one data format: RGB or RGBA with 8 bits per channel. Let's 6615 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)
6680 /* Create an image and pixmap serving as mask if the PNG image 6697 /* Create an image and pixmap serving as mask if the PNG image
6681 contains an alpha channel. */ 6698 contains an alpha channel. */
6682 if (channels == 4 6699 if (channels == 4
6683 && !transparent_p 6700 && transparent_p
6684 && !image_create_x_image_and_pixmap (f, img, width, height, 1, 6701 && !image_create_x_image_and_pixmap (f, img, width, height, 1,
6685 &mask_img, 1)) 6702 &mask_img, 1))
6686 { 6703 {
diff --git a/src/keyboard.c b/src/keyboard.c
index 30686a25898..1b9a603ca17 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -8304,6 +8304,10 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
8304 AUTO_STRING (end, ")"); 8304 AUTO_STRING (end, ")");
8305 Lisp_Object orig = PROP (TOOL_BAR_ITEM_HELP); 8305 Lisp_Object orig = PROP (TOOL_BAR_ITEM_HELP);
8306 Lisp_Object desc = Fkey_description (keys, Qnil); 8306 Lisp_Object desc = Fkey_description (keys, Qnil);
8307
8308 if (NILP (orig))
8309 orig = PROP (TOOL_BAR_ITEM_CAPTION);
8310
8307 set_prop (TOOL_BAR_ITEM_HELP, CALLN (Fconcat, orig, beg, desc, end)); 8311 set_prop (TOOL_BAR_ITEM_HELP, CALLN (Fconcat, orig, beg, desc, end));
8308 } 8312 }
8309 8313
diff --git a/src/keymap.c b/src/keymap.c
index 6762915f70c..b1e09a92f20 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3371,12 +3371,10 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3371 3371
3372 if (!keymap_p) 3372 if (!keymap_p)
3373 { 3373 {
3374 /* Call Fkey_description first, to avoid GC bug for the other string. */
3375 if (!NILP (prefix) && XFIXNAT (Flength (prefix)) > 0) 3374 if (!NILP (prefix) && XFIXNAT (Flength (prefix)) > 0)
3376 { 3375 {
3377 Lisp_Object tem = Fkey_description (prefix, Qnil);
3378 AUTO_STRING (space, " "); 3376 AUTO_STRING (space, " ");
3379 elt_prefix = concat2 (tem, space); 3377 elt_prefix = concat2 (Fkey_description (prefix, Qnil), space);
3380 } 3378 }
3381 prefix = Qnil; 3379 prefix = Qnil;
3382 } 3380 }
diff --git a/src/lisp.h b/src/lisp.h
index 56ad99b8e39..a7b19ab576e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2307,7 +2307,7 @@ struct Lisp_Hash_Table
2307 weakness of the table. */ 2307 weakness of the table. */
2308 Lisp_Object weak; 2308 Lisp_Object weak;
2309 2309
2310 /* Vector of hash codes. 2310 /* Vector of hash codes, or nil if the table needs rehashing.
2311 If the I-th entry is unused, then hash[I] should be nil. */ 2311 If the I-th entry is unused, then hash[I] should be nil. */
2312 Lisp_Object hash; 2312 Lisp_Object hash;
2313 2313
@@ -2327,8 +2327,7 @@ struct Lisp_Hash_Table
2327 'index' are special and are either ignored by the GC or traced in 2327 'index' are special and are either ignored by the GC or traced in
2328 a special way (e.g. because of weakness). */ 2328 a special way (e.g. because of weakness). */
2329 2329
2330 /* Number of key/value entries in the table. This number is 2330 /* Number of key/value entries in the table. */
2331 negated if the table needs rehashing. */
2332 ptrdiff_t count; 2331 ptrdiff_t count;
2333 2332
2334 /* Index of first free entry in free list, or -1 if none. */ 2333 /* 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)
2413INLINE ptrdiff_t 2412INLINE ptrdiff_t
2414HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) 2413HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
2415{ 2414{
2416 return ASIZE (h->next); 2415 ptrdiff_t size = ASIZE (h->next);
2416 eassume (0 < size);
2417 return size;
2417} 2418}
2418 2419
2419void hash_table_rehash (struct Lisp_Hash_Table *h); 2420void hash_table_rehash (struct Lisp_Hash_Table *h);
@@ -3614,7 +3615,6 @@ extern void set_default_internal (Lisp_Object, Lisp_Object,
3614extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object); 3615extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
3615extern void syms_of_data (void); 3616extern void syms_of_data (void);
3616extern void swap_in_global_binding (struct Lisp_Symbol *); 3617extern void swap_in_global_binding (struct Lisp_Symbol *);
3617extern Lisp_Object integer_mod (Lisp_Object, Lisp_Object);
3618 3618
3619/* Defined in cmds.c */ 3619/* Defined in cmds.c */
3620extern void syms_of_cmds (void); 3620extern void syms_of_cmds (void);
diff --git a/src/lread.c b/src/lread.c
index 1bfbf5aa865..6ae7a0d8ba0 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1064,18 +1064,13 @@ required.
1064This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) 1064This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1065 (void) 1065 (void)
1066{ 1066{
1067 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext; 1067 Lisp_Object lst = Qnil, suffixes = Vload_suffixes;
1068 while (CONSP (suffixes)) 1068 FOR_EACH_TAIL (suffixes)
1069 { 1069 {
1070 Lisp_Object exts = Vload_file_rep_suffixes; 1070 Lisp_Object exts = Vload_file_rep_suffixes;
1071 suffix = XCAR (suffixes); 1071 Lisp_Object suffix = XCAR (suffixes);
1072 suffixes = XCDR (suffixes); 1072 FOR_EACH_TAIL (exts)
1073 while (CONSP (exts)) 1073 lst = Fcons (concat2 (suffix, XCAR (exts)), lst);
1074 {
1075 ext = XCAR (exts);
1076 exts = XCDR (exts);
1077 lst = Fcons (concat2 (suffix, ext), lst);
1078 }
1079 } 1074 }
1080 return Fnreverse (lst); 1075 return Fnreverse (lst);
1081} 1076}
@@ -1290,8 +1285,8 @@ Return t if the file exists and loads successfully. */)
1290 the general case; the second load may do something different. */ 1285 the general case; the second load may do something different. */
1291 { 1286 {
1292 int load_count = 0; 1287 int load_count = 0;
1293 Lisp_Object tem; 1288 Lisp_Object tem = Vloads_in_progress;
1294 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem)) 1289 FOR_EACH_TAIL_SAFE (tem)
1295 if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3)) 1290 if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
1296 signal_error ("Recursive load", Fcons (found, Vloads_in_progress)); 1291 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1297 record_unwind_protect (record_load_unwind, Vloads_in_progress); 1292 record_unwind_protect (record_load_unwind, Vloads_in_progress);
@@ -1611,7 +1606,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1611 1606
1612 CHECK_STRING (str); 1607 CHECK_STRING (str);
1613 1608
1614 for (tail = suffixes; CONSP (tail); tail = XCDR (tail)) 1609 tail = suffixes;
1610 FOR_EACH_TAIL_SAFE (tail)
1615 { 1611 {
1616 CHECK_STRING_CAR (tail); 1612 CHECK_STRING_CAR (tail);
1617 max_suffix_len = max (max_suffix_len, 1613 max_suffix_len = max (max_suffix_len,
@@ -1625,12 +1621,17 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1625 1621
1626 absolute = complete_filename_p (str); 1622 absolute = complete_filename_p (str);
1627 1623
1624 AUTO_LIST1 (just_use_str, Qnil);
1625 if (NILP (path))
1626 path = just_use_str;
1627
1628 /* Go through all entries in the path and see whether we find the 1628 /* Go through all entries in the path and see whether we find the
1629 executable. */ 1629 executable. */
1630 do { 1630 FOR_EACH_TAIL_SAFE (path)
1631 {
1631 ptrdiff_t baselen, prefixlen; 1632 ptrdiff_t baselen, prefixlen;
1632 1633
1633 if (NILP (path)) 1634 if (EQ (path, just_use_str))
1634 filename = str; 1635 filename = str;
1635 else 1636 else
1636 filename = Fexpand_file_name (str, XCAR (path)); 1637 filename = Fexpand_file_name (str, XCAR (path));
@@ -1663,8 +1664,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1663 memcpy (fn, SDATA (filename) + prefixlen, baselen); 1664 memcpy (fn, SDATA (filename) + prefixlen, baselen);
1664 1665
1665 /* Loop over suffixes. */ 1666 /* Loop over suffixes. */
1666 for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes; 1667 AUTO_LIST1 (empty_string_only, empty_unibyte_string);
1667 CONSP (tail); tail = XCDR (tail)) 1668 tail = NILP (suffixes) ? empty_string_only : suffixes;
1669 FOR_EACH_TAIL_SAFE (tail)
1668 { 1670 {
1669 Lisp_Object suffix = XCAR (tail); 1671 Lisp_Object suffix = XCAR (tail);
1670 ptrdiff_t fnlen, lsuffix = SBYTES (suffix); 1672 ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
@@ -1808,10 +1810,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1808 } 1810 }
1809 } 1811 }
1810 } 1812 }
1811 if (absolute || NILP (path)) 1813 if (absolute)
1812 break; 1814 break;
1813 path = XCDR (path); 1815 }
1814 } while (CONSP (path));
1815 1816
1816 SAFE_FREE (); 1817 SAFE_FREE ();
1817 errno = last_errno; 1818 errno = last_errno;
@@ -1838,7 +1839,7 @@ build_load_history (Lisp_Object filename, bool entire)
1838 tail = Vload_history; 1839 tail = Vload_history;
1839 prev = Qnil; 1840 prev = Qnil;
1840 1841
1841 while (CONSP (tail)) 1842 FOR_EACH_TAIL (tail)
1842 { 1843 {
1843 tem = XCAR (tail); 1844 tem = XCAR (tail);
1844 1845
@@ -1861,22 +1862,19 @@ build_load_history (Lisp_Object filename, bool entire)
1861 { 1862 {
1862 tem2 = Vcurrent_load_list; 1863 tem2 = Vcurrent_load_list;
1863 1864
1864 while (CONSP (tem2)) 1865 FOR_EACH_TAIL (tem2)
1865 { 1866 {
1866 newelt = XCAR (tem2); 1867 newelt = XCAR (tem2);
1867 1868
1868 if (NILP (Fmember (newelt, tem))) 1869 if (NILP (Fmember (newelt, tem)))
1869 Fsetcar (tail, Fcons (XCAR (tem), 1870 Fsetcar (tail, Fcons (XCAR (tem),
1870 Fcons (newelt, XCDR (tem)))); 1871 Fcons (newelt, XCDR (tem))));
1871
1872 tem2 = XCDR (tem2);
1873 maybe_quit (); 1872 maybe_quit ();
1874 } 1873 }
1875 } 1874 }
1876 } 1875 }
1877 else 1876 else
1878 prev = tail; 1877 prev = tail;
1879 tail = XCDR (tail);
1880 maybe_quit (); 1878 maybe_quit ();
1881 } 1879 }
1882 1880
@@ -1918,10 +1916,9 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
1918 if (EQ (CAR_SAFE (val), Qprogn)) 1916 if (EQ (CAR_SAFE (val), Qprogn))
1919 { 1917 {
1920 Lisp_Object subforms = XCDR (val); 1918 Lisp_Object subforms = XCDR (val);
1921 1919 val = Qnil;
1922 for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms)) 1920 FOR_EACH_TAIL (subforms)
1923 val = readevalloop_eager_expand_eval (XCAR (subforms), 1921 val = readevalloop_eager_expand_eval (XCAR (subforms), macroexpand);
1924 macroexpand);
1925 } 1922 }
1926 else 1923 else
1927 val = eval_sub (call2 (macroexpand, val, Qt)); 1924 val = eval_sub (call2 (macroexpand, val, Qt));
@@ -2588,7 +2585,8 @@ read_escape (Lisp_Object readcharfun, bool stringp)
2588 want. */ 2585 want. */
2589 int digit = char_hexdigit (c); 2586 int digit = char_hexdigit (c);
2590 if (digit < 0) 2587 if (digit < 0)
2591 error ("Non-hex digit used for Unicode escape"); 2588 error ("Non-hex character used for Unicode escape: %c (%d)",
2589 c, c);
2592 i = (i << 4) + digit; 2590 i = (i << 4) + digit;
2593 } 2591 }
2594 if (i > 0x10FFFF) 2592 if (i > 0x10FFFF)
@@ -2861,16 +2859,19 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2861 /* Now use params to make a new hash table and fill it. */ 2859 /* Now use params to make a new hash table and fill it. */
2862 ht = Fmake_hash_table (param_count, params); 2860 ht = Fmake_hash_table (param_count, params);
2863 2861
2864 while (CONSP (data)) 2862 Lisp_Object last = data;
2865 { 2863 FOR_EACH_TAIL_SAFE (data)
2864 {
2866 key = XCAR (data); 2865 key = XCAR (data);
2867 data = XCDR (data); 2866 data = XCDR (data);
2868 if (!CONSP (data)) 2867 if (!CONSP (data))
2869 error ("Odd number of elements in hash table data"); 2868 break;
2870 val = XCAR (data); 2869 val = XCAR (data);
2871 data = XCDR (data); 2870 last = XCDR (data);
2872 Fputhash (key, val, ht); 2871 Fputhash (key, val, ht);
2873 } 2872 }
2873 if (!NILP (last))
2874 error ("Hash table data is not a list of even length");
2874 2875
2875 return ht; 2876 return ht;
2876 } 2877 }
diff --git a/src/mini-gmp.c b/src/mini-gmp.c
index 88b71c3f9a6..e92e7cf9c72 100644
--- a/src/mini-gmp.c
+++ b/src/mini-gmp.c
@@ -2,7 +2,7 @@
2 2
3 Contributed to the GNU project by Niels Möller 3 Contributed to the GNU project by Niels Möller
4 4
5Copyright 1991-1997, 1999-2018 Free Software Foundation, Inc. 5Copyright 1991-1997, 1999-2019 Free Software Foundation, Inc.
6 6
7This file is part of the GNU MP Library. 7This file is part of the GNU MP Library.
8 8
@@ -295,7 +295,7 @@ gmp_default_alloc (size_t size)
295} 295}
296 296
297static void * 297static void *
298gmp_default_realloc (void *old, size_t old_size, size_t new_size) 298gmp_default_realloc (void *old, size_t unused_old_size, size_t new_size)
299{ 299{
300 void * p; 300 void * p;
301 301
@@ -308,7 +308,7 @@ gmp_default_realloc (void *old, size_t old_size, size_t new_size)
308} 308}
309 309
310static void 310static void
311gmp_default_free (void *p, size_t size) 311gmp_default_free (void *p, size_t unused_size)
312{ 312{
313 free (p); 313 free (p);
314} 314}
@@ -1595,7 +1595,7 @@ mpz_get_ui (const mpz_t u)
1595 int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; 1595 int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS;
1596 unsigned long r = 0; 1596 unsigned long r = 0;
1597 mp_size_t n = GMP_ABS (u->_mp_size); 1597 mp_size_t n = GMP_ABS (u->_mp_size);
1598 n = GMP_MIN (n, 1 + (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS); 1598 n = GMP_MIN (n, 1 + (mp_size_t) (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS);
1599 while (--n >= 0) 1599 while (--n >= 0)
1600 r = (r << LOCAL_GMP_LIMB_BITS) + u->_mp_d[n]; 1600 r = (r << LOCAL_GMP_LIMB_BITS) + u->_mp_d[n];
1601 return r; 1601 return r;
@@ -3499,7 +3499,7 @@ gmp_stronglucas (const mpz_t x, mpz_t Qk)
3499 b0 = mpz_scan0 (n, 0); 3499 b0 = mpz_scan0 (n, 0);
3500 3500
3501 /* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */ 3501 /* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */
3502 Q = (D & 2) ? (D >> 2) + 1 : -(long) (D >> 2); 3502 Q = (D & 2) ? (long) (D >> 2) + 1 : -(long) (D >> 2);
3503 3503
3504 if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */ 3504 if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */
3505 while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */ 3505 while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */
diff --git a/src/minibuf.c b/src/minibuf.c
index 14a0dbe762c..f6cf47f1f28 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -169,7 +169,8 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
169 { 169 {
170 int c = SREF (val, i); 170 int c = SREF (val, i);
171 if (c != ' ' && c != '\t' && c != '\n') 171 if (c != ' ' && c != '\t' && c != '\n')
172 error ("Trailing garbage following expression"); 172 xsignal1 (Qinvalid_read_syntax,
173 build_string ("Trailing garbage following expression"));
173 } 174 }
174 } 175 }
175 176
diff --git a/src/pdumper.c b/src/pdumper.c
index 326a346a632..98090238b1a 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/>. */
105# define VM_SUPPORTED 0 105# define VM_SUPPORTED 0
106#endif 106#endif
107 107
108#define DANGEROUS 0
109
110/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to 108/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to
111 check, for each hash table it dumps, that the hash table means the 109 check, for each hash table it dumps, that the hash table means the
112 same thing after rehashing. */ 110 same thing after rehashing. */
@@ -129,7 +127,11 @@ verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object));
129verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT)); 127verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT));
130verify (CHAR_BIT == 8); 128verify (CHAR_BIT == 8);
131 129
132#define DIVIDE_ROUND_UP(x, y) (((x) + (y) - 1) / (y)) 130static size_t
131divide_round_up (size_t x, size_t y)
132{
133 return (x + y - 1) / y;
134}
133 135
134static const char dump_magic[16] = { 136static const char dump_magic[16] = {
135 'D', 'U', 'M', 'P', 'E', 'D', 137 'D', 'U', 'M', 'P', 'E', 'D',
@@ -235,9 +237,12 @@ enum emacs_reloc_type
235 RELOC_EMACS_EMACS_LV, 237 RELOC_EMACS_EMACS_LV,
236 }; 238 };
237 239
238#define EMACS_RELOC_TYPE_BITS 3 240enum
239#define EMACS_RELOC_LENGTH_BITS \ 241 {
240 (sizeof (dump_off) * CHAR_BIT - EMACS_RELOC_TYPE_BITS) 242 EMACS_RELOC_TYPE_BITS = 3,
243 EMACS_RELOC_LENGTH_BITS = (sizeof (dump_off) * CHAR_BIT
244 - EMACS_RELOC_TYPE_BITS)
245 };
241 246
242struct emacs_reloc 247struct emacs_reloc
243{ 248{
@@ -274,19 +279,22 @@ struct dump_table_locator
274 dump_off nr_entries; 279 dump_off nr_entries;
275}; 280};
276 281
277#define DUMP_RELOC_TYPE_BITS 5 282enum
278verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS)); 283 {
284 DUMP_RELOC_TYPE_BITS = 5,
285 DUMP_RELOC_ALIGNMENT_BITS = 2,
279 286
280#define DUMP_RELOC_ALIGNMENT_BITS 2 287 /* Minimum alignment required by dump file format. */
281#define DUMP_RELOC_OFFSET_BITS \ 288 DUMP_RELOCATION_ALIGNMENT = 1 << DUMP_RELOC_ALIGNMENT_BITS,
282 (sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS)
283 289
284/* Minimum alignment required by dump file format. */ 290 /* The alignment granularity (in bytes) for objects we store in the
285#define DUMP_RELOCATION_ALIGNMENT (1<<DUMP_RELOC_ALIGNMENT_BITS) 291 dump. Always suitable for heap objects; may be more aligned. */
292 DUMP_ALIGNMENT = max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT),
293
294 DUMP_RELOC_OFFSET_BITS = sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS
295 };
286 296
287/* The alignment granularity (in bytes) for objects we store in the 297verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS));
288 dump. Always suitable for heap objects; may be more aligned. */
289#define DUMP_ALIGNMENT (max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT))
290verify (DUMP_ALIGNMENT >= GCALIGNMENT); 298verify (DUMP_ALIGNMENT >= GCALIGNMENT);
291 299
292struct dump_reloc 300struct dump_reloc
@@ -572,23 +580,17 @@ enum dump_object_special_offset
572 }; 580 };
573 581
574/* Weights for score scores for object non-locality. */ 582/* Weights for score scores for object non-locality. */
575enum link_weight_enum
576 {
577 WEIGHT_NONE_VALUE = 0,
578 WEIGHT_NORMAL_VALUE = 1000,
579 WEIGHT_STRONG_VALUE = 1200,
580 };
581 583
582struct link_weight 584struct link_weight
583{ 585{
584 /* Wrapped in a struct to break unwanted implicit conversion. */ 586 /* Wrapped in a struct to break unwanted implicit conversion. */
585 enum link_weight_enum value; 587 int value;
586}; 588};
587 589
588#define LINK_WEIGHT_LITERAL(x) ((struct link_weight){.value=(x)}) 590static struct link_weight const
589#define WEIGHT_NONE LINK_WEIGHT_LITERAL (WEIGHT_NONE_VALUE) 591 WEIGHT_NONE = { .value = 0 },
590#define WEIGHT_NORMAL LINK_WEIGHT_LITERAL (WEIGHT_NORMAL_VALUE) 592 WEIGHT_NORMAL = { .value = 1000 },
591#define WEIGHT_STRONG LINK_WEIGHT_LITERAL (WEIGHT_STRONG_VALUE) 593 WEIGHT_STRONG = { .value = 1200 };
592 594
593 595
594/* Dump file creation */ 596/* Dump file creation */
@@ -628,35 +630,27 @@ dump_set_have_current_referrer (struct dump_context *ctx, bool have)
628#endif 630#endif
629} 631}
630 632
631/* Remember the reason objects are enqueued. 633/* Return true if if objects should be enqueued in CTX to refer to an
634 object that the caller should store into CTX->current_referrer.
632 635
633 Until DUMP_CLEAR_REFERRER is called, any objects enqueued are being 636 Until dump_clear_referrer is called, any objects enqueued are being
634 enqueued because OBJECT refers to them. It is not legal to enqueue 637 enqueued because the object refers to them. It is not valid to
635 objects without a referer set. We check this constraint 638 enqueue objects without a referrer set. We check this constraint
636 at runtime. 639 at runtime.
637 640
638 It is illegal to call DUMP_SET_REFERRER twice without an 641 It is invalid to call dump_set_referrer twice without an
639 intervening call to DUMP_CLEAR_REFERRER. 642 intervening call to dump_clear_referrer. */
640 643static bool
641 Define as a macro so we can avoid evaluating OBJECT 644dump_set_referrer (struct dump_context *ctx)
642 if we dont want referrer tracking. */ 645{
643#define DUMP_SET_REFERRER(ctx, object) \ 646 eassert (!ctx->have_current_referrer);
644 do \ 647 dump_set_have_current_referrer (ctx, true);
645 { \ 648 return dump_tracking_referrers_p (ctx);
646 struct dump_context *_ctx = (ctx); \ 649}
647 eassert (!_ctx->have_current_referrer); \ 650
648 dump_set_have_current_referrer (_ctx, true); \ 651/* Unset the referrer that dump_set_referrer prepared for. */
649 if (dump_tracking_referrers_p (_ctx)) \
650 ctx->current_referrer = (object); \
651 } \
652 while (0)
653
654/* Unset the referer that DUMP_SET_REFERRER set.
655
656 Named with upper-case letters for symmetry with
657 DUMP_SET_REFERRER. */
658static void 652static void
659DUMP_CLEAR_REFERRER (struct dump_context *ctx) 653dump_clear_referrer (struct dump_context *ctx)
660{ 654{
661 eassert (ctx->have_current_referrer); 655 eassert (ctx->have_current_referrer);
662 dump_set_have_current_referrer (ctx, false); 656 dump_set_have_current_referrer (ctx, false);
@@ -732,34 +726,36 @@ dump_object_self_representing_p (Lisp_Object object)
732 return FIXNUMP (object) || dump_builtin_symbol_p (object); 726 return FIXNUMP (object) || dump_builtin_symbol_p (object);
733} 727}
734 728
735#define DEFINE_FROMLISP_FUNC(fn, type) \ 729static intmax_t
736 static type \ 730intmax_t_from_lisp (Lisp_Object value)
737 fn (Lisp_Object value) \ 731{
738 { \ 732 intmax_t n;
739 ALLOW_IMPLICIT_CONVERSION; \ 733 bool ok = integer_to_intmax (value, &n);
740 if (FIXNUMP (value)) \ 734 eassert (ok);
741 return XFIXNUM (value); \ 735 return n;
742 eassert (BIGNUMP (value)); \ 736}
743 type result; \
744 if (TYPE_SIGNED (type)) \
745 result = bignum_to_intmax (value); \
746 else \
747 result = bignum_to_uintmax (value); \
748 DISALLOW_IMPLICIT_CONVERSION; \
749 return result; \
750 }
751 737
752#define DEFINE_TOLISP_FUNC(fn, type) \ 738static Lisp_Object
753 static Lisp_Object \ 739intmax_t_to_lisp (intmax_t value)
754 fn (type value) \ 740{
755 { \ 741 return INT_TO_INTEGER (value);
756 return INT_TO_INTEGER (value); \ 742}
757 } 743
744static dump_off
745dump_off_from_lisp (Lisp_Object value)
746{
747 intmax_t n = intmax_t_from_lisp (value);
748 eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX);
749 ALLOW_IMPLICIT_CONVERSION;
750 return n;
751 DISALLOW_IMPLICIT_CONVERSION;
752}
758 753
759DEFINE_FROMLISP_FUNC (intmax_t_from_lisp, intmax_t) 754static Lisp_Object
760DEFINE_TOLISP_FUNC (intmax_t_to_lisp, intmax_t) 755dump_off_to_lisp (dump_off value)
761DEFINE_FROMLISP_FUNC (dump_off_from_lisp, dump_off) 756{
762DEFINE_TOLISP_FUNC (dump_off_to_lisp, dump_off) 757 return INT_TO_INTEGER (value);
758}
763 759
764static void 760static void
765dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte) 761dump_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,
1731 eassert (dump_builtin_symbol_p (value)); 1727 eassert (dump_builtin_symbol_p (value));
1732 /* Remember to dump the object itself later along with all the 1728 /* Remember to dump the object itself later along with all the
1733 rest of the copied-to-Emacs objects. */ 1729 rest of the copied-to-Emacs objects. */
1734 DUMP_SET_REFERRER (ctx, build_string ("built-in symbol list")); 1730 if (dump_set_referrer (ctx))
1731 ctx->current_referrer = build_string ("built-in symbol list");
1735 dump_enqueue_object (ctx, value, WEIGHT_NONE); 1732 dump_enqueue_object (ctx, value, WEIGHT_NONE);
1736 DUMP_CLEAR_REFERRER (ctx); 1733 dump_clear_referrer (ctx);
1737 } 1734 }
1738 else 1735 else
1739 { 1736 {
@@ -1743,9 +1740,11 @@ dump_root_visitor (Lisp_Object const *root_ptr, enum gc_root_type type,
1743 ctx->staticpro_table); 1740 ctx->staticpro_table);
1744 if (root_ptr != &Vinternal_interpreter_environment) 1741 if (root_ptr != &Vinternal_interpreter_environment)
1745 { 1742 {
1746 DUMP_SET_REFERRER (ctx, dump_ptr_referrer ("emacs root", root_ptr)); 1743 if (dump_set_referrer (ctx))
1744 ctx->current_referrer
1745 = dump_ptr_referrer ("emacs root", root_ptr);
1747 dump_emacs_reloc_to_lv (ctx, root_ptr, *root_ptr); 1746 dump_emacs_reloc_to_lv (ctx, root_ptr, *root_ptr);
1748 DUMP_CLEAR_REFERRER (ctx); 1747 dump_clear_referrer (ctx);
1749 } 1748 }
1750 } 1749 }
1751} 1750}
@@ -1759,7 +1758,7 @@ dump_roots (struct dump_context *ctx)
1759 visit_static_gc_roots (visitor); 1758 visit_static_gc_roots (visitor);
1760} 1759}
1761 1760
1762#define PDUMPER_MAX_OBJECT_SIZE 2048 1761enum { PDUMPER_MAX_OBJECT_SIZE = 2048 };
1763 1762
1764static dump_off 1763static dump_off
1765field_relpos (const void *in_start, const void *in_field) 1764field_relpos (const void *in_start, const void *in_field)
@@ -1788,11 +1787,7 @@ cpyptr (void *out, const void *in)
1788 1787
1789/* Convenience macro for regular assignment. */ 1788/* Convenience macro for regular assignment. */
1790#define DUMP_FIELD_COPY(out, in, name) \ 1789#define DUMP_FIELD_COPY(out, in, name) \
1791 do \ 1790 ((out)->name = (in)->name)
1792 { \
1793 (out)->name = (in)->name; \
1794 } \
1795 while (0)
1796 1791
1797static void 1792static void
1798dump_field_lv_or_rawptr (struct dump_context *ctx, 1793dump_field_lv_or_rawptr (struct dump_context *ctx,
@@ -1848,6 +1843,7 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
1848 intptr_t out_value; 1843 intptr_t out_value;
1849 dump_off out_field_offset = ctx->obj_offset + relpos; 1844 dump_off out_field_offset = ctx->obj_offset + relpos;
1850 dump_off target_offset = dump_recall_object (ctx, value); 1845 dump_off target_offset = dump_recall_object (ctx, value);
1846 enum { DANGEROUS = false };
1851 if (DANGEROUS 1847 if (DANGEROUS
1852 && target_offset > 0 && dump_object_emacs_ptr (value) == NULL) 1848 && target_offset > 0 && dump_object_emacs_ptr (value) == NULL)
1853 { 1849 {
@@ -2211,7 +2207,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object)
2211 const struct Lisp_Bignum *bignum = XBIGNUM (object); 2207 const struct Lisp_Bignum *bignum = XBIGNUM (object);
2212 START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out); 2208 START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out);
2213 verify (sizeof (out->value) >= sizeof (struct bignum_reload_info)); 2209 verify (sizeof (out->value) >= sizeof (struct bignum_reload_info));
2214 dump_field_fixup_later (ctx, out, bignum, &bignum->value); 2210 dump_field_fixup_later (ctx, out, bignum, xbignum_val (object));
2215 dump_off bignum_offset = finish_dump_pvec (ctx, &out->header); 2211 dump_off bignum_offset = finish_dump_pvec (ctx, &out->header);
2216 if (ctx->flags.dump_object_contents) 2212 if (ctx->flags.dump_object_contents)
2217 { 2213 {
@@ -2408,7 +2404,8 @@ dump_pre_dump_symbol (struct dump_context *ctx, struct Lisp_Symbol *symbol)
2408{ 2404{
2409 Lisp_Object symbol_lv = make_lisp_symbol (symbol); 2405 Lisp_Object symbol_lv = make_lisp_symbol (symbol);
2410 eassert (!dump_recall_symbol_aux (ctx, symbol_lv)); 2406 eassert (!dump_recall_symbol_aux (ctx, symbol_lv));
2411 DUMP_SET_REFERRER (ctx, symbol_lv); 2407 if (dump_set_referrer (ctx))
2408 ctx->current_referrer = symbol_lv;
2412 switch (symbol->u.s.redirect) 2409 switch (symbol->u.s.redirect)
2413 { 2410 {
2414 case SYMBOL_LOCALIZED: 2411 case SYMBOL_LOCALIZED:
@@ -2422,7 +2419,7 @@ dump_pre_dump_symbol (struct dump_context *ctx, struct Lisp_Symbol *symbol)
2422 default: 2419 default:
2423 break; 2420 break;
2424 } 2421 }
2425 DUMP_CLEAR_REFERRER (ctx); 2422 dump_clear_referrer (ctx);
2426} 2423}
2427 2424
2428static dump_off 2425static dump_off
@@ -2443,13 +2440,14 @@ dump_symbol (struct dump_context *ctx,
2443 { 2440 {
2444 eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE 2441 eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
2445 || offset == DUMP_OBJECT_NOT_SEEN); 2442 || offset == DUMP_OBJECT_NOT_SEEN);
2446 DUMP_CLEAR_REFERRER (ctx); 2443 dump_clear_referrer (ctx);
2447 struct dump_flags old_flags = ctx->flags; 2444 struct dump_flags old_flags = ctx->flags;
2448 ctx->flags.dump_object_contents = false; 2445 ctx->flags.dump_object_contents = false;
2449 ctx->flags.defer_symbols = false; 2446 ctx->flags.defer_symbols = false;
2450 dump_object (ctx, object); 2447 dump_object (ctx, object);
2451 ctx->flags = old_flags; 2448 ctx->flags = old_flags;
2452 DUMP_SET_REFERRER (ctx, object); 2449 if (dump_set_referrer (ctx))
2450 ctx->current_referrer = object;
2453 2451
2454 offset = DUMP_OBJECT_ON_SYMBOL_QUEUE; 2452 offset = DUMP_OBJECT_ON_SYMBOL_QUEUE;
2455 dump_remember_object (ctx, object, offset); 2453 dump_remember_object (ctx, object, offset);
@@ -2696,7 +2694,7 @@ dump_hash_table (struct dump_context *ctx,
2696 Lisp_Object object, 2694 Lisp_Object object,
2697 dump_off offset) 2695 dump_off offset)
2698{ 2696{
2699#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_BB1ACF756E 2697#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_12AFBF47AF
2700# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." 2698# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
2701#endif 2699#endif
2702 const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); 2700 const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
@@ -3118,7 +3116,8 @@ dump_object (struct dump_context *ctx, Lisp_Object object)
3118 } 3116 }
3119 3117
3120 /* Object needs to be dumped. */ 3118 /* Object needs to be dumped. */
3121 DUMP_SET_REFERRER (ctx, object); 3119 if (dump_set_referrer (ctx))
3120 ctx->current_referrer = object;
3122 switch (XTYPE (object)) 3121 switch (XTYPE (object))
3123 { 3122 {
3124 case Lisp_String: 3123 case Lisp_String:
@@ -3142,7 +3141,7 @@ dump_object (struct dump_context *ctx, Lisp_Object object)
3142 default: 3141 default:
3143 emacs_abort (); 3142 emacs_abort ();
3144 } 3143 }
3145 DUMP_CLEAR_REFERRER (ctx); 3144 dump_clear_referrer (ctx);
3146 3145
3147 /* offset can be < 0 if we've deferred an object. */ 3146 /* offset can be < 0 if we've deferred an object. */
3148 if (ctx->flags.dump_object_contents && offset > DUMP_OBJECT_NOT_SEEN) 3147 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)
3397static void 3396static void
3398dump_cold_bignum (struct dump_context *ctx, Lisp_Object object) 3397dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
3399{ 3398{
3400 const struct Lisp_Bignum *bignum = XBIGNUM (object); 3399 mpz_t const *n = xbignum_val (object);
3401 size_t sz_nlimbs = mpz_size (bignum->value); 3400 size_t sz_nlimbs = mpz_size (*n);
3402 eassert (sz_nlimbs < DUMP_OFF_MAX); 3401 eassert (sz_nlimbs < DUMP_OFF_MAX);
3403 dump_align_output (ctx, alignof (mp_limb_t)); 3402 dump_align_output (ctx, alignof (mp_limb_t));
3404 dump_off nlimbs = (dump_off) sz_nlimbs; 3403 dump_off nlimbs = (dump_off) sz_nlimbs;
3405 Lisp_Object descriptor 3404 Lisp_Object descriptor
3406 = list2 (dump_off_to_lisp (ctx->offset), 3405 = list2 (dump_off_to_lisp (ctx->offset),
3407 dump_off_to_lisp ((mpz_sgn (bignum->value) < 0 3406 dump_off_to_lisp (mpz_sgn (*n) < 0 ? -nlimbs : nlimbs));
3408 ? -nlimbs : nlimbs)));
3409 Fputhash (object, descriptor, ctx->bignum_data); 3407 Fputhash (object, descriptor, ctx->bignum_data);
3410 for (mp_size_t i = 0; i < nlimbs; ++i) 3408 for (mp_size_t i = 0; i < nlimbs; ++i)
3411 { 3409 {
3412 mp_limb_t limb = mpz_getlimbn (bignum->value, i); 3410 mp_limb_t limb = mpz_getlimbn (*n, i);
3413 dump_write (ctx, &limb, sizeof (limb)); 3411 dump_write (ctx, &limb, sizeof (limb));
3414 } 3412 }
3415} 3413}
@@ -3508,9 +3506,10 @@ dump_drain_user_remembered_data_hot (struct dump_context *ctx)
3508 read_ptr_raw_and_lv (mem, type, &value, &lv); 3506 read_ptr_raw_and_lv (mem, type, &value, &lv);
3509 if (value != NULL) 3507 if (value != NULL)
3510 { 3508 {
3511 DUMP_SET_REFERRER (ctx, dump_ptr_referrer ("user data", mem)); 3509 if (dump_set_referrer (ctx))
3510 ctx->current_referrer = dump_ptr_referrer ("user data", mem);
3512 dump_enqueue_object (ctx, lv, WEIGHT_NONE); 3511 dump_enqueue_object (ctx, lv, WEIGHT_NONE);
3513 DUMP_CLEAR_REFERRER (ctx); 3512 dump_clear_referrer (ctx);
3514 } 3513 }
3515 } 3514 }
3516 } 3515 }
@@ -4735,7 +4734,7 @@ dump_mmap_release_vm (struct dump_memory_map *map)
4735static bool 4734static bool
4736needs_mmap_retry_p (void) 4735needs_mmap_retry_p (void)
4737{ 4736{
4738#if defined (CYGWIN) || VM_SUPPORTED == VM_MS_WINDOWS 4737#if defined CYGWIN || VM_SUPPORTED == VM_MS_WINDOWS || defined _AIX
4739 return true; 4738 return true;
4740#else 4739#else
4741 return false; 4740 return false;
@@ -4878,7 +4877,7 @@ dump_bitset_init (struct dump_bitset *bitset, size_t number_bits)
4878{ 4877{
4879 int xword_size = sizeof (bitset->bits[0]); 4878 int xword_size = sizeof (bitset->bits[0]);
4880 int bits_per_word = xword_size * CHAR_BIT; 4879 int bits_per_word = xword_size * CHAR_BIT;
4881 ptrdiff_t words_needed = DIVIDE_ROUND_UP (number_bits, bits_per_word); 4880 ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
4882 bitset->number_words = words_needed; 4881 bitset->number_words = words_needed;
4883 bitset->bits = calloc (words_needed, xword_size); 4882 bitset->bits = calloc (words_needed, xword_size);
4884 return bitset->bits != NULL; 4883 return bitset->bits != NULL;
@@ -5058,7 +5057,7 @@ pdumper_cold_object_p_impl (const void *obj)
5058 return offset >= dump_private.header.cold_start; 5057 return offset >= dump_private.header.cold_start;
5059} 5058}
5060 5059
5061enum Lisp_Type 5060int
5062pdumper_find_object_type_impl (const void *obj) 5061pdumper_find_object_type_impl (const void *obj)
5063{ 5062{
5064 eassert (pdumper_object_p (obj)); 5063 eassert (pdumper_object_p (obj));
@@ -5068,7 +5067,7 @@ pdumper_find_object_type_impl (const void *obj)
5068 const struct dump_reloc *reloc = 5067 const struct dump_reloc *reloc =
5069 dump_find_relocation (&dump_private.header.object_starts, offset); 5068 dump_find_relocation (&dump_private.header.object_starts, offset);
5070 return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset) 5069 return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
5071 ? (enum Lisp_Type) reloc->type 5070 ? reloc->type
5072 : PDUMPER_NO_OBJECT; 5071 : PDUMPER_NO_OBJECT;
5073} 5072}
5074 5073
@@ -5205,8 +5204,8 @@ dump_do_dump_relocation (const uintptr_t dump_base,
5205 { 5204 {
5206 struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset); 5205 struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset);
5207 struct bignum_reload_info reload_info; 5206 struct bignum_reload_info reload_info;
5208 verify (sizeof (reload_info) <= sizeof (bignum->value)); 5207 verify (sizeof (reload_info) <= sizeof (*bignum_val (bignum)));
5209 memcpy (&reload_info, &bignum->value, sizeof (reload_info)); 5208 memcpy (&reload_info, bignum_val (bignum), sizeof (reload_info));
5210 const mp_limb_t *limbs = 5209 const mp_limb_t *limbs =
5211 dump_ptr (dump_base, reload_info.data_location); 5210 dump_ptr (dump_base, reload_info.data_location);
5212 mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs); 5211 mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs);
@@ -5421,7 +5420,7 @@ pdumper_load (const char *dump_filename)
5421 5420
5422 err = PDUMPER_LOAD_ERROR; 5421 err = PDUMPER_LOAD_ERROR;
5423 mark_bits_needed = 5422 mark_bits_needed =
5424 DIVIDE_ROUND_UP (header->discardable_start, DUMP_ALIGNMENT); 5423 divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
5425 if (!dump_bitset_init (&mark_bits, mark_bits_needed)) 5424 if (!dump_bitset_init (&mark_bits, mark_bits_needed))
5426 goto out; 5425 goto out;
5427 5426
diff --git a/src/pdumper.h b/src/pdumper.h
index 5d1e9c3aea3..83c094f3caa 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/>. */
24 24
25INLINE_HEADER_BEGIN 25INLINE_HEADER_BEGIN
26 26
27#define PDUMPER_NO_OBJECT ((enum Lisp_Type) -1) 27enum { PDUMPER_NO_OBJECT = -1 };
28 28
29/* Indicate in source code that we're deliberately relying on pdumper 29/* Indicate in source code that we're deliberately relying on pdumper
30 not preserving the given value. Compiles to nothing --- for humans 30 not preserving the given value. Compiles to nothing --- for humans
@@ -170,12 +170,12 @@ pdumper_cold_object_p (const void *obj)
170} 170}
171 171
172 172
173extern enum Lisp_Type pdumper_find_object_type_impl (const void *obj); 173extern int pdumper_find_object_type_impl (const void *obj);
174 174
175/* Return the type of the dumped object that starts at OBJ. It is a 175/* Return the type of the dumped object that starts at OBJ. It is a
176 programming error to call this routine for an OBJ for which 176 programming error to call this routine for an OBJ for which
177 pdumper_object_p would return false. */ 177 pdumper_object_p would return false. */
178INLINE _GL_ATTRIBUTE_CONST enum Lisp_Type 178INLINE _GL_ATTRIBUTE_CONST int
179pdumper_find_object_type (const void *obj) 179pdumper_find_object_type (const void *obj)
180{ 180{
181#ifdef HAVE_PDUMPER 181#ifdef HAVE_PDUMPER
@@ -186,6 +186,14 @@ pdumper_find_object_type (const void *obj)
186#endif 186#endif
187} 187}
188 188
189/* Return true if TYPE is that of a Lisp object.
190 PDUMPER_NO_OBJECT is invalid. */
191INLINE bool
192pdumper_valid_object_type_p (int type)
193{
194 return 0 <= type;
195}
196
189/* Return whether OBJ points exactly to the start of some object in 197/* Return whether OBJ points exactly to the start of some object in
190 the loaded dump image. It is a programming error to call this 198 the loaded dump image. It is a programming error to call this
191 routine for an OBJ for which pdumper_object_p would return 199 routine for an OBJ for which pdumper_object_p would return
@@ -194,7 +202,7 @@ INLINE _GL_ATTRIBUTE_CONST bool
194pdumper_object_p_precise (const void *obj) 202pdumper_object_p_precise (const void *obj)
195{ 203{
196#ifdef HAVE_PDUMPER 204#ifdef HAVE_PDUMPER
197 return pdumper_find_object_type (obj) != PDUMPER_NO_OBJECT; 205 return pdumper_valid_object_type_p (pdumper_find_object_type (obj));
198#else 206#else
199 (void) obj; 207 (void) obj;
200 emacs_abort (); 208 emacs_abort ();
diff --git a/src/process.c b/src/process.c
index 066edbc83d6..372277a953d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -276,6 +276,10 @@ static int read_process_output (Lisp_Object, int);
276static void create_pty (Lisp_Object); 276static void create_pty (Lisp_Object);
277static void exec_sentinel (Lisp_Object, Lisp_Object); 277static void exec_sentinel (Lisp_Object, Lisp_Object);
278 278
279static Lisp_Object
280network_lookup_address_info_1 (Lisp_Object host, const char *service,
281 struct addrinfo *hints, struct addrinfo **res);
282
279/* Number of bits set in connect_wait_mask. */ 283/* Number of bits set in connect_wait_mask. */
280static int num_pending_connects; 284static int num_pending_connects;
281 285
@@ -4106,7 +4110,7 @@ usage: (make-network-process &rest ARGS) */)
4106 if (!NILP (host)) 4110 if (!NILP (host))
4107 { 4111 {
4108 struct addrinfo *res, *lres; 4112 struct addrinfo *res, *lres;
4109 int ret; 4113 Lisp_Object msg;
4110 4114
4111 maybe_quit (); 4115 maybe_quit ();
4112 4116
@@ -4115,20 +4119,9 @@ usage: (make-network-process &rest ARGS) */)
4115 hints.ai_family = family; 4119 hints.ai_family = family;
4116 hints.ai_socktype = socktype; 4120 hints.ai_socktype = socktype;
4117 4121
4118 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res); 4122 msg = network_lookup_address_info_1 (host, portstring, &hints, &res);
4119 if (ret) 4123 if (!EQ (msg, Qt))
4120#ifdef HAVE_GAI_STRERROR 4124 error ("%s", SSDATA (msg));
4121 {
4122 synchronize_system_messages_locale ();
4123 char const *str = gai_strerror (ret);
4124 if (! NILP (Vlocale_coding_system))
4125 str = SSDATA (code_convert_string_norecord
4126 (build_string (str), Vlocale_coding_system, 0));
4127 error ("%s/%s %s", SSDATA (host), portstring, str);
4128 }
4129#else
4130 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4131#endif
4132 4125
4133 for (lres = res; lres; lres = lres->ai_next) 4126 for (lres = res; lres; lres = lres->ai_next)
4134 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); 4127 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
@@ -4576,6 +4569,86 @@ Data that is unavailable is returned as nil. */)
4576#endif 4569#endif
4577} 4570}
4578 4571
4572static Lisp_Object
4573network_lookup_address_info_1 (Lisp_Object host, const char *service,
4574 struct addrinfo *hints, struct addrinfo **res)
4575{
4576 Lisp_Object msg = Qt;
4577 int ret;
4578
4579 if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
4580 error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
4581 SSDATA (host));
4582 ret = getaddrinfo (SSDATA (host), service, hints, res);
4583 if (ret)
4584 {
4585 if (service == NULL)
4586 service = "0";
4587#ifdef HAVE_GAI_STRERROR
4588 synchronize_system_messages_locale ();
4589 char const *str = gai_strerror (ret);
4590 if (! NILP (Vlocale_coding_system))
4591 str = SSDATA (code_convert_string_norecord
4592 (build_string (str), Vlocale_coding_system, 0));
4593 AUTO_STRING (format, "%s/%s %s");
4594 msg = CALLN (Fformat, format, host, build_string (service),
4595 build_string (str));
4596#else
4597 AUTO_STRING (format, "%s/%s getaddrinfo error %d");
4598 msg = CALLN (Fformat, format, host, build_string (service),
4599 make_int (ret));
4600#endif
4601 }
4602 return msg;
4603}
4604
4605DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
4606 Snetwork_lookup_address_info, 1, 2, 0,
4607 doc: /* Look up ip address info of NAME.
4608Optional parameter FAMILY controls whether to look up IPv4 or IPv6
4609addresses. The default of nil means both, symbol `ipv4' means IPv4
4610only, symbol `ipv6' means IPv6 only. Returns a list of addresses, or
4611nil if none were found. Each address is a vector of integers. */)
4612 (Lisp_Object name, Lisp_Object family)
4613{
4614 Lisp_Object addresses = Qnil;
4615 Lisp_Object msg = Qnil;
4616
4617 struct addrinfo *res, *lres;
4618 struct addrinfo hints;
4619
4620 memset (&hints, 0, sizeof hints);
4621 if (EQ (family, Qnil))
4622 hints.ai_family = AF_UNSPEC;
4623 else if (EQ (family, Qipv4))
4624 hints.ai_family = AF_INET;
4625 else if (EQ (family, Qipv6))
4626#ifdef AF_INET6
4627 hints.ai_family = AF_INET6;
4628#else
4629 /* If we don't support IPv6, querying will never work anyway */
4630 return addresses;
4631#endif
4632 else
4633 error ("Unsupported lookup type");
4634 hints.ai_socktype = SOCK_DGRAM;
4635
4636 msg = network_lookup_address_info_1 (name, NULL, &hints, &res);
4637 if (!EQ (msg, Qt))
4638 message ("%s", SSDATA(msg));
4639 else
4640 {
4641 for (lres = res; lres; lres = lres->ai_next)
4642 addresses = Fcons (conv_sockaddr_to_lisp (lres->ai_addr,
4643 lres->ai_addrlen),
4644 addresses);
4645 addresses = Fnreverse (addresses);
4646
4647 freeaddrinfo (res);
4648 }
4649 return addresses;
4650}
4651
4579/* Turn off input and output for process PROC. */ 4652/* Turn off input and output for process PROC. */
4580 4653
4581static void 4654static void
@@ -8345,6 +8418,7 @@ returns non-`nil'. */);
8345 defsubr (&Sset_network_process_option); 8418 defsubr (&Sset_network_process_option);
8346 defsubr (&Smake_network_process); 8419 defsubr (&Smake_network_process);
8347 defsubr (&Sformat_network_address); 8420 defsubr (&Sformat_network_address);
8421 defsubr (&Snetwork_lookup_address_info);
8348 defsubr (&Snetwork_interface_list); 8422 defsubr (&Snetwork_interface_list);
8349 defsubr (&Snetwork_interface_info); 8423 defsubr (&Snetwork_interface_info);
8350#ifdef DATAGRAM_SOCKETS 8424#ifdef DATAGRAM_SOCKETS
diff --git a/src/sound.c b/src/sound.c
index 4ba826e82c4..44d4cbc6d56 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/>. */
72#include <soundcard.h> 72#include <soundcard.h>
73#endif 73#endif
74#ifdef HAVE_ALSA 74#ifdef HAVE_ALSA
75#ifdef ALSA_SUBDIR_INCLUDE
76#include <alsa/asoundlib.h> 75#include <alsa/asoundlib.h>
77#else 76#endif
78#include <asoundlib.h>
79#endif /* ALSA_SUBDIR_INCLUDE */
80#endif /* HAVE_ALSA */
81 77
82/* END: Non Windows Includes */ 78/* END: Non Windows Includes */
83 79
diff --git a/src/sysdep.c b/src/sysdep.c
index f7478253a35..aa18ee22fd5 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2810,12 +2810,6 @@ errputc (int c)
2810} 2810}
2811 2811
2812void 2812void
2813verrprintf (char const *fmt, va_list ap)
2814{
2815 vfprintf (errstream (), fmt, ap);
2816}
2817
2818void
2819errwrite (void const *buf, ptrdiff_t nbuf) 2813errwrite (void const *buf, ptrdiff_t nbuf)
2820{ 2814{
2821 fwrite_unlocked (buf, 1, nbuf, errstream ()); 2815 fwrite_unlocked (buf, 1, nbuf, errstream ());
diff --git a/src/sysstdio.h b/src/sysstdio.h
index f402bd633d4..1e1180a4d31 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/>. */
28 28
29extern FILE *emacs_fopen (char const *, char const *); 29extern FILE *emacs_fopen (char const *, char const *);
30extern void errputc (int); 30extern void errputc (int);
31extern void verrprintf (char const *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
32extern void errwrite (void const *, ptrdiff_t); 31extern void errwrite (void const *, ptrdiff_t);
33extern void close_output_streams (void); 32extern void close_output_streams (void);
34 33
diff --git a/src/systime.h b/src/systime.h
index 125b2f1385e..2f783efcfca 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -41,6 +41,8 @@ typedef unsigned long Time;
41#endif 41#endif
42 42
43#include <sys/time.h> /* for 'struct timeval' */ 43#include <sys/time.h> /* for 'struct timeval' */
44
45#undef hz /* AIX <sys/param.h> #defines this. */
44 46
45/* Emacs uses struct timespec to represent nonnegative temporal intervals. 47/* Emacs uses struct timespec to represent nonnegative temporal intervals.
46 48
diff --git a/src/timefns.c b/src/timefns.c
index 2d545a4f905..c1e3141c4cf 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -91,7 +91,7 @@ static Lisp_Object timespec_hz;
91#define TRILLION 1000000000000 91#define TRILLION 1000000000000
92#if FIXNUM_OVERFLOW_P (TRILLION) 92#if FIXNUM_OVERFLOW_P (TRILLION)
93static Lisp_Object trillion; 93static Lisp_Object trillion;
94# define ztrillion (XBIGNUM (trillion)->value) 94# define ztrillion (*xbignum_val (trillion))
95#else 95#else
96# define trillion make_fixnum (TRILLION) 96# define trillion make_fixnum (TRILLION)
97# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS 97# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS
@@ -99,6 +99,22 @@ mpz_t ztrillion;
99# endif 99# endif
100#endif 100#endif
101 101
102/* True if the nonzero Lisp integer HZ divides evenly into a trillion. */
103static bool
104trillion_factor (Lisp_Object hz)
105{
106 if (FASTER_TIMEFNS)
107 {
108 if (FIXNUMP (hz))
109 return TRILLION % XFIXNUM (hz) == 0;
110 if (!FIXNUM_OVERFLOW_P (TRILLION))
111 return false;
112 }
113 verify (TRILLION <= INTMAX_MAX);
114 intmax_t ihz;
115 return integer_to_intmax (hz, &ihz) && TRILLION % ihz == 0;
116}
117
102/* Return a struct timeval that is roughly equivalent to T. 118/* Return a struct timeval that is roughly equivalent to T.
103 Use the least timeval not less than T. 119 Use the least timeval not less than T.
104 Return an extremal value if the result would overflow. */ 120 Return an extremal value if the result would overflow. */
@@ -391,16 +407,36 @@ decode_float_time (double t, struct lisp_time *result)
391 else 407 else
392 { 408 {
393 int exponent = ilogb (t); 409 int exponent = ilogb (t);
394 if (exponent == FP_ILOGBNAN) 410 int scale;
395 return EINVAL; 411 if (exponent < DBL_MANT_DIG)
396 412 {
397 /* An enormous or infinite T would make SCALE < 0 which would make 413 if (exponent < DBL_MIN_EXP - 1)
398 HZ < 1, which the (TICKS . HZ) representation does not allow. */ 414 {
399 if (DBL_MANT_DIG - 1 < exponent) 415 if (exponent == FP_ILOGBNAN
400 return EOVERFLOW; 416 && (FP_ILOGBNAN != FP_ILOGB0 || isnan (t)))
401 417 return EINVAL;
402 /* min so we don't scale tiny numbers as if they were normalized. */ 418 /* T is tiny. SCALE must be less than FLT_RADIX_POWER_SIZE,
403 int scale = min (DBL_MANT_DIG - 1 - exponent, flt_radix_power_size - 1); 419 as otherwise T would be scaled as if it were normalized. */
420 scale = flt_radix_power_size - 1;
421 }
422 else
423 {
424 /* The typical case. */
425 scale = DBL_MANT_DIG - 1 - exponent;
426 }
427 }
428 else if (exponent < INT_MAX)
429 {
430 /* T is finite but so large that HZ would be less than 1 if
431 T's precision were represented exactly. SCALE must be
432 nonnegative, as the (TICKS . HZ) representation requires
433 HZ to be at least 1. So use SCALE = 0, which converts T to
434 (T . 1), which is the exact numeric value with too-large HZ,
435 which is typically better than signaling overflow. */
436 scale = 0;
437 }
438 else
439 return FP_ILOGBNAN == INT_MAX && isnan (t) ? EINVAL : EOVERFLOW;
404 440
405 double scaled = scalbn (t, scale); 441 double scaled = scalbn (t, scale);
406 eassert (trunc (scaled) == scaled); 442 eassert (trunc (scaled) == scaled);
@@ -498,7 +534,7 @@ lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz)
498 return make_int (ticks / XFIXNUM (t.hz) 534 return make_int (ticks / XFIXNUM (t.hz)
499 - (ticks % XFIXNUM (t.hz) < 0)); 535 - (ticks % XFIXNUM (t.hz) < 0));
500 } 536 }
501 else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))) 537 else if (! (BIGNUMP (hz) && 0 < mpz_sgn (*xbignum_val (hz))))
502 invalid_hz (hz); 538 invalid_hz (hz);
503 539
504 mpz_mul (mpz[0], 540 mpz_mul (mpz[0],
@@ -661,18 +697,10 @@ enum timeform
661 TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */ 697 TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */
662 TIMEFORM_NIL, /* current time in nanoseconds */ 698 TIMEFORM_NIL, /* current time in nanoseconds */
663 TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */ 699 TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */
664 /* These two should be last; see timeform_sub_ps_p. */
665 TIMEFORM_FLOAT, /* time as a float */ 700 TIMEFORM_FLOAT, /* time as a float */
666 TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */ 701 TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
667 }; 702 };
668 703
669/* True if Lisp times of form FORM can express sub-picosecond timestamps. */
670static bool
671timeform_sub_ps_p (enum timeform form)
672{
673 return TIMEFORM_FLOAT <= form;
674}
675
676/* From the valid form FORM and the time components HIGH, LOW, USEC 704/* From the valid form FORM and the time components HIGH, LOW, USEC
677 and PSEC, generate the corresponding time value. If LOW is 705 and PSEC, generate the corresponding time value. If LOW is
678 floating point, the other components should be zero and FORM should 706 floating point, the other components should be zero and FORM should
@@ -878,6 +906,7 @@ lisp_to_timespec (struct lisp_time t)
878 struct timespec result = invalid_timespec (); 906 struct timespec result = invalid_timespec ();
879 int ns; 907 int ns;
880 mpz_t *q = &mpz[0]; 908 mpz_t *q = &mpz[0];
909 mpz_t const *qt = q;
881 910
882 if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz)) 911 if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz))
883 { 912 {
@@ -896,7 +925,7 @@ lisp_to_timespec (struct lisp_time t)
896 return result; 925 return result;
897 } 926 }
898 else 927 else
899 ns = mpz_fdiv_q_ui (*q, XBIGNUM (t.ticks)->value, TIMESPEC_HZ); 928 ns = mpz_fdiv_q_ui (*q, *xbignum_val (t.ticks), TIMESPEC_HZ);
900 } 929 }
901 else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1))) 930 else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1)))
902 { 931 {
@@ -913,7 +942,7 @@ lisp_to_timespec (struct lisp_time t)
913 return result; 942 return result;
914 } 943 }
915 else 944 else
916 q = &XBIGNUM (t.ticks)->value; 945 qt = xbignum_val (t.ticks);
917 } 946 }
918 else 947 else
919 { 948 {
@@ -925,7 +954,7 @@ lisp_to_timespec (struct lisp_time t)
925 /* With some versions of MinGW, tv_sec is a 64-bit type, whereas 954 /* With some versions of MinGW, tv_sec is a 64-bit type, whereas
926 time_t is a 32-bit type. */ 955 time_t is a 32-bit type. */
927 time_t sec; 956 time_t sec;
928 if (mpz_time (*q, &sec)) 957 if (mpz_time (*qt, &sec))
929 { 958 {
930 result.tv_sec = sec; 959 result.tv_sec = sec;
931 result.tv_nsec = ns; 960 result.tv_nsec = ns;
@@ -1010,7 +1039,7 @@ lispint_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1010 if (eabs (XFIXNUM (b)) <= ULONG_MAX) 1039 if (eabs (XFIXNUM (b)) <= ULONG_MAX)
1011 { 1040 {
1012 ((XFIXNUM (b) < 0) == subtract ? mpz_add_ui : mpz_sub_ui) 1041 ((XFIXNUM (b) < 0) == subtract ? mpz_add_ui : mpz_sub_ui)
1013 (mpz[0], XBIGNUM (a)->value, eabs (XFIXNUM (b))); 1042 (mpz[0], *xbignum_val (a), eabs (XFIXNUM (b)));
1014 mpz_done = true; 1043 mpz_done = true;
1015 } 1044 }
1016 } 1045 }
@@ -1060,9 +1089,14 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1060 else 1089 else
1061 { 1090 {
1062 /* The plan is to decompose ta into na/da and tb into nb/db. 1091 /* The plan is to decompose ta into na/da and tb into nb/db.
1063 Start by computing da and db. */ 1092 Start by computing da and db, their minimum (which will be
1093 needed later) and the iticks temporary that will become
1094 available once only their minimum is needed. */
1064 mpz_t const *da = bignum_integer (&mpz[1], ta.hz); 1095 mpz_t const *da = bignum_integer (&mpz[1], ta.hz);
1065 mpz_t const *db = bignum_integer (&mpz[2], tb.hz); 1096 mpz_t const *db = bignum_integer (&mpz[2], tb.hz);
1097 bool da_lt_db = mpz_cmp (*da, *db) < 0;
1098 mpz_t const *hzmin = da_lt_db ? da : db;
1099 mpz_t *iticks = &mpz[da_lt_db + 1];
1066 1100
1067 /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db) 1101 /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
1068 where g = gcd (da, db). Start by computing g. */ 1102 where g = gcd (da, db). Start by computing g. */
@@ -1070,34 +1104,83 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1070 mpz_gcd (*g, *da, *db); 1104 mpz_gcd (*g, *da, *db);
1071 1105
1072 /* fa = da/g, fb = db/g. */ 1106 /* fa = da/g, fb = db/g. */
1073 mpz_t *fa = &mpz[1], *fb = &mpz[3]; 1107 mpz_t *fa = &mpz[4], *fb = &mpz[3];
1074 mpz_tdiv_q (*fa, *da, *g); 1108 mpz_divexact (*fa, *da, *g);
1075 mpz_tdiv_q (*fb, *db, *g); 1109 mpz_divexact (*fb, *db, *g);
1110
1111 /* ihz = fa * db. This is equal to lcm (da, db). */
1112 mpz_t *ihz = &mpz[0];
1113 mpz_mul (*ihz, *fa, *db);
1114
1115 /* When warning about obsolete timestamps, if the smaller
1116 denominator comes from a non-(TICKS . HZ) timestamp and could
1117 generate a (TICKS . HZ) timestamp that would look obsolete,
1118 arrange for the result to have a higher HZ to avoid a
1119 spurious warning by a later consumer of this function's
1120 returned value. */
1121 verify (1 << LO_TIME_BITS <= ULONG_MAX);
1122 if (WARN_OBSOLETE_TIMESTAMPS
1123 && (da_lt_db ? aform : bform) == TIMEFORM_FLOAT
1124 && (da_lt_db ? bform : aform) != TIMEFORM_TICKS_HZ
1125 && mpz_cmp_ui (*hzmin, 1) > 0
1126 && mpz_cmp_ui (*hzmin, 1 << LO_TIME_BITS) < 0)
1127 {
1128 mpz_t *hzmin1 = &mpz[2 - da_lt_db];
1129 mpz_set_ui (*hzmin1, 1 << LO_TIME_BITS);
1130 hzmin = hzmin1;
1131 }
1076 1132
1077 /* FIXME: Maybe omit need for extra temp by computing fa * db here? */ 1133 /* iticks = (fb * na) OP (fa * nb), where OP is + or -. */
1134 mpz_t const *na = bignum_integer (iticks, ta.ticks);
1135 mpz_mul (*iticks, *fb, *na);
1136 mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
1137 (subtract ? mpz_submul : mpz_addmul) (*iticks, *fa, *nb);
1138
1139 /* Normalize iticks/ihz by dividing both numerator and
1140 denominator by ig = gcd (iticks, ihz). However, if that
1141 would cause the denominator to become less than hzmin,
1142 rescale the denominator upwards from its ordinary value by
1143 multiplying numerator and denominator so that the denominator
1144 becomes at least hzmin. This rescaling avoids returning a
1145 timestamp that is less precise than both a and b, or a
1146 timestamp that looks obsolete when that might be a problem. */
1147 mpz_t *ig = &mpz[3];
1148 mpz_gcd (*ig, *iticks, *ihz);
1149
1150 if (!FASTER_TIMEFNS || mpz_cmp_ui (*ig, 1) > 0)
1151 {
1152 mpz_divexact (*iticks, *iticks, *ig);
1153 mpz_divexact (*ihz, *ihz, *ig);
1078 1154
1079 /* hz = fa * db. This is equal to lcm (da, db). */ 1155 if (!FASTER_TIMEFNS || mpz_cmp (*ihz, *hzmin) < 0)
1080 mpz_mul (mpz[0], *fa, *db); 1156 {
1157 /* Rescale straightforwardly. Although this might not
1158 yield the minimal denominator that preserves numeric
1159 value and is at least hzmin, calculating such a
1160 denominator would be too expensive because it would
1161 require testing multisets of factors of lcm (da, db). */
1162 mpz_t *rescale = &mpz[3];
1163 mpz_cdiv_q (*rescale, *hzmin, *ihz);
1164 mpz_mul (*iticks, *iticks, *rescale);
1165 mpz_mul (*ihz, *ihz, *rescale);
1166 }
1167 }
1081 hz = make_integer_mpz (); 1168 hz = make_integer_mpz ();
1082 1169 mpz_swap (mpz[0], *iticks);
1083 /* ticks = (fb * na) OPER (fa * nb), where OPER is + or -.
1084 OP is the multiply-add or multiply-sub form of OPER. */
1085 mpz_t const *na = bignum_integer (&mpz[0], ta.ticks);
1086 mpz_mul (mpz[0], *fb, *na);
1087 mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
1088 (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb);
1089 ticks = make_integer_mpz (); 1170 ticks = make_integer_mpz ();
1090 } 1171 }
1091 1172
1092 /* Return an integer if the timestamp resolution is 1, 1173 /* Return an integer if the timestamp resolution is 1,
1093 otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if 1174 otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if
1094 either input form supports timestamps that cannot be expressed 1175 either input used (TICKS . HZ) form or the result can't be expressed
1095 exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form 1176 exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form
1096 for backward compatibility. */ 1177 for backward compatibility. */
1097 return (EQ (hz, make_fixnum (1)) 1178 return (EQ (hz, make_fixnum (1))
1098 ? ticks 1179 ? ticks
1099 : (!CURRENT_TIME_LIST 1180 : (!CURRENT_TIME_LIST
1100 || timeform_sub_ps_p (aform) || timeform_sub_ps_p (bform)) 1181 || aform == TIMEFORM_TICKS_HZ
1182 || bform == TIMEFORM_TICKS_HZ
1183 || !trillion_factor (hz))
1101 ? Fcons (ticks, hz) 1184 ? Fcons (ticks, hz)
1102 : ticks_hz_list4 (ticks, hz)); 1185 : ticks_hz_list4 (ticks, hz));
1103} 1186}
diff --git a/src/w32.c b/src/w32.c
index 36a5a37496e..d7a91692c63 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -3918,7 +3918,7 @@ logon_network_drive (const char *path)
3918 return; 3918 return;
3919 3919
3920 n_slashes = 2; 3920 n_slashes = 2;
3921 strncpy (share, path, MAX_UTF8_PATH); 3921 strncpy (share, path, MAX_UTF8_PATH - 1);
3922 /* Truncate to just server and share name. */ 3922 /* Truncate to just server and share name. */
3923 for (p = share + 2; *p && p < share + MAX_UTF8_PATH; p++) 3923 for (p = share + 2; *p && p < share + MAX_UTF8_PATH; p++)
3924 { 3924 {
diff --git a/src/xdisp.c b/src/xdisp.c
index af772bdef28..94f969f37cf 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/>. */
184 infrequently. These include the face of the characters, whether 184 infrequently. These include the face of the characters, whether
185 text is invisible, the object (buffer or display or overlay string) 185 text is invisible, the object (buffer or display or overlay string)
186 being iterated, character composition info, etc. For any given 186 being iterated, character composition info, etc. For any given
187 buffer or string position, these sources of information that 187 buffer or string position, the sources of information that
188 affects the display can be determined by calling the appropriate 188 affects the display can be determined by calling the appropriate
189 primitives, such as Fnext_single_property_change, but both these 189 primitives, such as Fnext_single_property_change, but both these
190 calls and the processing of their return values is relatively 190 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/>. */
214 string's interval tree to determine where the text properties 214 string's interval tree to determine where the text properties
215 change, finds the next position where overlays and character 215 change, finds the next position where overlays and character
216 composition can change, and stores in stop_charpos the closest 216 composition can change, and stores in stop_charpos the closest
217 position where any of these factors should be reconsider. 217 position where any of these factors should be reconsidered.
218 218
219 Producing glyphs. 219 Producing glyphs.
220 220
@@ -13509,7 +13509,8 @@ hscroll_window_tree (Lisp_Object window)
13509 get glyph rows whose start and end have zero buffer 13509 get glyph rows whose start and end have zero buffer
13510 positions, which we cannot handle below. Just skip 13510 positions, which we cannot handle below. Just skip
13511 such windows. */ 13511 such windows. */
13512 && CHARPOS (cursor_row->start.pos) >= BUF_BEG (w->contents) 13512 && (CHARPOS (cursor_row->start.pos)
13513 >= BUF_BEG (XBUFFER (w->contents)))
13513 /* For left-to-right rows, hscroll when cursor is either 13514 /* For left-to-right rows, hscroll when cursor is either
13514 (i) inside the right hscroll margin, or (ii) if it is 13515 (i) inside the right hscroll margin, or (ii) if it is
13515 inside the left margin and the window is already 13516 inside the left margin and the window is already
@@ -20463,7 +20464,7 @@ append_space_for_newline (struct it *it, bool default_face_p)
20463static void 20464static void
20464extend_face_to_end_of_line (struct it *it) 20465extend_face_to_end_of_line (struct it *it)
20465{ 20466{
20466 struct face *face, *default_face; 20467 struct face *face;
20467 struct frame *f = it->f; 20468 struct frame *f = it->f;
20468 20469
20469 /* If line is already filled, do nothing. Non window-system frames 20470 /* If line is already filled, do nothing. Non window-system frames
@@ -20481,10 +20482,6 @@ extend_face_to_end_of_line (struct it *it)
20481 || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0)) 20482 || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0))
20482 return; 20483 return;
20483 20484
20484 /* The default face, possibly remapped. */
20485 default_face =
20486 FACE_FROM_ID_OR_NULL (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
20487
20488 /* Face extension extends the background and box of IT->face_id 20485 /* Face extension extends the background and box of IT->face_id
20489 to the end of the line. If the background equals the background 20486 to the end of the line. If the background equals the background
20490 of the frame, we don't have to do anything. */ 20487 of the frame, we don't have to do anything. */
@@ -20517,7 +20514,14 @@ extend_face_to_end_of_line (struct it *it)
20517 it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil); 20514 it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil);
20518 } 20515 }
20519 20516
20517 /* The default face, possibly remapped. */
20518 struct face *default_face =
20519 FACE_FROM_ID (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
20520
20520#ifdef HAVE_WINDOW_SYSTEM 20521#ifdef HAVE_WINDOW_SYSTEM
20522 if (default_face == NULL)
20523 error ("extend_face_to_end_of_line: default_face is not set!");
20524
20521 if (FRAME_WINDOW_P (f)) 20525 if (FRAME_WINDOW_P (f))
20522 { 20526 {
20523 /* If the row is empty, add a space with the current face of IT, 20527 /* 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 0d224063d76..b761eaf4d11 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10044,7 +10044,6 @@ For details, see etc/PROBLEMS.\n",
10044 { 10044 {
10045 fprintf (stderr, "%s\n", error_msg); 10045 fprintf (stderr, "%s\n", error_msg);
10046 Fkill_emacs (make_fixnum (70)); 10046 Fkill_emacs (make_fixnum (70));
10047 /* NOTREACHED */
10048 } 10047 }
10049 10048
10050 totally_unblock_input (); 10049 totally_unblock_input ();
diff --git a/test/Makefile.in b/test/Makefile.in
index b7959072083..abcba944734 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -233,6 +233,7 @@ define test_template
233 ifeq (,$(patsubst %-tests,,$(1))$(findstring -tests/,$(1))) 233 ifeq (,$(patsubst %-tests,,$(1))$(findstring -tests/,$(1)))
234 $(1).log: $(patsubst %-tests,$(srcdir)/../%,$(1))$(if \ 234 $(1).log: $(patsubst %-tests,$(srcdir)/../%,$(1))$(if \
235 $(patsubst src/%,,$(patsubst lib-src/%,,$(1))),.el,.c) 235 $(patsubst src/%,,$(patsubst lib-src/%,,$(1))),.el,.c)
236 $(notdir $(1).log): $(1).log
236 endif 237 endif
237 238
238 ## Short aliases that always re-run the tests, with no logging. 239 ## Short aliases that always re-run the tests, with no logging.
diff --git a/test/README b/test/README
index c34cdce8ef4..b55e24556f5 100644
--- a/test/README
+++ b/test/README
@@ -44,6 +44,9 @@ The Makefile in this directory supports the following targets:
44 tests. In the former case the output is shown on the terminal, in 44 tests. In the former case the output is shown on the terminal, in
45 the latter case the output is written to <filename>.log. 45 the latter case the output is written to <filename>.log.
46 46
47<filename> could be either a relative file name like
48"lisp/files-tests", or a package name like "files-tests".
49
47ERT offers selectors, which make it possible to filter out which test 50ERT offers selectors, which make it possible to filter out which test
48cases shall run. The make variable $(SELECTOR) gives you a simple 51cases shall run. The make variable $(SELECTOR) gives you a simple
49mean to use your own selectors. The ERT manual describes how 52mean 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 0ff3c5a4071..0aec1800dfe 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
277; (skip-unless (not (getenv "EMACS_HYDRA_CI"))) 277; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
278 278
279 (let ((tmpfile (make-temp-file "auto-revert-test")) 279 (let ((tmpfile (make-temp-file "auto-revert-test"))
280 ;; Try to catch bug#32645.
281 (auto-revert-debug (getenv "EMACS_HYDRA_CI"))
282 (file-notify-debug (getenv "EMACS_HYDRA_CI"))
280 buf desc) 283 buf desc)
281 (unwind-protect 284 (unwind-protect
282 (progn 285 (progn
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index baea4804045..0d7004d7106 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
1300" 1300"
1301)) 1301))
1302 1302
1303(ert-deftest icalendar-import-bug-33277 ()
1304 ;;bug#33277 -- start time equals end time
1305 (icalendar-tests--test-import
1306 "DTSTART:20181105T200000Z
1307DTSTAMP:20181105T181652Z
1308DESCRIPTION:
1309LAST-MODIFIED:20181105T181646Z
1310LOCATION:
1311SEQUENCE:0
1312SUMMARY:event with same start/end time
1313TRANSP:OPAQUE
1314"
1315
1316 "&2018/11/5 21:00 event with same start/end time\n"
1317 "&5/11/2018 21:00 event with same start/end time\n"
1318 "&11/5/2018 21:00 event with same start/end time\n"
1319 ))
1320
1303(ert-deftest icalendar-import-multiple-vcalendars () 1321(ert-deftest icalendar-import-multiple-vcalendars ()
1304 (icalendar-tests--test-import 1322 (icalendar-tests--test-import
1305 "DTSTART;VALUE=DATE:20110723 1323 "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 00000000000..bf6ac04b527
--- /dev/null
+++ b/test/lisp/net/nsm-tests.el
@@ -0,0 +1,69 @@
1;;; network-stream-tests.el --- tests for network security manager -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2019 Free Software Foundation, Inc.
4
5;; Author: Robert Pluim <rpluim@gmail.com>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24
25;;; Code:
26
27(require 'nsm)
28(eval-when-compile (require 'cl-lib))
29
30(ert-deftest nsm-check-local-subnet-ipv4 ()
31 "Check that nsm can be avoided for local subnets."
32 (let ((local-ip '[172 26 128 160 0])
33 (mask '[255 255 255 0 0])
34
35 (wrong-length-mask '[255 255 255])
36 (wrong-mask '[255 255 255 255 0])
37 (remote-ip-yes '[172 26 128 161 0])
38 (remote-ip-no '[172 26 129 161 0]))
39
40 (should (eq t (nsm-network-same-subnet local-ip mask remote-ip-yes)))
41 (should (eq nil (nsm-network-same-subnet local-ip mask remote-ip-no)))
42 (should-error (nsm-network-same-subnet local-ip wrong-length-mask remote-ip-yes))
43 (should (eq nil (nsm-network-same-subnet local-ip wrong-mask remote-ip-yes)))
44 (should (eq t (nsm-should-check "google.com")))
45 (should (eq t (nsm-should-check "127.1")))
46 (should (eq t (nsm-should-check "localhost")))
47 (let ((nsm-trust-local-network t))
48 (should (eq t (nsm-should-check "google.com")))
49 (should (eq nil (nsm-should-check "127.1")))
50 (should (eq nil (nsm-should-check "localhost"))))))
51
52;; FIXME This will never return true, since
53;; network-interface-list only gives the primary address of each
54;; interface, which will be the IPv4 one
55(defun nsm-ipv6-is-available ()
56 (and (featurep 'make-network-process '(:family ipv6))
57 (cl-rassoc-if
58 (lambda (elt)
59 (eq 9 (length elt)))
60 (network-interface-list))))
61
62(ert-deftest nsm-check-local-subnet-ipv6 ()
63 (skip-unless (nsm-ipv6-is-available))
64 (should (eq t (nsm-should-check "::1")))
65 (let ((nsm-trust-local-network t))
66 (should (eq nil (nsm-should-check "::1")))))
67
68
69;;; nsm-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 180f746c647..dd6b9edd000 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."
3098 (let ((attr1 (copy-sequence attr1)) 3098 (let ((attr1 (copy-sequence attr1))
3099 (attr2 (copy-sequence attr2)) 3099 (attr2 (copy-sequence attr2))
3100 (start-time (- tramp--test-start-time 10))) 3100 (start-time (- tramp--test-start-time 10)))
3101 ;; Link number. For directories, it includes the number of
3102 ;; subdirectories. Set it to 1.
3103 (when (eq (tramp-compat-file-attribute-type attr1) t)
3104 (setcar (nthcdr 1 attr1) 1))
3105 (when (eq (tramp-compat-file-attribute-type attr2) t)
3106 (setcar (nthcdr 1 attr2) 1))
3101 ;; Access time. 3107 ;; Access time.
3102 (setcar (nthcdr 4 attr1) tramp-time-dont-know) 3108 (setcar (nthcdr 4 attr1) tramp-time-dont-know)
3103 (setcar (nthcdr 4 attr2) tramp-time-dont-know) 3109 (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'."
3473 (setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2))))) 3479 (setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
3474 3480
3475 ;; Cleanup. 3481 ;; Cleanup.
3476 (ignore-errors (delete-directory tmp-name1 'recursive))) 3482 (ignore-errors
3483 (delete-file tmp-name3)
3484 (delete-directory tmp-name1 'recursive)))
3477 3485
3478 ;; Detect cyclic symbolic links. 3486 ;; Detect cyclic symbolic links.
3479 (unwind-protect 3487 (unwind-protect
@@ -3533,9 +3541,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3533 (file-attributes tmp-name1)) 3541 (file-attributes tmp-name1))
3534 tramp-time-dont-know) 3542 tramp-time-dont-know)
3535 (should 3543 (should
3536 (equal (tramp-compat-file-attribute-modification-time 3544 (tramp-compat-time-equal-p
3537 (file-attributes tmp-name1)) 3545 (tramp-compat-file-attribute-modification-time
3538 (seconds-to-time 1))) 3546 (file-attributes tmp-name1))
3547 (seconds-to-time 1)))
3539 (write-region "bla" nil tmp-name2) 3548 (write-region "bla" nil tmp-name2)
3540 (should (file-exists-p tmp-name2)) 3549 (should (file-exists-p tmp-name2))
3541 (should (file-newer-than-file-p tmp-name2 tmp-name1)) 3550 (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'."
4182 (with-timeout (10 (tramp--test-timeout-handler)) 4191 (with-timeout (10 (tramp--test-timeout-handler))
4183 (while (accept-process-output proc 0 nil t))) 4192 (while (accept-process-output proc 0 nil t)))
4184 ;; We cannot use `string-equal', because tramp-adb.el 4193 ;; We cannot use `string-equal', because tramp-adb.el
4185 ;; echoes also the sent string. 4194 ;; echoes also the sent string. And a remote macOS sends
4186 (should (string-match "killed\n\\'" (buffer-string)))) 4195 ;; a slightly modified string.
4196 (should (string-match "killed.*\n\\'" (buffer-string))))
4187 4197
4188 ;; Cleanup. 4198 ;; Cleanup.
4189 (ignore-errors (delete-process proc))) 4199 (ignore-errors (delete-process proc)))
@@ -5145,7 +5155,8 @@ This requires restrictions of file name syntax."
5145 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 5155 (tmp-name1 (tramp--test-make-temp-name nil quoted))
5146 (tmp-name2 (tramp--test-make-temp-name 'local quoted)) 5156 (tmp-name2 (tramp--test-make-temp-name 'local quoted))
5147 (files (delq nil files)) 5157 (files (delq nil files))
5148 (process-environment process-environment)) 5158 (process-environment process-environment)
5159 (sorted-files (sort (copy-sequence files) #'string-lessp)))
5149 (unwind-protect 5160 (unwind-protect
5150 (progn 5161 (progn
5151 (make-directory tmp-name1) 5162 (make-directory tmp-name1)
@@ -5192,10 +5203,20 @@ This requires restrictions of file name syntax."
5192 ;; Check file names. 5203 ;; Check file names.
5193 (should (equal (directory-files 5204 (should (equal (directory-files
5194 tmp-name1 nil directory-files-no-dot-files-regexp) 5205 tmp-name1 nil directory-files-no-dot-files-regexp)
5195 (sort (copy-sequence files) #'string-lessp))) 5206 sorted-files))
5196 (should (equal (directory-files 5207 (should (equal (directory-files
5197 tmp-name2 nil directory-files-no-dot-files-regexp) 5208 tmp-name2 nil directory-files-no-dot-files-regexp)
5198 (sort (copy-sequence files) #'string-lessp))) 5209 sorted-files))
5210 (should (equal (mapcar
5211 #'car
5212 (directory-files-and-attributes
5213 tmp-name1 nil directory-files-no-dot-files-regexp))
5214 sorted-files))
5215 (should (equal (mapcar
5216 #'car
5217 (directory-files-and-attributes
5218 tmp-name2 nil directory-files-no-dot-files-regexp))
5219 sorted-files))
5199 5220
5200 ;; `substitute-in-file-name' could return different 5221 ;; `substitute-in-file-name' could return different
5201 ;; values. For `adb', there could be strange file 5222 ;; values. For `adb', there could be strange file
@@ -5268,7 +5289,10 @@ This requires restrictions of file name syntax."
5268 (should-not (file-exists-p file1)))) 5289 (should-not (file-exists-p file1))))
5269 5290
5270 ;; Check, that environment variables are set correctly. 5291 ;; Check, that environment variables are set correctly.
5271 (when (and (tramp--test-expensive-test) (tramp--test-sh-p)) 5292 ;; We do not run on macOS due to encoding problems. See
5293 ;; Bug#36940.
5294 (when (and (tramp--test-expensive-test) (tramp--test-sh-p)
5295 (not (eq system-type 'darwin)))
5272 (dolist (elt files) 5296 (dolist (elt files)
5273 (let ((envvar (concat "VAR_" (upcase (md5 elt)))) 5297 (let ((envvar (concat "VAR_" (upcase (md5 elt))))
5274 (elt (encode-coding-string elt coding-system-for-read)) 5298 (elt (encode-coding-string elt coding-system-for-read))
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 2a777af4720..a93664f6536 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -64,6 +64,7 @@
64 "Temporary directory for Tramp tests.") 64 "Temporary directory for Tramp tests.")
65 65
66(setq password-cache-expiry nil 66(setq password-cache-expiry nil
67 shadow-debug t
67 tramp-verbose 0 68 tramp-verbose 0
68 tramp-message-show-message nil) 69 tramp-message-show-message nil)
69 70
@@ -79,6 +80,35 @@
79 (expand-file-name "shadow_todo_test" temporary-file-directory) 80 (expand-file-name "shadow_todo_test" temporary-file-directory)
80 "File to store the list of uncopied shadows in during tests.") 81 "File to store the list of uncopied shadows in during tests.")
81 82
83(defun shadow--tests-cleanup ()
84 "Reset all `shadowfile' internals."
85 ;; Delete auto-saved files.
86 (with-current-buffer (find-file-noselect shadow-info-file 'nowarn)
87 (ignore-errors (delete-file (make-auto-save-file-name)))
88 (set-buffer-modified-p nil)
89 (kill-buffer))
90 (with-current-buffer (find-file-noselect shadow-todo-file 'nowarn)
91 (ignore-errors (delete-file (make-auto-save-file-name)))
92 (set-buffer-modified-p nil)
93 (kill-buffer))
94 ;; Delete buffers.
95 (ignore-errors
96 (with-current-buffer shadow-info-buffer
97 (set-buffer-modified-p nil)
98 (kill-buffer)))
99 (ignore-errors
100 (with-current-buffer shadow-todo-buffer
101 (set-buffer-modified-p nil)
102 (kill-buffer)))
103 ;; Delete files.
104 (ignore-errors (delete-file shadow-info-file))
105 (ignore-errors (delete-file shadow-todo-file))
106 ;; Reset variables.
107 (setq shadow-info-buffer nil
108 shadow-hashtable nil
109 shadow-todo-buffer nil
110 shadow-files-to-copy nil))
111
82(ert-deftest shadow-test00-clusters () 112(ert-deftest shadow-test00-clusters ()
83 "Check cluster definitions. 113 "Check cluster definitions.
84Per definition, all files are identical on the different hosts of 114Per definition, all files are identical on the different hosts of
@@ -96,23 +126,21 @@ guaranteed by the originator of a cluster definition."
96 (unwind-protect 126 (unwind-protect
97 ;; We must mock `read-from-minibuffer' and `read-string', in 127 ;; We must mock `read-from-minibuffer' and `read-string', in
98 ;; order to avoid interactive arguments. 128 ;; order to avoid interactive arguments.
99 (cl-letf* (((symbol-function 'read-from-minibuffer) 129 (cl-letf* (((symbol-function #'read-from-minibuffer)
100 (lambda (&rest args) (pop mocked-input))) 130 (lambda (&rest args) (pop mocked-input)))
101 ((symbol-function 'read-string) 131 ((symbol-function #'read-string)
102 (lambda (&rest args) (pop mocked-input)))) 132 (lambda (&rest args) (pop mocked-input))))
103 133
104 ;; Cleanup. 134 ;; Cleanup & initialize.
105 (when (file-exists-p shadow-info-file) 135 (shadow--tests-cleanup)
106 (delete-file shadow-info-file)) 136 (shadow-initialize)
107 (when (file-exists-p shadow-todo-file)
108 (delete-file shadow-todo-file))
109 137
110 ;; Define a cluster. 138 ;; Define a cluster.
111 (setq cluster "cluster" 139 (setq cluster "cluster"
112 primary shadow-system-name 140 primary shadow-system-name
113 regexp (shadow-regexp-superquote primary) 141 regexp (shadow-regexp-superquote primary)
114 mocked-input `(,cluster ,primary ,regexp)) 142 mocked-input `(,cluster ,primary ,regexp))
115 (call-interactively 'shadow-define-cluster) 143 (call-interactively #'shadow-define-cluster)
116 (should 144 (should
117 (string-equal 145 (string-equal
118 (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) 146 (shadow-cluster-name (shadow-get-cluster cluster)) cluster))
@@ -136,7 +164,7 @@ guaranteed by the originator of a cluster definition."
136 mocked-input `(,cluster ,cluster ,primary ,regexp)) 164 mocked-input `(,cluster ,cluster ,primary ,regexp))
137 (with-current-buffer (messages-buffer) 165 (with-current-buffer (messages-buffer)
138 (narrow-to-region (point-max) (point-max))) 166 (narrow-to-region (point-max) (point-max)))
139 (call-interactively 'shadow-define-cluster) 167 (call-interactively #'shadow-define-cluster)
140 (should 168 (should
141 (string-match 169 (string-match
142 (regexp-quote "Not a valid primary!") 170 (regexp-quote "Not a valid primary!")
@@ -157,7 +185,7 @@ guaranteed by the originator of a cluster definition."
157 mocked-input `(,cluster ,primary ,cluster ,regexp)) 185 mocked-input `(,cluster ,primary ,cluster ,regexp))
158 (with-current-buffer (messages-buffer) 186 (with-current-buffer (messages-buffer)
159 (narrow-to-region (point-max) (point-max))) 187 (narrow-to-region (point-max) (point-max)))
160 (call-interactively 'shadow-define-cluster) 188 (call-interactively #'shadow-define-cluster)
161 (should 189 (should
162 (string-match 190 (string-match
163 (regexp-quote "Regexp doesn't include the primary host!") 191 (regexp-quote "Regexp doesn't include the primary host!")
@@ -178,7 +206,7 @@ guaranteed by the originator of a cluster definition."
178 (file-remote-p shadow-test-remote-temporary-file-directory) 206 (file-remote-p shadow-test-remote-temporary-file-directory)
179 regexp (shadow-regexp-superquote primary) 207 regexp (shadow-regexp-superquote primary)
180 mocked-input `(,cluster ,primary ,regexp)) 208 mocked-input `(,cluster ,primary ,regexp))
181 (call-interactively 'shadow-define-cluster) 209 (call-interactively #'shadow-define-cluster)
182 (should 210 (should
183 (string-equal 211 (string-equal
184 (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) 212 (shadow-cluster-name (shadow-get-cluster cluster)) cluster))
@@ -198,10 +226,7 @@ guaranteed by the originator of a cluster definition."
198 226
199 ;; Cleanup. 227 ;; Cleanup.
200 (with-current-buffer (messages-buffer) (widen)) 228 (with-current-buffer (messages-buffer) (widen))
201 (when (file-exists-p shadow-info-file) 229 (shadow--tests-cleanup))))
202 (delete-file shadow-info-file))
203 (when (file-exists-p shadow-todo-file)
204 (delete-file shadow-todo-file)))))
205 230
206(ert-deftest shadow-test01-sites () 231(ert-deftest shadow-test01-sites ()
207 "Check site definitions. 232 "Check site definitions.
@@ -218,16 +243,14 @@ guaranteed by the originator of a cluster definition."
218 (unwind-protect 243 (unwind-protect
219 ;; We must mock `read-from-minibuffer' and `read-string', in 244 ;; We must mock `read-from-minibuffer' and `read-string', in
220 ;; order to avoid interactive arguments. 245 ;; order to avoid interactive arguments.
221 (cl-letf* (((symbol-function 'read-from-minibuffer) 246 (cl-letf* (((symbol-function #'read-from-minibuffer)
222 (lambda (&rest args) (pop mocked-input))) 247 (lambda (&rest args) (pop mocked-input)))
223 ((symbol-function 'read-string) 248 ((symbol-function #'read-string)
224 (lambda (&rest args) (pop mocked-input)))) 249 (lambda (&rest args) (pop mocked-input))))
225 250
226 ;; Cleanup. 251 ;; Cleanup & initialize.
227 (when (file-exists-p shadow-info-file) 252 (shadow--tests-cleanup)
228 (delete-file shadow-info-file)) 253 (shadow-initialize)
229 (when (file-exists-p shadow-todo-file)
230 (delete-file shadow-todo-file))
231 254
232 ;; Define a cluster. 255 ;; Define a cluster.
233 (setq cluster1 "cluster1" 256 (setq cluster1 "cluster1"
@@ -308,10 +331,7 @@ guaranteed by the originator of a cluster definition."
308 (shadow-site-match (shadow-site-primary cluster1) cluster2))) 331 (shadow-site-match (shadow-site-primary cluster1) cluster2)))
309 332
310 ;; Cleanup. 333 ;; Cleanup.
311 (when (file-exists-p shadow-info-file) 334 (shadow--tests-cleanup))))
312 (delete-file shadow-info-file))
313 (when (file-exists-p shadow-todo-file)
314 (delete-file shadow-todo-file)))))
315 335
316(ert-deftest shadow-test02-files () 336(ert-deftest shadow-test02-files ()
317 "Check file manipulation functions." 337 "Check file manipulation functions."
@@ -324,11 +344,10 @@ guaranteed by the originator of a cluster definition."
324 cluster primary regexp file hup) 344 cluster primary regexp file hup)
325 (unwind-protect 345 (unwind-protect
326 (progn 346 (progn
327 ;; Cleanup. 347
328 (when (file-exists-p shadow-info-file) 348 ;; Cleanup & initialize.
329 (delete-file shadow-info-file)) 349 (shadow--tests-cleanup)
330 (when (file-exists-p shadow-todo-file) 350 (shadow-initialize)
331 (delete-file shadow-todo-file))
332 351
333 ;; Define a cluster. 352 ;; Define a cluster.
334 (setq cluster "cluster" 353 (setq cluster "cluster"
@@ -384,10 +403,7 @@ guaranteed by the originator of a cluster definition."
384 (should-not (shadow-local-file nil))) 403 (should-not (shadow-local-file nil)))
385 404
386 ;; Cleanup. 405 ;; Cleanup.
387 (when (file-exists-p shadow-info-file) 406 (shadow--tests-cleanup))))
388 (delete-file shadow-info-file))
389 (when (file-exists-p shadow-todo-file)
390 (delete-file shadow-todo-file)))))
391 407
392(ert-deftest shadow-test03-expand-cluster-in-file-name () 408(ert-deftest shadow-test03-expand-cluster-in-file-name ()
393 "Check canonical file name of a cluster or site." 409 "Check canonical file name of a cluster or site."
@@ -400,11 +416,10 @@ guaranteed by the originator of a cluster definition."
400 cluster primary regexp file1 file2) 416 cluster primary regexp file1 file2)
401 (unwind-protect 417 (unwind-protect
402 (progn 418 (progn
403 ;; Cleanup. 419
404 (when (file-exists-p shadow-info-file) 420 ;; Cleanup & initialize.
405 (delete-file shadow-info-file)) 421 (shadow--tests-cleanup)
406 (when (file-exists-p shadow-todo-file) 422 (shadow-initialize)
407 (delete-file shadow-todo-file))
408 423
409 ;; Define a cluster. 424 ;; Define a cluster.
410 (setq cluster "cluster" 425 (setq cluster "cluster"
@@ -455,10 +470,7 @@ guaranteed by the originator of a cluster definition."
455 (concat primary file1)))) 470 (concat primary file1))))
456 471
457 ;; Cleanup. 472 ;; Cleanup.
458 (when (file-exists-p shadow-info-file) 473 (shadow--tests-cleanup))))
459 (delete-file shadow-info-file))
460 (when (file-exists-p shadow-todo-file)
461 (delete-file shadow-todo-file)))))
462 474
463(ert-deftest shadow-test04-contract-file-name () 475(ert-deftest shadow-test04-contract-file-name ()
464 "Check canonical file name of a cluster or site." 476 "Check canonical file name of a cluster or site."
@@ -471,11 +483,10 @@ guaranteed by the originator of a cluster definition."
471 cluster primary regexp file) 483 cluster primary regexp file)
472 (unwind-protect 484 (unwind-protect
473 (progn 485 (progn
474 ;; Cleanup. 486
475 (when (file-exists-p shadow-info-file) 487 ;; Cleanup & initialize.
476 (delete-file shadow-info-file)) 488 (shadow--tests-cleanup)
477 (when (file-exists-p shadow-todo-file) 489 (shadow-initialize)
478 (delete-file shadow-todo-file))
479 490
480 ;; Define a cluster. 491 ;; Define a cluster.
481 (setq cluster "cluster" 492 (setq cluster "cluster"
@@ -516,10 +527,7 @@ guaranteed by the originator of a cluster definition."
516 (concat "/cluster:" file)))) 527 (concat "/cluster:" file))))
517 528
518 ;; Cleanup. 529 ;; Cleanup.
519 (when (file-exists-p shadow-info-file) 530 (shadow--tests-cleanup))))
520 (delete-file shadow-info-file))
521 (when (file-exists-p shadow-todo-file)
522 (delete-file shadow-todo-file)))))
523 531
524(ert-deftest shadow-test05-file-match () 532(ert-deftest shadow-test05-file-match ()
525 "Check `shadow-same-site' and `shadow-file-match'." 533 "Check `shadow-same-site' and `shadow-file-match'."
@@ -532,11 +540,10 @@ guaranteed by the originator of a cluster definition."
532 cluster primary regexp file) 540 cluster primary regexp file)
533 (unwind-protect 541 (unwind-protect
534 (progn 542 (progn
535 ;; Cleanup. 543
536 (when (file-exists-p shadow-info-file) 544 ;; Cleanup & initialize.
537 (delete-file shadow-info-file)) 545 (shadow--tests-cleanup)
538 (when (file-exists-p shadow-todo-file) 546 (shadow-initialize)
539 (delete-file shadow-todo-file))
540 547
541 ;; Define a cluster. 548 ;; Define a cluster.
542 (setq cluster "cluster" 549 (setq cluster "cluster"
@@ -575,10 +582,7 @@ guaranteed by the originator of a cluster definition."
575 file))) 582 file)))
576 583
577 ;; Cleanup. 584 ;; Cleanup.
578 (when (file-exists-p shadow-info-file) 585 (shadow--tests-cleanup))))
579 (delete-file shadow-info-file))
580 (when (file-exists-p shadow-todo-file)
581 (delete-file shadow-todo-file)))))
582 586
583(ert-deftest shadow-test06-literal-groups () 587(ert-deftest shadow-test06-literal-groups ()
584 "Check literal group definitions." 588 "Check literal group definitions."
@@ -592,16 +596,14 @@ guaranteed by the originator of a cluster definition."
592 (unwind-protect 596 (unwind-protect
593 ;; We must mock `read-from-minibuffer' and `read-string', in 597 ;; We must mock `read-from-minibuffer' and `read-string', in
594 ;; order to avoid interactive arguments. 598 ;; order to avoid interactive arguments.
595 (cl-letf* (((symbol-function 'read-from-minibuffer) 599 (cl-letf* (((symbol-function #'read-from-minibuffer)
596 (lambda (&rest args) (pop mocked-input))) 600 (lambda (&rest args) (pop mocked-input)))
597 ((symbol-function 'read-string) 601 ((symbol-function #'read-string)
598 (lambda (&rest args) (pop mocked-input)))) 602 (lambda (&rest args) (pop mocked-input))))
599 603
600 ;; Cleanup. 604 ;; Cleanup & initialize.
601 (when (file-exists-p shadow-info-file) 605 (shadow--tests-cleanup)
602 (delete-file shadow-info-file)) 606 (shadow-initialize)
603 (when (file-exists-p shadow-todo-file)
604 (delete-file shadow-todo-file))
605 607
606 ;; Define clusters. 608 ;; Define clusters.
607 (setq cluster1 "cluster1" 609 (setq cluster1 "cluster1"
@@ -627,7 +629,8 @@ guaranteed by the originator of a cluster definition."
627 mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) 629 mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET")))
628 (with-temp-buffer 630 (with-temp-buffer
629 (set-visited-file-name file1) 631 (set-visited-file-name file1)
630 (call-interactively 'shadow-define-literal-group)) 632 (call-interactively #'shadow-define-literal-group)
633 (set-buffer-modified-p nil))
631 634
632 ;; `shadow-literal-groups' is a list of lists. 635 ;; `shadow-literal-groups' is a list of lists.
633 (should (consp shadow-literal-groups)) 636 (should (consp shadow-literal-groups))
@@ -640,10 +643,7 @@ guaranteed by the originator of a cluster definition."
640 (car shadow-literal-groups)))) 643 (car shadow-literal-groups))))
641 644
642 ;; Cleanup. 645 ;; Cleanup.
643 (when (file-exists-p shadow-info-file) 646 (shadow--tests-cleanup))))
644 (delete-file shadow-info-file))
645 (when (file-exists-p shadow-todo-file)
646 (delete-file shadow-todo-file)))))
647 647
648(ert-deftest shadow-test07-regexp-groups () 648(ert-deftest shadow-test07-regexp-groups ()
649 "Check regexp group definitions." 649 "Check regexp group definitions."
@@ -657,16 +657,14 @@ guaranteed by the originator of a cluster definition."
657 (unwind-protect 657 (unwind-protect
658 ;; We must mock `read-from-minibuffer' and `read-string', in 658 ;; We must mock `read-from-minibuffer' and `read-string', in
659 ;; order to avoid interactive arguments. 659 ;; order to avoid interactive arguments.
660 (cl-letf* (((symbol-function 'read-from-minibuffer) 660 (cl-letf* (((symbol-function #'read-from-minibuffer)
661 (lambda (&rest args) (pop mocked-input))) 661 (lambda (&rest args) (pop mocked-input)))
662 ((symbol-function 'read-string) 662 ((symbol-function #'read-string)
663 (lambda (&rest args) (pop mocked-input)))) 663 (lambda (&rest args) (pop mocked-input))))
664 664
665 ;; Cleanup. 665 ;; Cleanup & initialize.
666 (when (file-exists-p shadow-info-file) 666 (shadow--tests-cleanup)
667 (delete-file shadow-info-file)) 667 (shadow-initialize)
668 (when (file-exists-p shadow-todo-file)
669 (delete-file shadow-todo-file))
670 668
671 ;; Define clusters. 669 ;; Define clusters.
672 (setq cluster1 "cluster1" 670 (setq cluster1 "cluster1"
@@ -688,7 +686,8 @@ guaranteed by the originator of a cluster definition."
688 ,cluster1 ,cluster2 ,(kbd "RET"))) 686 ,cluster1 ,cluster2 ,(kbd "RET")))
689 (with-temp-buffer 687 (with-temp-buffer
690 (set-visited-file-name nil) 688 (set-visited-file-name nil)
691 (call-interactively 'shadow-define-regexp-group)) 689 (call-interactively #'shadow-define-regexp-group)
690 (set-buffer-modified-p nil))
692 691
693 ;; `shadow-regexp-groups' is a list of lists. 692 ;; `shadow-regexp-groups' is a list of lists.
694 (should (consp shadow-regexp-groups)) 693 (should (consp shadow-regexp-groups))
@@ -707,10 +706,7 @@ guaranteed by the originator of a cluster definition."
707 (car shadow-regexp-groups)))) 706 (car shadow-regexp-groups))))
708 707
709 ;; Cleanup. 708 ;; Cleanup.
710 (when (file-exists-p shadow-info-file) 709 (shadow--tests-cleanup))))
711 (delete-file shadow-info-file))
712 (when (file-exists-p shadow-todo-file)
713 (delete-file shadow-todo-file)))))
714 710
715(ert-deftest shadow-test08-shadow-todo () 711(ert-deftest shadow-test08-shadow-todo ()
716 "Check that needed shadows are added to todo." 712 "Check that needed shadows are added to todo."
@@ -722,28 +718,37 @@ guaranteed by the originator of a cluster definition."
722 (shadow-info-file shadow-test-info-file) 718 (shadow-info-file shadow-test-info-file)
723 (shadow-todo-file shadow-test-todo-file) 719 (shadow-todo-file shadow-test-todo-file)
724 (shadow-inhibit-message t) 720 (shadow-inhibit-message t)
721 (shadow-test-remote-temporary-file-directory
722 (file-truename shadow-test-remote-temporary-file-directory))
725 shadow-clusters shadow-literal-groups shadow-regexp-groups 723 shadow-clusters shadow-literal-groups shadow-regexp-groups
726 shadow-files-to-copy 724 shadow-files-to-copy
727 cluster1 cluster2 primary regexp file) 725 cluster1 cluster2 primary regexp file)
728 (unwind-protect 726 (unwind-protect
729 (progn 727 (progn
730 ;; Cleanup. 728
731 (when (file-exists-p shadow-info-file) 729 ;; Cleanup & initialize.
732 (delete-file shadow-info-file)) 730 (shadow--tests-cleanup)
733 (when (file-exists-p shadow-todo-file) 731 (shadow-initialize)
734 (delete-file shadow-todo-file))
735 732
736 ;; Define clusters. 733 ;; Define clusters.
737 (setq cluster1 "cluster1" 734 (setq cluster1 "cluster1"
738 primary shadow-system-name 735 primary shadow-system-name
739 regexp (shadow-regexp-superquote primary)) 736 regexp (shadow-regexp-superquote primary))
740 (shadow-set-cluster cluster1 primary regexp) 737 (shadow-set-cluster cluster1 primary regexp)
738 (when shadow-debug
739 (message
740 "shadow-test08-shadow-todo: %s %s %s %s"
741 cluster1 primary regexp shadow-clusters))
741 742
742 (setq cluster2 "cluster2" 743 (setq cluster2 "cluster2"
743 primary 744 primary
744 (file-remote-p shadow-test-remote-temporary-file-directory) 745 (file-remote-p shadow-test-remote-temporary-file-directory)
745 regexp (shadow-regexp-superquote primary)) 746 regexp (shadow-regexp-superquote primary))
746 (shadow-set-cluster cluster2 primary regexp) 747 (shadow-set-cluster cluster2 primary regexp)
748 (when shadow-debug
749 (message
750 "shadow-test08-shadow-todo: %s %s %s %s"
751 cluster2 primary regexp shadow-clusters))
747 752
748 ;; Define a literal group. 753 ;; Define a literal group.
749 (setq file 754 (setq file
@@ -751,12 +756,20 @@ guaranteed by the originator of a cluster definition."
751 (expand-file-name "shadowfile-tests" temporary-file-directory)) 756 (expand-file-name "shadowfile-tests" temporary-file-directory))
752 shadow-literal-groups 757 shadow-literal-groups
753 `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) 758 `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file))))
759 (when shadow-debug
760 (message
761 "shadow-test08-shadow-todo: %s %s" file shadow-literal-groups))
754 762
755 ;; Save file from "cluster1" definition. 763 ;; Save file from "cluster1" definition.
756 (with-temp-buffer 764 (with-temp-buffer
757 (set-visited-file-name file) 765 (set-visited-file-name file)
758 (insert "foo") 766 (insert "foo")
759 (save-buffer)) 767 (save-buffer))
768 (when shadow-debug
769 (message
770 "shadow-test08-shadow-todo: %s %s"
771 (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
772 shadow-files-to-copy))
760 (should 773 (should
761 (member 774 (member
762 (cons file (shadow-contract-file-name (concat "/cluster2:" file))) 775 (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
@@ -767,6 +780,13 @@ guaranteed by the originator of a cluster definition."
767 (set-visited-file-name (concat (shadow-site-primary cluster2) file)) 780 (set-visited-file-name (concat (shadow-site-primary cluster2) file))
768 (insert "foo") 781 (insert "foo")
769 (save-buffer)) 782 (save-buffer))
783 (when shadow-debug
784 (message
785 "shadow-test08-shadow-todo: %s %s"
786 (cons
787 (concat (shadow-site-primary cluster2) file)
788 (shadow-contract-file-name (concat "/cluster1:" file)))
789 shadow-files-to-copy))
770 (should 790 (should
771 (member 791 (member
772 (cons 792 (cons
@@ -781,12 +801,20 @@ guaranteed by the originator of a cluster definition."
781 (shadow-regexp-superquote file)) 801 (shadow-regexp-superquote file))
782 ,(concat (shadow-site-primary cluster2) 802 ,(concat (shadow-site-primary cluster2)
783 (shadow-regexp-superquote file))))) 803 (shadow-regexp-superquote file)))))
804 (when shadow-debug
805 (message
806 "shadow-test08-shadow-todo: %s %s" file shadow-regexp-groups))
784 807
785 ;; Save file from "cluster1" definition. 808 ;; Save file from "cluster1" definition.
786 (with-temp-buffer 809 (with-temp-buffer
787 (set-visited-file-name file) 810 (set-visited-file-name file)
788 (insert "foo") 811 (insert "foo")
789 (save-buffer)) 812 (save-buffer))
813 (when shadow-debug
814 (message
815 "shadow-test08-shadow-todo: %s %s"
816 (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
817 shadow-files-to-copy))
790 (should 818 (should
791 (member 819 (member
792 (cons file (shadow-contract-file-name (concat "/cluster2:" file))) 820 (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
@@ -797,6 +825,13 @@ guaranteed by the originator of a cluster definition."
797 (set-visited-file-name (concat (shadow-site-primary cluster2) file)) 825 (set-visited-file-name (concat (shadow-site-primary cluster2) file))
798 (insert "foo") 826 (insert "foo")
799 (save-buffer)) 827 (save-buffer))
828 (when shadow-debug
829 (message
830 "shadow-test08-shadow-todo: %s %s"
831 (cons
832 (concat (shadow-site-primary cluster2) file)
833 (shadow-contract-file-name (concat "/cluster1:" file)))
834 shadow-files-to-copy))
800 (should 835 (should
801 (member 836 (member
802 (cons 837 (cons
@@ -805,16 +840,13 @@ guaranteed by the originator of a cluster definition."
805 shadow-files-to-copy))) 840 shadow-files-to-copy)))
806 841
807 ;; Cleanup. 842 ;; Cleanup.
808 (when (file-exists-p shadow-info-file) 843 (dolist (elt `(,file ,(concat (shadow-site-primary cluster2) file)))
809 (delete-file shadow-info-file)) 844 (ignore-errors
810 (when (file-exists-p shadow-todo-file) 845 (with-current-buffer (get-file-buffer elt)
811 (delete-file shadow-todo-file)) 846 (set-buffer-modified-p nil)
812 (ignore-errors 847 (kill-buffer)))
813 (when (file-exists-p file) 848 (ignore-errors (delete-file elt)))
814 (delete-file file))) 849 (shadow--tests-cleanup))))
815 (ignore-errors
816 (when (file-exists-p (concat (shadow-site-primary cluster2) file))
817 (delete-file (concat (shadow-site-primary cluster2) file)))))))
818 850
819(ert-deftest shadow-test09-shadow-copy-files () 851(ert-deftest shadow-test09-shadow-copy-files ()
820 "Check that needed shadow files are copied." 852 "Check that needed shadow files are copied."
@@ -826,18 +858,17 @@ guaranteed by the originator of a cluster definition."
826 (shadow-info-file shadow-test-info-file) 858 (shadow-info-file shadow-test-info-file)
827 (shadow-todo-file shadow-test-todo-file) 859 (shadow-todo-file shadow-test-todo-file)
828 (shadow-inhibit-message t) 860 (shadow-inhibit-message t)
861 (shadow-test-remote-temporary-file-directory
862 (file-truename shadow-test-remote-temporary-file-directory))
829 (shadow-noquery t) 863 (shadow-noquery t)
830 shadow-clusters shadow-files-to-copy 864 shadow-clusters shadow-files-to-copy
831 cluster1 cluster2 primary regexp file mocked-input) 865 cluster1 cluster2 primary regexp file mocked-input)
832 (unwind-protect 866 (unwind-protect
833 (progn 867 (progn
834 ;; Cleanup. 868
835 (when (file-exists-p shadow-info-file) 869 ;; Cleanup & initialize.
836 (delete-file shadow-info-file)) 870 (shadow--tests-cleanup)
837 (when (file-exists-p shadow-todo-file) 871 (shadow-initialize)
838 (delete-file shadow-todo-file))
839 (when (buffer-live-p shadow-todo-buffer)
840 (with-current-buffer shadow-todo-buffer (erase-buffer)))
841 872
842 ;; Define clusters. 873 ;; Define clusters.
843 (setq cluster1 "cluster1" 874 (setq cluster1 "cluster1"
@@ -878,7 +909,7 @@ guaranteed by the originator of a cluster definition."
878 ;; We must mock `write-region', in order to check proper 909 ;; We must mock `write-region', in order to check proper
879 ;; action. 910 ;; action.
880 (add-function 911 (add-function
881 :before (symbol-function 'write-region) 912 :before (symbol-function #'write-region)
882 (lambda (&rest args) 913 (lambda (&rest args)
883 (when (and (buffer-file-name) mocked-input) 914 (when (and (buffer-file-name) mocked-input)
884 (should (equal (buffer-file-name) (pop mocked-input))))) 915 (should (equal (buffer-file-name) (pop mocked-input)))))
@@ -893,17 +924,14 @@ guaranteed by the originator of a cluster definition."
893 (looking-at (regexp-quote "(setq shadow-files-to-copy nil)"))))) 924 (looking-at (regexp-quote "(setq shadow-files-to-copy nil)")))))
894 925
895 ;; Cleanup. 926 ;; Cleanup.
896 (remove-function (symbol-function 'write-region) "write-region-mock") 927 (remove-function (symbol-function #'write-region) "write-region-mock")
897 (when (file-exists-p shadow-info-file) 928 (dolist (elt `(,file ,(concat (shadow-site-primary cluster2) file)))
898 (delete-file shadow-info-file)) 929 (ignore-errors
899 (when (file-exists-p shadow-todo-file) 930 (with-current-buffer (get-file-buffer elt)
900 (delete-file shadow-todo-file)) 931 (set-buffer-modified-p nil)
901 (ignore-errors 932 (kill-buffer)))
902 (when (file-exists-p file) 933 (ignore-errors (delete-file elt)))
903 (delete-file file))) 934 (shadow--tests-cleanup))))
904 (ignore-errors
905 (when (file-exists-p (concat (shadow-site-primary cluster2) file))
906 (delete-file (concat (shadow-site-primary cluster2) file)))))))
907 935
908(defun shadowfile-test-all (&optional interactive) 936(defun shadowfile-test-all (&optional interactive)
909 "Run all tests for \\[shadowfile]." 937 "Run all tests for \\[shadowfile]."
@@ -912,9 +940,5 @@ guaranteed by the originator of a cluster definition."
912 (ert-run-tests-interactively "^shadowfile-") 940 (ert-run-tests-interactively "^shadowfile-")
913 (ert-run-tests-batch "^shadowfile-"))) 941 (ert-run-tests-batch "^shadowfile-")))
914 942
915(let ((shadow-info-file shadow-test-info-file)
916 (shadow-todo-file shadow-test-todo-file))
917 (shadow-initialize))
918
919(provide 'shadowfile-tests) 943(provide 'shadowfile-tests)
920;;; shadowfile-tests.el ends here 944;;; shadowfile-tests.el ends here
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index a9d48e29a8a..3a7462b6ada 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."
653 (data-tests-check-sign (% -1 -3) (% nb1 nb3)) 653 (data-tests-check-sign (% -1 -3) (% nb1 nb3))
654 (data-tests-check-sign (mod -1 -3) (mod nb1 nb3)))) 654 (data-tests-check-sign (mod -1 -3) (mod nb1 nb3))))
655 655
656(ert-deftest data-tests-mod-0 ()
657 (dolist (num (list (1- most-negative-fixnum) -1 0 1
658 (1+ most-positive-fixnum)))
659 (should-error (mod num 0)))
660 (when (ignore-errors (/ 0.0 0))
661 (should (equal (abs (mod 0.0 0)) (abs (- 0.0 (/ 0.0 0)))))))
662
656(ert-deftest data-tests-ash-lsh () 663(ert-deftest data-tests-ash-lsh ()
657 (should (= (ash most-negative-fixnum 1) 664 (should (= (ash most-negative-fixnum 1)
658 (* most-negative-fixnum 2))) 665 (* most-negative-fixnum 2)))
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 82b75b195ca..ba5bfe0145d 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -220,4 +220,7 @@ literals (Bug#20852)."
220 (* most-positive-fixnum most-positive-fixnum))) 220 (* most-positive-fixnum most-positive-fixnum)))
221 (should (= n (string-to-number (format "%d." n)))))) 221 (should (= n (string-to-number (format "%d." n))))))
222 222
223(ert-deftest lread-circular-hash ()
224 (should-error (read "#s(hash-table data #0=(#0# . #0#))")))
225
223;;; lread-tests.el ends here 226;;; lread-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 7745fccaf9d..158c036aaa7 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -22,6 +22,7 @@
22;;; Code: 22;;; Code:
23 23
24(require 'ert) 24(require 'ert)
25(require 'puny)
25 26
26;; Timeout in seconds; the test fails if the timeout is reached. 27;; Timeout in seconds; the test fails if the timeout is reached.
27(defvar process-test-sentinel-wait-timeout 2.0) 28(defvar process-test-sentinel-wait-timeout 2.0)
@@ -154,24 +155,30 @@
154 (concat invocation-directory invocation-name) 155 (concat invocation-directory invocation-name)
155 "-Q" "--batch" "--eval" 156 "-Q" "--batch" "--eval"
156 (prin1-to-string 157 (prin1-to-string
157 '(let (s) 158 '(let ((s nil) (count 0))
158 (while (setq s (read-from-minibuffer "$ ")) 159 (while (setq s (read-from-minibuffer
160 (format "%d> " count)))
159 (princ s) 161 (princ s)
160 (princ "\n"))))))) 162 (princ "\n")
163 (setq count (1+ count))))))))
161 (set-process-query-on-exit-flag proc nil) 164 (set-process-query-on-exit-flag proc nil)
162 (send-string proc "one\n") 165 (send-string proc "one\n")
163 (should 166 (while (not (equal (buffer-substring
164 (accept-process-output proc 1)) ; Read "one". 167 (line-beginning-position) (point-max))
165 (should (equal (buffer-string) "$ one\n$ ")) 168 "1> "))
169 (accept-process-output proc)) ; Read "one".
170 (should (equal (buffer-string) "0> one\n1> "))
166 (set-process-filter proc t) ; Stop reading from proc. 171 (set-process-filter proc t) ; Stop reading from proc.
167 (send-string proc "two\n") 172 (send-string proc "two\n")
168 (should-not 173 (should-not
169 (accept-process-output proc 1)) ; Can't read "two" yet. 174 (accept-process-output proc 1)) ; Can't read "two" yet.
170 (should (equal (buffer-string) "$ one\n$ ")) 175 (should (equal (buffer-string) "0> one\n1> "))
171 (set-process-filter proc nil) ; Resume reading from proc. 176 (set-process-filter proc nil) ; Resume reading from proc.
172 (should 177 (while (not (equal (buffer-substring
173 (accept-process-output proc 1)) ; Read "two" from proc. 178 (line-beginning-position) (point-max))
174 (should (equal (buffer-string) "$ one\n$ two\n$ "))))) 179 "2> "))
180 (accept-process-output proc)) ; Read "Two".
181 (should (equal (buffer-string) "0> one\n1> two\n2> ")))))
175 182
176(ert-deftest start-process-should-not-modify-arguments () 183(ert-deftest start-process-should-not-modify-arguments ()
177 "`start-process' must not modify its arguments in-place." 184 "`start-process' must not modify its arguments in-place."
@@ -322,5 +329,41 @@ See Bug#30460."
322 invocation-directory)) 329 invocation-directory))
323 :stop t))) 330 :stop t)))
324 331
332;; All the following tests require working DNS, which appears not to
333;; be the case for hydra.nixos.org, so disable them there for now.
334
335(ert-deftest lookup-family-specification ()
336 "network-lookup-address-info should only accept valid family symbols."
337 (skip-unless (not (getenv "EMACS_HYDRA_CI")))
338 (should-error (network-lookup-address-info "google.com" 'both))
339 (should (network-lookup-address-info "google.com" 'ipv4))
340 (should (network-lookup-address-info "google.com" 'ipv6)))
341
342(ert-deftest lookup-unicode-domains ()
343 "Unicode domains should fail"
344 (skip-unless (not (getenv "EMACS_HYDRA_CI")))
345 (should-error (network-lookup-address-info "faß.de"))
346 (should (network-lookup-address-info (puny-encode-domain "faß.de"))))
347
348(ert-deftest unibyte-domain-name ()
349 "Unibyte domain names should work"
350 (skip-unless (not (getenv "EMACS_HYDRA_CI")))
351 (should (network-lookup-address-info (string-to-unibyte "google.com"))))
352
353(ert-deftest lookup-google ()
354 "Check that we can look up google IP addresses"
355 (skip-unless (not (getenv "EMACS_HYDRA_CI")))
356 (let ((addresses-both (network-lookup-address-info "google.com"))
357 (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))
358 (addresses-v6 (network-lookup-address-info "google.com" 'ipv6)))
359 (should addresses-both)
360 (should addresses-v4)
361 (should addresses-v6)))
362
363(ert-deftest non-existent-lookup-failure ()
364 (skip-unless (not (getenv "EMACS_HYDRA_CI")))
365 "Check that looking up non-existent domain returns nil"
366 (should (eq nil (network-lookup-address-info "emacs.invalid"))))
367
325(provide 'process-tests) 368(provide 'process-tests)
326;; process-tests.el ends here. 369;; process-tests.el ends here.
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index a30b2de3a5b..3a18a4a24dd 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -19,6 +19,12 @@
19 19
20(require 'ert) 20(require 'ert)
21 21
22(defun timefns-tests--decode-time (look zone decoded-time)
23 (should (equal (decode-time look zone t) decoded-time))
24 (should (equal (decode-time look zone 'integer)
25 (cons (time-convert (car decoded-time) 'integer)
26 (cdr decoded-time)))))
27
22;;; Check format-time-string and decode-time with various TZ settings. 28;;; Check format-time-string and decode-time with various TZ settings.
23;;; Use only POSIX-compatible TZ values, since the tests should work 29;;; Use only POSIX-compatible TZ values, since the tests should work
24;;; even if tzdb is not in use. 30;;; even if tzdb is not in use.
@@ -40,31 +46,29 @@
40 (7879679999900 . 100000) 46 (7879679999900 . 100000)
41 (78796799999999999999 . 1000000000000))) 47 (78796799999999999999 . 1000000000000)))
42 ;; UTC. 48 ;; UTC.
43 (let ((sec (time-add 59 (time-subtract (time-convert look t) 49 (let* ((look-ticks-hz (time-convert look t))
44 (time-convert look 'integer))))) 50 (hz (cdr look-ticks-hz))
51 (look-integer (time-convert look 'integer))
52 (sec (time-add (time-convert 59 hz)
53 (time-subtract look-ticks-hz
54 (time-convert look-integer hz)))))
45 (should (string-equal 55 (should (string-equal
46 (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t) 56 (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
47 "1972-06-30 23:59:59.999 +0000")) 57 "1972-06-30 23:59:59.999 +0000"))
48 (should (equal (decode-time look t 'integer) 58 (timefns-tests--decode-time look t
49 '(59 59 23 30 6 1972 5 nil 0))) 59 (list sec 59 23 30 6 1972 5 nil 0))
50 (should (equal (decode-time look t t)
51 (list sec 59 23 30 6 1972 5 nil 0)))
52 ;; "UTC0". 60 ;; "UTC0".
53 (should (string-equal 61 (should (string-equal
54 (format-time-string format look "UTC0") 62 (format-time-string format look "UTC0")
55 "1972-06-30 23:59:59.999 +0000 (UTC)")) 63 "1972-06-30 23:59:59.999 +0000 (UTC)"))
56 (should (equal (decode-time look "UTC0" 'integer) 64 (timefns-tests--decode-time look "UTC0"
57 '(59 59 23 30 6 1972 5 nil 0))) 65 (list sec 59 23 30 6 1972 5 nil 0))
58 (should (equal (decode-time look "UTC0" t)
59 (list sec 59 23 30 6 1972 5 nil 0)))
60 ;; Negative UTC offset, as a Lisp list. 66 ;; Negative UTC offset, as a Lisp list.
61 (should (string-equal 67 (should (string-equal
62 (format-time-string format look '(-28800 "PST")) 68 (format-time-string format look '(-28800 "PST"))
63 "1972-06-30 15:59:59.999 -0800 (PST)")) 69 "1972-06-30 15:59:59.999 -0800 (PST)"))
64 (should (equal (decode-time look '(-28800 "PST") 'integer) 70 (timefns-tests--decode-time look '(-28800 "PST")
65 '(59 59 15 30 6 1972 5 nil -28800))) 71 (list sec 59 15 30 6 1972 5 nil -28800))
66 (should (equal (decode-time look '(-28800 "PST") t)
67 (list sec 59 15 30 6 1972 5 nil -28800)))
68 ;; Negative UTC offset, as a Lisp integer. 72 ;; Negative UTC offset, as a Lisp integer.
69 (should (string-equal 73 (should (string-equal
70 (format-time-string format look -28800) 74 (format-time-string format look -28800)
@@ -73,18 +77,14 @@
73 (if (eq system-type 'windows-nt) 77 (if (eq system-type 'windows-nt)
74 "1972-06-30 15:59:59.999 -0800 (ZZZ)" 78 "1972-06-30 15:59:59.999 -0800 (ZZZ)"
75 "1972-06-30 15:59:59.999 -0800 (-08)"))) 79 "1972-06-30 15:59:59.999 -0800 (-08)")))
76 (should (equal (decode-time look -28800 'integer) 80 (timefns-tests--decode-time look -28800
77 '(59 59 15 30 6 1972 5 nil -28800))) 81 (list sec 59 15 30 6 1972 5 nil -28800))
78 (should (equal (decode-time look -28800 t)
79 (list sec 59 15 30 6 1972 5 nil -28800)))
80 ;; Positive UTC offset that is not an hour multiple, as a string. 82 ;; Positive UTC offset that is not an hour multiple, as a string.
81 (should (string-equal 83 (should (string-equal
82 (format-time-string format look "IST-5:30") 84 (format-time-string format look "IST-5:30")
83 "1972-07-01 05:29:59.999 +0530 (IST)")) 85 "1972-07-01 05:29:59.999 +0530 (IST)"))
84 (should (equal (decode-time look "IST-5:30" 'integer) 86 (timefns-tests--decode-time look "IST-5:30"
85 '(59 29 5 1 7 1972 6 nil 19800))) 87 (list sec 29 5 1 7 1972 6 nil 19800))))))
86 (should (equal (decode-time look "IST-5:30" t)
87 (list sec 29 5 1 7 1972 6 nil 19800)))))))
88 88
89(ert-deftest decode-then-encode-time () 89(ert-deftest decode-then-encode-time ()
90 (let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0 90 (let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0
@@ -129,6 +129,12 @@
129 most-negative-fixnum most-positive-fixnum 129 most-negative-fixnum most-positive-fixnum
130 (1- most-negative-fixnum) 130 (1- most-negative-fixnum)
131 (1+ most-positive-fixnum) 131 (1+ most-positive-fixnum)
132 1e1 -1e1 1e-1 -1e-1
133 1e8 -1e8 1e-8 -1e-8
134 1e9 -1e9 1e-9 -1e-9
135 1e10 -1e10 1e-10 -1e-10
136 1e16 -1e16 1e-16 -1e-16
137 1e37 -1e37 1e-37 -1e-37
132 1e+INF -1e+INF 1e+NaN -1e+NaN 138 1e+INF -1e+INF 1e+NaN -1e+NaN
133 '(0 0 0 1) '(0 0 1 0) '(0 1 0 0) '(1 0 0 0) 139 '(0 0 0 1) '(0 0 1 0) '(0 1 0 0) '(1 0 0 0)
134 '(-1 0 0 0) '(1 2 3 4) '(-1 2 3 4) 140 '(-1 0 0 0) '(1 2 3 4) '(-1 2 3 4)