aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorVibhav Pant2017-01-30 18:35:43 +0530
committerVibhav Pant2017-01-30 18:35:43 +0530
commitbf7f7c0d82a56ed1b76358657e74ca2833b19fe2 (patch)
tree90f357b4a735ca7c90d1881ef9948186b9f919df
parent25d38a06eceb0853190a2d9acf53d85686f524bd (diff)
parent9c4dfdd1af9f97c6a8d7e922b68a39052116790c (diff)
downloademacs-bf7f7c0d82a56ed1b76358657e74ca2833b19fe2.tar.gz
emacs-bf7f7c0d82a56ed1b76358657e74ca2833b19fe2.zip
Merge remote-tracking branch 'origin/master' into feature/byte-switch
-rw-r--r--doc/lispref/internals.texi6
-rw-r--r--doc/lispref/lists.texi33
-rw-r--r--doc/lispref/processes.texi8
-rw-r--r--doc/lispref/threads.texi11
-rw-r--r--doc/misc/cl.texi2
-rw-r--r--doc/misc/emacs-mime.texi4
-rw-r--r--doc/misc/gnus.texi34
-rw-r--r--etc/DEBUG2
-rw-r--r--etc/NEWS29
-rw-r--r--etc/refcards/ru-refcard.tex2
-rw-r--r--lisp/battery.el3
-rw-r--r--lisp/calc/calc-misc.el2
-rw-r--r--lisp/dired-aux.el2
-rw-r--r--lisp/emacs-lisp/backquote.el10
-rw-r--r--lisp/emacs-lisp/cl-generic.el15
-rw-r--r--lisp/emacs-lisp/cl-lib.el143
-rw-r--r--lisp/emacs-lisp/cl.el24
-rw-r--r--lisp/emacs-lisp/derived.el2
-rw-r--r--lisp/emacs-lisp/tabulated-list.el9
-rw-r--r--lisp/ffap.el2
-rw-r--r--lisp/files.el11
-rw-r--r--lisp/gnus/gnus-art.el15
-rw-r--r--lisp/gnus/gnus-msg.el9
-rw-r--r--lisp/gnus/gnus-salt.el4
-rw-r--r--lisp/gnus/gnus-start.el9
-rw-r--r--lisp/gnus/gnus-sum.el28
-rw-r--r--lisp/gnus/gnus-topic.el2
-rw-r--r--lisp/gnus/gnus.el4
-rw-r--r--lisp/gnus/message.el132
-rw-r--r--lisp/gnus/mml.el98
-rw-r--r--lisp/gnus/nndoc.el20
-rw-r--r--lisp/gnus/nnimap.el6
-rw-r--r--lisp/help-fns.el40
-rw-r--r--lisp/help-mode.el2
-rw-r--r--lisp/hl-line.el3
-rw-r--r--lisp/htmlfontify.el12
-rw-r--r--lisp/info-look.el29
-rw-r--r--lisp/mail/ietf-drums.el11
-rw-r--r--lisp/mail/rfc2047.el12
-rw-r--r--lisp/net/eww.el71
-rw-r--r--lisp/net/network-stream.el4
-rw-r--r--lisp/net/shr.el32
-rw-r--r--lisp/net/tramp.el6
-rw-r--r--lisp/net/zeroconf.el6
-rw-r--r--lisp/play/dunnet.el119
-rw-r--r--lisp/progmodes/cc-engine.el48
-rw-r--r--lisp/progmodes/cc-mode.el3
-rw-r--r--lisp/progmodes/hideshow.el2
-rw-r--r--lisp/progmodes/js.el27
-rw-r--r--lisp/progmodes/python.el20
-rw-r--r--lisp/progmodes/sql.el2
-rw-r--r--lisp/progmodes/vhdl-mode.el43
-rw-r--r--lisp/progmodes/xref.el4
-rw-r--r--lisp/recentf.el2
-rw-r--r--lisp/shell.el13
-rw-r--r--lisp/simple.el8
-rw-r--r--lisp/subr.el120
-rw-r--r--lisp/term.el15
-rw-r--r--lisp/textmodes/css-mode.el3
-rw-r--r--lisp/textmodes/reftex-vars.el2
-rw-r--r--lisp/textmodes/rst.el15
-rw-r--r--lisp/vc/diff-mode.el274
-rw-r--r--lisp/vc/ediff-init.el46
-rw-r--r--lisp/xml.el6
-rw-r--r--src/alloc.c114
-rw-r--r--src/atimer.c1
-rw-r--r--src/buffer.c13
-rw-r--r--src/bytecode.c2
-rw-r--r--src/callint.c2
-rw-r--r--src/callproc.c16
-rw-r--r--src/category.c2
-rw-r--r--src/ccl.c2
-rw-r--r--src/decompress.c2
-rw-r--r--src/dired.c10
-rw-r--r--src/editfns.c16
-rw-r--r--src/emacs-module.c2
-rw-r--r--src/eval.c40
-rw-r--r--src/fileio.c73
-rw-r--r--src/filelock.c2
-rw-r--r--src/fns.c405
-rw-r--r--src/fontset.c8
-rw-r--r--src/frame.c5
-rw-r--r--src/gfilenotify.c8
-rw-r--r--src/gnutls.c13
-rw-r--r--src/image.c2
-rw-r--r--src/indent.c6
-rw-r--r--src/insdel.c12
-rw-r--r--src/keyboard.c18
-rw-r--r--src/keyboard.h2
-rw-r--r--src/keymap.c12
-rw-r--r--src/lisp.h49
-rw-r--r--src/lread.c14
-rw-r--r--src/macros.c2
-rw-r--r--src/minibuf.c2
-rw-r--r--src/print.c16
-rw-r--r--src/process.c22
-rw-r--r--src/profiler.c6
-rw-r--r--src/regex.c7
-rw-r--r--src/search.c49
-rw-r--r--src/syntax.c167
-rw-r--r--src/sysdep.c10
-rw-r--r--src/textprop.c2
-rw-r--r--src/thread.c61
-rw-r--r--src/w32fns.c8
-rw-r--r--src/w32notify.c2
-rw-r--r--src/w32proc.c2
-rw-r--r--src/window.c7
-rw-r--r--src/xdisp.c2
-rw-r--r--src/xselect.c4
-rw-r--r--src/xterm.c62
-rw-r--r--test/lisp/abbrev-tests.el3
-rw-r--r--test/lisp/emacs-lisp/cl-seq-tests.el6
-rw-r--r--test/lisp/emacs-lisp/let-alist-tests.el5
-rw-r--r--test/lisp/faces-tests.el9
-rw-r--r--test/lisp/ffap-tests.el2
-rw-r--r--test/lisp/filenotify-tests.el14
-rw-r--r--test/lisp/htmlfontify-tests.el12
-rw-r--r--test/lisp/ibuffer-tests.el9
-rw-r--r--test/lisp/minibuffer-tests.el2
-rw-r--r--test/lisp/net/dbus-tests.el3
-rw-r--r--test/lisp/net/tramp-tests.el16
-rw-r--r--test/lisp/progmodes/js-tests.el26
-rw-r--r--test/lisp/progmodes/python-tests.el23
-rw-r--r--test/lisp/simple-tests.el6
-rw-r--r--test/lisp/textmodes/tildify-tests.el2
-rw-r--r--test/lisp/xml-tests.el15
-rw-r--r--test/src/eval-tests.el10
-rw-r--r--test/src/syntax-tests.el85
-rw-r--r--test/src/thread-tests.el17
129 files changed, 1861 insertions, 1367 deletions
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 69d21bedaa4..663d0fd92b9 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -672,7 +672,7 @@ usage: (or CONDITIONS...) */)
672 if (!NILP (val)) 672 if (!NILP (val))
673 break; 673 break;
674 args = XCDR (args); 674 args = XCDR (args);
675 QUIT; 675 maybe_quit ();
676 @} 676 @}
677@end group 677@end group
678 678
@@ -792,8 +792,8 @@ their addresses after performing Lisp evaluation. Lisp evaluation can
792occur via calls to @code{eval_sub} or @code{Feval}, either directly or 792occur via calls to @code{eval_sub} or @code{Feval}, either directly or
793indirectly. 793indirectly.
794 794
795@cindex @code{QUIT}, use in Lisp primitives 795@cindex @code{maybe_quit}, use in Lisp primitives
796 Note the call to the @code{QUIT} macro inside the loop: this macro 796 Note the call to @code{maybe_quit} inside the loop: this function
797checks whether the user pressed @kbd{C-g}, and if so, aborts the 797checks whether the user pressed @kbd{C-g}, and if so, aborts the
798processing. You should do that in any loop that can potentially 798processing. You should do that in any loop that can potentially
799require a large number of iterations; in this case, the list of 799require a large number of iterations; in this case, the list of
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index bd7d85aa189..8eab2818f97 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -362,6 +362,39 @@ This is the same as @code{(cdr (cdr @var{cons-cell}))}
362or @code{(nthcdr 2 @var{cons-cell})}. 362or @code{(nthcdr 2 @var{cons-cell})}.
363@end defun 363@end defun
364 364
365@findex caaar
366@findex caadr
367@findex cadar
368@findex caddr
369@findex cdaar
370@findex cdadr
371@findex cddar
372@findex cdddr
373@findex caaaar
374@findex caaadr
375@findex caadar
376@findex caaddr
377@findex cadaar
378@findex cadadr
379@findex caddar
380@findex cadddr
381@findex cdaaar
382@findex cdaadr
383@findex cdadar
384@findex cdaddr
385@findex cddaar
386@findex cddadr
387@findex cdddar
388@findex cddddr
389In addition to the above, 24 additional compositions of @code{car} and
390@code{cdr} are defined as @code{c@var{xxx}r} and @code{c@var{xxxx}r},
391where each @code{@var{x}} is either @code{a} or @code{d}. @code{cadr},
392@code{caddr}, and @code{cadddr} pick out the second, third or fourth
393elements of a list, respectively. @file{cl-lib} provides the same
394under the names @code{cl-second}, @code{cl-third}, and
395@code{cl-fourth}. @xref{List Functions,,, cl, Common Lisp
396Extensions}.
397
365@defun butlast x &optional n 398@defun butlast x &optional n
366This function returns the list @var{x} with the last element, 399This function returns the list @var{x} with the last element,
367or the last @var{n} elements, removed. If @var{n} is greater 400or the last @var{n} elements, removed. If @var{n} is greater
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 014a0aed913..58e04a311a1 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2414,6 +2414,14 @@ If non-@code{nil}, the host's capability string.
2414The connection type: @samp{plain} or @samp{tls}. 2414The connection type: @samp{plain} or @samp{tls}.
2415@end table 2415@end table
2416 2416
2417@item :shell-command @var{string-or-nil}
2418If the connection @code{type} is @code{shell}, this parameter will be
2419interpreted as a format-spec string that will be executed to make the
2420connection. The specs available are @samp{%s} for the host name and
2421@samp{%p} for the port number. For instance, if you want to first ssh
2422to @samp{gateway} before making a plain connection, then this
2423parameter could be something like @samp{ssh gateway nc %s %p}.
2424
2417@end table 2425@end table
2418 2426
2419@end defun 2427@end defun
diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index d6cf99d2332..71742f576e5 100644
--- a/doc/lispref/threads.texi
+++ b/doc/lispref/threads.texi
@@ -127,6 +127,17 @@ Return a list of all the live thread objects. A new list is returned
127by each invocation. 127by each invocation.
128@end defun 128@end defun
129 129
130When code run by a thread signals an error that is unhandled, the
131thread exits. Other threads can access the error form which caused
132the thread to exit using the following function.
133
134@defun thread-last-error
135This function returns the last error form recorded when a thread
136exited due to an error. Each thread that exits abnormally overwrites
137the form stored by the previous thread's error with a new value, so
138only the last one can be accessed.
139@end defun
140
130@node Mutexes 141@node Mutexes
131@section Mutexes 142@section Mutexes
132 143
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 9e56a54ed74..8baa0bd88c6 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3694,7 +3694,7 @@ i.e., chains of cons cells.
3694 3694
3695@defun cl-caddr x 3695@defun cl-caddr x
3696This function is equivalent to @code{(car (cdr (cdr @var{x})))}. 3696This function is equivalent to @code{(car (cdr (cdr @var{x})))}.
3697Likewise, this package defines all 24 @code{c@var{xxx}r} functions 3697Likewise, this package aliases all 24 @code{c@var{xxx}r} functions
3698where @var{xxx} is up to four @samp{a}s and/or @samp{d}s. 3698where @var{xxx} is up to four @samp{a}s and/or @samp{d}s.
3699All of these functions are @code{setf}-able, and calls to them 3699All of these functions are @code{setf}-able, and calls to them
3700are expanded inline by the byte-compiler for maximum efficiency. 3700are expanded inline by the byte-compiler for maximum efficiency.
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 771c078be75..b0cfbc9d3c0 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -654,6 +654,10 @@ Each tag can contain zero or more parameters on the form
654but that's not necessary unless the value contains white space. So 654but that's not necessary unless the value contains white space. So
655@samp{filename=/home/user/#hello$^yes} is perfectly valid. 655@samp{filename=/home/user/#hello$^yes} is perfectly valid.
656 656
657If you want to talk about MML in a message, you need a way to
658``quote'' these tags. The way to do that is to include an exclamation
659point after the opening two characters; i. e. @samp{<#!part ...>}.
660
657The following parameters have meaning in @acronym{MML}; parameters that have no 661The following parameters have meaning in @acronym{MML}; parameters that have no
658meaning are ignored. The @acronym{MML} parameter names are the same as the 662meaning are ignored. The @acronym{MML} parameter names are the same as the
659@acronym{MIME} parameter names; the things in the parentheses say which 663@acronym{MIME} parameter names; the things in the parentheses say which
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 05159d4b2f7..ceeb42b9182 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -10197,6 +10197,11 @@ Sort by lines (@code{gnus-summary-sort-by-lines}).
10197@findex gnus-summary-sort-by-chars 10197@findex gnus-summary-sort-by-chars
10198Sort by article length (@code{gnus-summary-sort-by-chars}). 10198Sort by article length (@code{gnus-summary-sort-by-chars}).
10199 10199
10200@item C-c C-s C-m C-m
10201@kindex C-c C-s C-m C-m (Summary)
10202@findex gnus-summary-sort-by-marks
10203Sort by article ``readedness'' marks (@code{gnus-summary-sort-by-marks}).
10204
10200@item C-c C-s C-i 10205@item C-c C-s C-i
10201@kindex C-c C-s C-i (Summary) 10206@kindex C-c C-s C-i (Summary)
10202@findex gnus-summary-sort-by-score 10207@findex gnus-summary-sort-by-score
@@ -13515,7 +13520,8 @@ Close the connection (if any) to the server
13515@kindex D (Server) 13520@kindex D (Server)
13516@findex gnus-server-deny-server 13521@findex gnus-server-deny-server
13517Mark the current server as unreachable 13522Mark the current server as unreachable
13518(@code{gnus-server-deny-server}). 13523(@code{gnus-server-deny-server}). This will effectively disable the
13524server.
13519 13525
13520@item M-o 13526@item M-o
13521@kindex M-o (Server) 13527@kindex M-o (Server)
@@ -21857,37 +21863,37 @@ In summary mode:
21857 21863
21858@table @kbd 21864@table @kbd
21859 21865
21860@item $ m 21866@item G G m
21861@kindex $ m (Summary) 21867@kindex G G m (Summary)
21862@findex nnmairix-widget-search-from-this-article 21868@findex nnmairix-widget-search-from-this-article
21863Allows you to create a mairix query or group based on the current 21869Allows you to create a mairix query or group based on the current
21864message using graphical widgets (same as @code{nnmairix-widget-search}) 21870message using graphical widgets (same as @code{nnmairix-widget-search})
21865(@code{nnmairix-widget-search-from-this-article}). 21871(@code{nnmairix-widget-search-from-this-article}).
21866 21872
21867@item $ g 21873@item G G g
21868@kindex $ g (Summary) 21874@kindex G G g (Summary)
21869@findex nnmairix-create-search-group-from-message 21875@findex nnmairix-create-search-group-from-message
21870Interactively creates a new search group with query based on the current 21876Interactively creates a new search group with query based on the current
21871message, but uses the minibuffer instead of graphical widgets 21877message, but uses the minibuffer instead of graphical widgets
21872(@code{nnmairix-create-search-group-from-message}). 21878(@code{nnmairix-create-search-group-from-message}).
21873 21879
21874@item $ t 21880@item G G t
21875@kindex $ t (Summary) 21881@kindex G G t (Summary)
21876@findex nnmairix-search-thread-this-article 21882@findex nnmairix-search-thread-this-article
21877Searches thread for the current article 21883Searches thread for the current article
21878(@code{nnmairix-search-thread-this-article}). This is effectively a 21884(@code{nnmairix-search-thread-this-article}). This is effectively a
21879shortcut for calling @code{nnmairix-search} with @samp{m:msgid} of the 21885shortcut for calling @code{nnmairix-search} with @samp{m:msgid} of the
21880current article and enabled threads. 21886current article and enabled threads.
21881 21887
21882@item $ f 21888@item G G f
21883@kindex $ f (Summary) 21889@kindex G G f (Summary)
21884@findex nnmairix-search-from-this-article 21890@findex nnmairix-search-from-this-article
21885Searches all messages from sender of the current article 21891Searches all messages from sender of the current article
21886(@code{nnmairix-search-from-this-article}). This is a shortcut for 21892(@code{nnmairix-search-from-this-article}). This is a shortcut for
21887calling @code{nnmairix-search} with @samp{f:From}. 21893calling @code{nnmairix-search} with @samp{f:From}.
21888 21894
21889@item $ o 21895@item G G o
21890@kindex $ o (Summary) 21896@kindex G G o (Summary)
21891@findex nnmairix-goto-original-article 21897@findex nnmairix-goto-original-article
21892(Only in @code{nnmairix} groups!) Tries determine the group this article 21898(Only in @code{nnmairix} groups!) Tries determine the group this article
21893originally came from and displays the article in this group, so that, 21899originally came from and displays the article in this group, so that,
@@ -21896,8 +21902,8 @@ parameters are applied (@code{nnmairix-goto-original-article}). This
21896function will use the registry if available, but can also parse the 21902function will use the registry if available, but can also parse the
21897article file name as a fallback method. 21903article file name as a fallback method.
21898 21904
21899@item $ u 21905@item G G u
21900@kindex $ u (Summary) 21906@kindex G G u (Summary)
21901@findex nnmairix-remove-tick-mark-original-article 21907@findex nnmairix-remove-tick-mark-original-article
21902Remove possibly existing tick mark from original article 21908Remove possibly existing tick mark from original article
21903(@code{nnmairix-remove-tick-mark-original-article}). (@pxref{nnmairix 21909(@code{nnmairix-remove-tick-mark-original-article}). (@pxref{nnmairix
@@ -22051,7 +22057,7 @@ activate the always-unread feature by using @kbd{G b r} twice.
22051 22057
22052So far so good---but how do you remove the tick marks in the @code{nnmairix} 22058So far so good---but how do you remove the tick marks in the @code{nnmairix}
22053group? There are two options: You may simply use 22059group? There are two options: You may simply use
22054@code{nnmairix-remove-tick-mark-original-article} (bound to @kbd{$ u}) to remove 22060@code{nnmairix-remove-tick-mark-original-article} (bound to @kbd{G G u}) to remove
22055tick marks from the original article. The other possibility is to set 22061tick marks from the original article. The other possibility is to set
22056@code{nnmairix-propagate-marks-to-nnmairix-groups} to @code{t}, but see the above 22062@code{nnmairix-propagate-marks-to-nnmairix-groups} to @code{t}, but see the above
22057comments about this option. If it works for you, the tick marks should 22063comments about this option. If it works for you, the tick marks should
diff --git a/etc/DEBUG b/etc/DEBUG
index acb08c660e0..3719c3e6f66 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -225,7 +225,7 @@ this command:
225 handle SIGINT stop nopass 225 handle SIGINT stop nopass
226 226
227After this 'handle' command, SIGINT will return control to GDB. If 227After this 'handle' command, SIGINT will return control to GDB. If
228you want the C-g to cause a QUIT within Emacs as well, omit the 'nopass'. 228you want the C-g to cause a quit within Emacs as well, omit the 'nopass'.
229See the GDB manual for more details about signal handling and the 229See the GDB manual for more details about signal handling and the
230'handle' command. 230'handle' command.
231 231
diff --git a/etc/NEWS b/etc/NEWS
index 051b97e146a..12ff21f39ae 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -116,7 +116,16 @@ dired buffer.
116** Emacs now uses double buffering to reduce flicker when editing and 116** Emacs now uses double buffering to reduce flicker when editing and
117resizing graphical Emacs frames on the X Window System. This support 117resizing graphical Emacs frames on the X Window System. This support
118requires the DOUBLE-BUFFER extension, which major X servers have 118requires the DOUBLE-BUFFER extension, which major X servers have
119supported for many years. 119supported for many years. If your system has this extension, but an
120Emacs built with double buffering misbehaves on some displays you use,
121you can disable the feature by adding
122
123 '(inhibit-double-buffering . t)
124
125to default-frame-parameters. Or inject this parameter into the
126selected frame by evaluating this form:
127
128 (modify-frame-parameters nil '((inhibit-double-buffering . t)))
120 129
121--- 130---
122The group 'wp', whose label was "text", is now deprecated. 131The group 'wp', whose label was "text", is now deprecated.
@@ -339,6 +348,16 @@ bound to 'Buffer-menu-unmark-all-buffers'.
339*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and 348*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and
340'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'. 349'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'.
341 350
351** Gnus
352
353---
354*** The .newsrc file will now only be saved if the native select
355method is an NNTP select method.
356
357+++
358*** A new command for sorting articles by readedness marks has been
359added: `C-c C-s C-m C-m'.
360
342** Ibuffer 361** Ibuffer
343 362
344--- 363---
@@ -778,6 +797,11 @@ of an arbitrary function. This generalizes 'subr-arity' for functions
778that are not built-in primitives. We recommend using this new 797that are not built-in primitives. We recommend using this new
779function instead of 'subr-arity'. 798function instead of 'subr-arity'.
780 799
800** New function 'region-bounds' can be used in the interactive spec
801to provide region boundaries (for rectangular regions more than one)
802to an interactively callable function as a single argument instead of
803two separate arguments region-beginning and region-end.
804
781+++ 805+++
782** 'parse-partial-sexp' state has a new element. Element 10 is 806** 'parse-partial-sexp' state has a new element. Element 10 is
783non-nil when the last character scanned might be the first character 807non-nil when the last character scanned might be the first character
@@ -838,6 +862,9 @@ ABBR is a time zone abbreviation. The affected functions are
838collection). 862collection).
839 863
840+++ 864+++
865** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp.
866
867+++
841** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' 868** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
842can be used for creation of temporary files of remote or mounted directories. 869can be used for creation of temporary files of remote or mounted directories.
843 870
diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex
index c961f7a2a02..fad75ddda47 100644
--- a/etc/refcards/ru-refcard.tex
+++ b/etc/refcards/ru-refcard.tex
@@ -41,7 +41,7 @@
41\setlength{\ColThreeWidth}{25mm} 41\setlength{\ColThreeWidth}{25mm}
42 42
43\newcommand{\versionemacs}[0]{26} % version of Emacs this is for 43\newcommand{\versionemacs}[0]{26} % version of Emacs this is for
44\newcommand{\cyear}[0]{2016} % copyright year 44\newcommand{\cyear}[0]{2017} % copyright year
45 45
46\newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill 46\newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill
47 \centerline{\footnotesize \copyright\ \cyear\ Free Software Foundation, Inc. 47 \centerline{\footnotesize \copyright\ \cyear\ Free Software Foundation, Inc.
diff --git a/lisp/battery.el b/lisp/battery.el
index 71268e59ecd..b1834f06ff8 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -542,6 +542,9 @@ The following %-sequences are provided:
542 (t "N/A")))))) 542 (t "N/A"))))))
543 543
544 544
545(declare-function dbus-get-property "dbus.el"
546 (bus service path interface property))
547
545;;; `upowerd' interface. 548;;; `upowerd' interface.
546(defsubst battery-upower-prop (pname &optional device) 549(defsubst battery-upower-prop (pname &optional device)
547 (dbus-get-property 550 (dbus-get-property
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 7b7a7208aaa..e6af0920639 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -623,7 +623,7 @@ loaded and the keystroke automatically re-typed."
623 (unwind-protect 623 (unwind-protect
624 (progn 624 (progn
625 (sit-for 2) 625 (sit-for 2)
626 (identity 1) ; this forces a call to QUIT; in bytecode.c. 626 (identity 1) ; This forces a call to maybe_quit in bytecode.c.
627 (setq okay t)) 627 (setq okay t))
628 (progn 628 (progn
629 (delete-region savemax (point-max)) 629 (delete-region savemax (point-max))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index cabcfcdbd3f..caa3b45705b 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -987,6 +987,8 @@ corresponding command.
987Within CMD, %i denotes the input file(s), and %o denotes the 987Within CMD, %i denotes the input file(s), and %o denotes the
988output file. %i path(s) are relative, while %o is absolute.") 988output file. %i path(s) are relative, while %o is absolute.")
989 989
990(declare-function format-spec "format-spec.el" (format specification))
991
990;;;###autoload 992;;;###autoload
991(defun dired-do-compress-to () 993(defun dired-do-compress-to ()
992 "Compress selected files and directories to an archive. 994 "Compress selected files and directories to an archive.
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 94c561cba0a..bb877dd2c97 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -247,4 +247,14 @@ LEVEL is only used internally and indicates the nesting level:
247 tail)) 247 tail))
248 (t (cons 'list heads))))) 248 (t (cons 'list heads)))))
249 249
250
251;; Give `,' and `,@' documentation strings which can be examined by C-h f.
252(put '\, 'function-documentation
253 "See `\\=`' (also `pcase') for the usage of `,'.")
254(put '\, 'reader-construct t)
255
256(put '\,@ 'function-documentation
257 "See `\\=`' for the usage of `,@'.")
258(put '\,@ 'reader-construct t)
259
250;;; backquote.el ends here 260;;; backquote.el ends here
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8d141d7a646..6cc70c4c2f5 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -226,7 +226,13 @@ DEFAULT-BODY, if present, is used as the body of a default method.
226 (when (eq 'setf (car-safe name)) 226 (when (eq 'setf (car-safe name))
227 (require 'gv) 227 (require 'gv)
228 (setq name (gv-setter (cadr name)))) 228 (setq name (gv-setter (cadr name))))
229 `(progn 229 `(prog1
230 (progn
231 (defalias ',name
232 (cl-generic-define ',name ',args ',(nreverse options))
233 ,(help-add-fundoc-usage doc args))
234 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
235 (nreverse methods)))
230 ,@(mapcar (lambda (declaration) 236 ,@(mapcar (lambda (declaration)
231 (let ((f (cdr (assq (car declaration) 237 (let ((f (cdr (assq (car declaration)
232 defun-declarations-alist)))) 238 defun-declarations-alist))))
@@ -235,12 +241,7 @@ DEFAULT-BODY, if present, is used as the body of a default method.
235 (t (message "Warning: Unknown defun property `%S' in %S" 241 (t (message "Warning: Unknown defun property `%S' in %S"
236 (car declaration) name) 242 (car declaration) name)
237 nil)))) 243 nil))))
238 (cdr declarations)) 244 (cdr declarations)))))
239 (defalias ',name
240 (cl-generic-define ',name ',args ',(nreverse options))
241 ,(help-add-fundoc-usage doc args))
242 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
243 (nreverse methods)))))
244 245
245;;;###autoload 246;;;###autoload
246(defun cl-generic-define (name args options) 247(defun cl-generic-define (name args options)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index b1db07fe165..5aa8f1bf652 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -413,125 +413,30 @@ Signal an error if X is not a list."
413 (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) 413 (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
414 (nth 9 x)) 414 (nth 9 x))
415 415
416(defun cl-caaar (x) 416(defalias 'cl-caaar 'caaar)
417 "Return the `car' of the `car' of the `car' of X." 417(defalias 'cl-caadr 'caadr)
418 (declare (compiler-macro internal--compiler-macro-cXXr)) 418(defalias 'cl-cadar 'cadar)
419 (car (car (car x)))) 419(defalias 'cl-caddr 'caddr)
420 420(defalias 'cl-cdaar 'cdaar)
421(defun cl-caadr (x) 421(defalias 'cl-cdadr 'cdadr)
422 "Return the `car' of the `car' of the `cdr' of X." 422(defalias 'cl-cddar 'cddar)
423 (declare (compiler-macro internal--compiler-macro-cXXr)) 423(defalias 'cl-cdddr 'cdddr)
424 (car (car (cdr x)))) 424(defalias 'cl-caaaar 'caaaar)
425 425(defalias 'cl-caaadr 'caaadr)
426(defun cl-cadar (x) 426(defalias 'cl-caadar 'caadar)
427 "Return the `car' of the `cdr' of the `car' of X." 427(defalias 'cl-caaddr 'caaddr)
428 (declare (compiler-macro internal--compiler-macro-cXXr)) 428(defalias 'cl-cadaar 'cadaar)
429 (car (cdr (car x)))) 429(defalias 'cl-cadadr 'cadadr)
430 430(defalias 'cl-caddar 'caddar)
431(defun cl-caddr (x) 431(defalias 'cl-cadddr 'cadddr)
432 "Return the `car' of the `cdr' of the `cdr' of X." 432(defalias 'cl-cdaaar 'cdaaar)
433 (declare (compiler-macro internal--compiler-macro-cXXr)) 433(defalias 'cl-cdaadr 'cdaadr)
434 (car (cdr (cdr x)))) 434(defalias 'cl-cdadar 'cdadar)
435 435(defalias 'cl-cdaddr 'cdaddr)
436(defun cl-cdaar (x) 436(defalias 'cl-cddaar 'cddaar)
437 "Return the `cdr' of the `car' of the `car' of X." 437(defalias 'cl-cddadr 'cddadr)
438 (declare (compiler-macro internal--compiler-macro-cXXr)) 438(defalias 'cl-cdddar 'cdddar)
439 (cdr (car (car x)))) 439(defalias 'cl-cddddr 'cddddr)
440
441(defun cl-cdadr (x)
442 "Return the `cdr' of the `car' of the `cdr' of X."
443 (declare (compiler-macro internal--compiler-macro-cXXr))
444 (cdr (car (cdr x))))
445
446(defun cl-cddar (x)
447 "Return the `cdr' of the `cdr' of the `car' of X."
448 (declare (compiler-macro internal--compiler-macro-cXXr))
449 (cdr (cdr (car x))))
450
451(defun cl-cdddr (x)
452 "Return the `cdr' of the `cdr' of the `cdr' of X."
453 (declare (compiler-macro internal--compiler-macro-cXXr))
454 (cdr (cdr (cdr x))))
455
456(defun cl-caaaar (x)
457 "Return the `car' of the `car' of the `car' of the `car' of X."
458 (declare (compiler-macro internal--compiler-macro-cXXr))
459 (car (car (car (car x)))))
460
461(defun cl-caaadr (x)
462 "Return the `car' of the `car' of the `car' of the `cdr' of X."
463 (declare (compiler-macro internal--compiler-macro-cXXr))
464 (car (car (car (cdr x)))))
465
466(defun cl-caadar (x)
467 "Return the `car' of the `car' of the `cdr' of the `car' of X."
468 (declare (compiler-macro internal--compiler-macro-cXXr))
469 (car (car (cdr (car x)))))
470
471(defun cl-caaddr (x)
472 "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
473 (declare (compiler-macro internal--compiler-macro-cXXr))
474 (car (car (cdr (cdr x)))))
475
476(defun cl-cadaar (x)
477 "Return the `car' of the `cdr' of the `car' of the `car' of X."
478 (declare (compiler-macro internal--compiler-macro-cXXr))
479 (car (cdr (car (car x)))))
480
481(defun cl-cadadr (x)
482 "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
483 (declare (compiler-macro internal--compiler-macro-cXXr))
484 (car (cdr (car (cdr x)))))
485
486(defun cl-caddar (x)
487 "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
488 (declare (compiler-macro internal--compiler-macro-cXXr))
489 (car (cdr (cdr (car x)))))
490
491(defun cl-cadddr (x)
492 "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
493 (declare (compiler-macro internal--compiler-macro-cXXr))
494 (car (cdr (cdr (cdr x)))))
495
496(defun cl-cdaaar (x)
497 "Return the `cdr' of the `car' of the `car' of the `car' of X."
498 (declare (compiler-macro internal--compiler-macro-cXXr))
499 (cdr (car (car (car x)))))
500
501(defun cl-cdaadr (x)
502 "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
503 (declare (compiler-macro internal--compiler-macro-cXXr))
504 (cdr (car (car (cdr x)))))
505
506(defun cl-cdadar (x)
507 "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
508 (declare (compiler-macro internal--compiler-macro-cXXr))
509 (cdr (car (cdr (car x)))))
510
511(defun cl-cdaddr (x)
512 "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
513 (declare (compiler-macro internal--compiler-macro-cXXr))
514 (cdr (car (cdr (cdr x)))))
515
516(defun cl-cddaar (x)
517 "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
518 (declare (compiler-macro internal--compiler-macro-cXXr))
519 (cdr (cdr (car (car x)))))
520
521(defun cl-cddadr (x)
522 "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
523 (declare (compiler-macro internal--compiler-macro-cXXr))
524 (cdr (cdr (car (cdr x)))))
525
526(defun cl-cdddar (x)
527 "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
528 (declare (compiler-macro internal--compiler-macro-cXXr))
529 (cdr (cdr (cdr (car x)))))
530
531(defun cl-cddddr (x)
532 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
533 (declare (compiler-macro internal--compiler-macro-cXXr))
534 (cdr (cdr (cdr (cdr x)))))
535 440
536;;(defun last* (x &optional n) 441;;(defun last* (x &optional n)
537;; "Returns the last link in the list LIST. 442;; "Returns the last link in the list LIST.
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index e33a603d1b0..73eb9a4e866 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -258,30 +258,6 @@
258 copy-list 258 copy-list
259 ldiff 259 ldiff
260 list* 260 list*
261 cddddr
262 cdddar
263 cddadr
264 cddaar
265 cdaddr
266 cdadar
267 cdaadr
268 cdaaar
269 cadddr
270 caddar
271 cadadr
272 cadaar
273 caaddr
274 caadar
275 caaadr
276 caaaar
277 cdddr
278 cddar
279 cdadr
280 cdaar
281 caddr
282 cadar
283 caadr
284 caaar
285 tenth 261 tenth
286 ninth 262 ninth
287 eighth 263 eighth
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 762c7624577..fffe972460c 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -216,6 +216,7 @@ No problems result if this variable is not bound.
216 (purecopy ,(format "Keymap for `%s'." child)))) 216 (purecopy ,(format "Keymap for `%s'." child))))
217 ,(if declare-syntax 217 ,(if declare-syntax
218 `(progn 218 `(progn
219 (defvar ,syntax)
219 (unless (boundp ',syntax) 220 (unless (boundp ',syntax)
220 (put ',syntax 'definition-name ',child) 221 (put ',syntax 'definition-name ',child)
221 (defvar ,syntax (make-syntax-table))) 222 (defvar ,syntax (make-syntax-table)))
@@ -224,6 +225,7 @@ No problems result if this variable is not bound.
224 (purecopy ,(format "Syntax table for `%s'." child)))))) 225 (purecopy ,(format "Syntax table for `%s'." child))))))
225 ,(if declare-abbrev 226 ,(if declare-abbrev
226 `(progn 227 `(progn
228 (defvar ,abbrev)
227 (unless (boundp ',abbrev) 229 (unless (boundp ',abbrev)
228 (put ',abbrev 'definition-name ',child) 230 (put ',abbrev 'definition-name ',child)
229 (defvar ,abbrev 231 (defvar ,abbrev
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index eadf79ffd4f..b6b49b1bfa2 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -412,8 +412,13 @@ of column descriptors."
412 (inhibit-read-only t)) 412 (inhibit-read-only t))
413 (if (> tabulated-list-padding 0) 413 (if (> tabulated-list-padding 0)
414 (insert (make-string x ?\s))) 414 (insert (make-string x ?\s)))
415 (dotimes (n ncols) 415 (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
416 (setq x (tabulated-list-print-col n (aref cols n) x))) 416 (or (bound-and-true-p tabulated-list--near-rows)
417 (list (or (tabulated-list-get-entry (point-at-bol 0))
418 cols)
419 cols))))
420 (dotimes (n ncols)
421 (setq x (tabulated-list-print-col n (aref cols n) x))))
417 (insert ?\n) 422 (insert ?\n)
418 ;; Ever so slightly faster than calling `put-text-property' twice. 423 ;; Ever so slightly faster than calling `put-text-property' twice.
419 (add-text-properties 424 (add-text-properties
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 068897b21b8..d7222bfb681 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -171,7 +171,7 @@ this to nil will disable recognition of URLs that are not
171well-formed, such as \"user@host\" or \"<user@host>\"." 171well-formed, such as \"user@host\" or \"<user@host>\"."
172 :type 'boolean 172 :type 'boolean
173 :group 'ffap 173 :group 'ffap
174 :version "25.1") 174 :version "25.2") ; nil -> t
175 175
176(defcustom ffap-ftp-default-user "anonymous" 176(defcustom ffap-ftp-default-user "anonymous"
177 "User name in FTP file names generated by `ffap-host-to-path'. 177 "User name in FTP file names generated by `ffap-host-to-path'.
diff --git a/lisp/files.el b/lisp/files.el
index b57e35b9a0a..25392fdcc71 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3723,7 +3723,8 @@ Return the new variables list."
3723 (let* ((file-name (or (buffer-file-name) 3723 (let* ((file-name (or (buffer-file-name)
3724 ;; Handle non-file buffers, too. 3724 ;; Handle non-file buffers, too.
3725 (expand-file-name default-directory))) 3725 (expand-file-name default-directory)))
3726 (sub-file-name (if file-name 3726 (sub-file-name (if (and file-name
3727 (file-name-absolute-p file-name))
3727 ;; FIXME: Why not use file-relative-name? 3728 ;; FIXME: Why not use file-relative-name?
3728 (substring file-name (length root))))) 3729 (substring file-name (length root)))))
3729 (condition-case err 3730 (condition-case err
@@ -6074,8 +6075,8 @@ See also `auto-save-file-name-p'."
6074 ;; Make sure auto-save file names don't contain characters 6075 ;; Make sure auto-save file names don't contain characters
6075 ;; invalid for the underlying filesystem. 6076 ;; invalid for the underlying filesystem.
6076 (if (and (memq system-type '(ms-dos windows-nt cygwin)) 6077 (if (and (memq system-type '(ms-dos windows-nt cygwin))
6077 ;; Don't modify remote (ange-ftp) filenames 6078 ;; Don't modify remote filenames
6078 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result))) 6079 (not (file-remote-p result)))
6079 (convert-standard-filename result) 6080 (convert-standard-filename result)
6080 result)))) 6081 result))))
6081 6082
@@ -6112,8 +6113,8 @@ See also `auto-save-file-name-p'."
6112 ((file-writable-p "/var/tmp/") "/var/tmp/") 6113 ((file-writable-p "/var/tmp/") "/var/tmp/")
6113 ("~/"))))) 6114 ("~/")))))
6114 (if (and (memq system-type '(ms-dos windows-nt cygwin)) 6115 (if (and (memq system-type '(ms-dos windows-nt cygwin))
6115 ;; Don't modify remote (ange-ftp) filenames 6116 ;; Don't modify remote filenames
6116 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname))) 6117 (not (file-remote-p fname)))
6117 ;; The call to convert-standard-filename is in case 6118 ;; The call to convert-standard-filename is in case
6118 ;; buffer-name includes characters not allowed by the 6119 ;; buffer-name includes characters not allowed by the
6119 ;; DOS/Windows filesystems. make-temp-file writes to the 6120 ;; DOS/Windows filesystems. make-temp-file writes to the
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index e1af859516c..43e1231914c 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -251,7 +251,12 @@ This can also be a list of the above values."
251 (integer :value 200) 251 (integer :value 200)
252 (number :value 4.0) 252 (number :value 4.0)
253 function 253 function
254 (regexp :value ".*")) 254 (regexp :value ".*")
255 (repeat (choice (const nil)
256 (integer :value 200)
257 (number :value 4.0)
258 function
259 (regexp :value ".*"))))
255 :group 'gnus-article-signature) 260 :group 'gnus-article-signature)
256 261
257(defcustom gnus-hidden-properties 262(defcustom gnus-hidden-properties
@@ -6841,17 +6846,21 @@ then we display only bindings that start with that prefix."
6841 (let ((keymap (copy-keymap gnus-article-mode-map)) 6846 (let ((keymap (copy-keymap gnus-article-mode-map))
6842 (map (copy-keymap gnus-article-send-map)) 6847 (map (copy-keymap gnus-article-send-map))
6843 (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) 6848 (sumkeys (where-is-internal 'gnus-article-read-summary-keys))
6849 (summap (make-sparse-keymap))
6844 parent agent draft) 6850 parent agent draft)
6845 (define-key keymap "S" map) 6851 (define-key keymap "S" map)
6846 (define-key map [t] nil) 6852 (define-key map [t] nil)
6853 (define-key summap [t] 'undefined)
6847 (with-current-buffer gnus-article-current-summary 6854 (with-current-buffer gnus-article-current-summary
6855 (dolist (key sumkeys)
6856 (define-key summap key (key-binding key (current-local-map))))
6848 (set-keymap-parent 6857 (set-keymap-parent
6849 keymap 6858 keymap
6850 (if (setq parent (keymap-parent gnus-article-mode-map)) 6859 (if (setq parent (keymap-parent gnus-article-mode-map))
6851 (prog1 6860 (prog1
6852 (setq parent (copy-keymap parent)) 6861 (setq parent (copy-keymap parent))
6853 (set-keymap-parent parent (current-local-map))) 6862 (set-keymap-parent parent summap))
6854 (current-local-map))) 6863 summap))
6855 (set-keymap-parent map (key-binding "S")) 6864 (set-keymap-parent map (key-binding "S"))
6856 (let (key def gnus-pick-mode) 6865 (let (key def gnus-pick-mode)
6857 (while sumkeys 6866 (while sumkeys
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 19111171198..a193ab41348 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -546,7 +546,8 @@ instead."
546 (gnus-setup-message 'message 546 (gnus-setup-message 'message
547 (message-mail to subject other-headers continue 547 (message-mail to subject other-headers continue
548 nil yank-action send-actions return-action))) 548 nil yank-action send-actions return-action)))
549 (setq gnus-newsgroup-name group-name)) 549 (with-current-buffer buf
550 (setq gnus-newsgroup-name group-name)))
550 (when switch-action 551 (when switch-action
551 (setq mail-buf (current-buffer)) 552 (setq mail-buf (current-buffer))
552 (switch-to-buffer buf) 553 (switch-to-buffer buf)
@@ -1534,11 +1535,7 @@ If YANK is non-nil, include the original article."
1534 (message-pop-to-buffer "*Gnus Bug*")) 1535 (message-pop-to-buffer "*Gnus Bug*"))
1535 (let ((message-this-is-mail t)) 1536 (let ((message-this-is-mail t))
1536 (message-setup `((To . ,gnus-maintainer) 1537 (message-setup `((To . ,gnus-maintainer)
1537 (Subject . "") 1538 (Subject . ""))))
1538 (X-Debbugs-Package
1539 . ,(format "%s" gnus-bug-package))
1540 (X-Debbugs-Version
1541 . ,(format "%s" (gnus-continuum-version))))))
1542 (when gnus-bug-create-help-buffer 1539 (when gnus-bug-create-help-buffer
1543 (push `(gnus-bug-kill-buffer) message-send-actions)) 1540 (push `(gnus-bug-kill-buffer) message-send-actions))
1544 (goto-char (point-min)) 1541 (goto-char (point-min))
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 5361c2b86fc..7037328b7a4 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -131,9 +131,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
131(defvar gnus-pick-line-number 1) 131(defvar gnus-pick-line-number 1)
132(defun gnus-pick-line-number () 132(defun gnus-pick-line-number ()
133 "Return the current line number." 133 "Return the current line number."
134 (if (bobp) 134 (incf gnus-pick-line-number))
135 (setq gnus-pick-line-number 1)
136 (incf gnus-pick-line-number)))
137 135
138(defun gnus-pick-start-reading (&optional catch-up) 136(defun gnus-pick-start-reading (&optional catch-up)
139 "Start reading the picked articles. 137 "Start reading the picked articles.
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 47e33af96e8..be46339cd38 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2801,8 +2801,13 @@ If FORCE is non-nil, the .newsrc file is read."
2801 (gnus-run-hooks 'gnus-save-newsrc-hook) 2801 (gnus-run-hooks 'gnus-save-newsrc-hook)
2802 (if gnus-slave 2802 (if gnus-slave
2803 (gnus-slave-save-newsrc) 2803 (gnus-slave-save-newsrc)
2804 ;; Save .newsrc. 2804 ;; Save .newsrc only if the select method is an NNTP method.
2805 (when gnus-save-newsrc-file 2805 ;; The .newsrc file is for interoperability with other
2806 ;; newsreaders, so saving non-NNTP groups there doesn't make
2807 ;; much sense.
2808 (when (and gnus-save-newsrc-file
2809 (eq (car (gnus-server-to-method gnus-select-method))
2810 'nntp))
2806 (gnus-message 8 "Saving %s..." gnus-current-startup-file) 2811 (gnus-message 8 "Saving %s..." gnus-current-startup-file)
2807 (gnus-gnus-to-newsrc-format) 2812 (gnus-gnus-to-newsrc-format)
2808 (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) 2813 (gnus-message 8 "Saving %s...done" gnus-current-startup-file))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 72e902a11f8..2631514e425 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1895,6 +1895,7 @@ increase the score of each group you read."
1895 "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number 1895 "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number
1896 "\C-c\C-s\C-l" gnus-summary-sort-by-lines 1896 "\C-c\C-s\C-l" gnus-summary-sort-by-lines
1897 "\C-c\C-s\C-c" gnus-summary-sort-by-chars 1897 "\C-c\C-s\C-c" gnus-summary-sort-by-chars
1898 "\C-c\C-s\C-m\C-m" gnus-summary-sort-by-marks
1898 "\C-c\C-s\C-a" gnus-summary-sort-by-author 1899 "\C-c\C-s\C-a" gnus-summary-sort-by-author
1899 "\C-c\C-s\C-t" gnus-summary-sort-by-recipient 1900 "\C-c\C-s\C-t" gnus-summary-sort-by-recipient
1900 "\C-c\C-s\C-s" gnus-summary-sort-by-subject 1901 "\C-c\C-s\C-s" gnus-summary-sort-by-subject
@@ -2748,6 +2749,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2748 ["Sort by score" gnus-summary-sort-by-score t] 2749 ["Sort by score" gnus-summary-sort-by-score t]
2749 ["Sort by lines" gnus-summary-sort-by-lines t] 2750 ["Sort by lines" gnus-summary-sort-by-lines t]
2750 ["Sort by characters" gnus-summary-sort-by-chars t] 2751 ["Sort by characters" gnus-summary-sort-by-chars t]
2752 ["Sort by marks" gnus-summary-sort-by-marks t]
2751 ["Randomize" gnus-summary-sort-by-random t] 2753 ["Randomize" gnus-summary-sort-by-random t]
2752 ["Original sort" gnus-summary-sort-by-original t]) 2754 ["Original sort" gnus-summary-sort-by-original t])
2753 ("Help" 2755 ("Help"
@@ -3976,6 +3978,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
3976 ;; The group was successfully selected. 3978 ;; The group was successfully selected.
3977 (t 3979 (t
3978 (gnus-set-global-variables) 3980 (gnus-set-global-variables)
3981 (when (boundp 'gnus-pick-line-number)
3982 (setq gnus-pick-line-number 0))
3979 (when (boundp 'spam-install-hooks) 3983 (when (boundp 'spam-install-hooks)
3980 (spam-initialize)) 3984 (spam-initialize))
3981 ;; Save the active value in effect when the group was entered. 3985 ;; Save the active value in effect when the group was entered.
@@ -4037,6 +4041,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
4037 (when kill-buffer 4041 (when kill-buffer
4038 (gnus-kill-or-deaden-summary kill-buffer)) 4042 (gnus-kill-or-deaden-summary kill-buffer))
4039 (gnus-summary-auto-select-subject) 4043 (gnus-summary-auto-select-subject)
4044 ;; Don't mark any articles as selected if we haven't done that.
4045 (when no-article
4046 (setq overlay-arrow-position nil))
4040 ;; Show first unread article if requested. 4047 ;; Show first unread article if requested.
4041 (if (and (not no-article) 4048 (if (and (not no-article)
4042 (not no-display) 4049 (not no-display)
@@ -4941,6 +4948,16 @@ using some other form will lead to serious barfage."
4941 (gnus-article-sort-by-chars 4948 (gnus-article-sort-by-chars
4942 (gnus-thread-header h1) (gnus-thread-header h2))) 4949 (gnus-thread-header h1) (gnus-thread-header h2)))
4943 4950
4951(defsubst gnus-article-sort-by-marks (h1 h2)
4952 "Sort articles by octet length."
4953 (< (gnus-article-mark (mail-header-number h1))
4954 (gnus-article-mark (mail-header-number h2))))
4955
4956(defun gnus-thread-sort-by-marks (h1 h2)
4957 "Sort threads by root article octet length."
4958 (gnus-article-sort-by-marks
4959 (gnus-thread-header h1) (gnus-thread-header h2)))
4960
4944(defsubst gnus-article-sort-by-author (h1 h2) 4961(defsubst gnus-article-sort-by-author (h1 h2)
4945 "Sort articles by root author." 4962 "Sort articles by root author."
4946 (gnus-string< 4963 (gnus-string<
@@ -11925,6 +11942,12 @@ Argument REVERSE means reverse order."
11925 (interactive "P") 11942 (interactive "P")
11926 (gnus-summary-sort 'chars reverse)) 11943 (gnus-summary-sort 'chars reverse))
11927 11944
11945(defun gnus-summary-sort-by-mark (&optional reverse)
11946 "Sort the summary buffer by article marks.
11947Argument REVERSE means reverse order."
11948 (interactive "P")
11949 (gnus-summary-sort 'marks reverse))
11950
11928(defun gnus-summary-sort-by-original (&optional reverse) 11951(defun gnus-summary-sort-by-original (&optional reverse)
11929 "Sort the summary buffer using the default sorting method. 11952 "Sort the summary buffer using the default sorting method.
11930Argument REVERSE means reverse order." 11953Argument REVERSE means reverse order."
@@ -11970,7 +11993,10 @@ save those articles instead.
11970The variable `gnus-default-article-saver' specifies the saver function. 11993The variable `gnus-default-article-saver' specifies the saver function.
11971 11994
11972If the optional second argument NOT-SAVED is non-nil, articles saved 11995If the optional second argument NOT-SAVED is non-nil, articles saved
11973will not be marked as saved." 11996will not be marked as saved.
11997
11998The `gnus-prompt-before-saving' variable says how prompting is
11999performed."
11974 (interactive "P") 12000 (interactive "P")
11975 (require 'gnus-art) 12001 (require 'gnus-art)
11976 (let* ((articles (gnus-summary-work-articles n)) 12002 (let* ((articles (gnus-summary-work-articles n))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 8ab8f462885..6d6e20dc129 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1564,7 +1564,7 @@ If UNINDENT, remove an indentation."
1564 (parent (gnus-topic-parent-topic topic)) 1564 (parent (gnus-topic-parent-topic topic))
1565 (grandparent (gnus-topic-parent-topic parent))) 1565 (grandparent (gnus-topic-parent-topic parent)))
1566 (unless grandparent 1566 (unless grandparent
1567 (error "Nothing to indent %s into" topic)) 1567 (error "Can't unindent %s further" topic))
1568 (when topic 1568 (when topic
1569 (gnus-topic-goto-topic topic) 1569 (gnus-topic-goto-topic topic)
1570 (gnus-topic-kill-group) 1570 (gnus-topic-kill-group)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index ef6bd89c36e..bbf85fe584a 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2654,10 +2654,6 @@ such as a mark that says whether an article is stored in the cache
2654 "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)" 2654 "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)"
2655 "The mail address of the Gnus maintainers.") 2655 "The mail address of the Gnus maintainers.")
2656 2656
2657(defconst gnus-bug-package
2658 "gnus"
2659 "The package to use in the bug submission.")
2660
2661(defvar gnus-info-nodes 2657(defvar gnus-info-nodes
2662 '((gnus-group-mode "(gnus)Group Buffer") 2658 '((gnus-group-mode "(gnus)Group Buffer")
2663 (gnus-summary-mode "(gnus)Summary Buffer") 2659 (gnus-summary-mode "(gnus)Summary Buffer")
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 4d4ba089434..ce0dad9cb05 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2286,13 +2286,15 @@ body, set `message-archive-note' to nil."
2286 "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP. 2286 "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
2287With prefix-argument just set Follow-Up, don't cross-post." 2287With prefix-argument just set Follow-Up, don't cross-post."
2288 (interactive 2288 (interactive
2289 (list ; Completion based on Gnus 2289 (list ; Completion based on Gnus
2290 (completing-read "Followup To: " 2290 (replace-regexp-in-string
2291 (if (boundp 'gnus-newsrc-alist) 2291 "\\`.*:" ""
2292 gnus-newsrc-alist) 2292 (completing-read "Followup To: "
2293 nil nil '("poster" . 0) 2293 (if (boundp 'gnus-newsrc-alist)
2294 (if (boundp 'gnus-group-history) 2294 gnus-newsrc-alist)
2295 'gnus-group-history)))) 2295 nil nil '("poster" . 0)
2296 (if (boundp 'gnus-group-history)
2297 'gnus-group-history)))))
2296 (message-remove-header "Follow[Uu]p-[Tt]o" t) 2298 (message-remove-header "Follow[Uu]p-[Tt]o" t)
2297 (message-goto-newsgroups) 2299 (message-goto-newsgroups)
2298 (beginning-of-line) 2300 (beginning-of-line)
@@ -2361,13 +2363,15 @@ been made to before the user asked for a Crosspost."
2361 "Crossposts message and set Followup-To to TARGET-GROUP. 2363 "Crossposts message and set Followup-To to TARGET-GROUP.
2362With prefix-argument just set Follow-Up, don't cross-post." 2364With prefix-argument just set Follow-Up, don't cross-post."
2363 (interactive 2365 (interactive
2364 (list ; Completion based on Gnus 2366 (list ; Completion based on Gnus
2365 (completing-read "Followup To: " 2367 (replace-regexp-in-string
2366 (if (boundp 'gnus-newsrc-alist) 2368 "\\`.*:" ""
2367 gnus-newsrc-alist) 2369 (completing-read "Followup To: "
2368 nil nil '("poster" . 0) 2370 (if (boundp 'gnus-newsrc-alist)
2369 (if (boundp 'gnus-group-history) 2371 gnus-newsrc-alist)
2370 'gnus-group-history)))) 2372 nil nil '("poster" . 0)
2373 (if (boundp 'gnus-group-history)
2374 'gnus-group-history)))))
2371 (when (fboundp 'gnus-group-real-name) 2375 (when (fboundp 'gnus-group-real-name)
2372 (setq target-group (gnus-group-real-name target-group))) 2376 (setq target-group (gnus-group-real-name target-group)))
2373 (cond ((not (or (null target-group) ; new subject not empty 2377 (cond ((not (or (null target-group) ; new subject not empty
@@ -3108,18 +3112,29 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
3108 (looking-at "[ \t]*\n")) 3112 (looking-at "[ \t]*\n"))
3109 (expand-abbrev)) 3113 (expand-abbrev))
3110 (push-mark) 3114 (push-mark)
3115 (message-goto-body-1))
3116
3117(defun message-goto-body-1 ()
3118 "Go to the body and return point."
3111 (goto-char (point-min)) 3119 (goto-char (point-min))
3112 (or (search-forward (concat "\n" mail-header-separator "\n") nil t) 3120 (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
3113 (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) 3121 ;; If the message is mangled, find the end of the headers the
3122 ;; hard way.
3123 (progn
3124 ;; Skip past all headers and continuation lines.
3125 (while (looking-at "[^:]+:\\|[\t ]+[^\t ]")
3126 (forward-line 1))
3127 ;; We're now at the first empty line, so perhaps move past it.
3128 (when (and (eolp)
3129 (not (eobp)))
3130 (forward-line 1))
3131 (point))))
3114 3132
3115(defun message-in-body-p () 3133(defun message-in-body-p ()
3116 "Return t if point is in the message body." 3134 "Return t if point is in the message body."
3117 (>= (point) 3135 (>= (point)
3118 (save-excursion 3136 (save-excursion
3119 (goto-char (point-min)) 3137 (message-goto-body-1))))
3120 (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
3121 (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))
3122 (point))))
3123 3138
3124(defun message-goto-eoh () 3139(defun message-goto-eoh ()
3125 "Move point to the end of the headers." 3140 "Move point to the end of the headers."
@@ -3330,6 +3345,8 @@ of lines before the signature intact."
3330 "Insert four newlines, and then reformat if inside quoted text. 3345 "Insert four newlines, and then reformat if inside quoted text.
3331Prefix arg means justify as well." 3346Prefix arg means justify as well."
3332 (interactive (list (if current-prefix-arg 'full))) 3347 (interactive (list (if current-prefix-arg 'full)))
3348 (unless (message-in-body-p)
3349 (error "This command only works in the body of the message"))
3333 (let (quoted point beg end leading-space bolp fill-paragraph-function) 3350 (let (quoted point beg end leading-space bolp fill-paragraph-function)
3334 (setq point (point)) 3351 (setq point (point))
3335 (beginning-of-line) 3352 (beginning-of-line)
@@ -4102,8 +4119,8 @@ It should typically alter the sending method in some way or other."
4102 (let ((inhibit-read-only t)) 4119 (let ((inhibit-read-only t))
4103 (put-text-property (point-min) (point-max) 'read-only nil)) 4120 (put-text-property (point-min) (point-max) 'read-only nil))
4104 (message-fix-before-sending) 4121 (message-fix-before-sending)
4105 (mml-secure-bcc-is-safe)
4106 (run-hooks 'message-send-hook) 4122 (run-hooks 'message-send-hook)
4123 (mml-secure-bcc-is-safe)
4107 (when message-confirm-send 4124 (when message-confirm-send
4108 (or (y-or-n-p "Send message? ") 4125 (or (y-or-n-p "Send message? ")
4109 (keyboard-quit))) 4126 (keyboard-quit)))
@@ -4539,6 +4556,9 @@ This function could be useful in `message-setup-hook'."
4539 (forward-line 1) 4556 (forward-line 1)
4540 (unless (y-or-n-p "Send anyway? ") 4557 (unless (y-or-n-p "Send anyway? ")
4541 (error "Failed to send the message"))))) 4558 (error "Failed to send the message")))))
4559 ;; Fold too-long header lines. They should be no longer than
4560 ;; 998 octets long.
4561 (message--fold-long-headers)
4542 ;; Let the user do all of the above. 4562 ;; Let the user do all of the above.
4543 (run-hooks 'message-header-hook)) 4563 (run-hooks 'message-header-hook))
4544 (setq options message-options) 4564 (setq options message-options)
@@ -4635,6 +4655,14 @@ If you always want Gnus to send messages in one piece, set
4635 (setq message-options options) 4655 (setq message-options options)
4636 (push 'mail message-sent-message-via))) 4656 (push 'mail message-sent-message-via)))
4637 4657
4658(defun message--fold-long-headers ()
4659 (goto-char (point-min))
4660 (while (not (eobp))
4661 (when (and (looking-at "[^:]+:")
4662 (> (- (line-end-position) (point)) 998))
4663 (mail-header-fold-field))
4664 (forward-line 1)))
4665
4638(defvar sendmail-program) 4666(defvar sendmail-program)
4639(defvar smtpmail-smtp-server) 4667(defvar smtpmail-smtp-server)
4640(defvar smtpmail-smtp-service) 4668(defvar smtpmail-smtp-service)
@@ -5380,16 +5408,13 @@ Otherwise, generate and save a value for `canlock-password' first."
5380 "Process Fcc headers in the current buffer." 5408 "Process Fcc headers in the current buffer."
5381 (let ((case-fold-search t) 5409 (let ((case-fold-search t)
5382 (buf (current-buffer)) 5410 (buf (current-buffer))
5383 list file 5411 (mml-externalize-attachments message-fcc-externalize-attachments)
5384 (mml-externalize-attachments message-fcc-externalize-attachments)) 5412 (file (message-field-value "fcc" t))
5385 (save-excursion 5413 list)
5386 (save-restriction 5414 (when file
5387 (message-narrow-to-headers) 5415 (with-temp-buffer
5388 (setq file (message-fetch-field "fcc" t)))
5389 (when file
5390 (set-buffer (get-buffer-create " *message temp*"))
5391 (erase-buffer)
5392 (insert-buffer-substring buf) 5416 (insert-buffer-substring buf)
5417 (message-clone-locals buf)
5393 (message-encode-message-body) 5418 (message-encode-message-body)
5394 (save-restriction 5419 (save-restriction
5395 (message-narrow-to-headers) 5420 (message-narrow-to-headers)
@@ -5429,8 +5454,7 @@ Otherwise, generate and save a value for `canlock-password' first."
5429 (if (and (file-readable-p file) (mail-file-babyl-p file)) 5454 (if (and (file-readable-p file) (mail-file-babyl-p file))
5430 (rmail-output file 1 nil t) 5455 (rmail-output file 1 nil t)
5431 (let ((mail-use-rfc822 t)) 5456 (let ((mail-use-rfc822 t))
5432 (rmail-output file 1 t t)))))) 5457 (rmail-output file 1 t t))))))))))
5433 (kill-buffer (current-buffer))))))
5434 5458
5435(defun message-output (filename) 5459(defun message-output (filename)
5436 "Append this article to Unix/babyl mail file FILENAME." 5460 "Append this article to Unix/babyl mail file FILENAME."
@@ -5761,7 +5785,7 @@ give as trustworthy answer as possible."
5761 (not (string-match message-bogus-system-names message-user-fqdn))) 5785 (not (string-match message-bogus-system-names message-user-fqdn)))
5762 ;; `message-user-fqdn' seems to be valid 5786 ;; `message-user-fqdn' seems to be valid
5763 message-user-fqdn) 5787 message-user-fqdn)
5764 ((and (string-match message-bogus-system-names sysname)) 5788 ((not (string-match message-bogus-system-names sysname))
5765 ;; `system-name' returned the right result. 5789 ;; `system-name' returned the right result.
5766 sysname) 5790 sysname)
5767 ;; Try `mail-host-address'. 5791 ;; Try `mail-host-address'.
@@ -6644,29 +6668,27 @@ OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
6644to continue editing a message already being composed. SWITCH-FUNCTION 6668to continue editing a message already being composed. SWITCH-FUNCTION
6645is a function used to switch to and display the mail buffer." 6669is a function used to switch to and display the mail buffer."
6646 (interactive) 6670 (interactive)
6647 (let ((message-this-is-mail t)) 6671 (let ((message-this-is-mail t)
6648 (unless (message-mail-user-agent) 6672 message-buffers)
6649 (message-pop-to-buffer 6673 ;; Search for the existing message buffer if `continue' is non-nil.
6650 ;; Search for the existing message buffer if `continue' is non-nil. 6674 (if (and continue
6651 (let ((message-generate-new-buffers 6675 (setq message-buffers (message-buffers)))
6652 (when (or (not continue) 6676 (pop-to-buffer (car message-buffers))
6653 (eq message-generate-new-buffers 'standard) 6677 ;; Start a new buffer.
6654 (functionp message-generate-new-buffers)) 6678 (unless (message-mail-user-agent)
6655 message-generate-new-buffers))) 6679 (message-pop-to-buffer (message-buffer-name "mail" to) switch-function))
6656 (message-buffer-name "mail" to)) 6680 (message-setup
6657 switch-function)) 6681 (nconc
6658 (message-setup 6682 `((To . ,(or to "")) (Subject . ,(or subject "")))
6659 (nconc 6683 ;; C-h f compose-mail says that headers should be specified as
6660 `((To . ,(or to "")) (Subject . ,(or subject ""))) 6684 ;; (string . value); however all the rest of message expects
6661 ;; C-h f compose-mail says that headers should be specified as 6685 ;; headers to be symbols, not strings (eg message-header-format-alist).
6662 ;; (string . value); however all the rest of message expects 6686 ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
6663 ;; headers to be symbols, not strings (eg message-header-format-alist). 6687 ;; We need to convert any string input, eg from rmail-start-mail.
6664 ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html 6688 (dolist (h other-headers other-headers)
6665 ;; We need to convert any string input, eg from rmail-start-mail. 6689 (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
6666 (dolist (h other-headers other-headers) 6690 yank-action send-actions continue switch-function
6667 (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) 6691 return-action))))
6668 yank-action send-actions continue switch-function
6669 return-action)))
6670 6692
6671;;;###autoload 6693;;;###autoload
6672(defun message-news (&optional newsgroups subject) 6694(defun message-news (&optional newsgroups subject)
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 6d13d892b5a..3a31349d378 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -486,7 +486,8 @@ be \"related\" or \"alternate\"."
486 (equal (cdr (assq 'type (car cont))) "text/html")) 486 (equal (cdr (assq 'type (car cont))) "text/html"))
487 (setq cont (mml-expand-html-into-multipart-related (car cont)))) 487 (setq cont (mml-expand-html-into-multipart-related (car cont))))
488 (prog1 488 (prog1
489 (mm-with-multibyte-buffer 489 (with-temp-buffer
490 (set-buffer-multibyte nil)
490 (setq message-options options) 491 (setq message-options options)
491 (cond 492 (cond
492 ((and (consp (car cont)) 493 ((and (consp (car cont))
@@ -605,28 +606,38 @@ be \"related\" or \"alternate\"."
605 (intern (downcase charset)))))) 606 (intern (downcase charset))))))
606 (if (and (not raw) 607 (if (and (not raw)
607 (member (car (split-string type "/")) '("text" "message"))) 608 (member (car (split-string type "/")) '("text" "message")))
609 ;; We have a text-like MIME part, so we need to do
610 ;; charset encoding.
608 (progn 611 (progn
609 (with-temp-buffer 612 (with-temp-buffer
610 (cond 613 (set-buffer-multibyte nil)
611 ((cdr (assq 'buffer cont)) 614 ;; First insert the data into the buffer.
612 (insert-buffer-substring (cdr (assq 'buffer cont)))) 615 (if (and filename
613 ((and filename 616 (not (equal (cdr (assq 'nofile cont)) "yes")))
614 (not (equal (cdr (assq 'nofile cont)) "yes"))) 617 (mm-insert-file-contents filename)
615 (let ((coding-system-for-read coding)) 618 (insert
616 (mm-insert-file-contents filename))) 619 (with-temp-buffer
617 ((eq 'mml (car cont)) 620 (cond
618 (insert (cdr (assq 'contents cont)))) 621 ((cdr (assq 'buffer cont))
619 (t 622 (insert-buffer-substring (cdr (assq 'buffer cont))))
620 (save-restriction 623 ((eq 'mml (car cont))
621 (narrow-to-region (point) (point)) 624 (insert (cdr (assq 'contents cont))))
622 (insert (cdr (assq 'contents cont))) 625 (t
623 ;; Remove quotes from quoted tags. 626 (insert (cdr (assq 'contents cont)))
624 (goto-char (point-min)) 627 ;; Remove quotes from quoted tags.
625 (while (re-search-forward 628 (goto-char (point-min))
626 "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" 629 (while (re-search-forward
627 nil t) 630 "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)"
628 (delete-region (+ (match-beginning 0) 2) 631 nil t)
629 (+ (match-beginning 0) 3)))))) 632 (delete-region (+ (match-beginning 0) 2)
633 (+ (match-beginning 0) 3)))))
634 (setq charset
635 (mm-coding-system-to-mime-charset
636 (detect-coding-region
637 (point-min) (point-max) t)))
638 (encode-coding-region (point-min) (point-max)
639 charset)
640 (buffer-string))))
630 (cond 641 (cond
631 ((eq (car cont) 'mml) 642 ((eq (car cont) 'mml)
632 (let ((mml-boundary (mml-compute-boundary cont)) 643 (let ((mml-boundary (mml-compute-boundary cont))
@@ -667,21 +678,22 @@ be \"related\" or \"alternate\"."
667 ;; insert a "; format=flowed" string unless the 678 ;; insert a "; format=flowed" string unless the
668 ;; user has already specified it. 679 ;; user has already specified it.
669 (setq flowed (null (assq 'format cont))))) 680 (setq flowed (null (assq 'format cont)))))
670 ;; Prefer `utf-8' for text/calendar parts. 681 (unless charset
671 (if (or charset 682 (setq charset
672 (not (string= type "text/calendar"))) 683 ;; Prefer `utf-8' for text/calendar parts.
673 (setq charset (mm-encode-body charset)) 684 (if (string= type "text/calendar")
674 (let ((mm-coding-system-priorities 685 'utf-8
675 (cons 'utf-8 mm-coding-system-priorities))) 686 (mm-coding-system-to-mime-charset
676 (setq charset (mm-encode-body)))) 687 (detect-coding-region
677 (mm-disable-multibyte) 688 (point-min) (point-max) t)))))
678 (setq encoding (mm-body-encoding 689 (setq encoding (mm-body-encoding
679 charset (cdr (assq 'encoding cont)))))) 690 charset (cdr (assq 'encoding cont))))))
680 (setq coded (buffer-string))) 691 (setq coded (buffer-string)))
681 (mml-insert-mime-headers cont type charset encoding flowed) 692 (mml-insert-mime-headers cont type charset encoding flowed)
682 (insert "\n") 693 (insert "\n")
683 (insert coded)) 694 (insert coded))
684 (mm-with-unibyte-buffer 695 (with-temp-buffer
696 (set-buffer-multibyte nil)
685 (cond 697 (cond
686 ((cdr (assq 'buffer cont)) 698 ((cdr (assq 'buffer cont))
687 (insert (string-as-unibyte 699 (insert (string-as-unibyte
@@ -690,11 +702,7 @@ be \"related\" or \"alternate\"."
690 ((and filename 702 ((and filename
691 (not (equal (cdr (assq 'nofile cont)) "yes"))) 703 (not (equal (cdr (assq 'nofile cont)) "yes")))
692 (let ((coding-system-for-read mm-binary-coding-system)) 704 (let ((coding-system-for-read mm-binary-coding-system))
693 (mm-insert-file-contents filename nil nil nil nil t)) 705 (mm-insert-file-contents filename nil nil nil nil t)))
694 (unless charset
695 (setq charset (mm-coding-system-to-mime-charset
696 (mm-find-buffer-file-coding-system
697 filename)))))
698 (t 706 (t
699 (let ((contents (cdr (assq 'contents cont)))) 707 (let ((contents (cdr (assq 'contents cont))))
700 (if (multibyte-string-p contents) 708 (if (multibyte-string-p contents)
@@ -1244,6 +1252,7 @@ If not set, `default-directory' will be used."
1244 1252
1245(defun mml-minibuffer-read-file (prompt) 1253(defun mml-minibuffer-read-file (prompt)
1246 (let* ((completion-ignored-extensions nil) 1254 (let* ((completion-ignored-extensions nil)
1255 (buffer-file-name nil)
1247 (file (read-file-name prompt 1256 (file (read-file-name prompt
1248 (or mml-default-directory default-directory) 1257 (or mml-default-directory default-directory)
1249 nil t))) 1258 nil t)))
@@ -1378,12 +1387,23 @@ content-type, a string of the form \"type/subtype\". DESCRIPTION
1378is a one-line description of the attachment. The DISPOSITION 1387is a one-line description of the attachment. The DISPOSITION
1379specifies how the attachment is intended to be displayed. It can 1388specifies how the attachment is intended to be displayed. It can
1380be either \"inline\" (displayed automatically within the message 1389be either \"inline\" (displayed automatically within the message
1381body) or \"attachment\" (separate from the body)." 1390body) or \"attachment\" (separate from the body).
1391
1392If given a prefix interactively, no prompting will be done for
1393the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults
1394will be computed and used."
1382 (interactive 1395 (interactive
1383 (let* ((file (mml-minibuffer-read-file "Attach file: ")) 1396 (let* ((file (mml-minibuffer-read-file "Attach file: "))
1384 (type (mml-minibuffer-read-type file)) 1397 (type (if current-prefix-arg
1385 (description (mml-minibuffer-read-description)) 1398 (or (mm-default-file-encoding file)
1386 (disposition (mml-minibuffer-read-disposition type nil file))) 1399 "application/octet-stream")
1400 (mml-minibuffer-read-type file)))
1401 (description (if current-prefix-arg
1402 nil
1403 (mml-minibuffer-read-description)))
1404 (disposition (if current-prefix-arg
1405 (mml-content-disposition type file)
1406 (mml-minibuffer-read-disposition type nil file))))
1387 (list file type description disposition))) 1407 (list file type description disposition)))
1388 ;; If in the message header, attach at the end and leave point unchanged. 1408 ;; If in the message header, attach at the end and leave point unchanged.
1389 (let ((head (unless (message-in-body-p) (point)))) 1409 (let ((head (unless (message-in-body-p) (point))))
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index ede118d6eb6..7f7db8721db 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -356,14 +356,18 @@ from the document.")
356 (setq nndoc-dissection-alist nil) 356 (setq nndoc-dissection-alist nil)
357 (with-current-buffer nndoc-current-buffer 357 (with-current-buffer nndoc-current-buffer
358 (erase-buffer) 358 (erase-buffer)
359 (if (and (stringp nndoc-address) 359 (condition-case error
360 (string-match nndoc-binary-file-names nndoc-address)) 360 (if (and (stringp nndoc-address)
361 (let ((coding-system-for-read 'binary)) 361 (string-match nndoc-binary-file-names nndoc-address))
362 (mm-insert-file-contents nndoc-address)) 362 (let ((coding-system-for-read 'binary))
363 (if (stringp nndoc-address) 363 (mm-insert-file-contents nndoc-address))
364 (nnheader-insert-file-contents nndoc-address) 364 (if (stringp nndoc-address)
365 (insert-buffer-substring nndoc-address)) 365 (nnheader-insert-file-contents nndoc-address)
366 (run-hooks 'nndoc-open-document-hook))))) 366 (insert-buffer-substring nndoc-address))
367 (run-hooks 'nndoc-open-document-hook))
368 (file-error
369 (nnheader-report 'nndoc "Couldn't open %s: %s"
370 group error))))))
367 ;; Initialize the nndoc structures according to this new document. 371 ;; Initialize the nndoc structures according to this new document.
368 (when (and nndoc-current-buffer 372 (when (and nndoc-current-buffer
369 (not nndoc-dissection-alist)) 373 (not nndoc-dissection-alist))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 700e86a0c57..2943c8dc7d2 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -67,7 +67,11 @@ back on `network'.")
67 (if (listp imap-shell-program) 67 (if (listp imap-shell-program)
68 (car imap-shell-program) 68 (car imap-shell-program)
69 imap-shell-program) 69 imap-shell-program)
70 "ssh %s imapd")) 70 "ssh %s imapd")
71 "What command to execute to connect to an IMAP server.
72This will only be used if the connection type is `shell'. See
73the `open-network-stream' documentation for an explanation of
74the format.")
71 75
72(defvoo nnimap-inbox nil 76(defvoo nnimap-inbox nil
73 "The mail box where incoming mail arrives and should be split out of. 77 "The mail box where incoming mail arrives and should be split out of.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index fa16fa0bb67..742c66919af 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -115,13 +115,15 @@ When called from lisp, FUNCTION may also be a function object."
115 (if fn 115 (if fn
116 (format "Describe function (default %s): " fn) 116 (format "Describe function (default %s): " fn)
117 "Describe function: ") 117 "Describe function: ")
118 #'help--symbol-completion-table #'fboundp t nil nil 118 #'help--symbol-completion-table
119 (lambda (f) (or (fboundp f) (get f 'function-documentation)))
120 t nil nil
119 (and fn (symbol-name fn))))) 121 (and fn (symbol-name fn)))))
120 (unless (equal val "") 122 (unless (equal val "")
121 (setq fn (intern val))) 123 (setq fn (intern val)))
122 (unless (and fn (symbolp fn)) 124 (unless (and fn (symbolp fn))
123 (user-error "You didn't specify a function symbol")) 125 (user-error "You didn't specify a function symbol"))
124 (unless (fboundp fn) 126 (unless (or (fboundp fn) (get fn 'function-documentation))
125 (user-error "Symbol's function definition is void: %s" fn)) 127 (user-error "Symbol's function definition is void: %s" fn))
126 (list fn))) 128 (list fn)))
127 129
@@ -144,7 +146,9 @@ When called from lisp, FUNCTION may also be a function object."
144 146
145 (save-excursion 147 (save-excursion
146 (with-help-window (help-buffer) 148 (with-help-window (help-buffer)
147 (prin1 function) 149 (if (get function 'reader-construct)
150 (princ function)
151 (prin1 function))
148 ;; Use " is " instead of a colon so that 152 ;; Use " is " instead of a colon so that
149 ;; it is easier to get out the function name using forward-sexp. 153 ;; it is easier to get out the function name using forward-sexp.
150 (princ " is ") 154 (princ " is ")
@@ -469,7 +473,8 @@ suitable file is found, return nil."
469 (let ((fill-begin (point)) 473 (let ((fill-begin (point))
470 (high-usage (car high)) 474 (high-usage (car high))
471 (high-doc (cdr high))) 475 (high-doc (cdr high)))
472 (insert high-usage "\n") 476 (unless (get function 'reader-construct)
477 (insert high-usage "\n"))
473 (fill-region fill-begin (point)) 478 (fill-region fill-begin (point))
474 high-doc))))) 479 high-doc)))))
475 480
@@ -565,18 +570,21 @@ FILE is the file where FUNCTION was probably defined."
565 (or (and advised 570 (or (and advised
566 (advice--cd*r (advice--symbol-function function))) 571 (advice--cd*r (advice--symbol-function function)))
567 function)) 572 function))
568 ;; Get the real definition. 573 ;; Get the real definition, if any.
569 (def (if (symbolp real-function) 574 (def (if (symbolp real-function)
570 (or (symbol-function real-function) 575 (cond ((symbol-function real-function))
571 (signal 'void-function (list real-function))) 576 ((get real-function 'function-documentation)
577 nil)
578 (t (signal 'void-function (list real-function))))
572 real-function)) 579 real-function))
573 (aliased (or (symbolp def) 580 (aliased (and def
574 ;; Advised & aliased function. 581 (or (symbolp def)
575 (and advised (symbolp real-function) 582 ;; Advised & aliased function.
576 (not (eq 'autoload (car-safe def)))) 583 (and advised (symbolp real-function)
577 (and (subrp def) 584 (not (eq 'autoload (car-safe def))))
578 (not (string= (subr-name def) 585 (and (subrp def)
579 (symbol-name function)))))) 586 (not (string= (subr-name def)
587 (symbol-name function)))))))
580 (real-def (cond 588 (real-def (cond
581 ((and aliased (not (subrp def))) 589 ((and aliased (not (subrp def)))
582 (let ((f real-function)) 590 (let ((f real-function))
@@ -605,6 +613,8 @@ FILE is the file where FUNCTION was probably defined."
605 ;; Print what kind of function-like object FUNCTION is. 613 ;; Print what kind of function-like object FUNCTION is.
606 (princ (cond ((or (stringp def) (vectorp def)) 614 (princ (cond ((or (stringp def) (vectorp def))
607 "a keyboard macro") 615 "a keyboard macro")
616 ((get function 'reader-construct)
617 "a reader construct")
608 ;; Aliases are Lisp functions, so we need to check 618 ;; Aliases are Lisp functions, so we need to check
609 ;; aliases before functions. 619 ;; aliases before functions.
610 (aliased 620 (aliased
@@ -842,7 +852,7 @@ it is displayed along with the global value."
842 (terpri) 852 (terpri)
843 (pp val) 853 (pp val)
844 ;; Remove trailing newline. 854 ;; Remove trailing newline.
845 (delete-char -1)) 855 (and (= (char-before) ?\n) (delete-char -1)))
846 (let* ((sv (get variable 'standard-value)) 856 (let* ((sv (get variable 'standard-value))
847 (origval (and (consp sv) 857 (origval (and (consp sv)
848 (condition-case nil 858 (condition-case nil
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index a8d7294a5cc..3fb793e7aa5 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -328,7 +328,7 @@ Commands:
328 "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" 328 "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
329 "[ \t\n]+\\)?" 329 "[ \t\n]+\\)?"
330 ;; Note starting with word-syntax character: 330 ;; Note starting with word-syntax character:
331 "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]")) 331 "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]"))
332 "Regexp matching doc string references to symbols. 332 "Regexp matching doc string references to symbols.
333 333
334The words preceding the quoted symbol can be used in doc strings to 334The words preceding the quoted symbol can be used in doc strings to
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 4cf0573089f..38fe683785a 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -189,7 +189,8 @@ Specifically, when `hl-line-sticky-flag' is nil deactivate all
189such overlays in all buffers except the current one." 189such overlays in all buffers except the current one."
190 (let ((hlob hl-line-overlay-buffer) 190 (let ((hlob hl-line-overlay-buffer)
191 (curbuf (current-buffer))) 191 (curbuf (current-buffer)))
192 (when (and (not hl-line-sticky-flag) 192 (when (and (buffer-live-p hlob)
193 (not hl-line-sticky-flag)
193 (not (eq curbuf hlob)) 194 (not (eq curbuf hlob))
194 (not (minibufferp))) 195 (not (minibufferp)))
195 (with-current-buffer hlob 196 (with-current-buffer hlob
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 21aac1ab216..74393ffbaeb 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -365,9 +365,15 @@ commands in `hfy-etags-cmd-alist'."
365 365
366(defun hfy-which-etags () 366(defun hfy-which-etags ()
367 "Return a string indicating which flavor of etags we are using." 367 "Return a string indicating which flavor of etags we are using."
368 (let ((v (shell-command-to-string (concat hfy-etags-bin " --version")))) 368 (with-temp-buffer
369 (cond ((string-match "exube" v) "exuberant ctags") 369 (condition-case nil
370 ((string-match "GNU E" v) "emacs etags" )) )) 370 (when (eq (call-process hfy-etags-bin nil t nil "--version") 0)
371 (goto-char (point-min))
372 (cond
373 ((looking-at-p "exube") "exuberant ctags")
374 ((looking-at-p "GNU E") "emacs etags")))
375 ;; Return nil if the etags binary isn't executable (Bug#25468).
376 (file-error nil))))
371 377
372(defcustom hfy-etags-cmd 378(defcustom hfy-etags-cmd
373 ;; We used to wrap this in a `eval-and-compile', but: 379 ;; We used to wrap this in a `eval-and-compile', but:
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 1f3c50870e0..694bcb462ce 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -43,6 +43,7 @@
43;;; Code: 43;;; Code:
44 44
45(require 'info) 45(require 'info)
46(require 'subr-x)
46 47
47(defgroup info-lookup nil 48(defgroup info-lookup nil
48 "Major mode sensitive help agent." 49 "Major mode sensitive help agent."
@@ -648,6 +649,26 @@ Return nil if there is nothing appropriate in the buffer near point."
648 (buffer-substring-no-properties beg end))))) 649 (buffer-substring-no-properties beg end)))))
649 (error nil))) 650 (error nil)))
650 651
652(defun info-lookup-guess-gdb-script-symbol ()
653 "Get symbol at point in GDB script buffers."
654 (condition-case nil
655 (save-excursion
656 (back-to-indentation)
657 ;; Try to find the current line's full command in the index;
658 ;; and default to the longest subset that is found.
659 (when (looking-at "[-a-z]+\\(\\s-[-a-z]+\\)*")
660 (let ((str-list (split-string (match-string-no-properties 0)
661 "\\s-+" t))
662 (completions (info-lookup->completions 'symbol
663 'gdb-script-mode)))
664 (catch 'result
665 (while str-list
666 (let ((str (string-join str-list " ")))
667 (when (assoc str completions)
668 (throw 'result str))
669 (nbutlast str-list)))))))
670 (error nil)))
671
651;;;###autoload 672;;;###autoload
652(defun info-complete-symbol (&optional mode) 673(defun info-complete-symbol (&optional mode)
653 "Perform completion on symbol preceding point." 674 "Perform completion on symbol preceding point."
@@ -1051,6 +1072,14 @@ Return nil if there is nothing appropriate in the buffer near point."
1051 :mode 'help-mode 1072 :mode 'help-mode
1052 :regexp "[^][()`'‘’,:\" \t\n]+" 1073 :regexp "[^][()`'‘’,:\" \t\n]+"
1053 :other-modes '(emacs-lisp-mode)) 1074 :other-modes '(emacs-lisp-mode))
1075
1076(info-lookup-maybe-add-help
1077 :mode 'gdb-script-mode
1078 :ignore-case nil
1079 :regexp "\\([-a-z]+\\(\\s-+[-a-z]+\\)*\\)"
1080 :doc-spec '(("(gdb)Command and Variable Index" nil
1081 nil nil))
1082 :parse-rule 'info-lookup-guess-gdb-script-symbol)
1054 1083
1055(provide 'info-look) 1084(provide 'info-look)
1056 1085
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index a3e53cfe793..fd793a28309 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -192,6 +192,17 @@ the Content-Transfer-Encoding header of a mail."
192 (ietf-drums-init string) 192 (ietf-drums-init string)
193 (while (not (eobp)) 193 (while (not (eobp))
194 (setq c (char-after)) 194 (setq c (char-after))
195 ;; If we have an uneven number of quote characters,
196 ;; `forward-sexp' will fail. In these cases, just delete the
197 ;; final of these quote characters.
198 (when (and (eq c ?\")
199 (not
200 (save-excursion
201 (ignore-errors
202 (forward-sexp 1)
203 t))))
204 (delete-char 1)
205 (setq c (char-after)))
195 (cond 206 (cond
196 ((or (eq c ? ) 207 ((or (eq c ? )
197 (eq c ?\t)) 208 (eq c ?\t))
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 2a8160921a6..bcbdc17631d 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -281,17 +281,7 @@ Should be called narrowed to the head of the message."
281 (encode-coding-region 281 (encode-coding-region
282 (point-min) (point-max) 282 (point-min) (point-max)
283 (mm-charset-to-coding-system 283 (mm-charset-to-coding-system
284 (car message-posting-charset)))) 284 (car message-posting-charset)))))
285 ;; No encoding necessary, but folding is nice
286 (when nil
287 (rfc2047-fold-region
288 (save-excursion
289 (goto-char (point-min))
290 (skip-chars-forward "^:")
291 (when (looking-at ": ")
292 (forward-char 2))
293 (point))
294 (point-max))))
295 ;; We found something that may perhaps be encoded. 285 ;; We found something that may perhaps be encoded.
296 (re-search-forward "^[^:]+: *" nil t) 286 (re-search-forward "^[^:]+: *" nil t)
297 (cond 287 (cond
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d42180719dc..f7e06341443 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -59,7 +59,7 @@
59 "Directory where files will downloaded." 59 "Directory where files will downloaded."
60 :version "24.4" 60 :version "24.4"
61 :group 'eww 61 :group 'eww
62 :type 'string) 62 :type 'directory)
63 63
64;;;###autoload 64;;;###autoload
65(defcustom eww-suggest-uris 65(defcustom eww-suggest-uris
@@ -81,7 +81,7 @@ duplicate entries (if any) removed."
81 "Directory where bookmark files will be stored." 81 "Directory where bookmark files will be stored."
82 :version "25.1" 82 :version "25.1"
83 :group 'eww 83 :group 'eww
84 :type 'string) 84 :type 'directory)
85 85
86(defcustom eww-desktop-remove-duplicates t 86(defcustom eww-desktop-remove-duplicates t
87 "Whether to remove duplicates from the history when saving desktop data. 87 "Whether to remove duplicates from the history when saving desktop data.
@@ -251,6 +251,29 @@ word(s) will be searched for via `eww-search-prefix'."
251 (if uris (format " (default %s)" (car uris)) "") 251 (if uris (format " (default %s)" (car uris)) "")
252 ": "))) 252 ": ")))
253 (list (read-string prompt nil nil uris)))) 253 (list (read-string prompt nil nil uris))))
254 (setq url (eww--dwim-expand-url url))
255 (pop-to-buffer-same-window
256 (if (eq major-mode 'eww-mode)
257 (current-buffer)
258 (get-buffer-create "*eww*")))
259 (eww-setup-buffer)
260 ;; Check whether the domain only uses "Highly Restricted" Unicode
261 ;; IDNA characters. If not, transform to punycode to indicate that
262 ;; there may be funny business going on.
263 (let ((parsed (url-generic-parse-url url)))
264 (unless (puny-highly-restrictive-domain-p (url-host parsed))
265 (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
266 (setq url (url-recreate-url parsed))))
267 (plist-put eww-data :url url)
268 (plist-put eww-data :title "")
269 (eww-update-header-line-format)
270 (let ((inhibit-read-only t))
271 (insert (format "Loading %s..." url))
272 (goto-char (point-min)))
273 (url-retrieve url 'eww-render
274 (list url nil (current-buffer))))
275
276(defun eww--dwim-expand-url (url)
254 (setq url (string-trim url)) 277 (setq url (string-trim url))
255 (cond ((string-match-p "\\`file:/" url)) 278 (cond ((string-match-p "\\`file:/" url))
256 ;; Don't mangle file: URLs at all. 279 ;; Don't mangle file: URLs at all.
@@ -275,26 +298,7 @@ word(s) will be searched for via `eww-search-prefix'."
275 (setq url (concat url "/")))) 298 (setq url (concat url "/"))))
276 (setq url (concat eww-search-prefix 299 (setq url (concat eww-search-prefix
277 (replace-regexp-in-string " " "+" url)))))) 300 (replace-regexp-in-string " " "+" url))))))
278 (pop-to-buffer-same-window 301 url)
279 (if (eq major-mode 'eww-mode)
280 (current-buffer)
281 (get-buffer-create "*eww*")))
282 (eww-setup-buffer)
283 ;; Check whether the domain only uses "Highly Restricted" Unicode
284 ;; IDNA characters. If not, transform to punycode to indicate that
285 ;; there may be funny business going on.
286 (let ((parsed (url-generic-parse-url url)))
287 (unless (puny-highly-restrictive-domain-p (url-host parsed))
288 (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
289 (setq url (url-recreate-url parsed))))
290 (plist-put eww-data :url url)
291 (plist-put eww-data :title "")
292 (eww-update-header-line-format)
293 (let ((inhibit-read-only t))
294 (insert (format "Loading %s..." url))
295 (goto-char (point-min)))
296 (url-retrieve url 'eww-render
297 (list url nil (current-buffer))))
298 302
299;;;###autoload (defalias 'browse-web 'eww) 303;;;###autoload (defalias 'browse-web 'eww)
300 304
@@ -351,16 +355,25 @@ Currently this means either text/html or application/xhtml+xml."
351 "utf-8")))) 355 "utf-8"))))
352 (data-buffer (current-buffer)) 356 (data-buffer (current-buffer))
353 last-coding-system-used) 357 last-coding-system-used)
354 ;; Save the https peer status.
355 (with-current-buffer buffer 358 (with-current-buffer buffer
356 (plist-put eww-data :peer (plist-get status :peer))) 359 ;; Save the https peer status.
360 (plist-put eww-data :peer (plist-get status :peer))
361 ;; Make buffer listings more informative.
362 (setq list-buffers-directory url))
357 (unwind-protect 363 (unwind-protect
358 (progn 364 (progn
359 (cond 365 (cond
360 ((and eww-use-external-browser-for-content-type 366 ((and eww-use-external-browser-for-content-type
361 (string-match-p eww-use-external-browser-for-content-type 367 (string-match-p eww-use-external-browser-for-content-type
362 (car content-type))) 368 (car content-type)))
363 (eww-browse-with-external-browser url)) 369 (erase-buffer)
370 (insert "<title>Unsupported content type</title>")
371 (insert (format "<h1>Content-type %s is unsupported</h1>"
372 (car content-type)))
373 (insert (format "<a href=%S>Direct link to the document</a>"
374 url))
375 (goto-char (point-min))
376 (eww-display-html charset url nil point buffer encode))
364 ((eww-html-p (car content-type)) 377 ((eww-html-p (car content-type))
365 (eww-display-html charset url nil point buffer encode)) 378 (eww-display-html charset url nil point buffer encode))
366 ((equal (car content-type) "application/pdf") 379 ((equal (car content-type) "application/pdf")
@@ -804,7 +817,10 @@ the like."
804;;;###autoload 817;;;###autoload
805(defun eww-browse-url (url &optional new-window) 818(defun eww-browse-url (url &optional new-window)
806 (when new-window 819 (when new-window
807 (pop-to-buffer-same-window (generate-new-buffer "*eww*")) 820 (pop-to-buffer-same-window
821 (generate-new-buffer
822 (format "*eww-%s*" (url-host (url-generic-parse-url
823 (eww--dwim-expand-url url))))))
808 (eww-mode)) 824 (eww-mode))
809 (eww url)) 825 (eww url))
810 826
@@ -835,6 +851,8 @@ the like."
835 (erase-buffer) 851 (erase-buffer)
836 (insert text) 852 (insert text)
837 (goto-char (plist-get elem :point)) 853 (goto-char (plist-get elem :point))
854 ;; Make buffer listings more informative.
855 (setq list-buffers-directory (plist-get elem :url))
838 (eww-update-header-line-format)))) 856 (eww-update-header-line-format))))
839 857
840(defun eww-next-url () 858(defun eww-next-url ()
@@ -1483,6 +1501,7 @@ Differences in #targets are ignored."
1483(defun eww-download () 1501(defun eww-download ()
1484 "Download URL under point to `eww-download-directory'." 1502 "Download URL under point to `eww-download-directory'."
1485 (interactive) 1503 (interactive)
1504 (access-file eww-download-directory "Download failed")
1486 (let ((url (get-text-property (point) 'shr-url))) 1505 (let ((url (get-text-property (point) 'shr-url)))
1487 (if (not url) 1506 (if (not url)
1488 (message "No URL under point") 1507 (message "No URL under point")
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 93e1bae5fc2..bf60eee673c 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -139,6 +139,10 @@ a greeting from the server.
139:nowait, if non-nil, says the connection should be made 139:nowait, if non-nil, says the connection should be made
140asynchronously, if possible. 140asynchronously, if possible.
141 141
142:shell-command is a format-spec string that can be used if :type
143is `shell'. It has two specs, %s for host and %p for port
144number. Example: \"ssh gateway nc %s %p\".
145
142:tls-parameters is a list that should be supplied if you're 146:tls-parameters is a list that should be supplied if you're
143opening a TLS connection. The first element is the TLS 147opening a TLS connection. The first element is the TLS
144type (either `gnutls-x509pki' or `gnutls-anon'), and the 148type (either `gnutls-x509pki' or `gnutls-anon'), and the
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e0bb3dbb2b7..b7c48288494 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -96,8 +96,9 @@ If nil, don't draw horizontal table lines."
96(defcustom shr-width nil 96(defcustom shr-width nil
97 "Frame width to use for rendering. 97 "Frame width to use for rendering.
98May either be an integer specifying a fixed width in characters, 98May either be an integer specifying a fixed width in characters,
99or nil, meaning that the full width of the window should be 99or nil, meaning that the full width of the window should be used.
100used." 100If `shr-use-fonts' is set, the mean character width is used to
101compute the pixel width, which is used instead."
101 :version "25.1" 102 :version "25.1"
102 :type '(choice (integer :tag "Fixed width in characters") 103 :type '(choice (integer :tag "Fixed width in characters")
103 (const :tag "Use the width of the window" nil)) 104 (const :tag "Use the width of the window" nil))
@@ -978,7 +979,7 @@ element is the data blob and the second element is the content-type."
978 (create-image data nil t :ascent 100 979 (create-image data nil t :ascent 100
979 :format content-type)) 980 :format content-type))
980 ((eq content-type 'image/svg+xml) 981 ((eq content-type 'image/svg+xml)
981 (create-image data 'svg t :ascent 100)) 982 (create-image data 'imagemagick t :ascent 100))
982 ((eq size 'full) 983 ((eq size 'full)
983 (ignore-errors 984 (ignore-errors
984 (shr-rescale-image data content-type 985 (shr-rescale-image data content-type
@@ -1011,18 +1012,25 @@ element is the data blob and the second element is the content-type."
1011 image) 1012 image)
1012 (insert (or alt "")))) 1013 (insert (or alt ""))))
1013 1014
1014(defun shr-rescale-image (data content-type width height) 1015(defun shr-rescale-image (data content-type width height
1016 &optional max-width max-height)
1015 "Rescale DATA, if too big, to fit the current buffer. 1017 "Rescale DATA, if too big, to fit the current buffer.
1016WIDTH and HEIGHT are the sizes given in the HTML data, if any." 1018WIDTH and HEIGHT are the sizes given in the HTML data, if any.
1019
1020The size of the displayed image will not exceed
1021MAX-WIDTH/MAX-HEIGHT. If not given, use the current window
1022width/height instead."
1017 (if (or (not (fboundp 'imagemagick-types)) 1023 (if (or (not (fboundp 'imagemagick-types))
1018 (not (get-buffer-window (current-buffer)))) 1024 (not (get-buffer-window (current-buffer))))
1019 (create-image data nil t :ascent 100) 1025 (create-image data nil t :ascent 100)
1020 (let* ((edges (window-inside-pixel-edges 1026 (let* ((edges (window-inside-pixel-edges
1021 (get-buffer-window (current-buffer)))) 1027 (get-buffer-window (current-buffer))))
1022 (max-width (truncate (* shr-max-image-proportion 1028 (max-width (truncate (* shr-max-image-proportion
1023 (- (nth 2 edges) (nth 0 edges))))) 1029 (or max-width
1030 (- (nth 2 edges) (nth 0 edges))))))
1024 (max-height (truncate (* shr-max-image-proportion 1031 (max-height (truncate (* shr-max-image-proportion
1025 (- (nth 3 edges) (nth 1 edges))))) 1032 (or max-height
1033 (- (nth 3 edges) (nth 1 edges))))))
1026 (scaling (image-compute-scaling-factor image-scaling-factor))) 1034 (scaling (image-compute-scaling-factor image-scaling-factor)))
1027 (when (or (and width 1035 (when (or (and width
1028 (> width max-width)) 1036 (> width max-width))
@@ -1059,8 +1067,7 @@ Return a string with image data."
1059 (when (ignore-errors 1067 (when (ignore-errors
1060 (url-cache-extract (url-cache-create-filename (shr-encode-url url))) 1068 (url-cache-extract (url-cache-create-filename (shr-encode-url url)))
1061 t) 1069 t)
1062 (when (or (search-forward "\n\n" nil t) 1070 (when (re-search-forward "\r?\n\r?\n" nil t)
1063 (search-forward "\r\n\r\n" nil t))
1064 (shr-parse-image-data))))) 1071 (shr-parse-image-data)))))
1065 1072
1066(declare-function libxml-parse-xml-region "xml.c" 1073(declare-function libxml-parse-xml-region "xml.c"
@@ -1079,9 +1086,12 @@ Return a string with image data."
1079 obarray))))))) 1086 obarray)))))))
1080 ;; SVG images may contain references to further images that we may 1087 ;; SVG images may contain references to further images that we may
1081 ;; want to block. So special-case these by parsing the XML data 1088 ;; want to block. So special-case these by parsing the XML data
1082 ;; and remove the blocked bits. 1089 ;; and remove anything that looks like a blocked bit.
1083 (when (eq content-type 'image/svg+xml) 1090 (when (and shr-blocked-images
1091 (eq content-type 'image/svg+xml))
1084 (setq data 1092 (setq data
1093 ;; Note that libxml2 doesn't parse everything perfectly,
1094 ;; so glitches may occur during this transformation.
1085 (shr-dom-to-xml 1095 (shr-dom-to-xml
1086 (libxml-parse-xml-region (point) (point-max))))) 1096 (libxml-parse-xml-region (point) (point-max)))))
1087 (list data content-type))) 1097 (list data content-type)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3697d50429d..fc7fdd30850 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4063,7 +4063,11 @@ this file, if that variable is non-nil."
4063 (file-exists-p tramp-auto-save-directory)) 4063 (file-exists-p tramp-auto-save-directory))
4064 (make-directory tramp-auto-save-directory t)) 4064 (make-directory tramp-auto-save-directory t))
4065 4065
4066 (let ((system-type 'not-windows) 4066 (let ((system-type
4067 (if (and (stringp tramp-auto-save-directory)
4068 (file-remote-p tramp-auto-save-directory))
4069 'not-windows
4070 system-type))
4067 (auto-save-file-name-transforms 4071 (auto-save-file-name-transforms
4068 (if (null tramp-auto-save-directory) 4072 (if (null tramp-auto-save-directory)
4069 auto-save-file-name-transforms)) 4073 auto-save-file-name-transforms))
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index 37816bb8881..393f3a549f9 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -256,7 +256,7 @@ supported keys depend on the service type.")
256 "Returns all discovered Avahi service names as list." 256 "Returns all discovered Avahi service names as list."
257 (let (result) 257 (let (result)
258 (maphash 258 (maphash
259 (lambda (key value) (add-to-list 'result (zeroconf-service-name value))) 259 (lambda (_key value) (add-to-list 'result (zeroconf-service-name value)))
260 zeroconf-services-hash) 260 zeroconf-services-hash)
261 result)) 261 result))
262 262
@@ -264,7 +264,7 @@ supported keys depend on the service type.")
264 "Returns all discovered Avahi service types as list." 264 "Returns all discovered Avahi service types as list."
265 (let (result) 265 (let (result)
266 (maphash 266 (maphash
267 (lambda (key value) (add-to-list 'result (zeroconf-service-type value))) 267 (lambda (_key value) (add-to-list 'result (zeroconf-service-type value)))
268 zeroconf-services-hash) 268 zeroconf-services-hash)
269 result)) 269 result))
270 270
@@ -276,7 +276,7 @@ The service type is one of the returned values of
276format of SERVICE." 276format of SERVICE."
277 (let (result) 277 (let (result)
278 (maphash 278 (maphash
279 (lambda (key value) 279 (lambda (_key value)
280 (when (equal type (zeroconf-service-type value)) 280 (when (equal type (zeroconf-service-type value))
281 (add-to-list 'result value))) 281 (add-to-list 'result value)))
282 zeroconf-services-hash) 282 zeroconf-services-hash)
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 6cbd84a9cf3..ed5b4c65068 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -50,7 +50,7 @@
50 (make-local-variable 'scroll-step) 50 (make-local-variable 'scroll-step)
51 (setq scroll-step 2)) 51 (setq scroll-step 2))
52 52
53(defun dun-parse (arg) 53(defun dun-parse (_arg)
54 "Function called when return is pressed in interactive mode to parse line." 54 "Function called when return is pressed in interactive mode to parse line."
55 (interactive "*p") 55 (interactive "*p")
56 (beginning-of-line) 56 (beginning-of-line)
@@ -210,13 +210,13 @@ disk bursts into flames, and disintegrates.")
210 (dun-score nil) 210 (dun-score nil)
211 (setq dun-dead t)) 211 (setq dun-dead t))
212 212
213(defun dun-quit (args) 213(defun dun-quit (_args)
214 (dun-die nil)) 214 (dun-die nil))
215 215
216;;; Print every object in player's inventory. Special case for the jar, 216;;; Print every object in player's inventory. Special case for the jar,
217;;; as we must also print what is in it. 217;;; as we must also print what is in it.
218 218
219(defun dun-inven (args) 219(defun dun-inven (_args)
220 (dun-mprinc "You currently have:") 220 (dun-mprinc "You currently have:")
221 (dun-mprinc "\n") 221 (dun-mprinc "\n")
222 (dolist (curobj dun-inventory) 222 (dolist (curobj dun-inventory)
@@ -265,9 +265,9 @@ on your head.")
265(defun dun-drop (obj) 265(defun dun-drop (obj)
266 (if dun-inbus 266 (if dun-inbus
267 (dun-mprincl "You can't drop anything while on the bus.") 267 (dun-mprincl "You can't drop anything while on the bus.")
268 (let (objnum ptr) 268 (let (objnum)
269 (when (setq objnum (dun-objnum-from-args-std obj)) 269 (when (setq objnum (dun-objnum-from-args-std obj))
270 (if (not (setq ptr (member objnum dun-inventory))) 270 (if (not (member objnum dun-inventory))
271 (dun-mprincl "You don't have that.") 271 (dun-mprincl "You don't have that.")
272 (progn 272 (progn
273 (dun-remove-obj-from-inven objnum) 273 (dun-remove-obj-from-inven objnum)
@@ -412,10 +412,10 @@ For an explosive time, go to Fourth St. and Vermont.")
412;;; We try to take an object that is untakable. Print a message 412;;; We try to take an object that is untakable. Print a message
413;;; depending on what it is. 413;;; depending on what it is.
414 414
415(defun dun-try-take (obj) 415(defun dun-try-take (_obj)
416 (dun-mprinc "You cannot take that.")) 416 (dun-mprinc "You cannot take that."))
417 417
418(defun dun-dig (args) 418(defun dun-dig (_args)
419 (if dun-inbus 419 (if dun-inbus
420 (dun-mprincl "Digging here reveals nothing.") 420 (dun-mprincl "Digging here reveals nothing.")
421 (if (not (member 0 dun-inventory)) 421 (if (not (member 0 dun-inventory))
@@ -557,7 +557,7 @@ with a bang. The key seems to have vanished!")
557just try dropping it.") 557just try dropping it.")
558 (dun-mprincl"You can't put that there."))))))))))) 558 (dun-mprincl"You can't put that there.")))))))))))
559 559
560(defun dun-type (args) 560(defun dun-type (_args)
561 (if (not (= dun-current-room computer-room)) 561 (if (not (= dun-current-room computer-room))
562 (dun-mprincl "There is nothing here on which you could type.") 562 (dun-mprincl "There is nothing here on which you could type.")
563 (if (not dun-computer) 563 (if (not dun-computer)
@@ -567,40 +567,40 @@ just try dropping it.")
567 567
568;;; Various movement directions 568;;; Various movement directions
569 569
570(defun dun-n (args) 570(defun dun-n (_args)
571 (dun-move north)) 571 (dun-move north))
572 572
573(defun dun-s (args) 573(defun dun-s (_args)
574 (dun-move south)) 574 (dun-move south))
575 575
576(defun dun-e (args) 576(defun dun-e (_args)
577 (dun-move east)) 577 (dun-move east))
578 578
579(defun dun-w (args) 579(defun dun-w (_args)
580 (dun-move west)) 580 (dun-move west))
581 581
582(defun dun-ne (args) 582(defun dun-ne (_args)
583 (dun-move northeast)) 583 (dun-move northeast))
584 584
585(defun dun-se (args) 585(defun dun-se (_args)
586 (dun-move southeast)) 586 (dun-move southeast))
587 587
588(defun dun-nw (args) 588(defun dun-nw (_args)
589 (dun-move northwest)) 589 (dun-move northwest))
590 590
591(defun dun-sw (args) 591(defun dun-sw (_args)
592 (dun-move southwest)) 592 (dun-move southwest))
593 593
594(defun dun-up (args) 594(defun dun-up (_args)
595 (dun-move up)) 595 (dun-move up))
596 596
597(defun dun-down (args) 597(defun dun-down (_args)
598 (dun-move down)) 598 (dun-move down))
599 599
600(defun dun-in (args) 600(defun dun-in (_args)
601 (dun-move in)) 601 (dun-move in))
602 602
603(defun dun-out (args) 603(defun dun-out (_args)
604 (dun-move out)) 604 (dun-move out))
605 605
606(defun dun-go (args) 606(defun dun-go (args)
@@ -774,7 +774,7 @@ engulf you, and you burn to death.")
774huge rocks sliding down from the ceiling, and blocking your way out.\n") 774huge rocks sliding down from the ceiling, and blocking your way out.\n")
775 (setq dun-current-room misty-room))))) 775 (setq dun-current-room misty-room)))))
776 776
777(defun dun-long (args) 777(defun dun-long (_args)
778 (setq dun-mode "long")) 778 (setq dun-mode "long"))
779 779
780(defun dun-turn (obj) 780(defun dun-turn (obj)
@@ -867,7 +867,7 @@ as you release it, the passageway closes."))
867 (dun-mprincl "The button is now in the on position.") 867 (dun-mprincl "The button is now in the on position.")
868 (setq dun-black t)))))))) 868 (setq dun-black t))))))))
869 869
870(defun dun-swim (args) 870(defun dun-swim (_args)
871 (if (not (member dun-current-room (list lakefront-north lakefront-south))) 871 (if (not (member dun-current-room (list lakefront-north lakefront-south)))
872 (dun-mprincl "I see no water!") 872 (dun-mprincl "I see no water!")
873 (if (not (member obj-life dun-inventory)) 873 (if (not (member obj-life dun-inventory))
@@ -882,7 +882,7 @@ to swim.")
882 (setq dun-current-room lakefront-north))))) 882 (setq dun-current-room lakefront-north)))))
883 883
884 884
885(defun dun-score (args) 885(defun dun-score (_args)
886 (if (not dun-endgame) 886 (if (not dun-endgame)
887 (let (total) 887 (let (total)
888 (setq total (dun-reg-score)) 888 (setq total (dun-reg-score))
@@ -896,7 +896,7 @@ to swim.")
896 (dun-mprincl 896 (dun-mprincl
897"\n\nCongratulations. You have won. The wizard password is ‘moby’")))) 897"\n\nCongratulations. You have won. The wizard password is ‘moby’"))))
898 898
899(defun dun-help (args) 899(defun dun-help (_args)
900 (dun-mprincl 900 (dun-mprincl
901"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). 901"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell).
902Here is some useful information (read carefully because there are one 902Here is some useful information (read carefully because there are one
@@ -937,14 +937,14 @@ If you have questions or comments, please contact ronnie@driver-aces.com
937My home page is http://www.driver-aces.com/ronnie.html 937My home page is http://www.driver-aces.com/ronnie.html
938")) 938"))
939 939
940(defun dun-flush (args) 940(defun dun-flush (_args)
941 (if (not (= dun-current-room bathroom)) 941 (if (not (= dun-current-room bathroom))
942 (dun-mprincl "I see nothing to flush.") 942 (dun-mprincl "I see nothing to flush.")
943 (dun-mprincl "Whoooosh!!") 943 (dun-mprincl "Whoooosh!!")
944 (dun-put-objs-in-treas (nth urinal dun-room-objects)) 944 (dun-put-objs-in-treas (nth urinal dun-room-objects))
945 (dun-replace dun-room-objects urinal nil))) 945 (dun-replace dun-room-objects urinal nil)))
946 946
947(defun dun-piss (args) 947(defun dun-piss (_args)
948 (if (not (= dun-current-room bathroom)) 948 (if (not (= dun-current-room bathroom))
949 (dun-mprincl "You can't do that here, don't even bother trying.") 949 (dun-mprincl "You can't do that here, don't even bother trying.")
950 (if (not dun-gottago) 950 (if (not dun-gottago)
@@ -956,7 +956,7 @@ My home page is http://www.driver-aces.com/ronnie.html
956 (list obj-URINE)))))) 956 (list obj-URINE))))))
957 957
958 958
959(defun dun-sleep (args) 959(defun dun-sleep (_args)
960 (if (not (= dun-current-room bedroom)) 960 (if (not (= dun-current-room bedroom))
961 (dun-mprincl 961 (dun-mprincl
962"You try to go to sleep while standing up here, but can't seem to do it.") 962"You try to go to sleep while standing up here, but can't seem to do it.")
@@ -1012,12 +1012,12 @@ for a moment, then straighten yourself up.
1012 (dun-mprincl "Your axe breaks it into a million pieces.") 1012 (dun-mprincl "Your axe breaks it into a million pieces.")
1013 (dun-remove-obj-from-room dun-current-room objnum))))))))) 1013 (dun-remove-obj-from-room dun-current-room objnum)))))))))
1014 1014
1015(defun dun-drive (args) 1015(defun dun-drive (_args)
1016 (if (not dun-inbus) 1016 (if (not dun-inbus)
1017 (dun-mprincl "You cannot drive when you aren't in a vehicle.") 1017 (dun-mprincl "You cannot drive when you aren't in a vehicle.")
1018 (dun-mprincl "To drive while you are in the bus, just give a direction."))) 1018 (dun-mprincl "To drive while you are in the bus, just give a direction.")))
1019 1019
1020(defun dun-superb (args) 1020(defun dun-superb (_args)
1021 (setq dun-mode 'dun-superb)) 1021 (setq dun-mode 'dun-superb))
1022 1022
1023(defun dun-reg-score () 1023(defun dun-reg-score ()
@@ -1073,7 +1073,7 @@ for a moment, then straighten yourself up.
1073 (setq i (1+ i))) 1073 (setq i (1+ i)))
1074 (setq dun-endgame-questions newques)))) 1074 (setq dun-endgame-questions newques))))
1075 1075
1076(defun dun-power (args) 1076(defun dun-power (_args)
1077 (if (not (= dun-current-room pc-area)) 1077 (if (not (= dun-current-room pc-area))
1078 (dun-mprincl "That operation is not applicable here.") 1078 (dun-mprincl "That operation is not applicable here.")
1079 (if (not dun-floppy) 1079 (if (not dun-floppy)
@@ -1113,7 +1113,7 @@ for a moment, then straighten yourself up.
1113 (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) 1113 (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest)))
1114 (if (not (cdr (assq (intern verb) dun-verblist))) -1 1114 (if (not (cdr (assq (intern verb) dun-verblist))) -1
1115 (setq dun-numcmds (1+ dun-numcmds)) 1115 (setq dun-numcmds (1+ dun-numcmds))
1116 (eval (list (cdr (assq (intern verb) dun-verblist)) (quote rest))))))) 1116 (funcall (cdr (assq (intern verb) dun-verblist)) rest)))))
1117 1117
1118 1118
1119;;; Function to take a string and change it into a list of lowercase words. 1119;;; Function to take a string and change it into a list of lowercase words.
@@ -1221,11 +1221,10 @@ for a moment, then straighten yourself up.
1221;;; words in the command, except for the verb. 1221;;; words in the command, except for the verb.
1222 1222
1223(defun dun-objnum-from-args (obj) 1223(defun dun-objnum-from-args (obj)
1224 (let (objnum) 1224 (setq obj (dun-firstword obj))
1225 (setq obj (dun-firstword obj)) 1225 (if (not obj)
1226 (if (not obj) 1226 obj-special
1227 obj-special 1227 (cdr (assq (intern obj) dun-objnames))))
1228 (setq objnum (cdr (assq (intern obj) dun-objnames))))))
1229 1228
1230(defun dun-objnum-from-args-std (obj) 1229(defun dun-objnum-from-args-std (obj)
1231 (let (result) 1230 (let (result)
@@ -1251,7 +1250,7 @@ for a moment, then straighten yourself up.
1251;;; Given a unix style pathname, build a list of path components (recursive) 1250;;; Given a unix style pathname, build a list of path components (recursive)
1252 1251
1253(defun dun-get-path (dirstring startlist) 1252(defun dun-get-path (dirstring startlist)
1254 (let (slash pos) 1253 (let (slash)
1255 (if (= (length dirstring) 0) 1254 (if (= (length dirstring) 0)
1256 startlist 1255 startlist
1257 (if (string= (substring dirstring 0 1) "/") 1256 (if (string= (substring dirstring 0 1) "/")
@@ -2480,7 +2479,7 @@ treasures for points?" "4" "four")
2480;;;; This section defines the UNIX emulation functions for dunnet. 2479;;;; This section defines the UNIX emulation functions for dunnet.
2481;;;; 2480;;;;
2482 2481
2483(defun dun-unix-parse (args) 2482(defun dun-unix-parse (_args)
2484 (interactive "*p") 2483 (interactive "*p")
2485 (beginning-of-line) 2484 (beginning-of-line)
2486 (let (beg esign) 2485 (let (beg esign)
@@ -2687,13 +2686,13 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
2687 (dun-mprinc var) 2686 (dun-mprinc var)
2688 (dun-mprinc ": Permission denied") 2687 (dun-mprinc ": Permission denied")
2689 (setq nomore t)) 2688 (setq nomore t))
2690 (eval (list 'dun-mprinc var)) 2689 (dun-mprinc var)
2691 (dun-mprinc " "))))))) 2690 (dun-mprinc " ")))))))
2692 (dun-mprinc "\n"))) 2691 (dun-mprinc "\n")))
2693 2692
2694 2693
2695(defun dun-ftp (args) 2694(defun dun-ftp (args)
2696 (let (host username passwd ident newlist) 2695 (let (host username ident newlist)
2697 (if (not (car args)) 2696 (if (not (car args))
2698 (dun-mprincl "ftp: hostname required on command line.") 2697 (dun-mprincl "ftp: hostname required on command line.")
2699 (setq host (intern (car args))) 2698 (setq host (intern (car args)))
@@ -2768,15 +2767,15 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
2768 (dun-fascii 'nil) 2767 (dun-fascii 'nil)
2769 (dun-mprincl "Unknown type."))))) 2768 (dun-mprincl "Unknown type.")))))
2770 2769
2771(defun dun-bin (args) 2770(defun dun-bin (_args)
2772 (dun-mprincl "Type set to binary.") 2771 (dun-mprincl "Type set to binary.")
2773 (setq dun-ftptype 'binary)) 2772 (setq dun-ftptype 'binary))
2774 2773
2775(defun dun-fascii (args) 2774(defun dun-fascii (_args)
2776 (dun-mprincl "Type set to ascii.") 2775 (dun-mprincl "Type set to ascii.")
2777 (setq dun-ftptype 'ascii)) 2776 (setq dun-ftptype 'ascii))
2778 2777
2779(defun dun-ftpquit (args) 2778(defun dun-ftpquit (_args)
2780 (setq dun-exitf t)) 2779 (setq dun-exitf t))
2781 2780
2782(defun dun-send (args) 2781(defun dun-send (args)
@@ -2831,18 +2830,18 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
2831 (if (not foo) 2830 (if (not foo)
2832 (dun-mprincl "No such file.")))))) 2831 (dun-mprincl "No such file."))))))
2833 2832
2834(defun dun-ftphelp (args) 2833(defun dun-ftphelp (_args)
2835 (dun-mprincl 2834 (dun-mprincl
2836 "Possible commands are:\nsend quit type ascii binary help")) 2835 "Possible commands are:\nsend quit type ascii binary help"))
2837 2836
2838(defun dun-uexit (args) 2837(defun dun-uexit (_args)
2839 (setq dungeon-mode 'dungeon) 2838 (setq dungeon-mode 'dungeon)
2840 (dun-mprincl "\nYou step back from the console.") 2839 (dun-mprincl "\nYou step back from the console.")
2841 (define-key dun-mode-map "\r" 'dun-parse) 2840 (define-key dun-mode-map "\r" 'dun-parse)
2842 (if (not dun-batch-mode) 2841 (if (not dun-batch-mode)
2843 (dun-messages))) 2842 (dun-messages)))
2844 2843
2845(defun dun-pwd (args) 2844(defun dun-pwd (_args)
2846 (dun-mprincl dun-cdpath)) 2845 (dun-mprincl dun-cdpath))
2847 2846
2848(defun dun-uncompress (args) 2847(defun dun-uncompress (args)
@@ -3009,7 +3008,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
3009;;;; This section defines the DOS emulation functions for dunnet 3008;;;; This section defines the DOS emulation functions for dunnet
3010;;;; 3009;;;;
3011 3010
3012(defun dun-dos-parse (args) 3011(defun dun-dos-parse (_args)
3013 (interactive "*p") 3012 (interactive "*p")
3014 (beginning-of-line) 3013 (beginning-of-line)
3015 (let (beg) 3014 (let (beg)
@@ -3047,7 +3046,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
3047 (dun-mprincl (upcase args)))) 3046 (dun-mprincl (upcase args))))
3048 (dun-mprincl "Must supply file name"))) 3047 (dun-mprincl "Must supply file name")))
3049 3048
3050(defun dun-dos-invd (args) 3049(defun dun-dos-invd (_args)
3051 (sleep-for 1) 3050 (sleep-for 1)
3052 (dun-mprincl "Invalid drive specification")) 3051 (dun-mprincl "Invalid drive specification"))
3053 3052
@@ -3084,11 +3083,11 @@ File not found")))
3084 (if (not dun-batch-mode) 3083 (if (not dun-batch-mode)
3085 (dun-mprinc "\n"))) 3084 (dun-mprinc "\n")))
3086 3085
3087(defun dun-dos-spawn (args) 3086(defun dun-dos-spawn (_args)
3088 (sleep-for 1) 3087 (sleep-for 1)
3089 (dun-mprincl "Cannot spawn subshell")) 3088 (dun-mprincl "Cannot spawn subshell"))
3090 3089
3091(defun dun-dos-exit (args) 3090(defun dun-dos-exit (_args)
3092 (setq dungeon-mode 'dungeon) 3091 (setq dungeon-mode 'dungeon)
3093 (dun-mprincl "\nYou power down the machine and step back.") 3092 (dun-mprincl "\nYou power down the machine and step back.")
3094 (define-key dun-mode-map "\r" 'dun-parse) 3093 (define-key dun-mode-map "\r" 'dun-parse)
@@ -3106,7 +3105,7 @@ File not found")))
3106 (dun-mprinc dun-combination) 3105 (dun-mprinc dun-combination)
3107 (dun-mprinc ".\n")) 3106 (dun-mprinc ".\n"))
3108 3107
3109(defun dun-dos-nil (args)) 3108(defun dun-dos-nil (_args))
3110 3109
3111 3110
3112;;;; 3111;;;;
@@ -3177,9 +3176,7 @@ File not found")))
3177 3176
3178 3177
3179(defun dun-save-val (varname) 3178(defun dun-save-val (varname)
3180 (let (value) 3179 (let ((value (symbol-value (intern varname))))
3181 (setq varname (intern varname))
3182 (setq value (eval varname))
3183 (dun-minsert "(setq ") 3180 (dun-minsert "(setq ")
3184 (dun-minsert varname) 3181 (dun-minsert varname)
3185 (dun-minsert " ") 3182 (dun-minsert " ")
@@ -3205,7 +3202,7 @@ File not found")))
3205 3202
3206 3203
3207(defun dun-do-logfile (type how) 3204(defun dun-do-logfile (type how)
3208 (let (ferror newscore) 3205 (let (ferror)
3209 (setq ferror nil) 3206 (setq ferror nil)
3210 (switch-to-buffer (get-buffer-create "*score*")) 3207 (switch-to-buffer (get-buffer-create "*score*"))
3211 (erase-buffer) 3208 (erase-buffer)
@@ -3231,8 +3228,8 @@ File not found")))
3231 (dun-minsert (cadr (nth (abs room) dun-rooms))) 3228 (dun-minsert (cadr (nth (abs room) dun-rooms)))
3232 (dun-minsert ". score: ") 3229 (dun-minsert ". score: ")
3233 (if (> (dun-endgame-score) 0) 3230 (if (> (dun-endgame-score) 0)
3234 (dun-minsert (setq newscore (+ 90 (dun-endgame-score)))) 3231 (dun-minsert (+ 90 (dun-endgame-score)))
3235 (dun-minsert (setq newscore (dun-reg-score)))) 3232 (dun-minsert (dun-reg-score)))
3236 (dun-minsert " saves: ") 3233 (dun-minsert " saves: ")
3237 (dun-minsert dun-numsaves) 3234 (dun-minsert dun-numsaves)
3238 (dun-minsert " commands: ") 3235 (dun-minsert " commands: ")
@@ -3318,7 +3315,7 @@ File not found")))
3318 (goto-char (point-max)) 3315 (goto-char (point-max))
3319 (dun-mprinc "\n")))) 3316 (dun-mprinc "\n"))))
3320 3317
3321(defun dungeon-nil (arg) 3318(defun dungeon-nil (_arg)
3322 "noop" 3319 "noop"
3323 (interactive "*p") 3320 (interactive "*p")
3324 nil) 3321 nil)
@@ -3329,7 +3326,7 @@ File not found")))
3329 (dun-mprinc "\n") 3326 (dun-mprinc "\n")
3330 (dun-batch-loop)) 3327 (dun-batch-loop))
3331 3328
3332(unless (not noninteractive) 3329(when noninteractive
3333 (fset 'dun-mprinc 'dun-batch-mprinc) 3330 (fset 'dun-mprinc 'dun-batch-mprinc)
3334 (fset 'dun-mprincl 'dun-batch-mprincl) 3331 (fset 'dun-mprincl 'dun-batch-mprincl)
3335 (fset 'dun-vparse 'dun-batch-parse) 3332 (fset 'dun-vparse 'dun-batch-parse)
@@ -3343,8 +3340,8 @@ File not found")))
3343 3340
3344(provide 'dunnet) 3341(provide 'dunnet)
3345 3342
3346;;; dunnet.el ends here
3347
3348;; Local Variables: 3343;; Local Variables:
3349;; byte-compile-warnings: (not free-vars lexical) 3344;; byte-compile-warnings: (not free-vars lexical)
3350;; End: 3345;; End:
3346
3347;;; dunnet.el ends here
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e84c4cebf69..fd7aa50840f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -313,7 +313,8 @@ comment at the start of cc-engine.el for more info."
313 (c-macro-is-genuine-p)) 313 (c-macro-is-genuine-p))
314 (progn 314 (progn
315 (setq c-macro-cache (cons (point) nil) 315 (setq c-macro-cache (cons (point) nil)
316 c-macro-cache-start-pos here) 316 c-macro-cache-start-pos here
317 c-macro-cache-syntactic nil)
317 t) 318 t)
318 (goto-char here) 319 (goto-char here)
319 nil)))))) 320 nil))))))
@@ -344,7 +345,8 @@ comment at the start of cc-engine.el for more info."
344 (forward-char) 345 (forward-char)
345 t))) 346 t)))
346 (when (car c-macro-cache) 347 (when (car c-macro-cache)
347 (setcdr c-macro-cache (point))))) 348 (setcdr c-macro-cache (point))
349 (setq c-macro-cache-syntactic nil))))
348 350
349(defun c-syntactic-end-of-macro () 351(defun c-syntactic-end-of-macro ()
350 ;; Go to the end of a CPP directive, or a "safe" pos just before. 352 ;; Go to the end of a CPP directive, or a "safe" pos just before.
@@ -364,7 +366,8 @@ comment at the start of cc-engine.el for more info."
364 (goto-char c-macro-cache-syntactic) 366 (goto-char c-macro-cache-syntactic)
365 (setq s (parse-partial-sexp here there)) 367 (setq s (parse-partial-sexp here there))
366 (while (and (or (nth 3 s) ; in a string 368 (while (and (or (nth 3 s) ; in a string
367 (nth 4 s)) ; in a comment (maybe at end of line comment) 369 (and (nth 4 s) ; in a comment (maybe at end of line comment)
370 (not (eq (nth 7 s) 'syntax-table)))) ; Not a pseudo comment
368 (> there here)) ; No infinite loops, please. 371 (> there here)) ; No infinite loops, please.
369 (setq there (1- (nth 8 s))) 372 (setq there (1- (nth 8 s)))
370 (setq s (parse-partial-sexp here there))) 373 (setq s (parse-partial-sexp here there)))
@@ -389,7 +392,8 @@ comment at the start of cc-engine.el for more info."
389 (> there here)) ; No infinite loops, please. 392 (> there here)) ; No infinite loops, please.
390 (setq here (1+ (nth 8 s))) 393 (setq here (1+ (nth 8 s)))
391 (setq s (parse-partial-sexp here there))) 394 (setq s (parse-partial-sexp here there)))
392 (when (nth 4 s) 395 (when (and (nth 4 s)
396 (not (eq (nth 7 s) 'syntax-table))) ; no pseudo comments.
393 (goto-char (1- (nth 8 s)))) 397 (goto-char (1- (nth 8 s))))
394 (setq c-macro-cache-no-comment (point))) 398 (setq c-macro-cache-no-comment (point)))
395 (point))) 399 (point)))
@@ -2407,7 +2411,9 @@ comment at the start of cc-engine.el for more info."
2407 (s (parse-partial-sexp base here nil nil s)) 2411 (s (parse-partial-sexp base here nil nil s))
2408 ty) 2412 ty)
2409 (cond 2413 (cond
2410 ((or (nth 3 s) (nth 4 s)) ; in a string or comment 2414 ((or (nth 3 s)
2415 (and (nth 4 s)
2416 (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment
2411 (setq ty (cond 2417 (setq ty (cond
2412 ((nth 3 s) 'string) 2418 ((nth 3 s) 'string)
2413 ((nth 7 s) 'c++) 2419 ((nth 7 s) 'c++)
@@ -2453,7 +2459,9 @@ comment at the start of cc-engine.el for more info."
2453 (s (parse-partial-sexp base here nil nil s)) 2459 (s (parse-partial-sexp base here nil nil s))
2454 ty start) 2460 ty start)
2455 (cond 2461 (cond
2456 ((or (nth 3 s) (nth 4 s)) ; in a string or comment 2462 ((or (nth 3 s)
2463 (and (nth 4 s)
2464 (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment
2457 (setq ty (cond 2465 (setq ty (cond
2458 ((nth 3 s) 'string) 2466 ((nth 3 s) 'string)
2459 ((nth 7 s) 'c++) 2467 ((nth 7 s) 'c++)
@@ -2479,7 +2487,7 @@ comment at the start of cc-engine.el for more info."
2479 2487
2480 (t (list s)))))))) 2488 (t (list s))))))))
2481 2489
2482(defsubst c-state-pp-to-literal (from to &optional not-in-delimiter) 2490(defun c-state-pp-to-literal (from to &optional not-in-delimiter)
2483 ;; Do a parse-partial-sexp from FROM to TO, returning either 2491 ;; Do a parse-partial-sexp from FROM to TO, returning either
2484 ;; (STATE TYPE (BEG . END)) if TO is in a literal; or 2492 ;; (STATE TYPE (BEG . END)) if TO is in a literal; or
2485 ;; (STATE) otherwise, 2493 ;; (STATE) otherwise,
@@ -2498,7 +2506,9 @@ comment at the start of cc-engine.el for more info."
2498 (let ((s (parse-partial-sexp from to)) 2506 (let ((s (parse-partial-sexp from to))
2499 ty co-st) 2507 ty co-st)
2500 (cond 2508 (cond
2501 ((or (nth 3 s) (nth 4 s)) ; in a string or comment 2509 ((or (nth 3 s)
2510 (and (nth 4 s)
2511 (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment
2502 (setq ty (cond 2512 (setq ty (cond
2503 ((nth 3 s) 'string) 2513 ((nth 3 s) 'string)
2504 ((nth 7 s) 'c++) 2514 ((nth 7 s) 'c++)
@@ -2560,7 +2570,8 @@ comment at the start of cc-engine.el for more info."
2560 (cond 2570 (cond
2561 ((nth 3 state) ; A string 2571 ((nth 3 state) ; A string
2562 (list (point) (nth 3 state) (nth 8 state))) 2572 (list (point) (nth 3 state) (nth 8 state)))
2563 ((nth 4 state) ; A comment 2573 ((and (nth 4 state) ; A comment
2574 (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment.
2564 (list (point) 2575 (list (point)
2565 (if (eq (nth 7 state) 1) 'c++ 'c) 2576 (if (eq (nth 7 state) 1) 'c++ 'c)
2566 (nth 8 state))) 2577 (nth 8 state)))
@@ -2697,7 +2708,7 @@ comment at the start of cc-engine.el for more info."
2697 (widen) 2708 (widen)
2698 (save-excursion 2709 (save-excursion
2699 (let ((pos (c-state-safe-place here))) 2710 (let ((pos (c-state-safe-place here)))
2700 (car (cddr (c-state-pp-to-literal pos here))))))) 2711 (car (cddr (c-state-pp-to-literal pos here)))))))
2701 2712
2702(defsubst c-state-lit-beg (pos) 2713(defsubst c-state-lit-beg (pos)
2703 ;; Return the start of the literal containing POS, or POS itself. 2714 ;; Return the start of the literal containing POS, or POS itself.
@@ -2708,7 +2719,8 @@ comment at the start of cc-engine.el for more info."
2708 ;; Return a position outside of a string/comment/macro at or before POS. 2719 ;; Return a position outside of a string/comment/macro at or before POS.
2709 ;; STATE is the parse-partial-sexp state at POS. 2720 ;; STATE is the parse-partial-sexp state at POS.
2710 (let ((res (if (or (nth 3 state) ; in a string? 2721 (let ((res (if (or (nth 3 state) ; in a string?
2711 (nth 4 state)) ; in a comment? 2722 (and (nth 4 state)
2723 (not (eq (nth 7 state) 'syntax-table)))) ; in a comment?
2712 (nth 8 state) 2724 (nth 8 state)
2713 pos))) 2725 pos)))
2714 (save-excursion 2726 (save-excursion
@@ -3467,7 +3479,7 @@ comment at the start of cc-engine.el for more info."
3467 ((and (consp (car c-state-cache)) 3479 ((and (consp (car c-state-cache))
3468 (> (cdar c-state-cache) here)) 3480 (> (cdar c-state-cache) here))
3469 ;; CASE 1: The top of the cache is a brace pair which now encloses 3481 ;; CASE 1: The top of the cache is a brace pair which now encloses
3470 ;; `here'. As good-pos, return the address. of the "{". Since we've no 3482 ;; `here'. As good-pos, return the address of the "{". Since we've no
3471 ;; knowledge of what's inside these braces, we have no alternative but 3483 ;; knowledge of what's inside these braces, we have no alternative but
3472 ;; to direct the caller to scan the buffer from the opening brace. 3484 ;; to direct the caller to scan the buffer from the opening brace.
3473 (setq pos (caar c-state-cache)) 3485 (setq pos (caar c-state-cache))
@@ -4952,7 +4964,8 @@ comment at the start of cc-engine.el for more info."
4952 (lit-limits 4964 (lit-limits
4953 (if lim 4965 (if lim
4954 (let ((s (parse-partial-sexp lim (point)))) 4966 (let ((s (parse-partial-sexp lim (point))))
4955 (when (or (nth 3 s) (nth 4 s)) 4967 (when (or (nth 3 s)
4968 (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))))
4956 (cons (nth 8 s) 4969 (cons (nth 8 s)
4957 (progn (parse-partial-sexp (point) (point-max) 4970 (progn (parse-partial-sexp (point) (point-max)
4958 nil nil 4971 nil nil
@@ -5005,7 +5018,8 @@ point isn't in one. SAFE-POS, if non-nil, is a position before point which is
5005a known \"safe position\", i.e. outside of any string or comment." 5018a known \"safe position\", i.e. outside of any string or comment."
5006 (if safe-pos 5019 (if safe-pos
5007 (let ((s (parse-partial-sexp safe-pos (point)))) 5020 (let ((s (parse-partial-sexp safe-pos (point))))
5008 (and (or (nth 3 s) (nth 4 s)) 5021 (and (or (nth 3 s)
5022 (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))))
5009 (nth 8 s))) 5023 (nth 8 s)))
5010 (car (cddr (c-state-semi-pp-to-literal (point)))))) 5024 (car (cddr (c-state-semi-pp-to-literal (point))))))
5011 5025
@@ -5106,7 +5120,8 @@ comment at the start of cc-engine.el for more info."
5106 'syntax-table)) ; stop-comment 5120 'syntax-table)) ; stop-comment
5107 5121
5108 ;; Gather details of the non-literal-bit - starting pos and size. 5122 ;; Gather details of the non-literal-bit - starting pos and size.
5109 (setq size (- (if (or (nth 4 s) (nth 3 s)) 5123 (setq size (- (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))
5124 (nth 3 s))
5110 (nth 8 s) 5125 (nth 8 s)
5111 (point)) 5126 (point))
5112 pos)) 5127 pos))
@@ -5114,7 +5129,8 @@ comment at the start of cc-engine.el for more info."
5114 (setq stack (cons (cons pos size) stack))) 5129 (setq stack (cons (cons pos size) stack)))
5115 5130
5116 ;; Move forward to the end of the comment/string. 5131 ;; Move forward to the end of the comment/string.
5117 (if (or (nth 4 s) (nth 3 s)) 5132 (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))
5133 (nth 3 s))
5118 (setq s (parse-partial-sexp 5134 (setq s (parse-partial-sexp
5119 (point) 5135 (point)
5120 start 5136 start
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 7e3c6ba15a5..e2969c607a5 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1068,7 +1068,8 @@ Note that the style variables are always made local to the buffer."
1068 (parse-partial-sexp pps-position (point) nil nil pps-state) 1068 (parse-partial-sexp pps-position (point) nil nil pps-state)
1069 pps-position (point)) 1069 pps-position (point))
1070 (or (nth 3 pps-state) ; in a string? 1070 (or (nth 3 pps-state) ; in a string?
1071 (nth 4 pps-state)))) ; in a comment? 1071 (and (nth 4 pps-state)
1072 (not (eq (nth 7 pps-state) 'syntax-table)))))) ; in a comment?
1072 (goto-char (match-beginning 1)) 1073 (goto-char (match-beginning 1))
1073 (setq mbeg (point)) 1074 (setq mbeg (point))
1074 (if (> (c-no-comment-end-of-macro) mbeg) 1075 (if (> (c-no-comment-end-of-macro) mbeg)
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 0e4e67018ed..5328526abd9 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -582,7 +582,7 @@ and then further adjusted to be at the end of the line."
582 (setq p (line-end-position))) 582 (setq p (line-end-position)))
583 ;; `q' is the point at the end of the block 583 ;; `q' is the point at the end of the block
584 (hs-forward-sexp mdata 1) 584 (hs-forward-sexp mdata 1)
585 (setq q (if (looking-back hs-block-end-regexp) 585 (setq q (if (looking-back hs-block-end-regexp nil)
586 (match-beginning 0) 586 (match-beginning 0)
587 (point))) 587 (point)))
588 (when (and (< p q) (> (count-lines p q) 1)) 588 (when (and (< p q) (> (count-lines p q) 1))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 54df3913fc6..74dd4add9e2 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -574,8 +574,8 @@ then the \".\"s will be lined up:
574 (define-key keymap [(control ?c) (control ?j)] #'js-set-js-context) 574 (define-key keymap [(control ?c) (control ?j)] #'js-set-js-context)
575 (define-key keymap [(control meta ?x)] #'js-eval-defun) 575 (define-key keymap [(control meta ?x)] #'js-eval-defun)
576 (define-key keymap [(meta ?.)] #'js-find-symbol) 576 (define-key keymap [(meta ?.)] #'js-find-symbol)
577 (easy-menu-define nil keymap "Javascript Menu" 577 (easy-menu-define nil keymap "JavaScript Menu"
578 '("Javascript" 578 '("JavaScript"
579 ["Select New Mozilla Context..." js-set-js-context 579 ["Select New Mozilla Context..." js-set-js-context
580 (fboundp #'inferior-moz-process)] 580 (fboundp #'inferior-moz-process)]
581 ["Evaluate Expression in Mozilla Context..." js-eval 581 ["Evaluate Expression in Mozilla Context..." js-eval
@@ -1712,7 +1712,7 @@ This performs fontification according to `js--class-styles'."
1712 nil)))))) 1712 nil))))))
1713 1713
1714(defun js-syntax-propertize (start end) 1714(defun js-syntax-propertize (start end)
1715 ;; Javascript allows immediate regular expression objects, written /.../. 1715 ;; JavaScript allows immediate regular expression objects, written /.../.
1716 (goto-char start) 1716 (goto-char start)
1717 (js-syntax-propertize-regexp end) 1717 (js-syntax-propertize-regexp end)
1718 (funcall 1718 (funcall
@@ -1720,10 +1720,10 @@ This performs fontification according to `js--class-styles'."
1720 ;; Distinguish /-division from /-regexp chars (and from /-comment-starter). 1720 ;; Distinguish /-division from /-regexp chars (and from /-comment-starter).
1721 ;; FIXME: Allow regexps after infix ops like + ... 1721 ;; FIXME: Allow regexps after infix ops like + ...
1722 ;; https://developer.mozilla.org/en/JavaScript/Reference/Operators 1722 ;; https://developer.mozilla.org/en/JavaScript/Reference/Operators
1723 ;; We can probably just add +, -, !, <, >, %, ^, ~, |, &, ?, : at which 1723 ;; We can probably just add +, -, <, >, %, ^, ~, ?, : at which
1724 ;; point I think only * and / would be missing which could also be added, 1724 ;; point I think only * and / would be missing which could also be added,
1725 ;; but need care to avoid affecting the // and */ comment markers. 1725 ;; but need care to avoid affecting the // and */ comment markers.
1726 ("\\(?:^\\|[=([{,:;]\\|\\_<return\\_>\\)\\(?:[ \t]\\)*\\(/\\)[^/*]" 1726 ("\\(?:^\\|[=([{,:;|&!]\\|\\_<return\\_>\\)\\(?:[ \t]\\)*\\(/\\)[^/*]"
1727 (1 (ignore 1727 (1 (ignore
1728 (forward-char -1) 1728 (forward-char -1)
1729 (when (or (not (memq (char-after (match-beginning 0)) '(?\s ?\t))) 1729 (when (or (not (memq (char-after (match-beginning 0)) '(?\s ?\t)))
@@ -2710,7 +2710,7 @@ current buffer. Pushes a mark onto the tag ring just like
2710;;; MozRepl integration 2710;;; MozRepl integration
2711 2711
2712(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error)) 2712(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error))
2713(define-error 'js-js-error "Javascript Error") ;; '(js-error error)) 2713(define-error 'js-js-error "JavaScript Error") ;; '(js-error error))
2714 2714
2715(defun js--wait-for-matching-output 2715(defun js--wait-for-matching-output
2716 (process regexp timeout &optional start) 2716 (process regexp timeout &optional start)
@@ -3214,7 +3214,7 @@ with `js--js-encode-value'."
3214Inside the lexical scope of `with-js', `js?', `js!', 3214Inside the lexical scope of `with-js', `js?', `js!',
3215`js-new', `js-eval', `js-list', `js<', `js>', `js-get-service', 3215`js-new', `js-eval', `js-list', `js<', `js>', `js-get-service',
3216`js-create-instance', and `js-qi' are defined." 3216`js-create-instance', and `js-qi' are defined."
3217 3217 (declare (indent 0) (debug t))
3218 `(progn 3218 `(progn
3219 (js--js-enter-repl) 3219 (js--js-enter-repl)
3220 (unwind-protect 3220 (unwind-protect
@@ -3391,7 +3391,7 @@ With argument, run even if no intervening GC has happened."
3391 3391
3392(defun js-eval (js) 3392(defun js-eval (js)
3393 "Evaluate the JavaScript in JS and return JSON-decoded result." 3393 "Evaluate the JavaScript in JS and return JSON-decoded result."
3394 (interactive "MJavascript to evaluate: ") 3394 (interactive "MJavaScript to evaluate: ")
3395 (with-js 3395 (with-js
3396 (let* ((content-window (js--js-content-window 3396 (let* ((content-window (js--js-content-window
3397 (js--get-js-context))) 3397 (js--get-js-context)))
@@ -3431,11 +3431,8 @@ left-to-right."
3431 (eq (cl-fifth window-info) 2)) 3431 (eq (cl-fifth window-info) 2))
3432 do (push window-info windows)) 3432 do (push window-info windows))
3433 3433
3434 (cl-loop for window-info in windows 3434 (cl-loop for (window title location) in windows
3435 for window = (cl-first window-info) 3435 collect (list title location window)
3436 collect (list (cl-second window-info)
3437 (cl-third window-info)
3438 window)
3439 3436
3440 for gbrowser = (js< window "gBrowser") 3437 for gbrowser = (js< window "gBrowser")
3441 if (js-handle? gbrowser) 3438 if (js-handle? gbrowser)
@@ -3668,7 +3665,7 @@ Change with `js-set-js-context'.")
3668(defun js-set-js-context (context) 3665(defun js-set-js-context (context)
3669 "Set the JavaScript context to CONTEXT. 3666 "Set the JavaScript context to CONTEXT.
3670When called interactively, prompt for CONTEXT." 3667When called interactively, prompt for CONTEXT."
3671 (interactive (list (js--read-tab "Javascript Context: "))) 3668 (interactive (list (js--read-tab "JavaScript Context: ")))
3672 (setq js--js-context context)) 3669 (setq js--js-context context))
3673 3670
3674(defun js--get-js-context () 3671(defun js--get-js-context ()
@@ -3682,7 +3679,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
3682 (`browser (not (js? (js< (cdr js--js-context) 3679 (`browser (not (js? (js< (cdr js--js-context)
3683 "contentDocument")))) 3680 "contentDocument"))))
3684 (x (error "Unmatched case in js--get-js-context: %S" x)))) 3681 (x (error "Unmatched case in js--get-js-context: %S" x))))
3685 (setq js--js-context (js--read-tab "Javascript Context: "))) 3682 (setq js--js-context (js--read-tab "JavaScript Context: ")))
3686 js--js-context)) 3683 js--js-context))
3687 3684
3688(defun js--js-content-window (context) 3685(defun js--js-content-window (context)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index d8262dd0a75..90b5e4e0dc6 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4693,7 +4693,8 @@ likely an invalid python file."
4693 (let ((dedenter-pos (python-info-dedenter-statement-p))) 4693 (let ((dedenter-pos (python-info-dedenter-statement-p)))
4694 (when dedenter-pos 4694 (when dedenter-pos
4695 (goto-char dedenter-pos) 4695 (goto-char dedenter-pos)
4696 (let* ((pairs '(("elif" "elif" "if") 4696 (let* ((cur-line (line-beginning-position))
4697 (pairs '(("elif" "elif" "if")
4697 ("else" "if" "elif" "except" "for" "while") 4698 ("else" "if" "elif" "except" "for" "while")
4698 ("except" "except" "try") 4699 ("except" "except" "try")
4699 ("finally" "else" "except" "try"))) 4700 ("finally" "else" "except" "try")))
@@ -4709,7 +4710,22 @@ likely an invalid python file."
4709 (let ((indentation (current-indentation))) 4710 (let ((indentation (current-indentation)))
4710 (when (and (not (memq indentation collected-indentations)) 4711 (when (and (not (memq indentation collected-indentations))
4711 (or (not collected-indentations) 4712 (or (not collected-indentations)
4712 (< indentation (apply #'min collected-indentations)))) 4713 (< indentation (apply #'min collected-indentations)))
4714 ;; There must be no line with indentation
4715 ;; smaller than `indentation' (except for
4716 ;; blank lines) between the found opening
4717 ;; block and the current line, otherwise it
4718 ;; is not an opening block.
4719 (save-excursion
4720 (forward-line)
4721 (let ((no-back-indent t))
4722 (save-match-data
4723 (while (and (< (point) cur-line)
4724 (setq no-back-indent
4725 (or (> (current-indentation) indentation)
4726 (python-info-current-line-empty-p))))
4727 (forward-line)))
4728 no-back-indent)))
4713 (setq collected-indentations 4729 (setq collected-indentations
4714 (cons indentation collected-indentations)) 4730 (cons indentation collected-indentations))
4715 (when (member (match-string-no-properties 0) 4731 (when (member (match-string-no-properties 0)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 71563486ecd..88683431290 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -2790,7 +2790,7 @@ local variable."
2790 ;; Iterate until we've moved the desired number of stmt ends 2790 ;; Iterate until we've moved the desired number of stmt ends
2791 (while (not (= (cl-signum arg) 0)) 2791 (while (not (= (cl-signum arg) 0))
2792 ;; if we're looking at the terminator, jump by 2 2792 ;; if we're looking at the terminator, jump by 2
2793 (if (or (and (> 0 arg) (looking-back term)) 2793 (if (or (and (> 0 arg) (looking-back term nil))
2794 (and (< 0 arg) (looking-at term))) 2794 (and (< 0 arg) (looking-at term)))
2795 (setq n 2) 2795 (setq n 2)
2796 (setq n 1)) 2796 (setq n 1))
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 0e8ff525e62..6c76d7e4ad2 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -126,6 +126,14 @@
126 126
127;;; Code: 127;;; Code:
128 128
129(eval-when-compile (require 'cl))
130(eval-and-compile
131 ;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin'
132 ;; even for relatively simple cases such as used here. We only test <25
133 ;; because it's easier and sufficient.
134 (when (or (featurep 'xemacs) (< emacs-major-version 25))
135 (require 'cl)))
136
129;; Emacs 21+ handling 137;; Emacs 21+ handling
130(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) 138(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs)))
131 "Non-nil if GNU Emacs 21, 22, ... is used.") 139 "Non-nil if GNU Emacs 21, 22, ... is used.")
@@ -14314,7 +14322,7 @@ of PROJECT."
14314 (vhdl-scan-directory-contents dir-name project nil 14322 (vhdl-scan-directory-contents dir-name project nil
14315 (format "(%s/%s) " act-dir num-dir) 14323 (format "(%s/%s) " act-dir num-dir)
14316 (cdr dir-list)) 14324 (cdr dir-list))
14317 (add-to-list 'dir-list-tmp (file-name-directory dir-name)) 14325 (pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal)
14318 (setq dir-list (cdr dir-list) 14326 (setq dir-list (cdr dir-list)
14319 act-dir (1+ act-dir))) 14327 act-dir (1+ act-dir)))
14320 (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) 14328 (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
@@ -16406,8 +16414,8 @@ component instantiation."
16406 (if (or (member constant-name single-list) 16414 (if (or (member constant-name single-list)
16407 (member constant-name multi-list)) 16415 (member constant-name multi-list))
16408 (progn (setq single-list (delete constant-name single-list)) 16416 (progn (setq single-list (delete constant-name single-list))
16409 (add-to-list 'multi-list constant-name)) 16417 (pushnew constant-name multi-list :test #'equal))
16410 (add-to-list 'single-list constant-name)) 16418 (pushnew constant-name single-list :test #'equal))
16411 (unless (match-string 1) 16419 (unless (match-string 1)
16412 (setq generic-alist (cdr generic-alist))) 16420 (setq generic-alist (cdr generic-alist)))
16413 (vhdl-forward-syntactic-ws)) 16421 (vhdl-forward-syntactic-ws))
@@ -16433,12 +16441,12 @@ component instantiation."
16433 (member signal-name multi-out-list)) 16441 (member signal-name multi-out-list))
16434 (setq single-out-list (delete signal-name single-out-list)) 16442 (setq single-out-list (delete signal-name single-out-list))
16435 (setq multi-out-list (delete signal-name multi-out-list)) 16443 (setq multi-out-list (delete signal-name multi-out-list))
16436 (add-to-list 'local-list signal-name)) 16444 (pushnew signal-name local-list :test #'equal))
16437 ((member signal-name single-in-list) 16445 ((member signal-name single-in-list)
16438 (setq single-in-list (delete signal-name single-in-list)) 16446 (setq single-in-list (delete signal-name single-in-list))
16439 (add-to-list 'multi-in-list signal-name)) 16447 (pushnew signal-name multi-in-list :test #'equal))
16440 ((not (member signal-name multi-in-list)) 16448 ((not (member signal-name multi-in-list))
16441 (add-to-list 'single-in-list signal-name))) 16449 (pushnew signal-name single-in-list :test #'equal)))
16442 ;; output signal 16450 ;; output signal
16443 (cond 16451 (cond
16444 ((member signal-name local-list) 16452 ((member signal-name local-list)
@@ -16447,17 +16455,18 @@ component instantiation."
16447 (member signal-name multi-in-list)) 16455 (member signal-name multi-in-list))
16448 (setq single-in-list (delete signal-name single-in-list)) 16456 (setq single-in-list (delete signal-name single-in-list))
16449 (setq multi-in-list (delete signal-name multi-in-list)) 16457 (setq multi-in-list (delete signal-name multi-in-list))
16450 (add-to-list 'local-list signal-name)) 16458 (pushnew signal-name local-list :test #'equal))
16451 ((member signal-name single-out-list) 16459 ((member signal-name single-out-list)
16452 (setq single-out-list (delete signal-name single-out-list)) 16460 (setq single-out-list (delete signal-name single-out-list))
16453 (add-to-list 'multi-out-list signal-name)) 16461 (pushnew signal-name multi-out-list :test #'equal))
16454 ((not (member signal-name multi-out-list)) 16462 ((not (member signal-name multi-out-list))
16455 (add-to-list 'single-out-list signal-name)))) 16463 (pushnew signal-name single-out-list :test #'equal))))
16456 (unless (match-string 1) 16464 (unless (match-string 1)
16457 (setq port-alist (cdr port-alist))) 16465 (setq port-alist (cdr port-alist)))
16458 (vhdl-forward-syntactic-ws)) 16466 (vhdl-forward-syntactic-ws))
16459 (push (list inst-name (nreverse constant-alist) 16467 (push (list inst-name (nreverse constant-alist)
16460 (nreverse signal-alist)) inst-alist)) 16468 (nreverse signal-alist))
16469 inst-alist))
16461 ;; prepare signal insertion 16470 ;; prepare signal insertion
16462 (vhdl-goto-marker arch-decl-pos) 16471 (vhdl-goto-marker arch-decl-pos)
16463 (forward-line 1) 16472 (forward-line 1)
@@ -16534,14 +16543,14 @@ component instantiation."
16534 generic-end-pos 16543 generic-end-pos
16535 (vhdl-compose-insert-generic constant-entry))) 16544 (vhdl-compose-insert-generic constant-entry)))
16536 (setq generic-pos (point-marker)) 16545 (setq generic-pos (point-marker))
16537 (add-to-list 'written-list constant-name)) 16546 (pushnew constant-name written-list :test #'equal))
16538 (t 16547 (t
16539 (vhdl-goto-marker 16548 (vhdl-goto-marker
16540 (vhdl-max-marker generic-inst-pos generic-pos)) 16549 (vhdl-max-marker generic-inst-pos generic-pos))
16541 (setq generic-end-pos 16550 (setq generic-end-pos
16542 (vhdl-compose-insert-generic constant-entry)) 16551 (vhdl-compose-insert-generic constant-entry))
16543 (setq generic-inst-pos (point-marker)) 16552 (setq generic-inst-pos (point-marker))
16544 (add-to-list 'written-list constant-name)))) 16553 (pushnew constant-name written-list :test #'equal))))
16545 (setq constant-alist (cdr constant-alist))) 16554 (setq constant-alist (cdr constant-alist)))
16546 (when (/= constant-temp-pos generic-inst-pos) 16555 (when (/= constant-temp-pos generic-inst-pos)
16547 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) 16556 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
@@ -16560,14 +16569,14 @@ component instantiation."
16560 (vhdl-max-marker 16569 (vhdl-max-marker
16561 port-end-pos (vhdl-compose-insert-port signal-entry))) 16570 port-end-pos (vhdl-compose-insert-port signal-entry)))
16562 (setq port-in-pos (point-marker)) 16571 (setq port-in-pos (point-marker))
16563 (add-to-list 'written-list signal-name)) 16572 (pushnew signal-name written-list :test #'equal))
16564 ((member signal-name multi-out-list) 16573 ((member signal-name multi-out-list)
16565 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) 16574 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
16566 (setq port-end-pos 16575 (setq port-end-pos
16567 (vhdl-max-marker 16576 (vhdl-max-marker
16568 port-end-pos (vhdl-compose-insert-port signal-entry))) 16577 port-end-pos (vhdl-compose-insert-port signal-entry)))
16569 (setq port-out-pos (point-marker)) 16578 (setq port-out-pos (point-marker))
16570 (add-to-list 'written-list signal-name)) 16579 (pushnew signal-name written-list :test #'equal))
16571 ((or (member signal-name single-in-list) 16580 ((or (member signal-name single-in-list)
16572 (member signal-name single-out-list)) 16581 (member signal-name single-out-list))
16573 (vhdl-goto-marker 16582 (vhdl-goto-marker
@@ -16576,12 +16585,12 @@ component instantiation."
16576 (vhdl-max-marker port-out-pos port-in-pos))) 16585 (vhdl-max-marker port-out-pos port-in-pos)))
16577 (setq port-end-pos (vhdl-compose-insert-port signal-entry)) 16586 (setq port-end-pos (vhdl-compose-insert-port signal-entry))
16578 (setq port-inst-pos (point-marker)) 16587 (setq port-inst-pos (point-marker))
16579 (add-to-list 'written-list signal-name)) 16588 (pushnew signal-name written-list :test #'equal))
16580 ((equal (upcase (nth 2 signal-entry)) "OUT") 16589 ((equal (upcase (nth 2 signal-entry)) "OUT")
16581 (vhdl-goto-marker signal-pos) 16590 (vhdl-goto-marker signal-pos)
16582 (vhdl-compose-insert-signal signal-entry) 16591 (vhdl-compose-insert-signal signal-entry)
16583 (setq signal-pos (point-marker)) 16592 (setq signal-pos (point-marker))
16584 (add-to-list 'written-list signal-name))) 16593 (pushnew signal-name written-list :test #'equal)))
16585 (setq signal-alist (cdr signal-alist))) 16594 (setq signal-alist (cdr signal-alist)))
16586 (when (/= port-temp-pos port-inst-pos) 16595 (when (/= port-temp-pos port-inst-pos)
16587 (vhdl-goto-marker 16596 (vhdl-goto-marker
@@ -16932,7 +16941,7 @@ no project is defined."
16932 "Remove duplicate elements from IN-LIST." 16941 "Remove duplicate elements from IN-LIST."
16933 (let (out-list) 16942 (let (out-list)
16934 (while in-list 16943 (while in-list
16935 (add-to-list 'out-list (car in-list)) 16944 (pushnew (car in-list) out-list :test #'equal)
16936 (setq in-list (cdr in-list))) 16945 (setq in-list (cdr in-list)))
16937 out-list)) 16946 out-list))
16938 16947
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index d8098c5a54a..a507755d42e 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -918,6 +918,10 @@ IGNORES is a list of glob patterns."
918 (grep-compute-defaults) 918 (grep-compute-defaults)
919 (defvar grep-find-template) 919 (defvar grep-find-template)
920 (defvar grep-highlight-matches) 920 (defvar grep-highlight-matches)
921 ;; 'grep -E -foo' results in 'grep: oo: No such file or directory'.
922 ;; while 'grep -e -foo' inexplicably doesn't.
923 (when (eq (aref regexp 0) ?-)
924 (setq regexp (concat "\\" regexp)))
921 (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " 925 (let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
922 grep-find-template t t)) 926 grep-find-template t t))
923 (grep-highlight-matches nil) 927 (grep-highlight-matches nil)
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 2b1d22bb907..4f0573911b9 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -82,7 +82,7 @@ See the command `recentf-save-list'."
82 recentf-mode 82 recentf-mode
83 (recentf-load-list))))) 83 (recentf-load-list)))))
84 84
85(defcustom recentf-save-file-modes 384 ;; 0600 85(defcustom recentf-save-file-modes #o600
86 "Mode bits of recentf save file, as an integer, or nil. 86 "Mode bits of recentf save file, as an integer, or nil.
87If non-nil, after writing `recentf-save-file', set its mode bits to 87If non-nil, after writing `recentf-save-file', set its mode bits to
88this value. By default give R/W access only to the user who owns that 88this value. By default give R/W access only to the user who owns that
diff --git a/lisp/shell.el b/lisp/shell.el
index 133771aeb32..c8a8555d632 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -544,11 +544,14 @@ control whether input and output cause the window to scroll to the end of the
544buffer." 544buffer."
545 (setq comint-prompt-regexp shell-prompt-pattern) 545 (setq comint-prompt-regexp shell-prompt-pattern)
546 (shell-completion-vars) 546 (shell-completion-vars)
547 (set (make-local-variable 'paragraph-separate) "\\'") 547 (setq-local paragraph-separate "\\'")
548 (set (make-local-variable 'paragraph-start) comint-prompt-regexp) 548 (setq-local paragraph-start comint-prompt-regexp)
549 (set (make-local-variable 'font-lock-defaults) '(shell-font-lock-keywords t)) 549 (setq-local font-lock-defaults '(shell-font-lock-keywords t))
550 (set (make-local-variable 'shell-dirstack) nil) 550 (setq-local shell-dirstack nil)
551 (set (make-local-variable 'shell-last-dir) nil) 551 (setq-local shell-last-dir nil)
552 ;; People expect Shell mode to keep the last line of output at
553 ;; window bottom.
554 (setq-local scroll-conservatively 101)
552 (shell-dirtrack-mode 1) 555 (shell-dirtrack-mode 1)
553 556
554 ;; By default, ansi-color applies faces using overlays. This is 557 ;; By default, ansi-color applies faces using overlays. This is
diff --git a/lisp/simple.el b/lisp/simple.el
index f798cd43847..441713a18b8 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5410,11 +5410,15 @@ also checks the value of `use-empty-active-region'."
5410 ;; region is active when there's no mark. 5410 ;; region is active when there's no mark.
5411 (progn (cl-assert (mark)) t))) 5411 (progn (cl-assert (mark)) t)))
5412 5412
5413(defun region-bounds ()
5414 "Return the boundaries of the region as a list of (START . END) positions."
5415 (funcall region-extract-function 'bounds))
5416
5413(defun region-noncontiguous-p () 5417(defun region-noncontiguous-p ()
5414 "Return non-nil if the region contains several pieces. 5418 "Return non-nil if the region contains several pieces.
5415An example is a rectangular region handled as a list of 5419An example is a rectangular region handled as a list of
5416separate contiguous regions for each line." 5420separate contiguous regions for each line."
5417 (> (length (funcall region-extract-function 'bounds)) 1)) 5421 (> (length (region-bounds)) 1))
5418 5422
5419(defvar redisplay-unhighlight-region-function 5423(defvar redisplay-unhighlight-region-function
5420 (lambda (rol) (when (overlayp rol) (delete-overlay rol)))) 5424 (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
@@ -7568,7 +7572,7 @@ More precisely, a char with closeparen syntax is self-inserted.")
7568 7572
7569;; This executes C-g typed while Emacs is waiting for a command. 7573;; This executes C-g typed while Emacs is waiting for a command.
7570;; Quitting out of a program does not go through here; 7574;; Quitting out of a program does not go through here;
7571;; that happens in the QUIT macro at the C code level. 7575;; that happens in the maybe_quit function at the C code level.
7572(defun keyboard-quit () 7576(defun keyboard-quit ()
7573 "Signal a `quit' condition. 7577 "Signal a `quit' condition.
7574During execution of Lisp code, this character causes a quit directly. 7578During execution of Lisp code, this character causes a quit directly.
diff --git a/lisp/subr.el b/lisp/subr.el
index 53774169b42..a6ba05c2021 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -384,6 +384,126 @@ configuration."
384 (declare (compiler-macro internal--compiler-macro-cXXr)) 384 (declare (compiler-macro internal--compiler-macro-cXXr))
385 (cdr (cdr x))) 385 (cdr (cdr x)))
386 386
387(defun caaar (x)
388 "Return the `car' of the `car' of the `car' of X."
389 (declare (compiler-macro internal--compiler-macro-cXXr))
390 (car (car (car x))))
391
392(defun caadr (x)
393 "Return the `car' of the `car' of the `cdr' of X."
394 (declare (compiler-macro internal--compiler-macro-cXXr))
395 (car (car (cdr x))))
396
397(defun cadar (x)
398 "Return the `car' of the `cdr' of the `car' of X."
399 (declare (compiler-macro internal--compiler-macro-cXXr))
400 (car (cdr (car x))))
401
402(defun caddr (x)
403 "Return the `car' of the `cdr' of the `cdr' of X."
404 (declare (compiler-macro internal--compiler-macro-cXXr))
405 (car (cdr (cdr x))))
406
407(defun cdaar (x)
408 "Return the `cdr' of the `car' of the `car' of X."
409 (declare (compiler-macro internal--compiler-macro-cXXr))
410 (cdr (car (car x))))
411
412(defun cdadr (x)
413 "Return the `cdr' of the `car' of the `cdr' of X."
414 (declare (compiler-macro internal--compiler-macro-cXXr))
415 (cdr (car (cdr x))))
416
417(defun cddar (x)
418 "Return the `cdr' of the `cdr' of the `car' of X."
419 (declare (compiler-macro internal--compiler-macro-cXXr))
420 (cdr (cdr (car x))))
421
422(defun cdddr (x)
423 "Return the `cdr' of the `cdr' of the `cdr' of X."
424 (declare (compiler-macro internal--compiler-macro-cXXr))
425 (cdr (cdr (cdr x))))
426
427(defun caaaar (x)
428 "Return the `car' of the `car' of the `car' of the `car' of X."
429 (declare (compiler-macro internal--compiler-macro-cXXr))
430 (car (car (car (car x)))))
431
432(defun caaadr (x)
433 "Return the `car' of the `car' of the `car' of the `cdr' of X."
434 (declare (compiler-macro internal--compiler-macro-cXXr))
435 (car (car (car (cdr x)))))
436
437(defun caadar (x)
438 "Return the `car' of the `car' of the `cdr' of the `car' of X."
439 (declare (compiler-macro internal--compiler-macro-cXXr))
440 (car (car (cdr (car x)))))
441
442(defun caaddr (x)
443 "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
444 (declare (compiler-macro internal--compiler-macro-cXXr))
445 (car (car (cdr (cdr x)))))
446
447(defun cadaar (x)
448 "Return the `car' of the `cdr' of the `car' of the `car' of X."
449 (declare (compiler-macro internal--compiler-macro-cXXr))
450 (car (cdr (car (car x)))))
451
452(defun cadadr (x)
453 "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
454 (declare (compiler-macro internal--compiler-macro-cXXr))
455 (car (cdr (car (cdr x)))))
456
457(defun caddar (x)
458 "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
459 (declare (compiler-macro internal--compiler-macro-cXXr))
460 (car (cdr (cdr (car x)))))
461
462(defun cadddr (x)
463 "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
464 (declare (compiler-macro internal--compiler-macro-cXXr))
465 (car (cdr (cdr (cdr x)))))
466
467(defun cdaaar (x)
468 "Return the `cdr' of the `car' of the `car' of the `car' of X."
469 (declare (compiler-macro internal--compiler-macro-cXXr))
470 (cdr (car (car (car x)))))
471
472(defun cdaadr (x)
473 "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
474 (declare (compiler-macro internal--compiler-macro-cXXr))
475 (cdr (car (car (cdr x)))))
476
477(defun cdadar (x)
478 "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
479 (declare (compiler-macro internal--compiler-macro-cXXr))
480 (cdr (car (cdr (car x)))))
481
482(defun cdaddr (x)
483 "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
484 (declare (compiler-macro internal--compiler-macro-cXXr))
485 (cdr (car (cdr (cdr x)))))
486
487(defun cddaar (x)
488 "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
489 (declare (compiler-macro internal--compiler-macro-cXXr))
490 (cdr (cdr (car (car x)))))
491
492(defun cddadr (x)
493 "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
494 (declare (compiler-macro internal--compiler-macro-cXXr))
495 (cdr (cdr (car (cdr x)))))
496
497(defun cdddar (x)
498 "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
499 (declare (compiler-macro internal--compiler-macro-cXXr))
500 (cdr (cdr (cdr (car x)))))
501
502(defun cddddr (x)
503 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
504 (declare (compiler-macro internal--compiler-macro-cXXr))
505 (cdr (cdr (cdr (cdr x)))))
506
387(defun last (list &optional n) 507(defun last (list &optional n)
388 "Return the last link of LIST. Its car is the last element. 508 "Return the last link of LIST. Its car is the last element.
389If LIST is nil, return nil. 509If LIST is nil, return nil.
diff --git a/lisp/term.el b/lisp/term.el
index 5259571eb6d..063a6ea592f 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -2901,15 +2901,16 @@ See `term-prompt-regexp'."
2901 ((eq char ?\017)) ; Shift In - ignored 2901 ((eq char ?\017)) ; Shift In - ignored
2902 ((eq char ?\^G) ;; (terminfo: bel) 2902 ((eq char ?\^G) ;; (terminfo: bel)
2903 (beep t)) 2903 (beep t))
2904 ((and (eq char ?\032) 2904 ((eq char ?\032)
2905 (not handled-ansi-message))
2906 (let ((end (string-match "\r?\n" str i))) 2905 (let ((end (string-match "\r?\n" str i)))
2907 (if end 2906 (if end
2908 (funcall term-command-hook 2907 (progn
2909 (decode-coding-string 2908 (unless handled-ansi-message
2910 (prog1 (substring str (1+ i) end) 2909 (funcall term-command-hook
2911 (setq i (1- (match-end 0)))) 2910 (decode-coding-string
2912 locale-coding-system)) 2911 (substring str (1+ i) end)
2912 locale-coding-system)))
2913 (setq i (1- (match-end 0))))
2913 (setq term-terminal-parameter (substring str i)) 2914 (setq term-terminal-parameter (substring str i))
2914 (setq term-terminal-state 4) 2915 (setq term-terminal-state 4)
2915 (setq i str-length)))) 2916 (setq i str-length))))
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index dfe1cf0c341..c81c3f62e16 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -27,7 +27,6 @@
27 27
28;;; Todo: 28;;; Todo:
29 29
30;; - electric ; and }
31;; - filling code with auto-fill-mode 30;; - filling code with auto-fill-mode
32;; - fix font-lock errors with multi-line selectors 31;; - fix font-lock errors with multi-line selectors
33 32
@@ -667,6 +666,8 @@ cannot be completed sensibly: `custom-ident',
667 ;; Variables. 666 ;; Variables.
668 (,(concat "--" css-ident-re) (0 font-lock-variable-name-face)) 667 (,(concat "--" css-ident-re) (0 font-lock-variable-name-face))
669 ;; Selectors. 668 ;; Selectors.
669 ;; Allow plain ":root" as a selector.
670 ("^[ \t]*\\(:root\\)\\(?:[\n \t]*\\)*{" (1 'css-selector keep))
670 ;; FIXME: attribute selectors don't work well because they may contain 671 ;; FIXME: attribute selectors don't work well because they may contain
671 ;; strings which have already been highlighted as f-l-string-face and 672 ;; strings which have already been highlighted as f-l-string-face and
672 ;; thus prevent this highlighting from being applied (actually now that 673 ;; thus prevent this highlighting from being applied (actually now that
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 63abd048e9d..03da584e96f 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -164,6 +164,8 @@ distribution. Mixed-case symbols are convenience aliases.")
164 (?U . "\\autocite*[][]{%l}") 164 (?U . "\\autocite*[][]{%l}")
165 (?a . "\\citeauthor{%l}") 165 (?a . "\\citeauthor{%l}")
166 (?A . "\\citeauthor*{%l}") 166 (?A . "\\citeauthor*{%l}")
167 (?i . "\\citetitle{%l}")
168 (?I . "\\citetitle*{%l}")
167 (?y . "\\citeyear{%l}") 169 (?y . "\\citeyear{%l}")
168 (?Y . "\\citeyear*{%l}") 170 (?Y . "\\citeyear*{%l}")
169 (?n . "\\nocite{%l}"))) 171 (?n . "\\nocite{%l}")))
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 06f969d2784..261e98eabce 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -109,7 +109,7 @@
109(def-edebug-spec push 109(def-edebug-spec push
110 (&or [form symbolp] [form gv-place])) 110 (&or [form symbolp] [form gv-place]))
111 111
112;; Correct wrong declaration. This still doesn't support dotted desctructuring 112;; Correct wrong declaration. This still doesn't support dotted destructuring
113;; though. 113;; though.
114(def-edebug-spec cl-lambda-list 114(def-edebug-spec cl-lambda-list
115 (([&rest cl-macro-arg] 115 (([&rest cl-macro-arg]
@@ -1006,7 +1006,7 @@ BEG-UND are the starting points of the overline or underline,
1006respectively. They may be nil if the respective thing is missing. 1006respectively. They may be nil if the respective thing is missing.
1007BEG-TXT is the beginning of the title line or the transition and 1007BEG-TXT is the beginning of the title line or the transition and
1008must be given. The end of the line is used as the end point. TXT 1008must be given. The end of the line is used as the end point. TXT
1009is the title text or nil. If TXT is given the indendation of the 1009is the title text or nil. If TXT is given the indentation of the
1010line containing BEG-TXT is used as indentation. Match group 0 is 1010line containing BEG-TXT is used as indentation. Match group 0 is
1011derived from the remaining information." 1011derived from the remaining information."
1012 (cl-check-type beg-txt integer-or-marker) 1012 (cl-check-type beg-txt integer-or-marker)
@@ -1845,8 +1845,7 @@ Uses and sets `rst-all-ttls-cache'."
1845HDRS reflects the order in which the headers appear in the 1845HDRS reflects the order in which the headers appear in the
1846buffer. Return a `rst-Hdr' list representing the hierarchy of 1846buffer. Return a `rst-Hdr' list representing the hierarchy of
1847headers in the buffer. Indentation is unified." 1847headers in the buffer. Indentation is unified."
1848 (let (ado2indents) ; Asscociates `rst-Ado' with the set of indents seen for 1848 (let (ado2indents) ; Associates `rst-Ado' with the set of indents seen for it.
1849 ; it.
1850 (dolist (hdr hdrs) 1849 (dolist (hdr hdrs)
1851 (let* ((ado (rst-Hdr-ado hdr)) 1850 (let* ((ado (rst-Hdr-ado hdr))
1852 (indent (rst-Hdr-indent hdr)) 1851 (indent (rst-Hdr-indent hdr))
@@ -2451,7 +2450,7 @@ also arranged by `rst-insert-list-new-tag'."
2451(defun rst-insert-list-continue (ind tag tab prefer-roman) 2450(defun rst-insert-list-continue (ind tag tab prefer-roman)
2452 ;; testcover: ok. 2451 ;; testcover: ok.
2453 "Insert a new list tag after the current line according to style. 2452 "Insert a new list tag after the current line according to style.
2454Style is defined by indentaton IND, TAG and suffix TAB. If 2453Style is defined by indentation IND, TAG and suffix TAB. If
2455PREFER-ROMAN roman numbering is preferred over using letters." 2454PREFER-ROMAN roman numbering is preferred over using letters."
2456 (end-of-line) 2455 (end-of-line)
2457 (insert 2456 (insert
@@ -2551,8 +2550,8 @@ roman numerical list, just use a prefix to set PREFER-ROMAN."
2551 "Return the positions of begs in region BEG to END. 2550 "Return the positions of begs in region BEG to END.
2552RST-RE-BEG is a `rst-re' argument and matched at the beginning of 2551RST-RE-BEG is a `rst-re' argument and matched at the beginning of
2553a line. Return a list of (POINT . COLUMN) where POINT gives the 2552a line. Return a list of (POINT . COLUMN) where POINT gives the
2554point after indentaton and COLUMN gives its column. The list is 2553point after indentation and COLUMN gives its column. The list is
2555ordererd by POINT." 2554ordered by POINT."
2556 (let (r) 2555 (let (r)
2557 (save-match-data 2556 (save-match-data
2558 (save-excursion 2557 (save-excursion
@@ -2963,7 +2962,7 @@ error if there is no working link at the given position."
2963 (unless link-buf 2962 (unless link-buf
2964 (setq link-buf (current-buffer))) 2963 (setq link-buf (current-buffer)))
2965 ;; Do not catch errors from `rst-toc-get-link' because otherwise the error is 2964 ;; Do not catch errors from `rst-toc-get-link' because otherwise the error is
2966 ;; suppressed and invisible in interactve use. 2965 ;; suppressed and invisible in interactive use.
2967 (let ((mrkr (rst-toc-get-link link-buf link-pnt))) 2966 (let ((mrkr (rst-toc-get-link link-buf link-pnt)))
2968 (condition-case nil 2967 (condition-case nil
2969 (rst-toc-mode-return kill) 2968 (rst-toc-mode-return kill)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 9dfcd944bbd..e609ca9f943 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -498,22 +498,57 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
498 ;; The return value is used by easy-mmode-define-navigation. 498 ;; The return value is used by easy-mmode-define-navigation.
499 (goto-char (or end (point-max))))) 499 (goto-char (or end (point-max)))))
500 500
501;; "index ", "old mode", "new mode", "new file mode" and
502;; "deleted file mode" are output by git-diff.
503(defconst diff-file-junk-re
504 (concat "Index: \\|=\\{20,\\}\\|" ; SVN
505 "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file"))
506
507;; If point is in a diff header, then return beginning
508;; of hunk position otherwise return nil.
509(defun diff--at-diff-header-p ()
510 "Return non-nil if point is inside a diff header."
511 (let ((regexp-hunk diff-hunk-header-re)
512 (regexp-file diff-file-header-re)
513 (regexp-junk diff-file-junk-re)
514 (orig (point)))
515 (catch 'headerp
516 (save-excursion
517 (forward-line 0)
518 (when (looking-at regexp-hunk) ; Hunk header.
519 (throw 'headerp (point)))
520 (forward-line -1)
521 (when (re-search-forward regexp-file (point-at-eol 4) t) ; File header.
522 (forward-line 0)
523 (throw 'headerp (point)))
524 (goto-char orig)
525 (forward-line 0)
526 (when (looking-at regexp-junk) ; Git diff junk.
527 (while (and (looking-at regexp-junk)
528 (not (bobp)))
529 (forward-line -1))
530 (re-search-forward regexp-file nil t)
531 (forward-line 0)
532 (throw 'headerp (point)))) nil)))
533
501(defun diff-beginning-of-hunk (&optional try-harder) 534(defun diff-beginning-of-hunk (&optional try-harder)
502 "Move back to the previous hunk beginning, and return its position. 535 "Move back to the previous hunk beginning, and return its position.
503If point is in a file header rather than a hunk, advance to the 536If point is in a file header rather than a hunk, advance to the
504next hunk if TRY-HARDER is non-nil; otherwise signal an error." 537next hunk if TRY-HARDER is non-nil; otherwise signal an error."
505 (beginning-of-line) 538 (beginning-of-line)
506 (if (looking-at diff-hunk-header-re) 539 (if (looking-at diff-hunk-header-re) ; At hunk header.
507 (point) 540 (point)
508 (forward-line 1) 541 (let ((pos (diff--at-diff-header-p))
509 (condition-case () 542 (regexp diff-hunk-header-re))
510 (re-search-backward diff-hunk-header-re) 543 (cond (pos ; At junk diff header.
511 (error 544 (if try-harder
512 (unless try-harder 545 (goto-char pos)
513 (error "Can't find the beginning of the hunk")) 546 (error "Can't find the beginning of the hunk")))
514 (diff-beginning-of-file-and-junk) 547 ((re-search-backward regexp nil t)) ; In the middle of a hunk.
515 (diff-hunk-next) 548 ((re-search-forward regexp nil t) ; At first hunk header.
516 (point))))) 549 (forward-line 0)
550 (point))
551 (t (error "Can't find the beginning of the hunk"))))))
517 552
518(defun diff-unified-hunk-p () 553(defun diff-unified-hunk-p ()
519 (save-excursion 554 (save-excursion
@@ -551,124 +586,26 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error."
551 586
552;; Define diff-{hunk,file}-{prev,next} 587;; Define diff-{hunk,file}-{prev,next}
553(easy-mmode-define-navigation 588(easy-mmode-define-navigation
554 diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view) 589 diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view
590 (when diff-auto-refine-mode
591 (unless (prog1 diff--auto-refine-data
592 (setq diff--auto-refine-data
593 (cons (current-buffer) (point-marker))))
594 (run-at-time 0.0 nil
595 (lambda ()
596 (when diff--auto-refine-data
597 (let ((buffer (car diff--auto-refine-data))
598 (point (cdr diff--auto-refine-data)))
599 (setq diff--auto-refine-data nil)
600 (with-local-quit
601 (when (buffer-live-p buffer)
602 (with-current-buffer buffer
603 (save-excursion
604 (goto-char point)
605 (diff-refine-hunk))))))))))))
555 606
556(easy-mmode-define-navigation 607(easy-mmode-define-navigation
557 diff--internal-file diff-file-header-re "file" diff-end-of-file) 608 diff-file diff-file-header-re "file" diff-end-of-file)
558
559(defun diff--wrap-navigation (skip-hunk-start
560 what orig
561 header-re goto-start-func count)
562 "Wrap diff-{hunk,file}-{next,prev} for more intuitive behavior.
563Override the default diff-{hunk,file}-{next,prev} implementation
564by skipping any lines that are associated with this hunk/file but
565precede the hunk-start marker. For instance, a diff file could
566contain
567
568diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
569index 923de9a..6b1c24f 100644
570--- a/lisp/vc/diff-mode.el
571+++ b/lisp/vc/diff-mode.el
572@@ -590,6 +590,22 @@
573.......
574
575If a point is on 'index', then the point is considered to be in
576this first hunk. Move the point to the @@... marker before
577executing the default diff-hunk-next/prev implementation to move
578to the NEXT marker."
579 (if (not skip-hunk-start)
580 (funcall orig count)
581
582 (let ((start (point)))
583 (funcall goto-start-func)
584
585 ;; Trap the error.
586 (condition-case nil
587 (funcall orig count)
588 (error nil))
589
590 (when (not (looking-at header-re))
591 (goto-char start)
592 (user-error (format "No %s" what)))
593
594 ;; We successfully moved to the next/prev hunk/file. Apply the
595 ;; auto-refinement if needed
596 (when diff-auto-refine-mode
597 (unless (prog1 diff--auto-refine-data
598 (setq diff--auto-refine-data
599 (cons (current-buffer) (point-marker))))
600 (run-at-time 0.0 nil
601 (lambda ()
602 (when diff--auto-refine-data
603 (let ((buffer (car diff--auto-refine-data))
604 (point (cdr diff--auto-refine-data)))
605 (setq diff--auto-refine-data nil)
606 (with-local-quit
607 (when (buffer-live-p buffer)
608 (with-current-buffer buffer
609 (save-excursion
610 (goto-char point)
611 (diff-refine-hunk))))))))))))))
612
613;; These functions all take a skip-hunk-start argument which controls
614;; whether we skip pre-hunk-start text or not. In interactive uses we
615;; always want to do this, but the simple behavior is still necessary
616;; to, for example, avoid an infinite loop:
617;;
618;; diff-hunk-next calls
619;; diff--wrap-navigation calls
620;; diff-bounds-of-hunk calls
621;; diff-beginning-of-hunk calls
622;; diff-hunk-next
623;;
624;; Here the outer diff-hunk-next has skip-hunk-start set to t, but the
625;; inner one does not, which breaks the loop.
626(defun diff-hunk-prev (&optional count skip-hunk-start)
627 "Go to the previous COUNT'th hunk."
628 (interactive (list (prefix-numeric-value current-prefix-arg) t))
629 (diff--wrap-navigation
630 skip-hunk-start
631 "prev hunk"
632 'diff--internal-hunk-prev
633 diff-hunk-header-re
634 (lambda () (goto-char (car (diff-bounds-of-hunk))))
635 count))
636
637(defun diff-hunk-next (&optional count skip-hunk-start)
638 "Go to the next COUNT'th hunk."
639 (interactive (list (prefix-numeric-value current-prefix-arg) t))
640 (diff--wrap-navigation
641 skip-hunk-start
642 "next hunk"
643 'diff--internal-hunk-next
644 diff-hunk-header-re
645 (lambda () (goto-char (car (diff-bounds-of-hunk))))
646 count))
647
648(defun diff-file-prev (&optional count skip-hunk-start)
649 "Go to the previous COUNT'th file."
650 (interactive (list (prefix-numeric-value current-prefix-arg) t))
651 (diff--wrap-navigation
652 skip-hunk-start
653 "prev file"
654 'diff--internal-file-prev
655 diff-file-header-re
656 (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next))
657 count))
658
659(defun diff-file-next (&optional count skip-hunk-start)
660 "Go to the next COUNT'th file."
661 (interactive (list (prefix-numeric-value current-prefix-arg) t))
662 (diff--wrap-navigation
663 skip-hunk-start
664 "next file"
665 'diff--internal-file-next
666 diff-file-header-re
667 (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next))
668 count))
669
670
671
672 609
673(defun diff-bounds-of-hunk () 610(defun diff-bounds-of-hunk ()
674 "Return the bounds of the diff hunk at point. 611 "Return the bounds of the diff hunk at point.
@@ -679,13 +616,12 @@ point is in a file header, return the bounds of the next hunk."
679 (let ((pos (point)) 616 (let ((pos (point))
680 (beg (diff-beginning-of-hunk t)) 617 (beg (diff-beginning-of-hunk t))
681 (end (diff-end-of-hunk))) 618 (end (diff-end-of-hunk)))
682 (cond ((> end pos) 619 (cond ((>= end pos)
683 (list beg end)) 620 (list beg end))
684 ;; If this hunk ends above POS, consider the next hunk. 621 ;; If this hunk ends above POS, consider the next hunk.
685 ((re-search-forward diff-hunk-header-re nil t) 622 ((re-search-forward diff-hunk-header-re nil t)
686 (list (match-beginning 0) (diff-end-of-hunk))) 623 (list (match-beginning 0) (diff-end-of-hunk)))
687 ;; There's no next hunk, so just take the one we have. 624 (t (error "No hunk found"))))))
688 (t (list beg end))))))
689 625
690(defun diff-bounds-of-file () 626(defun diff-bounds-of-file ()
691 "Return the bounds of the file segment at point. 627 "Return the bounds of the file segment at point.
@@ -731,12 +667,8 @@ If the prefix ARG is given, restrict the view to the current file instead."
731 hunk-bounds)) 667 hunk-bounds))
732 (inhibit-read-only t)) 668 (inhibit-read-only t))
733 (apply 'kill-region bounds) 669 (apply 'kill-region bounds)
734 (goto-char (car bounds)))) 670 (goto-char (car bounds))
735 671 (diff-beginning-of-hunk t)))
736;; "index ", "old mode", "new mode", "new file mode" and
737;; "deleted file mode" are output by git-diff.
738(defconst diff-file-junk-re
739 "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file")
740 672
741(defun diff-beginning-of-file-and-junk () 673(defun diff-beginning-of-file-and-junk ()
742 "Go to the beginning of file-related diff-info. 674 "Go to the beginning of file-related diff-info.
@@ -771,7 +703,7 @@ data such as \"Index: ...\" and such."
771 (setq prevfile nextfile)) 703 (setq prevfile nextfile))
772 (if (and previndex (numberp prevfile) (< previndex prevfile)) 704 (if (and previndex (numberp prevfile) (< previndex prevfile))
773 (setq prevfile previndex)) 705 (setq prevfile previndex))
774 (if (numberp prevfile) 706 (if (and (numberp prevfile) (<= prevfile start))
775 (progn 707 (progn
776 (goto-char prevfile) 708 (goto-char prevfile)
777 ;; Now skip backward over the leading junk we may have before the 709 ;; Now skip backward over the leading junk we may have before the
@@ -789,7 +721,8 @@ data such as \"Index: ...\" and such."
789 "Kill current file's hunks." 721 "Kill current file's hunks."
790 (interactive) 722 (interactive)
791 (let ((inhibit-read-only t)) 723 (let ((inhibit-read-only t))
792 (apply 'kill-region (diff-bounds-of-file)))) 724 (apply 'kill-region (diff-bounds-of-file)))
725 (diff-beginning-of-hunk t))
793 726
794(defun diff-kill-junk () 727(defun diff-kill-junk ()
795 "Kill spurious empty diffs." 728 "Kill spurious empty diffs."
@@ -1373,7 +1306,7 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
1373 ;; it's safer not to do it on big changes, e.g. when yanking a big 1306 ;; it's safer not to do it on big changes, e.g. when yanking a big
1374 ;; diff, or when the user edits the header, since we might then 1307 ;; diff, or when the user edits the header, since we might then
1375 ;; screw up perfectly correct values. --Stef 1308 ;; screw up perfectly correct values. --Stef
1376 (diff-beginning-of-hunk) 1309 (diff-beginning-of-hunk t)
1377 (let* ((style (if (looking-at "\\*\\*\\*") 'context)) 1310 (let* ((style (if (looking-at "\\*\\*\\*") 'context))
1378 (start (line-beginning-position (if (eq style 'context) 3 2))) 1311 (start (line-beginning-position (if (eq style 'context) 3 2)))
1379 (mid (if (eq style 'context) 1312 (mid (if (eq style 'context)
@@ -1764,9 +1697,8 @@ SRC and DST are the two variants of text as returned by `diff-hunk-text'.
1764SWITCHED is non-nil if the patch is already applied. 1697SWITCHED is non-nil if the patch is already applied.
1765NOPROMPT, if non-nil, means not to prompt the user." 1698NOPROMPT, if non-nil, means not to prompt the user."
1766 (save-excursion 1699 (save-excursion
1767 (let* ((hunk-bounds (diff-bounds-of-hunk)) 1700 (let* ((other (diff-xor other-file diff-jump-to-old-file))
1768 (other (diff-xor other-file diff-jump-to-old-file)) 1701 (char-offset (- (point) (diff-beginning-of-hunk t)))
1769 (char-offset (- (point) (goto-char (car hunk-bounds))))
1770 ;; Check that the hunk is well-formed. Otherwise diff-mode and 1702 ;; Check that the hunk is well-formed. Otherwise diff-mode and
1771 ;; the user may disagree on what constitutes the hunk 1703 ;; the user may disagree on what constitutes the hunk
1772 ;; (e.g. because an empty line truncates the hunk mid-course), 1704 ;; (e.g. because an empty line truncates the hunk mid-course),
@@ -1775,7 +1707,7 @@ NOPROMPT, if non-nil, means not to prompt the user."
1775 ;; Suppress check when NOPROMPT is non-nil (Bug#3033). 1707 ;; Suppress check when NOPROMPT is non-nil (Bug#3033).
1776 (_ (unless noprompt (diff-sanity-check-hunk))) 1708 (_ (unless noprompt (diff-sanity-check-hunk)))
1777 (hunk (buffer-substring 1709 (hunk (buffer-substring
1778 (point) (cadr hunk-bounds))) 1710 (point) (save-excursion (diff-end-of-hunk) (point))))
1779 (old (diff-hunk-text hunk reverse char-offset)) 1711 (old (diff-hunk-text hunk reverse char-offset))
1780 (new (diff-hunk-text hunk (not reverse) char-offset)) 1712 (new (diff-hunk-text hunk (not reverse) char-offset))
1781 ;; Find the location specification. 1713 ;; Find the location specification.
@@ -1838,6 +1770,7 @@ the value of this variable when given an appropriate prefix argument).
1838 1770
1839With a prefix argument, REVERSE the hunk." 1771With a prefix argument, REVERSE the hunk."
1840 (interactive "P") 1772 (interactive "P")
1773 (diff-beginning-of-hunk t)
1841 (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched) 1774 (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
1842 ;; Sometimes we'd like to have the following behavior: if 1775 ;; Sometimes we'd like to have the following behavior: if
1843 ;; REVERSE go to the new file, otherwise go to the old. 1776 ;; REVERSE go to the new file, otherwise go to the old.
@@ -1883,15 +1816,8 @@ With a prefix argument, REVERSE the hunk."
1883 ;; Display BUF in a window 1816 ;; Display BUF in a window
1884 (set-window-point (display-buffer buf) (+ (car pos) (cdr new))) 1817 (set-window-point (display-buffer buf) (+ (car pos) (cdr new)))
1885 (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil) 1818 (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
1886
1887 ;; Advance to the next hunk with skip-hunk-start set to t
1888 ;; because we want the behavior of moving to the next logical
1889 ;; hunk, not the original behavior where were would sometimes
1890 ;; stay on the current hunk. This is the behavior we get when
1891 ;; navigating through hunks interactively, and we want it when
1892 ;; applying hunks too (see http://debbugs.gnu.org/17544).
1893 (when diff-advance-after-apply-hunk 1819 (when diff-advance-after-apply-hunk
1894 (diff-hunk-next nil t)))))) 1820 (diff-hunk-next))))))
1895 1821
1896 1822
1897(defun diff-test-hunk (&optional reverse) 1823(defun diff-test-hunk (&optional reverse)
@@ -1972,15 +1898,14 @@ For use in `add-log-current-defun-function'."
1972(defun diff-ignore-whitespace-hunk () 1898(defun diff-ignore-whitespace-hunk ()
1973 "Re-diff the current hunk, ignoring whitespace differences." 1899 "Re-diff the current hunk, ignoring whitespace differences."
1974 (interactive) 1900 (interactive)
1975 (let* ((hunk-bounds (diff-bounds-of-hunk)) 1901 (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
1976 (char-offset (- (point) (goto-char (car hunk-bounds))))
1977 (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b"))) 1902 (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
1978 (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") 1903 (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
1979 (error "Can't find line number")) 1904 (error "Can't find line number"))
1980 (string-to-number (match-string 1)))) 1905 (string-to-number (match-string 1))))
1981 (inhibit-read-only t) 1906 (inhibit-read-only t)
1982 (hunk (delete-and-extract-region 1907 (hunk (delete-and-extract-region
1983 (point) (cadr hunk-bounds))) 1908 (point) (save-excursion (diff-end-of-hunk) (point))))
1984 (lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1. 1909 (lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1.
1985 (file1 (make-temp-file "diff1")) 1910 (file1 (make-temp-file "diff1"))
1986 (file2 (make-temp-file "diff2")) 1911 (file2 (make-temp-file "diff2"))
@@ -2062,35 +1987,48 @@ For use in `add-log-current-defun-function'."
2062(declare-function smerge-refine-subst "smerge-mode" 1987(declare-function smerge-refine-subst "smerge-mode"
2063 (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)) 1988 (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a))
2064 1989
1990(defun diff--forward-while-leading-char (char bound)
1991 "Move point until reaching a line not starting with CHAR.
1992Return new point, if it was moved."
1993 (let ((pt nil))
1994 (while (and (< (point) bound) (eql (following-char) char))
1995 (forward-line 1)
1996 (setq pt (point)))
1997 pt))
1998
2065(defun diff-refine-hunk () 1999(defun diff-refine-hunk ()
2066 "Highlight changes of hunk at point at a finer granularity." 2000 "Highlight changes of hunk at point at a finer granularity."
2067 (interactive) 2001 (interactive)
2068 (require 'smerge-mode) 2002 (require 'smerge-mode)
2069 (save-excursion 2003 (save-excursion
2070 (let* ((hunk-bounds (diff-bounds-of-hunk)) 2004 (diff-beginning-of-hunk t)
2071 (style (progn (goto-char (car hunk-bounds)) 2005 (let* ((start (point))
2072 (diff-hunk-style))) ;Skips the hunk header as well. 2006 (style (diff-hunk-style)) ;Skips the hunk header as well.
2073 (beg (point)) 2007 (beg (point))
2074 (end (cadr hunk-bounds))
2075 (props-c '((diff-mode . fine) (face diff-refine-changed))) 2008 (props-c '((diff-mode . fine) (face diff-refine-changed)))
2076 (props-r '((diff-mode . fine) (face diff-refine-removed))) 2009 (props-r '((diff-mode . fine) (face diff-refine-removed)))
2077 (props-a '((diff-mode . fine) (face diff-refine-added)))) 2010 (props-a '((diff-mode . fine) (face diff-refine-added)))
2011 ;; Be careful to go back to `start' so diff-end-of-hunk gets
2012 ;; to read the hunk header's line info.
2013 (end (progn (goto-char start) (diff-end-of-hunk) (point))))
2078 2014
2079 (remove-overlays beg end 'diff-mode 'fine) 2015 (remove-overlays beg end 'diff-mode 'fine)
2080 2016
2081 (goto-char beg) 2017 (goto-char beg)
2082 (pcase style 2018 (pcase style
2083 (`unified 2019 (`unified
2084 (while (re-search-forward 2020 (while (re-search-forward "^-" end t)
2085 (eval-when-compile 2021 (let ((beg-del (progn (beginning-of-line) (point)))
2086 (let ((no-LF-at-eol-re "\\(?:\\\\.*\n\\)?")) 2022 beg-add end-add)
2087 (concat "^\\(?:-.*\n\\)+" no-LF-at-eol-re 2023 (when (and (diff--forward-while-leading-char ?- end)
2088 "\\(\\)" 2024 ;; Allow for "\ No newline at end of file".
2089 "\\(?:\\+.*\n\\)+" no-LF-at-eol-re))) 2025 (progn (diff--forward-while-leading-char ?\\ end)
2090 end t) 2026 (setq beg-add (point)))
2091 (smerge-refine-subst (match-beginning 0) (match-end 1) 2027 (diff--forward-while-leading-char ?+ end)
2092 (match-end 1) (match-end 0) 2028 (progn (diff--forward-while-leading-char ?\\ end)
2093 nil 'diff-refine-preproc props-r props-a))) 2029 (setq end-add (point))))
2030 (smerge-refine-subst beg-del beg-add beg-add end-add
2031 nil 'diff-refine-preproc props-r props-a)))))
2094 (`context 2032 (`context
2095 (let* ((middle (save-excursion (re-search-forward "^---"))) 2033 (let* ((middle (save-excursion (re-search-forward "^---")))
2096 (other middle)) 2034 (other middle))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 95568b29c7c..0235926fbe4 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -150,6 +150,26 @@ It needs to be killed when we quit the session.")
150(defsubst ediff-get-symbol-from-alist (buf-type alist) 150(defsubst ediff-get-symbol-from-alist (buf-type alist)
151 (cdr (assoc buf-type alist))) 151 (cdr (assoc buf-type alist)))
152 152
153;; Vector of differences between the variants. Each difference is
154;; represented by a vector of two overlays plus a vector of fine diffs,
155;; plus a no-fine-diffs flag. The first overlay spans the
156;; difference region in the A buffer and the second overlays the diff in
157;; the B buffer. If a difference section is empty, the corresponding
158;; overlay's endpoints coincide.
159;;
160;; The precise form of a Difference Vector for one buffer is:
161;; [diff diff diff ...]
162;; where each diff has the form:
163;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff]
164;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...]
165;; no-fine-diffs-flag says if there are fine differences.
166;; state-of-difference is A, B, C, or nil, indicating which buffer is
167;; different from the other two (used only in 3-way jobs.
168(ediff-defvar-local ediff-difference-vector-A nil "")
169(ediff-defvar-local ediff-difference-vector-B nil "")
170(ediff-defvar-local ediff-difference-vector-C nil "")
171(ediff-defvar-local ediff-difference-vector-Ancestor nil "")
172;; A-list of diff vector types associated with buffer types
153(defconst ediff-difference-vector-alist 173(defconst ediff-difference-vector-alist
154 '((A . ediff-difference-vector-A) 174 '((A . ediff-difference-vector-A)
155 (B . ediff-difference-vector-B) 175 (B . ediff-difference-vector-B)
@@ -642,32 +662,6 @@ shown in brighter colors."
642 ;;buffer-read-only 662 ;;buffer-read-only
643 mode-line-format)) 663 mode-line-format))
644 664
645;; Vector of differences between the variants. Each difference is
646;; represented by a vector of two overlays plus a vector of fine diffs,
647;; plus a no-fine-diffs flag. The first overlay spans the
648;; difference region in the A buffer and the second overlays the diff in
649;; the B buffer. If a difference section is empty, the corresponding
650;; overlay's endpoints coincide.
651;;
652;; The precise form of a Difference Vector for one buffer is:
653;; [diff diff diff ...]
654;; where each diff has the form:
655;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff]
656;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...]
657;; no-fine-diffs-flag says if there are fine differences.
658;; state-of-difference is A, B, C, or nil, indicating which buffer is
659;; different from the other two (used only in 3-way jobs.
660(ediff-defvar-local ediff-difference-vector-A nil "")
661(ediff-defvar-local ediff-difference-vector-B nil "")
662(ediff-defvar-local ediff-difference-vector-C nil "")
663(ediff-defvar-local ediff-difference-vector-Ancestor nil "")
664;; A-list of diff vector types associated with buffer types
665(defconst ediff-difference-vector-alist
666 '((A . ediff-difference-vector-A)
667 (B . ediff-difference-vector-B)
668 (C . ediff-difference-vector-C)
669 (Ancestor . ediff-difference-vector-Ancestor)))
670
671;; [ status status status ...] 665;; [ status status status ...]
672;; Each status: [state-of-merge state-of-ancestor] 666;; Each status: [state-of-merge state-of-ancestor]
673;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It 667;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It
diff --git a/lisp/xml.el b/lisp/xml.el
index cd801be3083..be2ac96f264 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -646,8 +646,10 @@ surpassed `xml-entity-expansion-limit'"))))
646(defun xml-parse-attlist (&optional xml-ns) 646(defun xml-parse-attlist (&optional xml-ns)
647 "Return the attribute-list after point. 647 "Return the attribute-list after point.
648Leave point at the first non-blank character after the tag." 648Leave point at the first non-blank character after the tag."
649 (let ((attlist ()) 649 (let* ((attlist ())
650 end-pos name) 650 (symbol-qnames (eq (car-safe xml-ns) 'symbol-qnames))
651 (xml-ns (if symbol-qnames (cdr xml-ns) xml-ns))
652 end-pos name)
651 (skip-syntax-forward " ") 653 (skip-syntax-forward " ")
652 (while (looking-at (eval-when-compile 654 (while (looking-at (eval-when-compile
653 (concat "\\(" xml-name-re "\\)\\s-*=\\s-*"))) 655 (concat "\\(" xml-name-re "\\)\\s-*=\\s-*")))
diff --git a/src/alloc.c b/src/alloc.c
index 1a6d4e2d565..dd2b688f91e 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2872,45 +2872,15 @@ usage: (list &rest OBJECTS) */)
2872 2872
2873DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, 2873DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2874 doc: /* Return a newly created list of length LENGTH, with each element being INIT. */) 2874 doc: /* Return a newly created list of length LENGTH, with each element being INIT. */)
2875 (register Lisp_Object length, Lisp_Object init) 2875 (Lisp_Object length, Lisp_Object init)
2876{ 2876{
2877 register Lisp_Object val; 2877 Lisp_Object val = Qnil;
2878 register EMACS_INT size;
2879
2880 CHECK_NATNUM (length); 2878 CHECK_NATNUM (length);
2881 size = XFASTINT (length);
2882 2879
2883 val = Qnil; 2880 for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
2884 while (size > 0)
2885 { 2881 {
2886 val = Fcons (init, val); 2882 val = Fcons (init, val);
2887 --size; 2883 maybe_quit ();
2888
2889 if (size > 0)
2890 {
2891 val = Fcons (init, val);
2892 --size;
2893
2894 if (size > 0)
2895 {
2896 val = Fcons (init, val);
2897 --size;
2898
2899 if (size > 0)
2900 {
2901 val = Fcons (init, val);
2902 --size;
2903
2904 if (size > 0)
2905 {
2906 val = Fcons (init, val);
2907 --size;
2908 }
2909 }
2910 }
2911 }
2912
2913 QUIT;
2914 } 2884 }
2915 2885
2916 return val; 2886 return val;
@@ -5464,6 +5434,37 @@ make_pure_vector (ptrdiff_t len)
5464 return new; 5434 return new;
5465} 5435}
5466 5436
5437/* Copy all contents and parameters of TABLE to a new table allocated
5438 from pure space, return the purified table. */
5439static struct Lisp_Hash_Table *
5440purecopy_hash_table (struct Lisp_Hash_Table *table) {
5441 eassert (NILP (table->weak));
5442 eassert (!NILP (table->pure));
5443
5444 struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
5445 struct hash_table_test pure_test = table->test;
5446
5447 /* Purecopy the hash table test. */
5448 pure_test.name = purecopy (table->test.name);
5449 pure_test.user_hash_function = purecopy (table->test.user_hash_function);
5450 pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
5451
5452 pure->test = pure_test;
5453 pure->header = table->header;
5454 pure->weak = purecopy (Qnil);
5455 pure->rehash_size = purecopy (table->rehash_size);
5456 pure->rehash_threshold = purecopy (table->rehash_threshold);
5457 pure->hash = purecopy (table->hash);
5458 pure->next = purecopy (table->next);
5459 pure->next_free = purecopy (table->next_free);
5460 pure->index = purecopy (table->index);
5461 pure->count = table->count;
5462 pure->key_and_value = purecopy (table->key_and_value);
5463 pure->pure = purecopy (table->pure);
5464
5465 return pure;
5466}
5467
5467DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, 5468DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
5468 doc: /* Make a copy of object OBJ in pure storage. 5469 doc: /* Make a copy of object OBJ in pure storage.
5469Recursively copies contents of vectors and cons cells. 5470Recursively copies contents of vectors and cons cells.
@@ -5472,14 +5473,22 @@ Does not copy symbols. Copies strings without text properties. */)
5472{ 5473{
5473 if (NILP (Vpurify_flag)) 5474 if (NILP (Vpurify_flag))
5474 return obj; 5475 return obj;
5475 else if (MARKERP (obj) || OVERLAYP (obj) 5476 else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj))
5476 || HASH_TABLE_P (obj) || SYMBOLP (obj))
5477 /* Can't purify those. */ 5477 /* Can't purify those. */
5478 return obj; 5478 return obj;
5479 else 5479 else
5480 return purecopy (obj); 5480 return purecopy (obj);
5481} 5481}
5482 5482
5483struct pinned_object
5484{
5485 Lisp_Object object;
5486 struct pinned_object *next;
5487};
5488
5489/* Pinned objects are marked before every GC cycle. */
5490static struct pinned_object *pinned_objects;
5491
5483static Lisp_Object 5492static Lisp_Object
5484purecopy (Lisp_Object obj) 5493purecopy (Lisp_Object obj)
5485{ 5494{
@@ -5507,7 +5516,27 @@ purecopy (Lisp_Object obj)
5507 obj = make_pure_string (SSDATA (obj), SCHARS (obj), 5516 obj = make_pure_string (SSDATA (obj), SCHARS (obj),
5508 SBYTES (obj), 5517 SBYTES (obj),
5509 STRING_MULTIBYTE (obj)); 5518 STRING_MULTIBYTE (obj));
5510 else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj)) 5519 else if (HASH_TABLE_P (obj))
5520 {
5521 struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
5522 /* We cannot purify hash tables which haven't been defined with
5523 :purecopy as non-nil or are weak - they aren't guaranteed to
5524 not change. */
5525 if (!NILP (table->weak) || NILP (table->pure))
5526 {
5527 /* Instead, the hash table is added to the list of pinned objects,
5528 and is marked before GC. */
5529 struct pinned_object *o = xmalloc (sizeof *o);
5530 o->object = obj;
5531 o->next = pinned_objects;
5532 pinned_objects = o;
5533 return obj; /* Don't hash cons it. */
5534 }
5535
5536 struct Lisp_Hash_Table *h = purecopy_hash_table (table);
5537 XSET_HASH_TABLE (obj, h);
5538 }
5539 else if (COMPILEDP (obj) || VECTORP (obj))
5511 { 5540 {
5512 struct Lisp_Vector *objp = XVECTOR (obj); 5541 struct Lisp_Vector *objp = XVECTOR (obj);
5513 ptrdiff_t nbytes = vector_nbytes (objp); 5542 ptrdiff_t nbytes = vector_nbytes (objp);
@@ -5724,6 +5753,16 @@ compact_undo_list (Lisp_Object list)
5724} 5753}
5725 5754
5726static void 5755static void
5756mark_pinned_objects (void)
5757{
5758 struct pinned_object *pobj;
5759 for (pobj = pinned_objects; pobj; pobj = pobj->next)
5760 {
5761 mark_object (pobj->object);
5762 }
5763}
5764
5765static void
5727mark_pinned_symbols (void) 5766mark_pinned_symbols (void)
5728{ 5767{
5729 struct symbol_block *sblk; 5768 struct symbol_block *sblk;
@@ -5843,6 +5882,7 @@ garbage_collect_1 (void *end)
5843 for (i = 0; i < staticidx; i++) 5882 for (i = 0; i < staticidx; i++)
5844 mark_object (*staticvec[i]); 5883 mark_object (*staticvec[i]);
5845 5884
5885 mark_pinned_objects ();
5846 mark_pinned_symbols (); 5886 mark_pinned_symbols ();
5847 mark_terminals (); 5887 mark_terminals ();
5848 mark_kboards (); 5888 mark_kboards ();
diff --git a/src/atimer.c b/src/atimer.c
index 7f099809d3c..5feb1f6777d 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20#include <stdio.h> 20#include <stdio.h>
21 21
22#include "lisp.h" 22#include "lisp.h"
23#include "keyboard.h"
23#include "syssignal.h" 24#include "syssignal.h"
24#include "systime.h" 25#include "systime.h"
25#include "atimer.h" 26#include "atimer.h"
diff --git a/src/buffer.c b/src/buffer.c
index fde23cace1a..c00cc40d6f2 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -415,19 +415,16 @@ followed by the rest of the buffers. */)
415} 415}
416 416
417/* Like Fassoc, but use Fstring_equal to compare 417/* Like Fassoc, but use Fstring_equal to compare
418 (which ignores text properties), 418 (which ignores text properties), and don't ever quit. */
419 and don't ever QUIT. */
420 419
421static Lisp_Object 420static Lisp_Object
422assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list) 421assoc_ignore_text_properties (Lisp_Object key, Lisp_Object list)
423{ 422{
424 register Lisp_Object tail; 423 Lisp_Object tail;
425 for (tail = list; CONSP (tail); tail = XCDR (tail)) 424 for (tail = list; CONSP (tail); tail = XCDR (tail))
426 { 425 {
427 register Lisp_Object elt, tem; 426 Lisp_Object elt = XCAR (tail);
428 elt = XCAR (tail); 427 if (!NILP (Fstring_equal (Fcar (elt), key)))
429 tem = Fstring_equal (Fcar (elt), key);
430 if (!NILP (tem))
431 return elt; 428 return elt;
432 } 429 }
433 return Qnil; 430 return Qnil;
diff --git a/src/bytecode.c b/src/bytecode.c
index f4540e94c9c..288d78efe41 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -681,7 +681,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
681 { 681 {
682 quitcounter = 1; 682 quitcounter = 1;
683 maybe_gc (); 683 maybe_gc ();
684 QUIT; 684 maybe_quit ();
685 } 685 }
686 pc += op; 686 pc += op;
687 NEXT; 687 NEXT;
diff --git a/src/callint.c b/src/callint.c
index 565fac8a451..d96454883cf 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -794,7 +794,7 @@ invoke it. If KEYS is omitted or nil, the return value of
794 } 794 }
795 unbind_to (speccount, Qnil); 795 unbind_to (speccount, Qnil);
796 796
797 QUIT; 797 maybe_quit ();
798 798
799 args[0] = Qfuncall_interactively; 799 args[0] = Qfuncall_interactively;
800 args[1] = function; 800 args[1] = function;
diff --git a/src/callproc.c b/src/callproc.c
index 90c15de2913..301ccf383b5 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,11 +198,11 @@ call_process_cleanup (Lisp_Object buffer)
198 { 198 {
199 kill (-synch_process_pid, SIGINT); 199 kill (-synch_process_pid, SIGINT);
200 message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); 200 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
201 immediate_quit = 1; 201 immediate_quit = true;
202 QUIT; 202 maybe_quit ();
203 wait_for_termination (synch_process_pid, 0, 1); 203 wait_for_termination (synch_process_pid, 0, 1);
204 synch_process_pid = 0; 204 synch_process_pid = 0;
205 immediate_quit = 0; 205 immediate_quit = false;
206 message1 ("Waiting for process to die...done"); 206 message1 ("Waiting for process to die...done");
207 } 207 }
208#endif /* !MSDOS */ 208#endif /* !MSDOS */
@@ -726,8 +726,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
726 process_coding.src_multibyte = 0; 726 process_coding.src_multibyte = 0;
727 } 727 }
728 728
729 immediate_quit = 1; 729 immediate_quit = true;
730 QUIT; 730 maybe_quit ();
731 731
732 if (0 <= fd0) 732 if (0 <= fd0)
733 { 733 {
@@ -769,7 +769,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
769 } 769 }
770 770
771 /* Now NREAD is the total amount of data in the buffer. */ 771 /* Now NREAD is the total amount of data in the buffer. */
772 immediate_quit = 0; 772 immediate_quit = false;
773 773
774 if (!nread) 774 if (!nread)
775 ; 775 ;
@@ -843,7 +843,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
843 display_on_the_fly = true; 843 display_on_the_fly = true;
844 } 844 }
845 immediate_quit = true; 845 immediate_quit = true;
846 QUIT; 846 maybe_quit ();
847 } 847 }
848 give_up: ; 848 give_up: ;
849 849
@@ -860,7 +860,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
860 wait_for_termination (pid, &status, fd0 < 0); 860 wait_for_termination (pid, &status, fd0 < 0);
861#endif 861#endif
862 862
863 immediate_quit = 0; 863 immediate_quit = false;
864 864
865 /* Don't kill any children that the subprocess may have left behind 865 /* Don't kill any children that the subprocess may have left behind
866 when exiting. */ 866 when exiting. */
diff --git a/src/category.c b/src/category.c
index e5d261c1cff..ff287a4af3d 100644
--- a/src/category.c
+++ b/src/category.c
@@ -67,7 +67,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
67 make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE), 67 make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
68 make_float (DEFAULT_REHASH_SIZE), 68 make_float (DEFAULT_REHASH_SIZE),
69 make_float (DEFAULT_REHASH_THRESHOLD), 69 make_float (DEFAULT_REHASH_THRESHOLD),
70 Qnil)); 70 Qnil, Qnil));
71 h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); 71 h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
72 i = hash_lookup (h, category_set, &hash); 72 i = hash_lookup (h, category_set, &hash);
73 if (i >= 0) 73 if (i >= 0)
diff --git a/src/ccl.c b/src/ccl.c
index c172fc66811..90bd2f46794 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1993,7 +1993,7 @@ programs. */)
1993 : 0); 1993 : 0);
1994 1994
1995 ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil); 1995 ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil);
1996 QUIT; 1996 maybe_quit ();
1997 if (ccl.status != CCL_STAT_SUCCESS) 1997 if (ccl.status != CCL_STAT_SUCCESS)
1998 error ("Error in CCL program at %dth code", ccl.ic); 1998 error ("Error in CCL program at %dth code", ccl.ic);
1999 1999
diff --git a/src/decompress.c b/src/decompress.c
index f6628d5ddd9..a53a66df187 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -186,7 +186,7 @@ This function can be called only in unibyte buffers. */)
186 decompressed = avail_out - stream.avail_out; 186 decompressed = avail_out - stream.avail_out;
187 insert_from_gap (decompressed, decompressed, 0); 187 insert_from_gap (decompressed, decompressed, 0);
188 unwind_data.nbytes += decompressed; 188 unwind_data.nbytes += decompressed;
189 QUIT; 189 maybe_quit ();
190 } 190 }
191 while (inflate_status == Z_OK); 191 while (inflate_status == Z_OK);
192 192
diff --git a/src/dired.c b/src/dired.c
index bf10f1710ff..52e81fb380b 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -139,7 +139,7 @@ read_dirent (DIR *dir, Lisp_Object dirname)
139#endif 139#endif
140 report_file_error ("Reading directory", dirname); 140 report_file_error ("Reading directory", dirname);
141 } 141 }
142 QUIT; 142 maybe_quit ();
143 } 143 }
144} 144}
145 145
@@ -248,13 +248,13 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
248 248
249 /* Now that we have unwind_protect in place, we might as well 249 /* Now that we have unwind_protect in place, we might as well
250 allow matching to be interrupted. */ 250 allow matching to be interrupted. */
251 immediate_quit = 1; 251 immediate_quit = true;
252 QUIT; 252 maybe_quit ();
253 253
254 bool wanted = (NILP (match) 254 bool wanted = (NILP (match)
255 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); 255 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
256 256
257 immediate_quit = 0; 257 immediate_quit = false;
258 258
259 if (wanted) 259 if (wanted)
260 { 260 {
@@ -508,7 +508,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
508 ptrdiff_t len = dirent_namelen (dp); 508 ptrdiff_t len = dirent_namelen (dp);
509 bool canexclude = 0; 509 bool canexclude = 0;
510 510
511 QUIT; 511 maybe_quit ();
512 if (len < SCHARS (encoded_file) 512 if (len < SCHARS (encoded_file)
513 || (scmp (dp->d_name, SSDATA (encoded_file), 513 || (scmp (dp->d_name, SSDATA (encoded_file),
514 SCHARS (encoded_file)) 514 SCHARS (encoded_file))
diff --git a/src/editfns.c b/src/editfns.c
index bee3bbc2cdd..82c6abb9987 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2695,7 +2695,7 @@ called interactively, INHERIT is t. */)
2695 string[i] = str[i % len]; 2695 string[i] = str[i % len];
2696 while (n > stringlen) 2696 while (n > stringlen)
2697 { 2697 {
2698 QUIT; 2698 maybe_quit ();
2699 if (!NILP (inherit)) 2699 if (!NILP (inherit))
2700 insert_and_inherit (string, stringlen); 2700 insert_and_inherit (string, stringlen);
2701 else 2701 else
@@ -3053,6 +3053,7 @@ determines whether case is significant or ignored. */)
3053 i2 = begp2; 3053 i2 = begp2;
3054 i1_byte = buf_charpos_to_bytepos (bp1, i1); 3054 i1_byte = buf_charpos_to_bytepos (bp1, i1);
3055 i2_byte = buf_charpos_to_bytepos (bp2, i2); 3055 i2_byte = buf_charpos_to_bytepos (bp2, i2);
3056 immediate_quit = true;
3056 3057
3057 while (i1 < endp1 && i2 < endp2) 3058 while (i1 < endp1 && i2 < endp2)
3058 { 3059 {
@@ -3060,8 +3061,6 @@ determines whether case is significant or ignored. */)
3060 characters, not just the bytes. */ 3061 characters, not just the bytes. */
3061 int c1, c2; 3062 int c1, c2;
3062 3063
3063 QUIT;
3064
3065 if (! NILP (BVAR (bp1, enable_multibyte_characters))) 3064 if (! NILP (BVAR (bp1, enable_multibyte_characters)))
3066 { 3065 {
3067 c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); 3066 c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
@@ -3093,14 +3092,17 @@ determines whether case is significant or ignored. */)
3093 c1 = char_table_translate (trt, c1); 3092 c1 = char_table_translate (trt, c1);
3094 c2 = char_table_translate (trt, c2); 3093 c2 = char_table_translate (trt, c2);
3095 } 3094 }
3096 if (c1 < c2) 3095 if (c1 != c2)
3097 return make_number (- 1 - chars); 3096 {
3098 if (c1 > c2) 3097 immediate_quit = false;
3099 return make_number (chars + 1); 3098 return make_number (c1 < c2 ? -1 - chars : chars + 1);
3099 }
3100 3100
3101 chars++; 3101 chars++;
3102 } 3102 }
3103 3103
3104 immediate_quit = false;
3105
3104 /* The strings match as far as they go. 3106 /* The strings match as far as they go.
3105 If one is shorter, that one is less. */ 3107 If one is shorter, that one is less. */
3106 if (chars < endp1 - begp1) 3108 if (chars < endp1 - begp1)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e22c7dc5b72..69fa5c8e64c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1016,7 +1016,7 @@ syms_of_module (void)
1016 = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE), 1016 = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
1017 make_float (DEFAULT_REHASH_SIZE), 1017 make_float (DEFAULT_REHASH_SIZE),
1018 make_float (DEFAULT_REHASH_THRESHOLD), 1018 make_float (DEFAULT_REHASH_THRESHOLD),
1019 Qnil); 1019 Qnil, Qnil);
1020 Funintern (Qmodule_refs_hash, Qnil); 1020 Funintern (Qmodule_refs_hash, Qnil);
1021 1021
1022 DEFSYM (Qmodule_environments, "module-environments"); 1022 DEFSYM (Qmodule_environments, "module-environments");
diff --git a/src/eval.c b/src/eval.c
index 1f8d4099324..62d4af15e27 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -856,10 +856,9 @@ usage: (let* VARLIST BODY...) */)
856 856
857 lexenv = Vinternal_interpreter_environment; 857 lexenv = Vinternal_interpreter_environment;
858 858
859 varlist = XCAR (args); 859 for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
860 while (CONSP (varlist))
861 { 860 {
862 QUIT; 861 maybe_quit ();
863 862
864 elt = XCAR (varlist); 863 elt = XCAR (varlist);
865 if (SYMBOLP (elt)) 864 if (SYMBOLP (elt))
@@ -893,9 +892,8 @@ usage: (let* VARLIST BODY...) */)
893 } 892 }
894 else 893 else
895 specbind (var, val); 894 specbind (var, val);
896
897 varlist = XCDR (varlist);
898 } 895 }
896 CHECK_LIST_END (varlist, XCAR (args));
899 897
900 val = Fprogn (XCDR (args)); 898 val = Fprogn (XCDR (args));
901 return unbind_to (count, val); 899 return unbind_to (count, val);
@@ -917,6 +915,7 @@ usage: (let VARLIST BODY...) */)
917 USE_SAFE_ALLOCA; 915 USE_SAFE_ALLOCA;
918 916
919 varlist = XCAR (args); 917 varlist = XCAR (args);
918 CHECK_LIST (varlist);
920 919
921 /* Make space to hold the values to give the bound variables. */ 920 /* Make space to hold the values to give the bound variables. */
922 elt = Flength (varlist); 921 elt = Flength (varlist);
@@ -926,7 +925,7 @@ usage: (let VARLIST BODY...) */)
926 925
927 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) 926 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
928 { 927 {
929 QUIT; 928 maybe_quit ();
930 elt = XCAR (varlist); 929 elt = XCAR (varlist);
931 if (SYMBOLP (elt)) 930 if (SYMBOLP (elt))
932 temps [argnum++] = Qnil; 931 temps [argnum++] = Qnil;
@@ -979,7 +978,7 @@ usage: (while TEST BODY...) */)
979 body = XCDR (args); 978 body = XCDR (args);
980 while (!NILP (eval_sub (test))) 979 while (!NILP (eval_sub (test)))
981 { 980 {
982 QUIT; 981 maybe_quit ();
983 prog_ignore (body); 982 prog_ignore (body);
984 } 983 }
985 984
@@ -1012,7 +1011,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1012 until we get a symbol that is not an alias. */ 1011 until we get a symbol that is not an alias. */
1013 while (SYMBOLP (def)) 1012 while (SYMBOLP (def))
1014 { 1013 {
1015 QUIT; 1014 maybe_quit ();
1016 sym = def; 1015 sym = def;
1017 tem = Fassq (sym, environment); 1016 tem = Fassq (sym, environment);
1018 if (NILP (tem)) 1017 if (NILP (tem))
@@ -1132,7 +1131,7 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
1132 /* Restore certain special C variables. */ 1131 /* Restore certain special C variables. */
1133 set_poll_suppress_count (catch->poll_suppress_count); 1132 set_poll_suppress_count (catch->poll_suppress_count);
1134 unblock_input_to (catch->interrupt_input_blocked); 1133 unblock_input_to (catch->interrupt_input_blocked);
1135 immediate_quit = 0; 1134 immediate_quit = false;
1136 1135
1137 do 1136 do
1138 { 1137 {
@@ -1451,7 +1450,7 @@ static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
1451static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, 1450static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
1452 Lisp_Object data); 1451 Lisp_Object data);
1453 1452
1454void 1453static void
1455process_quit_flag (void) 1454process_quit_flag (void)
1456{ 1455{
1457 Lisp_Object flag = Vquit_flag; 1456 Lisp_Object flag = Vquit_flag;
@@ -1463,6 +1462,15 @@ process_quit_flag (void)
1463 quit (); 1462 quit ();
1464} 1463}
1465 1464
1465void
1466maybe_quit (void)
1467{
1468 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
1469 process_quit_flag ();
1470 else if (pending_signals)
1471 process_pending_signals ();
1472}
1473
1466DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, 1474DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
1467 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. 1475 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1468This function does not return. 1476This function does not return.
@@ -1506,10 +1514,10 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
1506 Lisp_Object string; 1514 Lisp_Object string;
1507 Lisp_Object real_error_symbol 1515 Lisp_Object real_error_symbol
1508 = (NILP (error_symbol) ? Fcar (data) : error_symbol); 1516 = (NILP (error_symbol) ? Fcar (data) : error_symbol);
1509 register Lisp_Object clause = Qnil; 1517 Lisp_Object clause = Qnil;
1510 struct handler *h; 1518 struct handler *h;
1511 1519
1512 immediate_quit = 0; 1520 immediate_quit = false;
1513 if (gc_in_progress || waiting_for_input) 1521 if (gc_in_progress || waiting_for_input)
1514 emacs_abort (); 1522 emacs_abort ();
1515 1523
@@ -2127,7 +2135,7 @@ eval_sub (Lisp_Object form)
2127 if (!CONSP (form)) 2135 if (!CONSP (form))
2128 return form; 2136 return form;
2129 2137
2130 QUIT; 2138 maybe_quit ();
2131 2139
2132 maybe_gc (); 2140 maybe_gc ();
2133 2141
@@ -2713,7 +2721,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2713 Lisp_Object val; 2721 Lisp_Object val;
2714 ptrdiff_t count; 2722 ptrdiff_t count;
2715 2723
2716 QUIT; 2724 maybe_quit ();
2717 2725
2718 if (++lisp_eval_depth > max_lisp_eval_depth) 2726 if (++lisp_eval_depth > max_lisp_eval_depth)
2719 { 2727 {
@@ -2958,7 +2966,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
2958 bool previous_optional_or_rest = false; 2966 bool previous_optional_or_rest = false;
2959 for (; CONSP (syms_left); syms_left = XCDR (syms_left)) 2967 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
2960 { 2968 {
2961 QUIT; 2969 maybe_quit ();
2962 2970
2963 next = XCAR (syms_left); 2971 next = XCAR (syms_left);
2964 if (!SYMBOLP (next)) 2972 if (!SYMBOLP (next))
@@ -3096,7 +3104,7 @@ lambda_arity (Lisp_Object fun)
3096 if (EQ (XCAR (fun), Qclosure)) 3104 if (EQ (XCAR (fun), Qclosure))
3097 { 3105 {
3098 fun = XCDR (fun); /* Drop `closure'. */ 3106 fun = XCDR (fun); /* Drop `closure'. */
3099 CHECK_LIST_CONS (fun, fun); 3107 CHECK_CONS (fun);
3100 } 3108 }
3101 syms_left = XCDR (fun); 3109 syms_left = XCDR (fun);
3102 if (CONSP (syms_left)) 3110 if (CONSP (syms_left))
diff --git a/src/fileio.c b/src/fileio.c
index be52d0f3d0e..a46cfc7ac69 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -316,7 +316,7 @@ use the standard functions without calling themselves recursively. */)
316 } 316 }
317 } 317 }
318 318
319 QUIT; 319 maybe_quit ();
320 } 320 }
321 return result; 321 return result;
322} 322}
@@ -1960,9 +1960,9 @@ permissions. */)
1960 report_file_error ("Copying permissions to", newname); 1960 report_file_error ("Copying permissions to", newname);
1961 } 1961 }
1962#else /* not WINDOWSNT */ 1962#else /* not WINDOWSNT */
1963 immediate_quit = 1; 1963 immediate_quit = true;
1964 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); 1964 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
1965 immediate_quit = 0; 1965 immediate_quit = false;
1966 1966
1967 if (ifd < 0) 1967 if (ifd < 0)
1968 report_file_error ("Opening input file", file); 1968 report_file_error ("Opening input file", file);
@@ -2024,8 +2024,8 @@ permissions. */)
2024 oldsize = out_st.st_size; 2024 oldsize = out_st.st_size;
2025 } 2025 }
2026 2026
2027 immediate_quit = 1; 2027 immediate_quit = true;
2028 QUIT; 2028 maybe_quit ();
2029 2029
2030 if (clone_file (ofd, ifd)) 2030 if (clone_file (ofd, ifd))
2031 newsize = st.st_size; 2031 newsize = st.st_size;
@@ -2047,7 +2047,7 @@ permissions. */)
2047 if (newsize < oldsize && ftruncate (ofd, newsize) != 0) 2047 if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
2048 report_file_error ("Truncating output file", newname); 2048 report_file_error ("Truncating output file", newname);
2049 2049
2050 immediate_quit = 0; 2050 immediate_quit = false;
2051 2051
2052#ifndef MSDOS 2052#ifndef MSDOS
2053 /* Preserve the original file permissions, and if requested, also its 2053 /* Preserve the original file permissions, and if requested, also its
@@ -2682,7 +2682,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2682 2682
2683DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, 2683DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2684 doc: /* Access file FILENAME, and get an error if that does not work. 2684 doc: /* Access file FILENAME, and get an error if that does not work.
2685The second argument STRING is used in the error message. 2685The second argument STRING is prepended to the error message.
2686If there is no error, returns nil. */) 2686If there is no error, returns nil. */)
2687 (Lisp_Object filename, Lisp_Object string) 2687 (Lisp_Object filename, Lisp_Object string)
2688{ 2688{
@@ -2815,7 +2815,17 @@ really is a readable and searchable directory. */)
2815 if (!NILP (handler)) 2815 if (!NILP (handler))
2816 { 2816 {
2817 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname); 2817 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2818 errno = 0; 2818
2819 /* Set errno in case the handler failed. EACCES might be a lie
2820 (e.g., the directory might not exist, or be a regular file),
2821 but at least it does TRT in the "usual" case of an existing
2822 directory that is not accessible by the current user, and
2823 avoids reporting "Success" for a failed operation. Perhaps
2824 someday we can fix this in a better way, by improving
2825 file-accessible-directory-p's API; see Bug#25419. */
2826 if (!EQ (r, Qt))
2827 errno = EACCES;
2828
2819 return r; 2829 return r;
2820 } 2830 }
2821 2831
@@ -3393,13 +3403,13 @@ read_non_regular (Lisp_Object state)
3393{ 3403{
3394 int nbytes; 3404 int nbytes;
3395 3405
3396 immediate_quit = 1; 3406 immediate_quit = true;
3397 QUIT; 3407 maybe_quit ();
3398 nbytes = emacs_read (XSAVE_INTEGER (state, 0), 3408 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3399 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 3409 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3400 + XSAVE_INTEGER (state, 1)), 3410 + XSAVE_INTEGER (state, 1)),
3401 XSAVE_INTEGER (state, 2)); 3411 XSAVE_INTEGER (state, 2));
3402 immediate_quit = 0; 3412 immediate_quit = false;
3403 /* Fast recycle this object for the likely next call. */ 3413 /* Fast recycle this object for the likely next call. */
3404 free_misc (state); 3414 free_misc (state);
3405 return make_number (nbytes); 3415 return make_number (nbytes);
@@ -3858,8 +3868,8 @@ by calling `format-decode', which see. */)
3858 report_file_error ("Setting file position", orig_filename); 3868 report_file_error ("Setting file position", orig_filename);
3859 } 3869 }
3860 3870
3861 immediate_quit = 1; 3871 immediate_quit = true;
3862 QUIT; 3872 maybe_quit ();
3863 /* Count how many chars at the start of the file 3873 /* Count how many chars at the start of the file
3864 match the text at the beginning of the buffer. */ 3874 match the text at the beginning of the buffer. */
3865 while (1) 3875 while (1)
@@ -3910,7 +3920,7 @@ by calling `format-decode', which see. */)
3910 goto handled; 3920 goto handled;
3911 } 3921 }
3912 immediate_quit = true; 3922 immediate_quit = true;
3913 QUIT; 3923 maybe_quit ();
3914 /* Count how many chars at the end of the file 3924 /* Count how many chars at the end of the file
3915 match the text at the end of the buffer. But, if we have 3925 match the text at the end of the buffer. But, if we have
3916 already found that decoding is necessary, don't waste time. */ 3926 already found that decoding is necessary, don't waste time. */
@@ -3967,7 +3977,7 @@ by calling `format-decode', which see. */)
3967 if (nread == 0) 3977 if (nread == 0)
3968 break; 3978 break;
3969 } 3979 }
3970 immediate_quit = 0; 3980 immediate_quit = false;
3971 3981
3972 if (! giveup_match_end) 3982 if (! giveup_match_end)
3973 { 3983 {
@@ -4065,11 +4075,11 @@ by calling `format-decode', which see. */)
4065 quitting while reading a huge file. */ 4075 quitting while reading a huge file. */
4066 4076
4067 /* Allow quitting out of the actual I/O. */ 4077 /* Allow quitting out of the actual I/O. */
4068 immediate_quit = 1; 4078 immediate_quit = true;
4069 QUIT; 4079 maybe_quit ();
4070 this = emacs_read (fd, read_buf + unprocessed, 4080 this = emacs_read (fd, read_buf + unprocessed,
4071 READ_BUF_SIZE - unprocessed); 4081 READ_BUF_SIZE - unprocessed);
4072 immediate_quit = 0; 4082 immediate_quit = false;
4073 4083
4074 if (this <= 0) 4084 if (this <= 0)
4075 break; 4085 break;
@@ -4284,13 +4294,13 @@ by calling `format-decode', which see. */)
4284 /* Allow quitting out of the actual I/O. We don't make text 4294 /* Allow quitting out of the actual I/O. We don't make text
4285 part of the buffer until all the reading is done, so a C-g 4295 part of the buffer until all the reading is done, so a C-g
4286 here doesn't do any harm. */ 4296 here doesn't do any harm. */
4287 immediate_quit = 1; 4297 immediate_quit = true;
4288 QUIT; 4298 maybe_quit ();
4289 this = emacs_read (fd, 4299 this = emacs_read (fd,
4290 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 4300 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4291 + inserted), 4301 + inserted),
4292 trytry); 4302 trytry);
4293 immediate_quit = 0; 4303 immediate_quit = false;
4294 } 4304 }
4295 4305
4296 if (this <= 0) 4306 if (this <= 0)
@@ -4602,7 +4612,7 @@ by calling `format-decode', which see. */)
4602 } 4612 }
4603 } 4613 }
4604 4614
4605 QUIT; 4615 maybe_quit ();
4606 p = XCDR (p); 4616 p = XCDR (p);
4607 } 4617 }
4608 4618
@@ -4992,7 +5002,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4992 } 5002 }
4993 } 5003 }
4994 5004
4995 immediate_quit = 1; 5005 immediate_quit = true;
4996 5006
4997 if (STRINGP (start)) 5007 if (STRINGP (start))
4998 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); 5008 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
@@ -5016,7 +5026,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5016 save_errno = errno; 5026 save_errno = errno;
5017 } 5027 }
5018 5028
5019 immediate_quit = 0; 5029 immediate_quit = false;
5020 5030
5021 /* fsync is not crucial for temporary files. Nor for auto-save 5031 /* fsync is not crucial for temporary files. Nor for auto-save
5022 files, since they might lose some work anyway. */ 5032 files, since they might lose some work anyway. */
@@ -5142,19 +5152,26 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5142 if (! ok) 5152 if (! ok)
5143 report_file_errno ("Write error", filename, save_errno); 5153 report_file_errno ("Write error", filename, save_errno);
5144 5154
5155 bool auto_saving_into_visited_file =
5156 auto_saving
5157 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
5158 BVAR (current_buffer, auto_save_file_name)));
5145 if (visiting) 5159 if (visiting)
5146 { 5160 {
5147 SAVE_MODIFF = MODIFF; 5161 SAVE_MODIFF = MODIFF;
5148 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); 5162 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5149 bset_filename (current_buffer, visit_file); 5163 bset_filename (current_buffer, visit_file);
5150 update_mode_lines = 14; 5164 update_mode_lines = 14;
5165 if (auto_saving_into_visited_file)
5166 unlock_file (lockname);
5151 } 5167 }
5152 else if (quietly) 5168 else if (quietly)
5153 { 5169 {
5154 if (auto_saving 5170 if (auto_saving_into_visited_file)
5155 && ! NILP (Fstring_equal (BVAR (current_buffer, filename), 5171 {
5156 BVAR (current_buffer, auto_save_file_name)))) 5172 SAVE_MODIFF = MODIFF;
5157 SAVE_MODIFF = MODIFF; 5173 unlock_file (lockname);
5174 }
5158 5175
5159 return Qnil; 5176 return Qnil;
5160 } 5177 }
diff --git a/src/filelock.c b/src/filelock.c
index 886ab61c7aa..de65c52efa1 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -505,7 +505,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
505 /* readlinkat saw a non-symlink, but emacs_open saw a symlink. 505 /* readlinkat saw a non-symlink, but emacs_open saw a symlink.
506 The former must have been removed and replaced by the latter. 506 The former must have been removed and replaced by the latter.
507 Try again. */ 507 Try again. */
508 QUIT; 508 maybe_quit ();
509 } 509 }
510 510
511 return nbytes; 511 return nbytes;
diff --git a/src/fns.c b/src/fns.c
index 00fa65886f0..5769eac9987 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
34#include "buffer.h" 34#include "buffer.h"
35#include "intervals.h" 35#include "intervals.h"
36#include "window.h" 36#include "window.h"
37#include "puresize.h"
37 38
38static void sort_vector_copy (Lisp_Object, ptrdiff_t, 39static void sort_vector_copy (Lisp_Object, ptrdiff_t,
39 Lisp_Object *restrict, Lisp_Object *restrict); 40 Lisp_Object *restrict, Lisp_Object *restrict);
@@ -84,17 +85,23 @@ See Info node `(elisp)Random Numbers' for more details. */)
84} 85}
85 86
86/* Heuristic on how many iterations of a tight loop can be safely done 87/* Heuristic on how many iterations of a tight loop can be safely done
87 before it's time to do a QUIT. This must be a power of 2. */ 88 before it's time to do a quit. This must be a power of 2. It
89 is nice but not necessary for it to equal USHRT_MAX + 1. */
88enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; 90enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
89 91
90/* Random data-structure functions. */ 92/* Process a quit, but do it only rarely, for efficiency. "Rarely"
93 means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
94 whichever is smaller. Use *QUIT_COUNT to count this. */
91 95
92static void 96static void
93CHECK_LIST_END (Lisp_Object x, Lisp_Object y) 97rarely_quit (unsigned short int *quit_count)
94{ 98{
95 CHECK_TYPE (NILP (x), Qlistp, y); 99 if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
100 maybe_quit ();
96} 101}
97 102
103/* Random data-structure functions. */
104
98DEFUN ("length", Flength, Slength, 1, 1, 0, 105DEFUN ("length", Flength, Slength, 1, 1, 0,
99 doc: /* Return the length of vector, list or string SEQUENCE. 106 doc: /* Return the length of vector, list or string SEQUENCE.
100A byte-code function object is also allowed. 107A byte-code function object is also allowed.
@@ -126,7 +133,7 @@ To get the number of bytes, use `string-bytes'. */)
126 { 133 {
127 if (MOST_POSITIVE_FIXNUM < i) 134 if (MOST_POSITIVE_FIXNUM < i)
128 error ("List too long"); 135 error ("List too long");
129 QUIT; 136 maybe_quit ();
130 } 137 }
131 sequence = XCDR (sequence); 138 sequence = XCDR (sequence);
132 } 139 }
@@ -172,7 +179,7 @@ which is at least the number of distinct elements. */)
172 halftail = XCDR (halftail); 179 halftail = XCDR (halftail);
173 if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0) 180 if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
174 { 181 {
175 QUIT; 182 maybe_quit ();
176 if (lolen == 0) 183 if (lolen == 0)
177 hilen += UINTMAX_MAX + 1.0; 184 hilen += UINTMAX_MAX + 1.0;
178 } 185 }
@@ -1202,17 +1209,12 @@ are shared, however.
1202Elements of ALIST that are not conses are also shared. */) 1209Elements of ALIST that are not conses are also shared. */)
1203 (Lisp_Object alist) 1210 (Lisp_Object alist)
1204{ 1211{
1205 register Lisp_Object tem;
1206
1207 CHECK_LIST (alist);
1208 if (NILP (alist)) 1212 if (NILP (alist))
1209 return alist; 1213 return alist;
1210 alist = concat (1, &alist, Lisp_Cons, 0); 1214 alist = concat (1, &alist, Lisp_Cons, false);
1211 for (tem = alist; CONSP (tem); tem = XCDR (tem)) 1215 for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem))
1212 { 1216 {
1213 register Lisp_Object car; 1217 Lisp_Object car = XCAR (tem);
1214 car = XCAR (tem);
1215
1216 if (CONSP (car)) 1218 if (CONSP (car))
1217 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); 1219 XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
1218 } 1220 }
@@ -1356,16 +1358,22 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1356 doc: /* Take cdr N times on LIST, return the result. */) 1358 doc: /* Take cdr N times on LIST, return the result. */)
1357 (Lisp_Object n, Lisp_Object list) 1359 (Lisp_Object n, Lisp_Object list)
1358{ 1360{
1359 EMACS_INT i, num;
1360 CHECK_NUMBER (n); 1361 CHECK_NUMBER (n);
1361 num = XINT (n); 1362 EMACS_INT num = XINT (n);
1362 for (i = 0; i < num && !NILP (list); i++) 1363 Lisp_Object tail = list;
1364 immediate_quit = true;
1365 for (EMACS_INT i = 0; i < num; i++)
1363 { 1366 {
1364 QUIT; 1367 if (! CONSP (tail))
1365 CHECK_LIST_CONS (list, list); 1368 {
1366 list = XCDR (list); 1369 immediate_quit = false;
1370 CHECK_LIST_END (tail, list);
1371 return Qnil;
1372 }
1373 tail = XCDR (tail);
1367 } 1374 }
1368 return list; 1375 immediate_quit = false;
1376 return tail;
1369} 1377}
1370 1378
1371DEFUN ("nth", Fnth, Snth, 2, 2, 0, 1379DEFUN ("nth", Fnth, Snth, 2, 2, 0,
@@ -1392,66 +1400,61 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
1392DEFUN ("member", Fmember, Smember, 2, 2, 0, 1400DEFUN ("member", Fmember, Smember, 2, 2, 0,
1393 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. 1401 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1394The value is actually the tail of LIST whose car is ELT. */) 1402The value is actually the tail of LIST whose car is ELT. */)
1395 (register Lisp_Object elt, Lisp_Object list) 1403 (Lisp_Object elt, Lisp_Object list)
1396{ 1404{
1397 register Lisp_Object tail; 1405 unsigned short int quit_count = 0;
1398 for (tail = list; !NILP (tail); tail = XCDR (tail)) 1406 Lisp_Object tail;
1407 for (tail = list; CONSP (tail); tail = XCDR (tail))
1399 { 1408 {
1400 register Lisp_Object tem; 1409 if (! NILP (Fequal (elt, XCAR (tail))))
1401 CHECK_LIST_CONS (tail, list);
1402 tem = XCAR (tail);
1403 if (! NILP (Fequal (elt, tem)))
1404 return tail; 1410 return tail;
1405 QUIT; 1411 rarely_quit (&quit_count);
1406 } 1412 }
1413 CHECK_LIST_END (tail, list);
1407 return Qnil; 1414 return Qnil;
1408} 1415}
1409 1416
1410DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, 1417DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1411 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. 1418 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
1412The value is actually the tail of LIST whose car is ELT. */) 1419The value is actually the tail of LIST whose car is ELT. */)
1413 (register Lisp_Object elt, Lisp_Object list) 1420 (Lisp_Object elt, Lisp_Object list)
1414{ 1421{
1415 while (1) 1422 immediate_quit = true;
1423 Lisp_Object tail;
1424 for (tail = list; CONSP (tail); tail = XCDR (tail))
1416 { 1425 {
1417 if (!CONSP (list) || EQ (XCAR (list), elt)) 1426 if (EQ (XCAR (tail), elt))
1418 break; 1427 {
1419 1428 immediate_quit = false;
1420 list = XCDR (list); 1429 return tail;
1421 if (!CONSP (list) || EQ (XCAR (list), elt)) 1430 }
1422 break;
1423
1424 list = XCDR (list);
1425 if (!CONSP (list) || EQ (XCAR (list), elt))
1426 break;
1427
1428 list = XCDR (list);
1429 QUIT;
1430 } 1431 }
1431 1432 immediate_quit = false;
1432 CHECK_LIST (list); 1433 CHECK_LIST_END (tail, list);
1433 return list; 1434 return Qnil;
1434} 1435}
1435 1436
1436DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, 1437DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
1437 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. 1438 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'.
1438The value is actually the tail of LIST whose car is ELT. */) 1439The value is actually the tail of LIST whose car is ELT. */)
1439 (register Lisp_Object elt, Lisp_Object list) 1440 (Lisp_Object elt, Lisp_Object list)
1440{ 1441{
1441 register Lisp_Object tail;
1442
1443 if (!FLOATP (elt)) 1442 if (!FLOATP (elt))
1444 return Fmemq (elt, list); 1443 return Fmemq (elt, list);
1445 1444
1446 for (tail = list; !NILP (tail); tail = XCDR (tail)) 1445 immediate_quit = true;
1446 Lisp_Object tail;
1447 for (tail = list; CONSP (tail); tail = XCDR (tail))
1447 { 1448 {
1448 register Lisp_Object tem; 1449 Lisp_Object tem = XCAR (tail);
1449 CHECK_LIST_CONS (tail, list);
1450 tem = XCAR (tail);
1451 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) 1450 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
1452 return tail; 1451 {
1453 QUIT; 1452 immediate_quit = false;
1453 return tail;
1454 }
1454 } 1455 }
1456 immediate_quit = false;
1457 CHECK_LIST_END (tail, list);
1455 return Qnil; 1458 return Qnil;
1456} 1459}
1457 1460
@@ -1461,44 +1464,29 @@ The value is actually the first element of LIST whose car is KEY.
1461Elements of LIST that are not conses are ignored. */) 1464Elements of LIST that are not conses are ignored. */)
1462 (Lisp_Object key, Lisp_Object list) 1465 (Lisp_Object key, Lisp_Object list)
1463{ 1466{
1464 while (1) 1467 immediate_quit = true;
1465 { 1468 Lisp_Object tail;
1466 if (!CONSP (list) 1469 for (tail = list; CONSP (tail); tail = XCDR (tail))
1467 || (CONSP (XCAR (list)) 1470 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1468 && EQ (XCAR (XCAR (list)), key))) 1471 {
1469 break; 1472 immediate_quit = false;
1470 1473 return XCAR (tail);
1471 list = XCDR (list); 1474 }
1472 if (!CONSP (list) 1475 immediate_quit = true;
1473 || (CONSP (XCAR (list)) 1476 CHECK_LIST_END (tail, list);
1474 && EQ (XCAR (XCAR (list)), key))) 1477 return Qnil;
1475 break;
1476
1477 list = XCDR (list);
1478 if (!CONSP (list)
1479 || (CONSP (XCAR (list))
1480 && EQ (XCAR (XCAR (list)), key)))
1481 break;
1482
1483 list = XCDR (list);
1484 QUIT;
1485 }
1486
1487 return CAR (list);
1488} 1478}
1489 1479
1490/* Like Fassq but never report an error and do not allow quits. 1480/* Like Fassq but never report an error and do not allow quits.
1491 Use only on lists known never to be circular. */ 1481 Use only on objects known to be non-circular lists. */
1492 1482
1493Lisp_Object 1483Lisp_Object
1494assq_no_quit (Lisp_Object key, Lisp_Object list) 1484assq_no_quit (Lisp_Object key, Lisp_Object list)
1495{ 1485{
1496 while (CONSP (list) 1486 for (; ! NILP (list); list = XCDR (list))
1497 && (!CONSP (XCAR (list)) 1487 if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key))
1498 || !EQ (XCAR (XCAR (list)), key))) 1488 return XCAR (list);
1499 list = XCDR (list); 1489 return Qnil;
1500
1501 return CAR_SAFE (list);
1502} 1490}
1503 1491
1504DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, 1492DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
@@ -1506,81 +1494,52 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
1506The value is actually the first element of LIST whose car equals KEY. */) 1494The value is actually the first element of LIST whose car equals KEY. */)
1507 (Lisp_Object key, Lisp_Object list) 1495 (Lisp_Object key, Lisp_Object list)
1508{ 1496{
1509 Lisp_Object car; 1497 unsigned short int quit_count = 0;
1510 1498 Lisp_Object tail;
1511 while (1) 1499 for (tail = list; CONSP (tail); tail = XCDR (tail))
1512 { 1500 {
1513 if (!CONSP (list) 1501 Lisp_Object car = XCAR (tail);
1514 || (CONSP (XCAR (list)) 1502 if (CONSP (car)
1515 && (car = XCAR (XCAR (list)), 1503 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1516 EQ (car, key) || !NILP (Fequal (car, key))))) 1504 return car;
1517 break; 1505 rarely_quit (&quit_count);
1518
1519 list = XCDR (list);
1520 if (!CONSP (list)
1521 || (CONSP (XCAR (list))
1522 && (car = XCAR (XCAR (list)),
1523 EQ (car, key) || !NILP (Fequal (car, key)))))
1524 break;
1525
1526 list = XCDR (list);
1527 if (!CONSP (list)
1528 || (CONSP (XCAR (list))
1529 && (car = XCAR (XCAR (list)),
1530 EQ (car, key) || !NILP (Fequal (car, key)))))
1531 break;
1532
1533 list = XCDR (list);
1534 QUIT;
1535 } 1506 }
1536 1507 CHECK_LIST_END (tail, list);
1537 return CAR (list); 1508 return Qnil;
1538} 1509}
1539 1510
1540/* Like Fassoc but never report an error and do not allow quits. 1511/* Like Fassoc but never report an error and do not allow quits.
1541 Use only on lists known never to be circular. */ 1512 Use only on objects known to be non-circular lists. */
1542 1513
1543Lisp_Object 1514Lisp_Object
1544assoc_no_quit (Lisp_Object key, Lisp_Object list) 1515assoc_no_quit (Lisp_Object key, Lisp_Object list)
1545{ 1516{
1546 while (CONSP (list) 1517 for (; ! NILP (list); list = XCDR (list))
1547 && (!CONSP (XCAR (list)) 1518 {
1548 || (!EQ (XCAR (XCAR (list)), key) 1519 Lisp_Object car = XCAR (list);
1549 && NILP (Fequal (XCAR (XCAR (list)), key))))) 1520 if (CONSP (car)
1550 list = XCDR (list); 1521 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1551 1522 return car;
1552 return CONSP (list) ? XCAR (list) : Qnil; 1523 }
1524 return Qnil;
1553} 1525}
1554 1526
1555DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, 1527DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
1556 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. 1528 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
1557The value is actually the first element of LIST whose cdr is KEY. */) 1529The value is actually the first element of LIST whose cdr is KEY. */)
1558 (register Lisp_Object key, Lisp_Object list) 1530 (Lisp_Object key, Lisp_Object list)
1559{ 1531{
1560 while (1) 1532 immediate_quit = true;
1561 { 1533 Lisp_Object tail;
1562 if (!CONSP (list) 1534 for (tail = list; CONSP (tail); tail = XCDR (tail))
1563 || (CONSP (XCAR (list)) 1535 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
1564 && EQ (XCDR (XCAR (list)), key))) 1536 {
1565 break; 1537 immediate_quit = false;
1566 1538 return XCAR (tail);
1567 list = XCDR (list); 1539 }
1568 if (!CONSP (list) 1540 immediate_quit = true;
1569 || (CONSP (XCAR (list)) 1541 CHECK_LIST_END (tail, list);
1570 && EQ (XCDR (XCAR (list)), key))) 1542 return Qnil;
1571 break;
1572
1573 list = XCDR (list);
1574 if (!CONSP (list)
1575 || (CONSP (XCAR (list))
1576 && EQ (XCDR (XCAR (list)), key)))
1577 break;
1578
1579 list = XCDR (list);
1580 QUIT;
1581 }
1582
1583 return CAR (list);
1584} 1543}
1585 1544
1586DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, 1545DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
@@ -1588,35 +1547,18 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
1588The value is actually the first element of LIST whose cdr equals KEY. */) 1547The value is actually the first element of LIST whose cdr equals KEY. */)
1589 (Lisp_Object key, Lisp_Object list) 1548 (Lisp_Object key, Lisp_Object list)
1590{ 1549{
1591 Lisp_Object cdr; 1550 unsigned short int quit_count = 0;
1592 1551 Lisp_Object tail;
1593 while (1) 1552 for (tail = list; CONSP (tail); tail = XCDR (tail))
1594 { 1553 {
1595 if (!CONSP (list) 1554 Lisp_Object car = XCAR (tail);
1596 || (CONSP (XCAR (list)) 1555 if (CONSP (car)
1597 && (cdr = XCDR (XCAR (list)), 1556 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
1598 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) 1557 return car;
1599 break; 1558 rarely_quit (&quit_count);
1600
1601 list = XCDR (list);
1602 if (!CONSP (list)
1603 || (CONSP (XCAR (list))
1604 && (cdr = XCDR (XCAR (list)),
1605 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
1606 break;
1607
1608 list = XCDR (list);
1609 if (!CONSP (list)
1610 || (CONSP (XCAR (list))
1611 && (cdr = XCDR (XCAR (list)),
1612 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
1613 break;
1614
1615 list = XCDR (list);
1616 QUIT;
1617 } 1559 }
1618 1560 CHECK_LIST_END (tail, list);
1619 return CAR (list); 1561 return Qnil;
1620} 1562}
1621 1563
1622DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, 1564DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
@@ -1754,12 +1696,11 @@ changing the value of a sequence `foo'. */)
1754 } 1696 }
1755 else 1697 else
1756 { 1698 {
1699 unsigned short int quit_count = 0;
1757 Lisp_Object tail, prev; 1700 Lisp_Object tail, prev;
1758 1701
1759 for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) 1702 for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
1760 { 1703 {
1761 CHECK_LIST_CONS (tail, seq);
1762
1763 if (!NILP (Fequal (elt, XCAR (tail)))) 1704 if (!NILP (Fequal (elt, XCAR (tail))))
1764 { 1705 {
1765 if (NILP (prev)) 1706 if (NILP (prev))
@@ -1769,8 +1710,9 @@ changing the value of a sequence `foo'. */)
1769 } 1710 }
1770 else 1711 else
1771 prev = tail; 1712 prev = tail;
1772 QUIT; 1713 rarely_quit (&quit_count);
1773 } 1714 }
1715 CHECK_LIST_END (tail, seq);
1774 } 1716 }
1775 1717
1776 return seq; 1718 return seq;
@@ -1788,16 +1730,17 @@ This function may destructively modify SEQ to produce the value. */)
1788 return Freverse (seq); 1730 return Freverse (seq);
1789 else if (CONSP (seq)) 1731 else if (CONSP (seq))
1790 { 1732 {
1733 unsigned short int quit_count = 0;
1791 Lisp_Object prev, tail, next; 1734 Lisp_Object prev, tail, next;
1792 1735
1793 for (prev = Qnil, tail = seq; !NILP (tail); tail = next) 1736 for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
1794 { 1737 {
1795 QUIT; 1738 rarely_quit (&quit_count);
1796 CHECK_LIST_CONS (tail, tail);
1797 next = XCDR (tail); 1739 next = XCDR (tail);
1798 Fsetcdr (tail, prev); 1740 Fsetcdr (tail, prev);
1799 prev = tail; 1741 prev = tail;
1800 } 1742 }
1743 CHECK_LIST_END (tail, seq);
1801 seq = prev; 1744 seq = prev;
1802 } 1745 }
1803 else if (VECTORP (seq)) 1746 else if (VECTORP (seq))
@@ -1838,9 +1781,10 @@ See also the function `nreverse', which is used more often. */)
1838 return Qnil; 1781 return Qnil;
1839 else if (CONSP (seq)) 1782 else if (CONSP (seq))
1840 { 1783 {
1784 unsigned short int quit_count = 0;
1841 for (new = Qnil; CONSP (seq); seq = XCDR (seq)) 1785 for (new = Qnil; CONSP (seq); seq = XCDR (seq))
1842 { 1786 {
1843 QUIT; 1787 rarely_quit (&quit_count);
1844 new = Fcons (XCAR (seq), new); 1788 new = Fcons (XCAR (seq), new);
1845 } 1789 }
1846 CHECK_LIST_END (seq, seq); 1790 CHECK_LIST_END (seq, seq);
@@ -2130,28 +2074,28 @@ If PROP is already a property on the list, its value is set to VAL,
2130otherwise the new PROP VAL pair is added. The new plist is returned; 2074otherwise the new PROP VAL pair is added. The new plist is returned;
2131use `(setq x (plist-put x prop val))' to be sure to use the new value. 2075use `(setq x (plist-put x prop val))' to be sure to use the new value.
2132The PLIST is modified by side effects. */) 2076The PLIST is modified by side effects. */)
2133 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) 2077 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2134{ 2078{
2135 register Lisp_Object tail, prev; 2079 immediate_quit = true;
2136 Lisp_Object newcell; 2080 Lisp_Object prev = Qnil;
2137 prev = Qnil; 2081 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2138 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2139 tail = XCDR (XCDR (tail))) 2082 tail = XCDR (XCDR (tail)))
2140 { 2083 {
2141 if (EQ (prop, XCAR (tail))) 2084 if (EQ (prop, XCAR (tail)))
2142 { 2085 {
2086 immediate_quit = false;
2143 Fsetcar (XCDR (tail), val); 2087 Fsetcar (XCDR (tail), val);
2144 return plist; 2088 return plist;
2145 } 2089 }
2146 2090
2147 prev = tail; 2091 prev = tail;
2148 QUIT;
2149 } 2092 }
2150 newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); 2093 immediate_quit = true;
2094 Lisp_Object newcell
2095 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
2151 if (NILP (prev)) 2096 if (NILP (prev))
2152 return newcell; 2097 return newcell;
2153 else 2098 Fsetcdr (XCDR (prev), newcell);
2154 Fsetcdr (XCDR (prev), newcell);
2155 return plist; 2099 return plist;
2156} 2100}
2157 2101
@@ -2174,6 +2118,7 @@ corresponding to the given PROP, or nil if PROP is not
2174one of the properties on the list. */) 2118one of the properties on the list. */)
2175 (Lisp_Object plist, Lisp_Object prop) 2119 (Lisp_Object plist, Lisp_Object prop)
2176{ 2120{
2121 unsigned short int quit_count = 0;
2177 Lisp_Object tail; 2122 Lisp_Object tail;
2178 2123
2179 for (tail = plist; 2124 for (tail = plist;
@@ -2182,8 +2127,7 @@ one of the properties on the list. */)
2182 { 2127 {
2183 if (! NILP (Fequal (prop, XCAR (tail)))) 2128 if (! NILP (Fequal (prop, XCAR (tail))))
2184 return XCAR (XCDR (tail)); 2129 return XCAR (XCDR (tail));
2185 2130 rarely_quit (&quit_count);
2186 QUIT;
2187 } 2131 }
2188 2132
2189 CHECK_LIST_END (tail, prop); 2133 CHECK_LIST_END (tail, prop);
@@ -2199,12 +2143,11 @@ If PROP is already a property on the list, its value is set to VAL,
2199otherwise the new PROP VAL pair is added. The new plist is returned; 2143otherwise the new PROP VAL pair is added. The new plist is returned;
2200use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. 2144use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
2201The PLIST is modified by side effects. */) 2145The PLIST is modified by side effects. */)
2202 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) 2146 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2203{ 2147{
2204 register Lisp_Object tail, prev; 2148 unsigned short int quit_count = 0;
2205 Lisp_Object newcell; 2149 Lisp_Object prev = Qnil;
2206 prev = Qnil; 2150 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2207 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2208 tail = XCDR (XCDR (tail))) 2151 tail = XCDR (XCDR (tail)))
2209 { 2152 {
2210 if (! NILP (Fequal (prop, XCAR (tail)))) 2153 if (! NILP (Fequal (prop, XCAR (tail))))
@@ -2214,13 +2157,12 @@ The PLIST is modified by side effects. */)
2214 } 2157 }
2215 2158
2216 prev = tail; 2159 prev = tail;
2217 QUIT; 2160 rarely_quit (&quit_count);
2218 } 2161 }
2219 newcell = list2 (prop, val); 2162 Lisp_Object newcell = list2 (prop, val);
2220 if (NILP (prev)) 2163 if (NILP (prev))
2221 return newcell; 2164 return newcell;
2222 else 2165 Fsetcdr (XCDR (prev), newcell);
2223 Fsetcdr (XCDR (prev), newcell);
2224 return plist; 2166 return plist;
2225} 2167}
2226 2168
@@ -2293,8 +2235,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2293 } 2235 }
2294 } 2236 }
2295 2237
2238 unsigned short int quit_count = 0;
2296 tail_recurse: 2239 tail_recurse:
2297 QUIT; 2240 rarely_quit (&quit_count);
2298 if (EQ (o1, o2)) 2241 if (EQ (o1, o2))
2299 return 1; 2242 return 1;
2300 if (XTYPE (o1) != XTYPE (o2)) 2243 if (XTYPE (o1) != XTYPE (o2))
@@ -2483,14 +2426,12 @@ Only the last argument is not altered, and need not be a list.
2483usage: (nconc &rest LISTS) */) 2426usage: (nconc &rest LISTS) */)
2484 (ptrdiff_t nargs, Lisp_Object *args) 2427 (ptrdiff_t nargs, Lisp_Object *args)
2485{ 2428{
2486 ptrdiff_t argnum; 2429 unsigned short int quit_count = 0;
2487 register Lisp_Object tail, tem, val; 2430 Lisp_Object val = Qnil;
2488 2431
2489 val = tail = Qnil; 2432 for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
2490
2491 for (argnum = 0; argnum < nargs; argnum++)
2492 { 2433 {
2493 tem = args[argnum]; 2434 Lisp_Object tem = args[argnum];
2494 if (NILP (tem)) continue; 2435 if (NILP (tem)) continue;
2495 2436
2496 if (NILP (val)) 2437 if (NILP (val))
@@ -2498,14 +2439,19 @@ usage: (nconc &rest LISTS) */)
2498 2439
2499 if (argnum + 1 == nargs) break; 2440 if (argnum + 1 == nargs) break;
2500 2441
2501 CHECK_LIST_CONS (tem, tem); 2442 CHECK_CONS (tem);
2502 2443
2503 while (CONSP (tem)) 2444 immediate_quit = true;
2445 Lisp_Object tail;
2446 do
2504 { 2447 {
2505 tail = tem; 2448 tail = tem;
2506 tem = XCDR (tail); 2449 tem = XCDR (tail);
2507 QUIT;
2508 } 2450 }
2451 while (CONSP (tem));
2452
2453 immediate_quit = false;
2454 rarely_quit (&quit_count);
2509 2455
2510 tem = args[argnum + 1]; 2456 tem = args[argnum + 1];
2511 Fsetcdr (tail, tem); 2457 Fsetcdr (tail, tem);
@@ -2927,12 +2873,13 @@ property and a property with the value nil.
2927The value is actually the tail of PLIST whose car is PROP. */) 2873The value is actually the tail of PLIST whose car is PROP. */)
2928 (Lisp_Object plist, Lisp_Object prop) 2874 (Lisp_Object plist, Lisp_Object prop)
2929{ 2875{
2876 immediate_quit = true;
2930 while (CONSP (plist) && !EQ (XCAR (plist), prop)) 2877 while (CONSP (plist) && !EQ (XCAR (plist), prop))
2931 { 2878 {
2932 plist = XCDR (plist); 2879 plist = XCDR (plist);
2933 plist = CDR (plist); 2880 plist = CDR (plist);
2934 QUIT;
2935 } 2881 }
2882 immediate_quit = false;
2936 return plist; 2883 return plist;
2937} 2884}
2938 2885
@@ -3804,12 +3751,17 @@ allocate_hash_table (void)
3804 (table size) is >= REHASH_THRESHOLD. 3751 (table size) is >= REHASH_THRESHOLD.
3805 3752
3806 WEAK specifies the weakness of the table. If non-nil, it must be 3753 WEAK specifies the weakness of the table. If non-nil, it must be
3807 one of the symbols `key', `value', `key-or-value', or `key-and-value'. */ 3754 one of the symbols `key', `value', `key-or-value', or `key-and-value'.
3755
3756 If PURECOPY is non-nil, the table can be copied to pure storage via
3757 `purecopy' when Emacs is being dumped. Such tables can no longer be
3758 changed after purecopy. */
3808 3759
3809Lisp_Object 3760Lisp_Object
3810make_hash_table (struct hash_table_test test, 3761make_hash_table (struct hash_table_test test,
3811 Lisp_Object size, Lisp_Object rehash_size, 3762 Lisp_Object size, Lisp_Object rehash_size,
3812 Lisp_Object rehash_threshold, Lisp_Object weak) 3763 Lisp_Object rehash_threshold, Lisp_Object weak,
3764 Lisp_Object pure)
3813{ 3765{
3814 struct Lisp_Hash_Table *h; 3766 struct Lisp_Hash_Table *h;
3815 Lisp_Object table; 3767 Lisp_Object table;
@@ -3850,6 +3802,7 @@ make_hash_table (struct hash_table_test test,
3850 h->hash = Fmake_vector (size, Qnil); 3802 h->hash = Fmake_vector (size, Qnil);
3851 h->next = Fmake_vector (size, Qnil); 3803 h->next = Fmake_vector (size, Qnil);
3852 h->index = Fmake_vector (make_number (index_size), Qnil); 3804 h->index = Fmake_vector (make_number (index_size), Qnil);
3805 h->pure = pure;
3853 3806
3854 /* Set up the free list. */ 3807 /* Set up the free list. */
3855 for (i = 0; i < sz - 1; ++i) 3808 for (i = 0; i < sz - 1; ++i)
@@ -4514,10 +4467,15 @@ key, value, one of key or value, or both key and value, depending on
4514WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK 4467WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
4515is nil. 4468is nil.
4516 4469
4470:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied
4471to pure storage when Emacs is being dumped, making the contents of the
4472table read only. Any further changes to purified tables will result
4473in an error.
4474
4517usage: (make-hash-table &rest KEYWORD-ARGS) */) 4475usage: (make-hash-table &rest KEYWORD-ARGS) */)
4518 (ptrdiff_t nargs, Lisp_Object *args) 4476 (ptrdiff_t nargs, Lisp_Object *args)
4519{ 4477{
4520 Lisp_Object test, size, rehash_size, rehash_threshold, weak; 4478 Lisp_Object test, size, rehash_size, rehash_threshold, weak, pure;
4521 struct hash_table_test testdesc; 4479 struct hash_table_test testdesc;
4522 ptrdiff_t i; 4480 ptrdiff_t i;
4523 USE_SAFE_ALLOCA; 4481 USE_SAFE_ALLOCA;
@@ -4551,6 +4509,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
4551 testdesc.cmpfn = cmpfn_user_defined; 4509 testdesc.cmpfn = cmpfn_user_defined;
4552 } 4510 }
4553 4511
4512 /* See if there's a `:purecopy PURECOPY' argument. */
4513 i = get_key_arg (QCpurecopy, nargs, args, used);
4514 pure = i ? args[i] : Qnil;
4554 /* See if there's a `:size SIZE' argument. */ 4515 /* See if there's a `:size SIZE' argument. */
4555 i = get_key_arg (QCsize, nargs, args, used); 4516 i = get_key_arg (QCsize, nargs, args, used);
4556 size = i ? args[i] : Qnil; 4517 size = i ? args[i] : Qnil;
@@ -4592,7 +4553,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
4592 signal_error ("Invalid argument list", args[i]); 4553 signal_error ("Invalid argument list", args[i]);
4593 4554
4594 SAFE_FREE (); 4555 SAFE_FREE ();
4595 return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak); 4556 return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
4557 pure);
4596} 4558}
4597 4559
4598 4560
@@ -4671,7 +4633,9 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
4671 doc: /* Clear hash table TABLE and return it. */) 4633 doc: /* Clear hash table TABLE and return it. */)
4672 (Lisp_Object table) 4634 (Lisp_Object table)
4673{ 4635{
4674 hash_clear (check_hash_table (table)); 4636 struct Lisp_Hash_Table *h = check_hash_table (table);
4637 CHECK_IMPURE (table, h);
4638 hash_clear (h);
4675 /* Be compatible with XEmacs. */ 4639 /* Be compatible with XEmacs. */
4676 return table; 4640 return table;
4677} 4641}
@@ -4695,9 +4659,10 @@ VALUE. In any case, return VALUE. */)
4695 (Lisp_Object key, Lisp_Object value, Lisp_Object table) 4659 (Lisp_Object key, Lisp_Object value, Lisp_Object table)
4696{ 4660{
4697 struct Lisp_Hash_Table *h = check_hash_table (table); 4661 struct Lisp_Hash_Table *h = check_hash_table (table);
4662 CHECK_IMPURE (table, h);
4663
4698 ptrdiff_t i; 4664 ptrdiff_t i;
4699 EMACS_UINT hash; 4665 EMACS_UINT hash;
4700
4701 i = hash_lookup (h, key, &hash); 4666 i = hash_lookup (h, key, &hash);
4702 if (i >= 0) 4667 if (i >= 0)
4703 set_hash_value_slot (h, i, value); 4668 set_hash_value_slot (h, i, value);
@@ -4713,6 +4678,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
4713 (Lisp_Object key, Lisp_Object table) 4678 (Lisp_Object key, Lisp_Object table)
4714{ 4679{
4715 struct Lisp_Hash_Table *h = check_hash_table (table); 4680 struct Lisp_Hash_Table *h = check_hash_table (table);
4681 CHECK_IMPURE (table, h);
4716 hash_remove_from_table (h, key); 4682 hash_remove_from_table (h, key);
4717 return Qnil; 4683 return Qnil;
4718} 4684}
@@ -5083,6 +5049,7 @@ syms_of_fns (void)
5083 DEFSYM (Qequal, "equal"); 5049 DEFSYM (Qequal, "equal");
5084 DEFSYM (QCtest, ":test"); 5050 DEFSYM (QCtest, ":test");
5085 DEFSYM (QCsize, ":size"); 5051 DEFSYM (QCsize, ":size");
5052 DEFSYM (QCpurecopy, ":purecopy");
5086 DEFSYM (QCrehash_size, ":rehash-size"); 5053 DEFSYM (QCrehash_size, ":rehash-size");
5087 DEFSYM (QCrehash_threshold, ":rehash-threshold"); 5054 DEFSYM (QCrehash_threshold, ":rehash-threshold");
5088 DEFSYM (QCweakness, ":weakness"); 5055 DEFSYM (QCweakness, ":weakness");
diff --git a/src/fontset.c b/src/fontset.c
index 33d1d24e5b3..850558b08a0 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1677,11 +1677,10 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
1677`set-fontset-font' for the meaning. */) 1677`set-fontset-font' for the meaning. */)
1678 (Lisp_Object name, Lisp_Object fontlist) 1678 (Lisp_Object name, Lisp_Object fontlist)
1679{ 1679{
1680 Lisp_Object fontset; 1680 Lisp_Object fontset, tail;
1681 int id; 1681 int id;
1682 1682
1683 CHECK_STRING (name); 1683 CHECK_STRING (name);
1684 CHECK_LIST (fontlist);
1685 1684
1686 name = Fdowncase (name); 1685 name = Fdowncase (name);
1687 id = fs_query_fontset (name, 0); 1686 id = fs_query_fontset (name, 0);
@@ -1714,11 +1713,11 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
1714 Fset_char_table_range (fontset, Qt, Qnil); 1713 Fset_char_table_range (fontset, Qt, Qnil);
1715 } 1714 }
1716 1715
1717 for (; CONSP (fontlist); fontlist = XCDR (fontlist)) 1716 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
1718 { 1717 {
1719 Lisp_Object elt, script; 1718 Lisp_Object elt, script;
1720 1719
1721 elt = XCAR (fontlist); 1720 elt = XCAR (tail);
1722 script = Fcar (elt); 1721 script = Fcar (elt);
1723 elt = Fcdr (elt); 1722 elt = Fcdr (elt);
1724 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt)))) 1723 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
@@ -1727,6 +1726,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
1727 else 1726 else
1728 Fset_fontset_font (name, script, elt, Qnil, Qappend); 1727 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1729 } 1728 }
1729 CHECK_LIST_END (tail, fontlist);
1730 return name; 1730 return name;
1731} 1731}
1732 1732
diff --git a/src/frame.c b/src/frame.c
index 2c2c1e150d4..d0f653fc762 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -2691,9 +2691,7 @@ list, but are otherwise ignored. */)
2691 (Lisp_Object frame, Lisp_Object alist) 2691 (Lisp_Object frame, Lisp_Object alist)
2692{ 2692{
2693 struct frame *f = decode_live_frame (frame); 2693 struct frame *f = decode_live_frame (frame);
2694 register Lisp_Object prop, val; 2694 Lisp_Object prop, val;
2695
2696 CHECK_LIST (alist);
2697 2695
2698 /* I think this should be done with a hook. */ 2696 /* I think this should be done with a hook. */
2699#ifdef HAVE_WINDOW_SYSTEM 2697#ifdef HAVE_WINDOW_SYSTEM
@@ -3142,6 +3140,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3142 3140
3143 for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail)) 3141 for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
3144 size++; 3142 size++;
3143 CHECK_LIST_END (tail, alist);
3145 3144
3146 USE_SAFE_ALLOCA; 3145 USE_SAFE_ALLOCA;
3147 SAFE_ALLOCA_LISP (parms, 2 * size); 3146 SAFE_ALLOCA_LISP (parms, 2 * size);
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index 6ec5c642825..285a253733d 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -178,20 +178,18 @@ will be reported only in case of the `moved' event. */)
178 if (NILP (Ffile_exists_p (file))) 178 if (NILP (Ffile_exists_p (file)))
179 report_file_error ("File does not exist", file); 179 report_file_error ("File does not exist", file);
180 180
181 CHECK_LIST (flags);
182
183 if (!FUNCTIONP (callback)) 181 if (!FUNCTIONP (callback))
184 wrong_type_argument (Qinvalid_function, callback); 182 wrong_type_argument (Qinvalid_function, callback);
185 183
186 /* Create GFile name. */
187 gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
188
189 /* Assemble flags. */ 184 /* Assemble flags. */
190 if (!NILP (Fmember (Qwatch_mounts, flags))) 185 if (!NILP (Fmember (Qwatch_mounts, flags)))
191 gflags |= G_FILE_MONITOR_WATCH_MOUNTS; 186 gflags |= G_FILE_MONITOR_WATCH_MOUNTS;
192 if (!NILP (Fmember (Qsend_moved, flags))) 187 if (!NILP (Fmember (Qsend_moved, flags)))
193 gflags |= G_FILE_MONITOR_SEND_MOVED; 188 gflags |= G_FILE_MONITOR_SEND_MOVED;
194 189
190 /* Create GFile name. */
191 gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
192
195 /* Enable watch. */ 193 /* Enable watch. */
196 monitor = g_file_monitor (gfile, gflags, NULL, &gerror); 194 monitor = g_file_monitor (gfile, gflags, NULL, &gerror);
197 g_object_unref (gfile); 195 g_object_unref (gfile);
diff --git a/src/gnutls.c b/src/gnutls.c
index 735d2e35810..d0d7f2dfc84 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -390,7 +390,7 @@ gnutls_try_handshake (struct Lisp_Process *proc)
390 { 390 {
391 ret = gnutls_handshake (state); 391 ret = gnutls_handshake (state);
392 emacs_gnutls_handle_error (state, ret); 392 emacs_gnutls_handle_error (state, ret);
393 QUIT; 393 maybe_quit ();
394 } 394 }
395 while (ret < 0 395 while (ret < 0
396 && gnutls_error_is_fatal (ret) == 0 396 && gnutls_error_is_fatal (ret) == 0
@@ -582,8 +582,17 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
582 582
583 if (gnutls_error_is_fatal (err)) 583 if (gnutls_error_is_fatal (err))
584 { 584 {
585 int level = 1;
586 /* Mostly ignore "The TLS connection was non-properly
587 terminated" message which just means that the peer closed the
588 connection. */
589#ifdef HAVE_GNUTLS3
590 if (err == GNUTLS_E_PREMATURE_TERMINATION)
591 level = 3;
592#endif
593
594 GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
585 ret = 0; 595 ret = 0;
586 GNUTLS_LOG2 (1, max_log_level, "fatal error:", str);
587 } 596 }
588 else 597 else
589 { 598 {
diff --git a/src/image.c b/src/image.c
index 39677d2add9..ad0143be48b 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4020,7 +4020,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int,
4020 return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE), 4020 return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
4021 make_float (DEFAULT_REHASH_SIZE), 4021 make_float (DEFAULT_REHASH_SIZE),
4022 make_float (DEFAULT_REHASH_THRESHOLD), 4022 make_float (DEFAULT_REHASH_THRESHOLD),
4023 Qnil); 4023 Qnil, Qnil);
4024} 4024}
4025 4025
4026static void 4026static void
diff --git a/src/indent.c b/src/indent.c
index 34449955a6c..23951a16eb6 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,8 +1200,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1200 continuation_glyph_width = 0; /* In the fringe. */ 1200 continuation_glyph_width = 0; /* In the fringe. */
1201#endif 1201#endif
1202 1202
1203 immediate_quit = 1; 1203 immediate_quit = true;
1204 QUIT; 1204 maybe_quit ();
1205 1205
1206 /* It's just impossible to be too paranoid here. */ 1206 /* It's just impossible to be too paranoid here. */
1207 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); 1207 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
@@ -1694,7 +1694,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1694 /* Nonzero if have just continued a line */ 1694 /* Nonzero if have just continued a line */
1695 val_compute_motion.contin = (contin_hpos && prev_hpos == 0); 1695 val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
1696 1696
1697 immediate_quit = 0; 1697 immediate_quit = false;
1698 return &val_compute_motion; 1698 return &val_compute_motion;
1699} 1699}
1700 1700
diff --git a/src/insdel.c b/src/insdel.c
index b93606ced85..3f933b0ad85 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -129,7 +129,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
129 Change BYTEPOS to be where we have actually moved the gap to. 129 Change BYTEPOS to be where we have actually moved the gap to.
130 Note that this cannot happen when we are called to make the 130 Note that this cannot happen when we are called to make the
131 gap larger or smaller, since make_gap_larger and 131 gap larger or smaller, since make_gap_larger and
132 make_gap_smaller prevent QUIT by setting inhibit-quit. */ 132 make_gap_smaller set inhibit-quit. */
133 if (QUITP) 133 if (QUITP)
134 { 134 {
135 bytepos = new_s1; 135 bytepos = new_s1;
@@ -151,7 +151,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
151 GPT = charpos; 151 GPT = charpos;
152 eassert (charpos <= bytepos); 152 eassert (charpos <= bytepos);
153 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ 153 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
154 QUIT; 154 maybe_quit ();
155} 155}
156 156
157/* Move the gap to a position greater than the current GPT. 157/* Move the gap to a position greater than the current GPT.
@@ -185,7 +185,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
185 Change BYTEPOS to be where we have actually moved the gap to. 185 Change BYTEPOS to be where we have actually moved the gap to.
186 Note that this cannot happen when we are called to make the 186 Note that this cannot happen when we are called to make the
187 gap larger or smaller, since make_gap_larger and 187 gap larger or smaller, since make_gap_larger and
188 make_gap_smaller prevent QUIT by setting inhibit-quit. */ 188 make_gap_smaller set inhibit-quit. */
189 if (QUITP) 189 if (QUITP)
190 { 190 {
191 bytepos = new_s1; 191 bytepos = new_s1;
@@ -204,7 +204,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
204 GPT_BYTE = bytepos; 204 GPT_BYTE = bytepos;
205 eassert (charpos <= bytepos); 205 eassert (charpos <= bytepos);
206 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ 206 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
207 QUIT; 207 maybe_quit ();
208} 208}
209 209
210/* If the selected window's old pointm is adjacent or covered by the 210/* If the selected window's old pointm is adjacent or covered by the
@@ -464,7 +464,7 @@ make_gap_larger (ptrdiff_t nbytes_added)
464 464
465 enlarge_buffer_text (current_buffer, nbytes_added); 465 enlarge_buffer_text (current_buffer, nbytes_added);
466 466
467 /* Prevent quitting in gap_left. We cannot allow a QUIT there, 467 /* Prevent quitting in gap_left. We cannot allow a quit there,
468 because that would leave the buffer text in an inconsistent 468 because that would leave the buffer text in an inconsistent
469 state, with 2 gap holes instead of just one. */ 469 state, with 2 gap holes instead of just one. */
470 tem = Vinhibit_quit; 470 tem = Vinhibit_quit;
@@ -512,7 +512,7 @@ make_gap_smaller (ptrdiff_t nbytes_removed)
512 if (GAP_SIZE - nbytes_removed < GAP_BYTES_MIN) 512 if (GAP_SIZE - nbytes_removed < GAP_BYTES_MIN)
513 nbytes_removed = GAP_SIZE - GAP_BYTES_MIN; 513 nbytes_removed = GAP_SIZE - GAP_BYTES_MIN;
514 514
515 /* Prevent quitting in gap_right. We cannot allow a QUIT there, 515 /* Prevent quitting in gap_right. We cannot allow a quit there,
516 because that would leave the buffer text in an inconsistent 516 because that would leave the buffer text in an inconsistent
517 state, with 2 gap holes instead of just one. */ 517 state, with 2 gap holes instead of just one. */
518 tem = Vinhibit_quit; 518 tem = Vinhibit_quit;
diff --git a/src/keyboard.c b/src/keyboard.c
index 6aad0acc656..d41603b2e50 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -87,7 +87,7 @@ char const DEV_TTY[] = "/dev/tty";
87volatile int interrupt_input_blocked; 87volatile int interrupt_input_blocked;
88 88
89/* True means an input interrupt or alarm signal has arrived. 89/* True means an input interrupt or alarm signal has arrived.
90 The QUIT macro checks this. */ 90 The maybe_quit function checks this. */
91volatile bool pending_signals; 91volatile bool pending_signals;
92 92
93#define KBD_BUFFER_SIZE 4096 93#define KBD_BUFFER_SIZE 4096
@@ -1416,7 +1416,7 @@ command_loop_1 (void)
1416 if (!NILP (Vquit_flag)) 1416 if (!NILP (Vquit_flag))
1417 { 1417 {
1418 Vexecuting_kbd_macro = Qt; 1418 Vexecuting_kbd_macro = Qt;
1419 QUIT; /* Make some noise. */ 1419 maybe_quit (); /* Make some noise. */
1420 /* Will return since macro now empty. */ 1420 /* Will return since macro now empty. */
1421 } 1421 }
1422 } 1422 }
@@ -3591,7 +3591,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
3591 if (immediate_quit && NILP (Vinhibit_quit)) 3591 if (immediate_quit && NILP (Vinhibit_quit))
3592 { 3592 {
3593 immediate_quit = false; 3593 immediate_quit = false;
3594 QUIT; 3594 maybe_quit ();
3595 } 3595 }
3596 } 3596 }
3597} 3597}
@@ -7426,7 +7426,7 @@ menu_bar_items (Lisp_Object old)
7426 USE_SAFE_ALLOCA; 7426 USE_SAFE_ALLOCA;
7427 7427
7428 /* In order to build the menus, we need to call the keymap 7428 /* In order to build the menus, we need to call the keymap
7429 accessors. They all call QUIT. But this function is called 7429 accessors. They all call maybe_quit. But this function is called
7430 during redisplay, during which a quit is fatal. So inhibit 7430 during redisplay, during which a quit is fatal. So inhibit
7431 quitting while building the menus. 7431 quitting while building the menus.
7432 We do this instead of specbind because (1) errors will clear it anyway 7432 We do this instead of specbind because (1) errors will clear it anyway
@@ -7987,7 +7987,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems)
7987 *nitems = 0; 7987 *nitems = 0;
7988 7988
7989 /* In order to build the menus, we need to call the keymap 7989 /* In order to build the menus, we need to call the keymap
7990 accessors. They all call QUIT. But this function is called 7990 accessors. They all call maybe_quit. But this function is called
7991 during redisplay, during which a quit is fatal. So inhibit 7991 during redisplay, during which a quit is fatal. So inhibit
7992 quitting while building the menus. We do this instead of 7992 quitting while building the menus. We do this instead of
7993 specbind because (1) errors will clear it anyway and (2) this 7993 specbind because (1) errors will clear it anyway and (2) this
@@ -9806,7 +9806,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9806 9806
9807 if (!NILP (prompt)) 9807 if (!NILP (prompt))
9808 CHECK_STRING (prompt); 9808 CHECK_STRING (prompt);
9809 QUIT; 9809 maybe_quit ();
9810 9810
9811 specbind (Qinput_method_exit_on_first_char, 9811 specbind (Qinput_method_exit_on_first_char,
9812 (NILP (cmd_loop) ? Qt : Qnil)); 9812 (NILP (cmd_loop) ? Qt : Qnil));
@@ -9840,7 +9840,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9840 if (i == -1) 9840 if (i == -1)
9841 { 9841 {
9842 Vquit_flag = Qt; 9842 Vquit_flag = Qt;
9843 QUIT; 9843 maybe_quit ();
9844 } 9844 }
9845 9845
9846 return unbind_to (count, 9846 return unbind_to (count,
@@ -10278,7 +10278,7 @@ clear_waiting_for_input (void)
10278 10278
10279 If we have a frame on the controlling tty, we assume that the 10279 If we have a frame on the controlling tty, we assume that the
10280 SIGINT was generated by C-g, so we call handle_interrupt. 10280 SIGINT was generated by C-g, so we call handle_interrupt.
10281 Otherwise, tell QUIT to kill Emacs. */ 10281 Otherwise, tell maybe_quit to kill Emacs. */
10282 10282
10283static void 10283static void
10284handle_interrupt_signal (int sig) 10284handle_interrupt_signal (int sig)
@@ -10289,7 +10289,7 @@ handle_interrupt_signal (int sig)
10289 { 10289 {
10290 /* If there are no frames there, let's pretend that we are a 10290 /* If there are no frames there, let's pretend that we are a
10291 well-behaving UN*X program and quit. We must not call Lisp 10291 well-behaving UN*X program and quit. We must not call Lisp
10292 in a signal handler, so tell QUIT to exit when it is 10292 in a signal handler, so tell maybe_quit to exit when it is
10293 safe. */ 10293 safe. */
10294 Vquit_flag = Qkill_emacs; 10294 Vquit_flag = Qkill_emacs;
10295 } 10295 }
diff --git a/src/keyboard.h b/src/keyboard.h
index 7cd41ae55b6..2219c011352 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -486,6 +486,8 @@ extern bool kbd_buffer_events_waiting (void);
486extern void add_user_signal (int, const char *); 486extern void add_user_signal (int, const char *);
487 487
488extern int tty_read_avail_input (struct terminal *, struct input_event *); 488extern int tty_read_avail_input (struct terminal *, struct input_event *);
489extern bool volatile pending_signals;
490extern void process_pending_signals (void);
489extern struct timespec timer_check (void); 491extern struct timespec timer_check (void);
490extern void mark_kboards (void); 492extern void mark_kboards (void);
491 493
diff --git a/src/keymap.c b/src/keymap.c
index 9e759478518..9caf55f98fb 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -523,7 +523,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
523 retval = Fcons (Qkeymap, Fcons (retval, retval_tail)); 523 retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
524 } 524 }
525 } 525 }
526 QUIT; 526 maybe_quit ();
527 } 527 }
528 528
529 return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval; 529 return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
@@ -877,7 +877,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
877 should be inserted before it. */ 877 should be inserted before it. */
878 goto keymap_end; 878 goto keymap_end;
879 879
880 QUIT; 880 maybe_quit ();
881 } 881 }
882 882
883 keymap_end: 883 keymap_end:
@@ -1250,7 +1250,7 @@ recognize the default bindings, just as `read-key-sequence' does. */)
1250 if (!CONSP (keymap)) 1250 if (!CONSP (keymap))
1251 return make_number (idx); 1251 return make_number (idx);
1252 1252
1253 QUIT; 1253 maybe_quit ();
1254 } 1254 }
1255} 1255}
1256 1256
@@ -2466,7 +2466,7 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2466 non-ascii prefixes like `C-down-mouse-2'. */ 2466 non-ascii prefixes like `C-down-mouse-2'. */
2467 continue; 2467 continue;
2468 2468
2469 QUIT; 2469 maybe_quit ();
2470 2470
2471 data.definition = definition; 2471 data.definition = definition;
2472 data.noindirect = noindirect; 2472 data.noindirect = noindirect;
@@ -3173,7 +3173,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
3173 3173
3174 for (tail = map; CONSP (tail); tail = XCDR (tail)) 3174 for (tail = map; CONSP (tail); tail = XCDR (tail))
3175 { 3175 {
3176 QUIT; 3176 maybe_quit ();
3177 3177
3178 if (VECTORP (XCAR (tail)) 3178 if (VECTORP (XCAR (tail))
3179 || CHAR_TABLE_P (XCAR (tail))) 3179 || CHAR_TABLE_P (XCAR (tail)))
@@ -3426,7 +3426,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3426 int range_beg, range_end; 3426 int range_beg, range_end;
3427 Lisp_Object val; 3427 Lisp_Object val;
3428 3428
3429 QUIT; 3429 maybe_quit ();
3430 3430
3431 if (i == stop) 3431 if (i == stop)
3432 { 3432 {
diff --git a/src/lisp.h b/src/lisp.h
index e7747563085..91c430fe98d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -310,7 +310,6 @@ error !;
310# define lisp_h_XLI(o) (o) 310# define lisp_h_XLI(o) (o)
311# define lisp_h_XIL(i) (i) 311# define lisp_h_XIL(i) (i)
312#endif 312#endif
313#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y)
314#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) 313#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
315#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) 314#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
316#define lisp_h_CHECK_TYPE(ok, predicate, x) \ 315#define lisp_h_CHECK_TYPE(ok, predicate, x) \
@@ -367,7 +366,6 @@ error !;
367#if DEFINE_KEY_OPS_AS_MACROS 366#if DEFINE_KEY_OPS_AS_MACROS
368# define XLI(o) lisp_h_XLI (o) 367# define XLI(o) lisp_h_XLI (o)
369# define XIL(i) lisp_h_XIL (i) 368# define XIL(i) lisp_h_XIL (i)
370# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
371# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) 369# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
372# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) 370# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
373# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) 371# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
@@ -1997,6 +1995,10 @@ struct Lisp_Hash_Table
1997 hash table size to reduce collisions. */ 1995 hash table size to reduce collisions. */
1998 Lisp_Object index; 1996 Lisp_Object index;
1999 1997
1998 /* Non-nil if the table can be purecopied. Any changes the table after
1999 purecopy will result in an error. */
2000 Lisp_Object pure;
2001
2000 /* Only the fields above are traced normally by the GC. The ones below 2002 /* Only the fields above are traced normally by the GC. The ones below
2001 `count' are special and are either ignored by the GC or traced in 2003 `count' are special and are either ignored by the GC or traced in
2002 a special way (e.g. because of weakness). */ 2004 a special way (e.g. because of weakness). */
@@ -2751,9 +2753,9 @@ CHECK_LIST (Lisp_Object x)
2751} 2753}
2752 2754
2753INLINE void 2755INLINE void
2754(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) 2756CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
2755{ 2757{
2756 lisp_h_CHECK_LIST_CONS (x, y); 2758 CHECK_TYPE (NILP (x), Qlistp, y);
2757} 2759}
2758 2760
2759INLINE void 2761INLINE void
@@ -3121,34 +3123,25 @@ struct handler
3121 3123
3122extern Lisp_Object memory_signal_data; 3124extern Lisp_Object memory_signal_data;
3123 3125
3124/* Check quit-flag and quit if it is non-nil. 3126/* Check quit-flag and quit if it is non-nil. Typing C-g does not
3125 Typing C-g does not directly cause a quit; it only sets Vquit_flag. 3127 directly cause a quit; it only sets Vquit_flag. So the program
3126 So the program needs to do QUIT at times when it is safe to quit. 3128 needs to call maybe_quit at times when it is safe to quit. Every
3127 Every loop that might run for a long time or might not exit 3129 loop that might run for a long time or might not exit ought to call
3128 ought to do QUIT at least once, at a safe place. 3130 maybe_quit at least once, at a safe place. Unless that is
3129 Unless that is impossible, of course. 3131 impossible, of course. But it is very desirable to avoid creating
3130 But it is very desirable to avoid creating loops where QUIT is impossible. 3132 loops where maybe_quit is impossible.
3131 3133
3132 Exception: if you set immediate_quit to true, 3134 Exception: if you set immediate_quit, the handler that responds to
3133 then the handler that responds to the C-g does the quit itself. 3135 the C-g does the quit itself. This is a good thing to do around a
3134 This is a good thing to do around a loop that has no side effects 3136 loop that has no side effects and (in particular) cannot call
3135 and (in particular) cannot call arbitrary Lisp code. 3137 arbitrary Lisp code.
3136 3138
3137 If quit-flag is set to `kill-emacs' the SIGINT handler has received 3139 If quit-flag is set to `kill-emacs' the SIGINT handler has received
3138 a request to exit Emacs when it is safe to do. */ 3140 a request to exit Emacs when it is safe to do.
3139
3140extern void process_pending_signals (void);
3141extern bool volatile pending_signals;
3142 3141
3143extern void process_quit_flag (void); 3142 When not quitting, process any pending signals. */
3144#define QUIT \
3145 do { \
3146 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
3147 process_quit_flag (); \
3148 else if (pending_signals) \
3149 process_pending_signals (); \
3150 } while (false)
3151 3143
3144extern void maybe_quit (void);
3152 3145
3153/* True if ought to quit now. */ 3146/* True if ought to quit now. */
3154 3147
@@ -3375,7 +3368,7 @@ extern void sweep_weak_hash_tables (void);
3375EMACS_UINT hash_string (char const *, ptrdiff_t); 3368EMACS_UINT hash_string (char const *, ptrdiff_t);
3376EMACS_UINT sxhash (Lisp_Object, int); 3369EMACS_UINT sxhash (Lisp_Object, int);
3377Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, 3370Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
3378 Lisp_Object, Lisp_Object); 3371 Lisp_Object, Lisp_Object, Lisp_Object);
3379ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); 3372ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
3380ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, 3373ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
3381 EMACS_UINT); 3374 EMACS_UINT);
diff --git a/src/lread.c b/src/lread.c
index 284fd1aafbc..17806922a8c 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -451,7 +451,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
451 while (c == EOF && ferror (instream) && errno == EINTR) 451 while (c == EOF && ferror (instream) && errno == EINTR)
452 { 452 {
453 unblock_input (); 453 unblock_input ();
454 QUIT; 454 maybe_quit ();
455 block_input (); 455 block_input ();
456 clearerr (instream); 456 clearerr (instream);
457 c = getc (instream); 457 c = getc (instream);
@@ -1702,14 +1702,14 @@ build_load_history (Lisp_Object filename, bool entire)
1702 Fcons (newelt, XCDR (tem)))); 1702 Fcons (newelt, XCDR (tem))));
1703 1703
1704 tem2 = XCDR (tem2); 1704 tem2 = XCDR (tem2);
1705 QUIT; 1705 maybe_quit ();
1706 } 1706 }
1707 } 1707 }
1708 } 1708 }
1709 else 1709 else
1710 prev = tail; 1710 prev = tail;
1711 tail = XCDR (tail); 1711 tail = XCDR (tail);
1712 QUIT; 1712 maybe_quit ();
1713 } 1713 }
1714 1714
1715 /* If we're loading an entire file, cons the new assoc onto the 1715 /* If we're loading an entire file, cons the new assoc onto the
@@ -2599,7 +2599,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2599 Lisp_Object val = Qnil; 2599 Lisp_Object val = Qnil;
2600 /* The size is 2 * number of allowed keywords to 2600 /* The size is 2 * number of allowed keywords to
2601 make-hash-table. */ 2601 make-hash-table. */
2602 Lisp_Object params[10]; 2602 Lisp_Object params[12];
2603 Lisp_Object ht; 2603 Lisp_Object ht;
2604 Lisp_Object key = Qnil; 2604 Lisp_Object key = Qnil;
2605 int param_count = 0; 2605 int param_count = 0;
@@ -2636,6 +2636,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2636 if (!NILP (params[param_count + 1])) 2636 if (!NILP (params[param_count + 1]))
2637 param_count += 2; 2637 param_count += 2;
2638 2638
2639 params[param_count] = QCpurecopy;
2640 params[param_count + 1] = Fplist_get (tmp, Qpurecopy);
2641 if (!NILP (params[param_count + 1]))
2642 param_count += 2;
2643
2639 /* This is the hash table data. */ 2644 /* This is the hash table data. */
2640 data = Fplist_get (tmp, Qdata); 2645 data = Fplist_get (tmp, Qdata);
2641 2646
@@ -4849,6 +4854,7 @@ that are loaded before your customizations are read! */);
4849 DEFSYM (Qdata, "data"); 4854 DEFSYM (Qdata, "data");
4850 DEFSYM (Qtest, "test"); 4855 DEFSYM (Qtest, "test");
4851 DEFSYM (Qsize, "size"); 4856 DEFSYM (Qsize, "size");
4857 DEFSYM (Qpurecopy, "purecopy");
4852 DEFSYM (Qweakness, "weakness"); 4858 DEFSYM (Qweakness, "weakness");
4853 DEFSYM (Qrehash_size, "rehash-size"); 4859 DEFSYM (Qrehash_size, "rehash-size");
4854 DEFSYM (Qrehash_threshold, "rehash-threshold"); 4860 DEFSYM (Qrehash_threshold, "rehash-threshold");
diff --git a/src/macros.c b/src/macros.c
index 3b29cc67cf8..f0ffda3f441 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -325,7 +325,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
325 325
326 executing_kbd_macro_iterations = ++success_count; 326 executing_kbd_macro_iterations = ++success_count;
327 327
328 QUIT; 328 maybe_quit ();
329 } 329 }
330 while (--repeat 330 while (--repeat
331 && (STRINGP (Vexecuting_kbd_macro) || VECTORP (Vexecuting_kbd_macro))); 331 && (STRINGP (Vexecuting_kbd_macro) || VECTORP (Vexecuting_kbd_macro)));
diff --git a/src/minibuf.c b/src/minibuf.c
index d44bb44baee..1bbe276776e 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1865,7 +1865,7 @@ single string, rather than a cons cell whose car is a string. */)
1865 case_fold); 1865 case_fold);
1866 if (EQ (tem, Qt)) 1866 if (EQ (tem, Qt))
1867 return elt; 1867 return elt;
1868 QUIT; 1868 maybe_quit ();
1869 } 1869 }
1870 return Qnil; 1870 return Qnil;
1871} 1871}
diff --git a/src/print.c b/src/print.c
index dfaa489a98d..db3d00f51f2 100644
--- a/src/print.c
+++ b/src/print.c
@@ -279,7 +279,7 @@ printchar (unsigned int ch, Lisp_Object fun)
279 unsigned char str[MAX_MULTIBYTE_LENGTH]; 279 unsigned char str[MAX_MULTIBYTE_LENGTH];
280 int len = CHAR_STRING (ch, str); 280 int len = CHAR_STRING (ch, str);
281 281
282 QUIT; 282 maybe_quit ();
283 283
284 if (NILP (fun)) 284 if (NILP (fun))
285 { 285 {
@@ -1352,7 +1352,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1352 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t), 1352 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
1353 40))]; 1353 40))];
1354 1354
1355 QUIT; 1355 maybe_quit ();
1356 1356
1357 /* Detect circularities and truncate them. */ 1357 /* Detect circularities and truncate them. */
1358 if (NILP (Vprint_circle)) 1358 if (NILP (Vprint_circle))
@@ -1446,7 +1446,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1446 1446
1447 FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte); 1447 FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
1448 1448
1449 QUIT; 1449 maybe_quit ();
1450 1450
1451 if (multibyte 1451 if (multibyte
1452 ? (CHAR_BYTE8_P (c) && (c = CHAR_TO_BYTE8 (c), true)) 1452 ? (CHAR_BYTE8_P (c) && (c = CHAR_TO_BYTE8 (c), true))
@@ -1550,7 +1550,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1550 /* Here, we must convert each multi-byte form to the 1550 /* Here, we must convert each multi-byte form to the
1551 corresponding character code before handing it to PRINTCHAR. */ 1551 corresponding character code before handing it to PRINTCHAR. */
1552 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte); 1552 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1553 QUIT; 1553 maybe_quit ();
1554 1554
1555 if (escapeflag) 1555 if (escapeflag)
1556 { 1556 {
@@ -1707,7 +1707,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1707 1707
1708 for (i = 0; i < size_in_chars; i++) 1708 for (i = 0; i < size_in_chars; i++)
1709 { 1709 {
1710 QUIT; 1710 maybe_quit ();
1711 c = bool_vector_uchar_data (obj)[i]; 1711 c = bool_vector_uchar_data (obj)[i];
1712 if (c == '\n' && print_escape_newlines) 1712 if (c == '\n' && print_escape_newlines)
1713 print_c_string ("\\n", printcharfun); 1713 print_c_string ("\\n", printcharfun);
@@ -1818,6 +1818,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1818 print_object (h->rehash_threshold, printcharfun, escapeflag); 1818 print_object (h->rehash_threshold, printcharfun, escapeflag);
1819 } 1819 }
1820 1820
1821 if (!NILP (h->pure))
1822 {
1823 print_c_string (" purecopy ", printcharfun);
1824 print_object (h->pure, printcharfun, escapeflag);
1825 }
1826
1821 print_c_string (" data ", printcharfun); 1827 print_c_string (" data ", printcharfun);
1822 1828
1823 /* Print the data here as a plist. */ 1829 /* Print the data here as a plist. */
diff --git a/src/process.c b/src/process.c
index ab9657b15a4..dbd4358dd1a 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,8 +3431,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3431 break; 3431 break;
3432 } 3432 }
3433 3433
3434 immediate_quit = 1; 3434 immediate_quit = true;
3435 QUIT; 3435 maybe_quit ();
3436 3436
3437 ret = connect (s, sa, addrlen); 3437 ret = connect (s, sa, addrlen);
3438 xerrno = errno; 3438 xerrno = errno;
@@ -3459,7 +3459,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3459 retry_select: 3459 retry_select:
3460 FD_ZERO (&fdset); 3460 FD_ZERO (&fdset);
3461 FD_SET (s, &fdset); 3461 FD_SET (s, &fdset);
3462 QUIT; 3462 maybe_quit ();
3463 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL); 3463 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3464 if (sc == -1) 3464 if (sc == -1)
3465 { 3465 {
@@ -3481,7 +3481,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3481 } 3481 }
3482#endif /* !WINDOWSNT */ 3482#endif /* !WINDOWSNT */
3483 3483
3484 immediate_quit = 0; 3484 immediate_quit = false;
3485 3485
3486 /* Discard the unwind protect closing S. */ 3486 /* Discard the unwind protect closing S. */
3487 specpdl_ptr = specpdl + count; 3487 specpdl_ptr = specpdl + count;
@@ -3539,7 +3539,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3539#endif 3539#endif
3540 } 3540 }
3541 3541
3542 immediate_quit = 0; 3542 immediate_quit = false;
3543 3543
3544 if (s < 0) 3544 if (s < 0)
3545 { 3545 {
@@ -4012,8 +4012,8 @@ usage: (make-network-process &rest ARGS) */)
4012 struct addrinfo *res, *lres; 4012 struct addrinfo *res, *lres;
4013 int ret; 4013 int ret;
4014 4014
4015 immediate_quit = 1; 4015 immediate_quit = true;
4016 QUIT; 4016 maybe_quit ();
4017 4017
4018 struct addrinfo hints; 4018 struct addrinfo hints;
4019 memset (&hints, 0, sizeof hints); 4019 memset (&hints, 0, sizeof hints);
@@ -4034,7 +4034,7 @@ usage: (make-network-process &rest ARGS) */)
4034#else 4034#else
4035 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); 4035 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4036#endif 4036#endif
4037 immediate_quit = 0; 4037 immediate_quit = false;
4038 4038
4039 for (lres = res; lres; lres = lres->ai_next) 4039 for (lres = res; lres; lres = lres->ai_next)
4040 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); 4040 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
@@ -5020,7 +5020,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
5020 since we want to return C-g as an input character. 5020 since we want to return C-g as an input character.
5021 Otherwise, do pending quit if requested. */ 5021 Otherwise, do pending quit if requested. */
5022 if (read_kbd >= 0) 5022 if (read_kbd >= 0)
5023 QUIT; 5023 maybe_quit ();
5024 else if (pending_signals) 5024 else if (pending_signals)
5025 process_pending_signals (); 5025 process_pending_signals ();
5026 5026
@@ -5748,7 +5748,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
5748 { 5748 {
5749 /* Prevent input_pending from remaining set if we quit. */ 5749 /* Prevent input_pending from remaining set if we quit. */
5750 clear_input_pending (); 5750 clear_input_pending ();
5751 QUIT; 5751 maybe_quit ();
5752 } 5752 }
5753 5753
5754 return got_some_output; 5754 return got_some_output;
@@ -7486,7 +7486,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7486 since we want to return C-g as an input character. 7486 since we want to return C-g as an input character.
7487 Otherwise, do pending quit if requested. */ 7487 Otherwise, do pending quit if requested. */
7488 if (read_kbd >= 0) 7488 if (read_kbd >= 0)
7489 QUIT; 7489 maybe_quit ();
7490 7490
7491 /* Exit now if the cell we're waiting for became non-nil. */ 7491 /* Exit now if the cell we're waiting for became non-nil. */
7492 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 7492 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
diff --git a/src/profiler.c b/src/profiler.c
index efc0cb316fc..a223a7e7c07 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -48,7 +48,7 @@ make_log (EMACS_INT heap_size, EMACS_INT max_stack_depth)
48 make_number (heap_size), 48 make_number (heap_size),
49 make_float (DEFAULT_REHASH_SIZE), 49 make_float (DEFAULT_REHASH_SIZE),
50 make_float (DEFAULT_REHASH_THRESHOLD), 50 make_float (DEFAULT_REHASH_THRESHOLD),
51 Qnil); 51 Qnil, Qnil);
52 struct Lisp_Hash_Table *h = XHASH_TABLE (log); 52 struct Lisp_Hash_Table *h = XHASH_TABLE (log);
53 53
54 /* What is special about our hash-tables is that the keys are pre-filled 54 /* What is special about our hash-tables is that the keys are pre-filled
@@ -174,8 +174,8 @@ record_backtrace (log_t *log, EMACS_INT count)
174 some global flag so that some Elisp code can offload its 174 some global flag so that some Elisp code can offload its
175 data elsewhere, so as to avoid the eviction code. 175 data elsewhere, so as to avoid the eviction code.
176 There are 2 ways to do that, AFAICT: 176 There are 2 ways to do that, AFAICT:
177 - Set a flag checked in QUIT, such that QUIT can then call 177 - Set a flag checked in maybe_quit, such that maybe_quit can then
178 Fprofiler_cpu_log and stash the full log for later use. 178 call Fprofiler_cpu_log and stash the full log for later use.
179 - Set a flag check in post-gc-hook, so that Elisp code can call 179 - Set a flag check in post-gc-hook, so that Elisp code can call
180 profiler-cpu-log. That gives us more flexibility since that 180 profiler-cpu-log. That gives us more flexibility since that
181 Elisp code can then do all kinds of fun stuff like write 181 Elisp code can then do all kinds of fun stuff like write
diff --git a/src/regex.c b/src/regex.c
index db3f0c16a2d..f6e67afef4c 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1729,12 +1729,9 @@ typedef struct
1729/* Explicit quit checking is needed for Emacs, which uses polling to 1729/* Explicit quit checking is needed for Emacs, which uses polling to
1730 process input events. */ 1730 process input events. */
1731#ifdef emacs 1731#ifdef emacs
1732# define IMMEDIATE_QUIT_CHECK \ 1732# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0)
1733 do { \
1734 if (immediate_quit) QUIT; \
1735 } while (0)
1736#else 1733#else
1737# define IMMEDIATE_QUIT_CHECK ((void)0) 1734# define IMMEDIATE_QUIT_CHECK ((void) 0)
1738#endif 1735#endif
1739 1736
1740/* Structure to manage work area for range table. */ 1737/* Structure to manage work area for range table. */
diff --git a/src/search.c b/src/search.c
index d3045108705..f54f44c8818 100644
--- a/src/search.c
+++ b/src/search.c
@@ -276,8 +276,9 @@ looking_at_1 (Lisp_Object string, bool posix)
276 posix, 276 posix,
277 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 277 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
278 278
279 immediate_quit = 1; 279 /* Do a pending quit right away, to avoid paradoxical behavior */
280 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ 280 immediate_quit = true;
281 maybe_quit ();
281 282
282 /* Get pointers and sizes of the two strings 283 /* Get pointers and sizes of the two strings
283 that make up the visible portion of the buffer. */ 284 that make up the visible portion of the buffer. */
@@ -310,7 +311,7 @@ looking_at_1 (Lisp_Object string, bool posix)
310 (NILP (Vinhibit_changing_match_data) 311 (NILP (Vinhibit_changing_match_data)
311 ? &search_regs : NULL), 312 ? &search_regs : NULL),
312 ZV_BYTE - BEGV_BYTE); 313 ZV_BYTE - BEGV_BYTE);
313 immediate_quit = 0; 314 immediate_quit = false;
314#ifdef REL_ALLOC 315#ifdef REL_ALLOC
315 r_alloc_inhibit_buffer_relocation (0); 316 r_alloc_inhibit_buffer_relocation (0);
316#endif 317#endif
@@ -398,7 +399,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
398 ? BVAR (current_buffer, case_canon_table) : Qnil), 399 ? BVAR (current_buffer, case_canon_table) : Qnil),
399 posix, 400 posix,
400 STRING_MULTIBYTE (string)); 401 STRING_MULTIBYTE (string));
401 immediate_quit = 1; 402 immediate_quit = true;
402 re_match_object = string; 403 re_match_object = string;
403 404
404 val = re_search (bufp, SSDATA (string), 405 val = re_search (bufp, SSDATA (string),
@@ -406,7 +407,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
406 SBYTES (string) - pos_byte, 407 SBYTES (string) - pos_byte,
407 (NILP (Vinhibit_changing_match_data) 408 (NILP (Vinhibit_changing_match_data)
408 ? &search_regs : NULL)); 409 ? &search_regs : NULL));
409 immediate_quit = 0; 410 immediate_quit = false;
410 411
411 /* Set last_thing_searched only when match data is changed. */ 412 /* Set last_thing_searched only when match data is changed. */
412 if (NILP (Vinhibit_changing_match_data)) 413 if (NILP (Vinhibit_changing_match_data))
@@ -470,13 +471,13 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string,
470 471
471 bufp = compile_pattern (regexp, 0, table, 472 bufp = compile_pattern (regexp, 0, table,
472 0, STRING_MULTIBYTE (string)); 473 0, STRING_MULTIBYTE (string));
473 immediate_quit = 1; 474 immediate_quit = true;
474 re_match_object = string; 475 re_match_object = string;
475 476
476 val = re_search (bufp, SSDATA (string), 477 val = re_search (bufp, SSDATA (string),
477 SBYTES (string), 0, 478 SBYTES (string), 0,
478 SBYTES (string), 0); 479 SBYTES (string), 0);
479 immediate_quit = 0; 480 immediate_quit = false;
480 return val; 481 return val;
481} 482}
482 483
@@ -497,9 +498,9 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
497 bufp = compile_pattern (regexp, 0, 498 bufp = compile_pattern (regexp, 0,
498 Vascii_canon_table, 0, 499 Vascii_canon_table, 0,
499 0); 500 0);
500 immediate_quit = 1; 501 immediate_quit = true;
501 val = re_search (bufp, string, len, 0, len, 0); 502 val = re_search (bufp, string, len, 0, len, 0);
502 immediate_quit = 0; 503 immediate_quit = false;
503 return val; 504 return val;
504} 505}
505 506
@@ -560,7 +561,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
560 } 561 }
561 562
562 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); 563 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
563 immediate_quit = 1; 564 immediate_quit = true;
564#ifdef REL_ALLOC 565#ifdef REL_ALLOC
565 /* Prevent ralloc.c from relocating the current buffer while 566 /* Prevent ralloc.c from relocating the current buffer while
566 searching it. */ 567 searching it. */
@@ -571,7 +572,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
571#ifdef REL_ALLOC 572#ifdef REL_ALLOC
572 r_alloc_inhibit_buffer_relocation (0); 573 r_alloc_inhibit_buffer_relocation (0);
573#endif 574#endif
574 immediate_quit = 0; 575 immediate_quit = false;
575 576
576 return len; 577 return len;
577} 578}
@@ -703,7 +704,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
703 ptrdiff_t next_change; 704 ptrdiff_t next_change;
704 int result = 1; 705 int result = 1;
705 706
706 immediate_quit = 0; 707 immediate_quit = false;
707 while (start < end && result) 708 while (start < end && result)
708 { 709 {
709 ptrdiff_t lim1; 710 ptrdiff_t lim1;
@@ -809,7 +810,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
809 810
810 if (--count == 0) 811 if (--count == 0)
811 { 812 {
812 immediate_quit = 0; 813 immediate_quit = false;
813 if (bytepos) 814 if (bytepos)
814 *bytepos = lim_byte + next; 815 *bytepos = lim_byte + next;
815 return BYTE_TO_CHAR (lim_byte + next); 816 return BYTE_TO_CHAR (lim_byte + next);
@@ -832,7 +833,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
832 ptrdiff_t next_change; 833 ptrdiff_t next_change;
833 int result = 1; 834 int result = 1;
834 835
835 immediate_quit = 0; 836 immediate_quit = false;
836 while (start > end && result) 837 while (start > end && result)
837 { 838 {
838 ptrdiff_t lim1; 839 ptrdiff_t lim1;
@@ -917,7 +918,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
917 918
918 if (++count >= 0) 919 if (++count >= 0)
919 { 920 {
920 immediate_quit = 0; 921 immediate_quit = false;
921 if (bytepos) 922 if (bytepos)
922 *bytepos = ceiling_byte + prev + 1; 923 *bytepos = ceiling_byte + prev + 1;
923 return BYTE_TO_CHAR (ceiling_byte + prev + 1); 924 return BYTE_TO_CHAR (ceiling_byte + prev + 1);
@@ -929,7 +930,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
929 } 930 }
930 } 931 }
931 932
932 immediate_quit = 0; 933 immediate_quit = false;
933 if (shortage) 934 if (shortage)
934 *shortage = count * direction; 935 *shortage = count * direction;
935 if (bytepos) 936 if (bytepos)
@@ -1196,10 +1197,10 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1196 trt, posix, 1197 trt, posix,
1197 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 1198 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
1198 1199
1199 immediate_quit = 1; /* Quit immediately if user types ^G, 1200 immediate_quit = true; /* Quit immediately if user types ^G,
1200 because letting this function finish 1201 because letting this function finish
1201 can take too long. */ 1202 can take too long. */
1202 QUIT; /* Do a pending quit right away, 1203 maybe_quit (); /* Do a pending quit right away,
1203 to avoid paradoxical behavior */ 1204 to avoid paradoxical behavior */
1204 /* Get pointers and sizes of the two strings 1205 /* Get pointers and sizes of the two strings
1205 that make up the visible portion of the buffer. */ 1206 that make up the visible portion of the buffer. */
@@ -1267,7 +1268,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1267 } 1268 }
1268 else 1269 else
1269 { 1270 {
1270 immediate_quit = 0; 1271 immediate_quit = false;
1271#ifdef REL_ALLOC 1272#ifdef REL_ALLOC
1272 r_alloc_inhibit_buffer_relocation (0); 1273 r_alloc_inhibit_buffer_relocation (0);
1273#endif 1274#endif
@@ -1312,7 +1313,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1312 } 1313 }
1313 else 1314 else
1314 { 1315 {
1315 immediate_quit = 0; 1316 immediate_quit = false;
1316#ifdef REL_ALLOC 1317#ifdef REL_ALLOC
1317 r_alloc_inhibit_buffer_relocation (0); 1318 r_alloc_inhibit_buffer_relocation (0);
1318#endif 1319#endif
@@ -1320,7 +1321,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1320 } 1321 }
1321 n--; 1322 n--;
1322 } 1323 }
1323 immediate_quit = 0; 1324 immediate_quit = false;
1324#ifdef REL_ALLOC 1325#ifdef REL_ALLOC
1325 r_alloc_inhibit_buffer_relocation (0); 1326 r_alloc_inhibit_buffer_relocation (0);
1326#endif 1327#endif
@@ -1927,7 +1928,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
1927 < 0) 1928 < 0)
1928 return (n * (0 - direction)); 1929 return (n * (0 - direction));
1929 /* First we do the part we can by pointers (maybe nothing) */ 1930 /* First we do the part we can by pointers (maybe nothing) */
1930 QUIT; 1931 maybe_quit ();
1931 pat = base_pat; 1932 pat = base_pat;
1932 limit = pos_byte - dirlen + direction; 1933 limit = pos_byte - dirlen + direction;
1933 if (direction > 0) 1934 if (direction > 0)
@@ -3274,7 +3275,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3274 3275
3275 if (--count == 0) 3276 if (--count == 0)
3276 { 3277 {
3277 immediate_quit = 0; 3278 immediate_quit = false;
3278 if (bytepos) 3279 if (bytepos)
3279 *bytepos = lim_byte + next; 3280 *bytepos = lim_byte + next;
3280 return BYTE_TO_CHAR (lim_byte + next); 3281 return BYTE_TO_CHAR (lim_byte + next);
@@ -3286,7 +3287,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3286 } 3287 }
3287 } 3288 }
3288 3289
3289 immediate_quit = 0; 3290 immediate_quit = false;
3290 if (shortage) 3291 if (shortage)
3291 *shortage = count; 3292 *shortage = count;
3292 if (bytepos) 3293 if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index 84147a2dc15..f9e4093765c 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1426,8 +1426,8 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1426 int ch0, ch1; 1426 int ch0, ch1;
1427 Lisp_Object func, pos; 1427 Lisp_Object func, pos;
1428 1428
1429 immediate_quit = 1; 1429 immediate_quit = true;
1430 QUIT; 1430 maybe_quit ();
1431 1431
1432 SETUP_SYNTAX_TABLE (from, count); 1432 SETUP_SYNTAX_TABLE (from, count);
1433 1433
@@ -1437,7 +1437,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1437 { 1437 {
1438 if (from == end) 1438 if (from == end)
1439 { 1439 {
1440 immediate_quit = 0; 1440 immediate_quit = false;
1441 return 0; 1441 return 0;
1442 } 1442 }
1443 UPDATE_SYNTAX_TABLE_FORWARD (from); 1443 UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -1487,7 +1487,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1487 { 1487 {
1488 if (from == beg) 1488 if (from == beg)
1489 { 1489 {
1490 immediate_quit = 0; 1490 immediate_quit = false;
1491 return 0; 1491 return 0;
1492 } 1492 }
1493 DEC_BOTH (from, from_byte); 1493 DEC_BOTH (from, from_byte);
@@ -1536,7 +1536,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1536 count++; 1536 count++;
1537 } 1537 }
1538 1538
1539 immediate_quit = 0; 1539 immediate_quit = false;
1540 1540
1541 return from; 1541 return from;
1542} 1542}
@@ -1921,7 +1921,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1921 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; 1921 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
1922 } 1922 }
1923 1923
1924 immediate_quit = 1; 1924 immediate_quit = true;
1925 /* This code may look up syntax tables using functions that rely on the 1925 /* This code may look up syntax tables using functions that rely on the
1926 gl_state object. To make sure this object is not out of date, 1926 gl_state object. To make sure this object is not out of date,
1927 let's initialize it manually. 1927 let's initialize it manually.
@@ -2064,7 +2064,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2064 } 2064 }
2065 2065
2066 SET_PT_BOTH (pos, pos_byte); 2066 SET_PT_BOTH (pos, pos_byte);
2067 immediate_quit = 0; 2067 immediate_quit = false;
2068 2068
2069 SAFE_FREE (); 2069 SAFE_FREE ();
2070 return make_number (PT - start_point); 2070 return make_number (PT - start_point);
@@ -2138,7 +2138,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2138 ptrdiff_t pos_byte = PT_BYTE; 2138 ptrdiff_t pos_byte = PT_BYTE;
2139 unsigned char *p, *endp, *stop; 2139 unsigned char *p, *endp, *stop;
2140 2140
2141 immediate_quit = 1; 2141 immediate_quit = true;
2142 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); 2142 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
2143 2143
2144 if (forwardp) 2144 if (forwardp)
@@ -2224,7 +2224,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2224 2224
2225 done: 2225 done:
2226 SET_PT_BOTH (pos, pos_byte); 2226 SET_PT_BOTH (pos, pos_byte);
2227 immediate_quit = 0; 2227 immediate_quit = false;
2228 2228
2229 return make_number (PT - start_point); 2229 return make_number (PT - start_point);
2230 } 2230 }
@@ -2412,8 +2412,8 @@ between them, return t; otherwise return nil. */)
2412 count1 = XINT (count); 2412 count1 = XINT (count);
2413 stop = count1 > 0 ? ZV : BEGV; 2413 stop = count1 > 0 ? ZV : BEGV;
2414 2414
2415 immediate_quit = 1; 2415 immediate_quit = true;
2416 QUIT; 2416 maybe_quit ();
2417 2417
2418 from = PT; 2418 from = PT;
2419 from_byte = PT_BYTE; 2419 from_byte = PT_BYTE;
@@ -2429,7 +2429,7 @@ between them, return t; otherwise return nil. */)
2429 if (from == stop) 2429 if (from == stop)
2430 { 2430 {
2431 SET_PT_BOTH (from, from_byte); 2431 SET_PT_BOTH (from, from_byte);
2432 immediate_quit = 0; 2432 immediate_quit = false;
2433 return Qnil; 2433 return Qnil;
2434 } 2434 }
2435 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2435 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2463,7 +2463,7 @@ between them, return t; otherwise return nil. */)
2463 comstyle = ST_COMMENT_STYLE; 2463 comstyle = ST_COMMENT_STYLE;
2464 else if (code != Scomment) 2464 else if (code != Scomment)
2465 { 2465 {
2466 immediate_quit = 0; 2466 immediate_quit = false;
2467 DEC_BOTH (from, from_byte); 2467 DEC_BOTH (from, from_byte);
2468 SET_PT_BOTH (from, from_byte); 2468 SET_PT_BOTH (from, from_byte);
2469 return Qnil; 2469 return Qnil;
@@ -2474,7 +2474,7 @@ between them, return t; otherwise return nil. */)
2474 from = out_charpos; from_byte = out_bytepos; 2474 from = out_charpos; from_byte = out_bytepos;
2475 if (!found) 2475 if (!found)
2476 { 2476 {
2477 immediate_quit = 0; 2477 immediate_quit = false;
2478 SET_PT_BOTH (from, from_byte); 2478 SET_PT_BOTH (from, from_byte);
2479 return Qnil; 2479 return Qnil;
2480 } 2480 }
@@ -2494,7 +2494,7 @@ between them, return t; otherwise return nil. */)
2494 if (from <= stop) 2494 if (from <= stop)
2495 { 2495 {
2496 SET_PT_BOTH (BEGV, BEGV_BYTE); 2496 SET_PT_BOTH (BEGV, BEGV_BYTE);
2497 immediate_quit = 0; 2497 immediate_quit = false;
2498 return Qnil; 2498 return Qnil;
2499 } 2499 }
2500 2500
@@ -2587,7 +2587,7 @@ between them, return t; otherwise return nil. */)
2587 else if (code != Swhitespace || quoted) 2587 else if (code != Swhitespace || quoted)
2588 { 2588 {
2589 leave: 2589 leave:
2590 immediate_quit = 0; 2590 immediate_quit = false;
2591 INC_BOTH (from, from_byte); 2591 INC_BOTH (from, from_byte);
2592 SET_PT_BOTH (from, from_byte); 2592 SET_PT_BOTH (from, from_byte);
2593 return Qnil; 2593 return Qnil;
@@ -2598,7 +2598,7 @@ between them, return t; otherwise return nil. */)
2598 } 2598 }
2599 2599
2600 SET_PT_BOTH (from, from_byte); 2600 SET_PT_BOTH (from, from_byte);
2601 immediate_quit = 0; 2601 immediate_quit = false;
2602 return Qt; 2602 return Qt;
2603} 2603}
2604 2604
@@ -2640,8 +2640,8 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2640 2640
2641 from_byte = CHAR_TO_BYTE (from); 2641 from_byte = CHAR_TO_BYTE (from);
2642 2642
2643 immediate_quit = 1; 2643 immediate_quit = true;
2644 QUIT; 2644 maybe_quit ();
2645 2645
2646 SETUP_SYNTAX_TABLE (from, count); 2646 SETUP_SYNTAX_TABLE (from, count);
2647 while (count > 0) 2647 while (count > 0)
@@ -2801,7 +2801,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2801 if (depth) 2801 if (depth)
2802 goto lose; 2802 goto lose;
2803 2803
2804 immediate_quit = 0; 2804 immediate_quit = false;
2805 return Qnil; 2805 return Qnil;
2806 2806
2807 /* End of object reached */ 2807 /* End of object reached */
@@ -2984,7 +2984,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2984 if (depth) 2984 if (depth)
2985 goto lose; 2985 goto lose;
2986 2986
2987 immediate_quit = 0; 2987 immediate_quit = false;
2988 return Qnil; 2988 return Qnil;
2989 2989
2990 done2: 2990 done2:
@@ -2992,7 +2992,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2992 } 2992 }
2993 2993
2994 2994
2995 immediate_quit = 0; 2995 immediate_quit = false;
2996 XSETFASTINT (val, from); 2996 XSETFASTINT (val, from);
2997 return val; 2997 return val;
2998 2998
@@ -3092,6 +3092,36 @@ the prefix syntax flag (p). */)
3092 return Qnil; 3092 return Qnil;
3093} 3093}
3094 3094
3095
3096/* If the character at FROM_BYTE is the second part of a 2-character
3097 comment opener based on PREV_FROM_SYNTAX, update STATE and return
3098 true. */
3099static bool
3100in_2char_comment_start (struct lisp_parse_state *state,
3101 int prev_from_syntax,
3102 ptrdiff_t prev_from,
3103 ptrdiff_t from_byte)
3104{
3105 int c1, syntax;
3106 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3107 && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
3108 syntax = SYNTAX_WITH_FLAGS (c1),
3109 SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
3110 {
3111 /* Record the comment style we have entered so that only
3112 the comment-end sequence of the same style actually
3113 terminates the comment section. */
3114 state->comstyle
3115 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3116 bool comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3117 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3118 state->incomment = comnested ? 1 : -1;
3119 state->comstr_start = prev_from;
3120 return true;
3121 }
3122 return false;
3123}
3124
3095/* Parse forward from FROM / FROM_BYTE to END, 3125/* Parse forward from FROM / FROM_BYTE to END,
3096 assuming that FROM has state STATE, 3126 assuming that FROM has state STATE,
3097 and return a description of the state of the parse at END. 3127 and return a description of the state of the parse at END.
@@ -3107,8 +3137,6 @@ scan_sexps_forward (struct lisp_parse_state *state,
3107 int commentstop) 3137 int commentstop)
3108{ 3138{
3109 enum syntaxcode code; 3139 enum syntaxcode code;
3110 int c1;
3111 bool comnested;
3112 struct level { ptrdiff_t last, prev; }; 3140 struct level { ptrdiff_t last, prev; };
3113 struct level levelstart[100]; 3141 struct level levelstart[100];
3114 struct level *curlevel = levelstart; 3142 struct level *curlevel = levelstart;
@@ -3122,7 +3150,6 @@ scan_sexps_forward (struct lisp_parse_state *state,
3122 ptrdiff_t prev_from; /* Keep one character before FROM. */ 3150 ptrdiff_t prev_from; /* Keep one character before FROM. */
3123 ptrdiff_t prev_from_byte; 3151 ptrdiff_t prev_from_byte;
3124 int prev_from_syntax, prev_prev_from_syntax; 3152 int prev_from_syntax, prev_prev_from_syntax;
3125 int syntax;
3126 bool boundary_stop = commentstop == -1; 3153 bool boundary_stop = commentstop == -1;
3127 bool nofence; 3154 bool nofence;
3128 bool found; 3155 bool found;
@@ -3146,8 +3173,8 @@ do { prev_from = from; \
3146 UPDATE_SYNTAX_TABLE_FORWARD (from); \ 3173 UPDATE_SYNTAX_TABLE_FORWARD (from); \
3147 } while (0) 3174 } while (0)
3148 3175
3149 immediate_quit = 1; 3176 immediate_quit = true;
3150 QUIT; 3177 maybe_quit ();
3151 3178
3152 depth = state->depth; 3179 depth = state->depth;
3153 start_quoted = state->quoted; 3180 start_quoted = state->quoted;
@@ -3187,53 +3214,31 @@ do { prev_from = from; \
3187 } 3214 }
3188 else if (start_quoted) 3215 else if (start_quoted)
3189 goto startquoted; 3216 goto startquoted;
3217 else if ((from < end)
3218 && (in_2char_comment_start (state, prev_from_syntax,
3219 prev_from, from_byte)))
3220 {
3221 INC_FROM;
3222 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3223 goto atcomment;
3224 }
3190 3225
3191 while (from < end) 3226 while (from < end)
3192 { 3227 {
3193 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) 3228 INC_FROM;
3194 && (c1 = FETCH_CHAR (from_byte), 3229
3195 syntax = SYNTAX_WITH_FLAGS (c1), 3230 if ((from < end)
3196 SYNTAX_FLAGS_COMSTART_SECOND (syntax))) 3231 && (in_2char_comment_start (state, prev_from_syntax,
3197 { 3232 prev_from, from_byte)))
3198 /* Record the comment style we have entered so that only
3199 the comment-end sequence of the same style actually
3200 terminates the comment section. */
3201 state->comstyle
3202 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3203 comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3204 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3205 state->incomment = comnested ? 1 : -1;
3206 state->comstr_start = prev_from;
3207 INC_FROM;
3208 prev_from_syntax = Smax; /* the syntax has already been
3209 "used up". */
3210 code = Scomment;
3211 }
3212 else
3213 { 3233 {
3214 INC_FROM; 3234 INC_FROM;
3215 code = prev_from_syntax & 0xff; 3235 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3216 if (code == Scomment_fence) 3236 goto atcomment;
3217 {
3218 /* Record the comment style we have entered so that only
3219 the comment-end sequence of the same style actually
3220 terminates the comment section. */
3221 state->comstyle = ST_COMMENT_STYLE;
3222 state->incomment = -1;
3223 state->comstr_start = prev_from;
3224 code = Scomment;
3225 }
3226 else if (code == Scomment)
3227 {
3228 state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
3229 state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3230 1 : -1);
3231 state->comstr_start = prev_from;
3232 }
3233 } 3237 }
3234 3238
3235 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) 3239 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
3236 continue; 3240 continue;
3241 code = prev_from_syntax & 0xff;
3237 switch (code) 3242 switch (code)
3238 { 3243 {
3239 case Sescape: 3244 case Sescape:
@@ -3252,24 +3257,15 @@ do { prev_from = from; \
3252 symstarted: 3257 symstarted:
3253 while (from < end) 3258 while (from < end)
3254 { 3259 {
3255 int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); 3260 if (in_2char_comment_start (state, prev_from_syntax,
3256 3261 prev_from, from_byte))
3257 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3258 && (syntax = SYNTAX_WITH_FLAGS (symchar),
3259 SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
3260 { 3262 {
3261 state->comstyle
3262 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3263 comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3264 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3265 state->incomment = comnested ? 1 : -1;
3266 state->comstr_start = prev_from;
3267 INC_FROM; 3263 INC_FROM;
3268 prev_from_syntax = Smax; 3264 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3269 code = Scomment;
3270 goto atcomment; 3265 goto atcomment;
3271 } 3266 }
3272 3267
3268 int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte);
3273 switch (SYNTAX (symchar)) 3269 switch (SYNTAX (symchar))
3274 { 3270 {
3275 case Scharquote: 3271 case Scharquote:
@@ -3290,8 +3286,19 @@ do { prev_from = from; \
3290 curlevel->prev = curlevel->last; 3286 curlevel->prev = curlevel->last;
3291 break; 3287 break;
3292 3288
3293 case Scomment_fence: /* Can't happen because it's handled above. */ 3289 case Scomment_fence:
3290 /* Record the comment style we have entered so that only
3291 the comment-end sequence of the same style actually
3292 terminates the comment section. */
3293 state->comstyle = ST_COMMENT_STYLE;
3294 state->incomment = -1;
3295 state->comstr_start = prev_from;
3296 goto atcomment;
3294 case Scomment: 3297 case Scomment:
3298 state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
3299 state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3300 1 : -1);
3301 state->comstr_start = prev_from;
3295 atcomment: 3302 atcomment:
3296 if (commentstop || boundary_stop) goto done; 3303 if (commentstop || boundary_stop) goto done;
3297 startincomment: 3304 startincomment:
@@ -3425,7 +3432,7 @@ do { prev_from = from; \
3425 state->levelstarts); 3432 state->levelstarts);
3426 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) 3433 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
3427 || state->quoted) ? prev_from_syntax : Smax; 3434 || state->quoted) ? prev_from_syntax : Smax;
3428 immediate_quit = 0; 3435 immediate_quit = false;
3429} 3436}
3430 3437
3431/* Convert a (lisp) parse state to the internal form used in 3438/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/sysdep.c b/src/sysdep.c
index 4316c21a1c7..e172dc0aed4 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -391,10 +391,10 @@ get_child_status (pid_t child, int *status, int options, bool interruptible)
391 if (errno != EINTR) 391 if (errno != EINTR)
392 emacs_abort (); 392 emacs_abort ();
393 393
394 /* Note: the MS-Windows emulation of waitpid calls QUIT 394 /* Note: the MS-Windows emulation of waitpid calls maybe_quit
395 internally. */ 395 internally. */
396 if (interruptible) 396 if (interruptible)
397 QUIT; 397 maybe_quit ();
398 } 398 }
399 399
400 /* If successful and status is requested, tell wait_reading_process_output 400 /* If successful and status is requested, tell wait_reading_process_output
@@ -2383,7 +2383,7 @@ emacs_open (const char *file, int oflags, int mode)
2383 oflags |= O_BINARY; 2383 oflags |= O_BINARY;
2384 oflags |= O_CLOEXEC; 2384 oflags |= O_CLOEXEC;
2385 while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) 2385 while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR)
2386 QUIT; 2386 maybe_quit ();
2387 if (! O_CLOEXEC && 0 <= fd) 2387 if (! O_CLOEXEC && 0 <= fd)
2388 fcntl (fd, F_SETFD, FD_CLOEXEC); 2388 fcntl (fd, F_SETFD, FD_CLOEXEC);
2389 return fd; 2389 return fd;
@@ -2516,7 +2516,7 @@ emacs_read (int fildes, void *buf, ptrdiff_t nbyte)
2516 2516
2517 while ((rtnval = read (fildes, buf, nbyte)) == -1 2517 while ((rtnval = read (fildes, buf, nbyte)) == -1
2518 && (errno == EINTR)) 2518 && (errno == EINTR))
2519 QUIT; 2519 maybe_quit ();
2520 return (rtnval); 2520 return (rtnval);
2521} 2521}
2522 2522
@@ -2538,7 +2538,7 @@ emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte,
2538 { 2538 {
2539 if (errno == EINTR) 2539 if (errno == EINTR)
2540 { 2540 {
2541 /* I originally used `QUIT' but that might cause files to 2541 /* I originally used maybe_quit but that might cause files to
2542 be truncated if you hit C-g in the middle of it. --Stef */ 2542 be truncated if you hit C-g in the middle of it. --Stef */
2543 if (process_signals && pending_signals) 2543 if (process_signals && pending_signals)
2544 process_pending_signals (); 2544 process_pending_signals ();
diff --git a/src/textprop.c b/src/textprop.c
index 7cb3d3c38e6..225ff28e57e 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -211,7 +211,7 @@ validate_plist (Lisp_Object list)
211 if (! CONSP (tail)) 211 if (! CONSP (tail))
212 error ("Odd length text property list"); 212 error ("Odd length text property list");
213 tail = XCDR (tail); 213 tail = XCDR (tail);
214 QUIT; 214 maybe_quit ();
215 } 215 }
216 while (CONSP (tail)); 216 while (CONSP (tail));
217 217
diff --git a/src/thread.c b/src/thread.c
index 5498fe5efcb..9ea7e121a82 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -128,11 +128,11 @@ lisp_mutex_init (lisp_mutex_t *mutex)
128 sys_cond_init (&mutex->condition); 128 sys_cond_init (&mutex->condition);
129} 129}
130 130
131/* Lock MUTEX setting its count to COUNT, if non-zero, or to 1 131/* Lock MUTEX for thread LOCKER, setting its lock count to COUNT, if
132 otherwise. 132 non-zero, or to 1 otherwise.
133 133
134 If MUTEX is locked by the current thread, COUNT must be zero, and 134 If MUTEX is locked by LOCKER, COUNT must be zero, and the MUTEX's
135 the MUTEX's lock count will be incremented. 135 lock count will be incremented.
136 136
137 If MUTEX is locked by another thread, this function will release 137 If MUTEX is locked by another thread, this function will release
138 the global lock, giving other threads a chance to run, and will 138 the global lock, giving other threads a chance to run, and will
@@ -143,24 +143,25 @@ lisp_mutex_init (lisp_mutex_t *mutex)
143 unlocked (meaning other threads could have run during the wait), 143 unlocked (meaning other threads could have run during the wait),
144 zero otherwise. */ 144 zero otherwise. */
145static int 145static int
146lisp_mutex_lock (lisp_mutex_t *mutex, int new_count) 146lisp_mutex_lock_for_thread (lisp_mutex_t *mutex, struct thread_state *locker,
147 int new_count)
147{ 148{
148 struct thread_state *self; 149 struct thread_state *self;
149 150
150 if (mutex->owner == NULL) 151 if (mutex->owner == NULL)
151 { 152 {
152 mutex->owner = current_thread; 153 mutex->owner = locker;
153 mutex->count = new_count == 0 ? 1 : new_count; 154 mutex->count = new_count == 0 ? 1 : new_count;
154 return 0; 155 return 0;
155 } 156 }
156 if (mutex->owner == current_thread) 157 if (mutex->owner == locker)
157 { 158 {
158 eassert (new_count == 0); 159 eassert (new_count == 0);
159 ++mutex->count; 160 ++mutex->count;
160 return 0; 161 return 0;
161 } 162 }
162 163
163 self = current_thread; 164 self = locker;
164 self->wait_condvar = &mutex->condition; 165 self->wait_condvar = &mutex->condition;
165 while (mutex->owner != NULL && (new_count != 0 166 while (mutex->owner != NULL && (new_count != 0
166 || NILP (self->error_symbol))) 167 || NILP (self->error_symbol)))
@@ -176,6 +177,12 @@ lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
176 return 1; 177 return 1;
177} 178}
178 179
180static int
181lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
182{
183 return lisp_mutex_lock_for_thread (mutex, current_thread, new_count);
184}
185
179/* Decrement MUTEX's lock count. If the lock count becomes zero after 186/* Decrement MUTEX's lock count. If the lock count becomes zero after
180 decrementing it, meaning the mutex is now unlocked, broadcast that 187 decrementing it, meaning the mutex is now unlocked, broadcast that
181 to all the threads that might be waiting to lock the mutex. This 188 to all the threads that might be waiting to lock the mutex. This
@@ -398,16 +405,16 @@ condition_wait_callback (void *arg)
398 self->wait_condvar = NULL; 405 self->wait_condvar = NULL;
399 } 406 }
400 self->event_object = Qnil; 407 self->event_object = Qnil;
401 /* Since sys_cond_wait could switch threads, we need to re-establish 408 /* Since sys_cond_wait could switch threads, we need to lock the
402 ourselves as the current thread, otherwise lisp_mutex_lock will 409 mutex for the thread which was the current when we were called,
403 record the wrong thread as the owner of the mutex lock. */ 410 otherwise lisp_mutex_lock will record the wrong thread as the
404 post_acquire_global_lock (self); 411 owner of the mutex lock. */
405 /* Calling lisp_mutex_lock might yield to other threads while this 412 lisp_mutex_lock_for_thread (&mutex->mutex, self, saved_count);
406 one waits for the mutex to become unlocked, so we need to 413 /* Calling lisp_mutex_lock_for_thread might yield to other threads
407 announce us as the current thread by calling 414 while this one waits for the mutex to become unlocked, so we need
415 to announce us as the current thread by calling
408 post_acquire_global_lock. */ 416 post_acquire_global_lock. */
409 if (lisp_mutex_lock (&mutex->mutex, saved_count)) 417 post_acquire_global_lock (self);
410 post_acquire_global_lock (self);
411} 418}
412 419
413DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0, 420DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0,
@@ -663,10 +670,13 @@ invoke_thread_function (void)
663 return unbind_to (count, Qnil); 670 return unbind_to (count, Qnil);
664} 671}
665 672
673static Lisp_Object last_thread_error;
674
666static Lisp_Object 675static Lisp_Object
667do_nothing (Lisp_Object whatever) 676record_thread_error (Lisp_Object error_form)
668{ 677{
669 return whatever; 678 last_thread_error = error_form;
679 return error_form;
670} 680}
671 681
672static void * 682static void *
@@ -695,7 +705,7 @@ run_thread (void *state)
695 handlerlist_sentinel->next = NULL; 705 handlerlist_sentinel->next = NULL;
696 706
697 /* It might be nice to do something with errors here. */ 707 /* It might be nice to do something with errors here. */
698 internal_condition_case (invoke_thread_function, Qt, do_nothing); 708 internal_condition_case (invoke_thread_function, Qt, record_thread_error);
699 709
700 update_processes_for_thread_death (Fcurrent_thread ()); 710 update_processes_for_thread_death (Fcurrent_thread ());
701 711
@@ -944,6 +954,13 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
944 return result; 954 return result;
945} 955}
946 956
957DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0,
958 doc: /* Return the last error form recorded by a dying thread. */)
959 (void)
960{
961 return last_thread_error;
962}
963
947 964
948 965
949bool 966bool
@@ -1028,6 +1045,10 @@ syms_of_threads (void)
1028 defsubr (&Scondition_notify); 1045 defsubr (&Scondition_notify);
1029 defsubr (&Scondition_mutex); 1046 defsubr (&Scondition_mutex);
1030 defsubr (&Scondition_name); 1047 defsubr (&Scondition_name);
1048 defsubr (&Sthread_last_error);
1049
1050 staticpro (&last_thread_error);
1051 last_thread_error = Qnil;
1031 } 1052 }
1032 1053
1033 DEFSYM (Qthreadp, "threadp"); 1054 DEFSYM (Qthreadp, "threadp");
diff --git a/src/w32fns.c b/src/w32fns.c
index c24fce11fc8..6a576fcec27 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -778,7 +778,7 @@ w32_color_map_lookup (const char *colorname)
778 break; 778 break;
779 } 779 }
780 780
781 QUIT; 781 maybe_quit ();
782 } 782 }
783 783
784 unblock_input (); 784 unblock_input ();
@@ -3166,7 +3166,7 @@ signal_user_input (void)
3166 if (!NILP (Vthrow_on_input)) 3166 if (!NILP (Vthrow_on_input))
3167 { 3167 {
3168 Vquit_flag = Vthrow_on_input; 3168 Vquit_flag = Vthrow_on_input;
3169 /* Doing a QUIT from this thread is a bad idea, since this 3169 /* Calling maybe_quit from this thread is a bad idea, since this
3170 unwinds the stack of the Lisp thread, and the Windows runtime 3170 unwinds the stack of the Lisp thread, and the Windows runtime
3171 rightfully barfs. Disabled. */ 3171 rightfully barfs. Disabled. */
3172#if 0 3172#if 0
@@ -3174,8 +3174,8 @@ signal_user_input (void)
3174 do it now. */ 3174 do it now. */
3175 if (immediate_quit && NILP (Vinhibit_quit)) 3175 if (immediate_quit && NILP (Vinhibit_quit))
3176 { 3176 {
3177 immediate_quit = 0; 3177 immediate_quit = false;
3178 QUIT; 3178 maybe_quit ();
3179 } 3179 }
3180#endif 3180#endif
3181 } 3181 }
diff --git a/src/w32notify.c b/src/w32notify.c
index 1f4cbe2df47..25205816bae 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -664,7 +664,7 @@ w32_get_watch_object (void *desc)
664 Lisp_Object descriptor = make_pointer_integer (desc); 664 Lisp_Object descriptor = make_pointer_integer (desc);
665 665
666 /* This is called from the input queue handling code, inside a 666 /* This is called from the input queue handling code, inside a
667 critical section, so we cannot possibly QUIT if watch_list is not 667 critical section, so we cannot possibly quit if watch_list is not
668 in the right condition. */ 668 in the right condition. */
669 return NILP (watch_list) ? Qnil : assoc_no_quit (descriptor, watch_list); 669 return NILP (watch_list) ? Qnil : assoc_no_quit (descriptor, watch_list);
670} 670}
diff --git a/src/w32proc.c b/src/w32proc.c
index a7f2b4a9950..0aa248a6f7b 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1449,7 +1449,7 @@ waitpid (pid_t pid, int *status, int options)
1449 1449
1450 do 1450 do
1451 { 1451 {
1452 QUIT; 1452 maybe_quit ();
1453 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); 1453 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
1454 } while (active == WAIT_TIMEOUT && !dont_wait); 1454 } while (active == WAIT_TIMEOUT && !dont_wait);
1455 1455
diff --git a/src/window.c b/src/window.c
index 0a6b94d4d1d..71a82b522c4 100644
--- a/src/window.c
+++ b/src/window.c
@@ -521,9 +521,10 @@ select_window (Lisp_Object window, Lisp_Object norecord,
521 bset_last_selected_window (XBUFFER (w->contents), window); 521 bset_last_selected_window (XBUFFER (w->contents), window);
522 522
523 record_and_return: 523 record_and_return:
524 /* record_buffer can run QUIT, so make sure it is run only after we have 524 /* record_buffer can call maybe_quit, so make sure it is run only
525 re-established the invariant between selected_window and selected_frame, 525 after we have re-established the invariant between
526 otherwise the temporary broken invariant might "escape" (bug#14161). */ 526 selected_window and selected_frame, otherwise the temporary
527 broken invariant might "escape" (Bug#14161). */
527 if (NILP (norecord)) 528 if (NILP (norecord))
528 { 529 {
529 w->use_time = ++window_select_count; 530 w->use_time = ++window_select_count;
diff --git a/src/xdisp.c b/src/xdisp.c
index 168922ef06b..33661c882cd 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -22635,7 +22635,7 @@ move_elt_to_front (Lisp_Object elt, Lisp_Object list)
22635 else 22635 else
22636 prev = tail; 22636 prev = tail;
22637 tail = XCDR (tail); 22637 tail = XCDR (tail);
22638 QUIT; 22638 maybe_quit ();
22639 } 22639 }
22640 22640
22641 /* Not found--return unchanged LIST. */ 22641 /* Not found--return unchanged LIST. */
diff --git a/src/xselect.c b/src/xselect.c
index 47ccf6886bf..2249828fb4e 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -329,7 +329,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
329 Fcons (selection_data, dpyinfo->terminal->Vselection_alist)); 329 Fcons (selection_data, dpyinfo->terminal->Vselection_alist));
330 330
331 /* If we already owned the selection, remove the old selection 331 /* If we already owned the selection, remove the old selection
332 data. Don't use Fdelq as that may QUIT. */ 332 data. Don't use Fdelq as that may quit. */
333 if (!NILP (prev_value)) 333 if (!NILP (prev_value))
334 { 334 {
335 /* We know it's not the CAR, so it's easy. */ 335 /* We know it's not the CAR, so it's easy. */
@@ -929,7 +929,7 @@ x_handle_selection_clear (struct selection_input_event *event)
929 && local_selection_time > changed_owner_time) 929 && local_selection_time > changed_owner_time)
930 return; 930 return;
931 931
932 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */ 932 /* Otherwise, really clear. Don't use Fdelq as that may quit. */
933 Vselection_alist = dpyinfo->terminal->Vselection_alist; 933 Vselection_alist = dpyinfo->terminal->Vselection_alist;
934 if (EQ (local_selection_data, CAR (Vselection_alist))) 934 if (EQ (local_selection_data, CAR (Vselection_alist)))
935 Vselection_alist = XCDR (Vselection_alist); 935 Vselection_alist = XCDR (Vselection_alist);
diff --git a/src/xterm.c b/src/xterm.c
index adc02e2768d..38229a5f31f 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -635,7 +635,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type)
635 (*surface_set_size_func) (surface, width, height); 635 (*surface_set_size_func) (surface, width, height);
636 636
637 unblock_input (); 637 unblock_input ();
638 QUIT; 638 maybe_quit ();
639 block_input (); 639 block_input ();
640 } 640 }
641 641
@@ -10993,19 +10993,12 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg,
10993 10993
10994/* Change of visibility. */ 10994/* Change of visibility. */
10995 10995
10996/* This tries to wait until the frame is really visible. 10996/* This function sends the request to make the frame visible, but may
10997 However, if the window manager asks the user where to position 10997 return before it the frame's visibility is changed. */
10998 the frame, this will return before the user finishes doing that.
10999 The frame will not actually be visible at that time,
11000 but it will become visible later when the window manager
11001 finishes with it. */
11002 10998
11003void 10999void
11004x_make_frame_visible (struct frame *f) 11000x_make_frame_visible (struct frame *f)
11005{ 11001{
11006 int original_top, original_left;
11007 int tries = 0;
11008
11009 block_input (); 11002 block_input ();
11010 11003
11011 x_set_bitmap_icon (f); 11004 x_set_bitmap_icon (f);
@@ -11052,16 +11045,13 @@ x_make_frame_visible (struct frame *f)
11052 before we do anything else. We do this loop with input not blocked 11045 before we do anything else. We do this loop with input not blocked
11053 so that incoming events are handled. */ 11046 so that incoming events are handled. */
11054 { 11047 {
11055 Lisp_Object frame;
11056 /* This must be before UNBLOCK_INPUT 11048 /* This must be before UNBLOCK_INPUT
11057 since events that arrive in response to the actions above 11049 since events that arrive in response to the actions above
11058 will set it when they are handled. */ 11050 will set it when they are handled. */
11059 bool previously_visible = f->output_data.x->has_been_visible; 11051 bool previously_visible = f->output_data.x->has_been_visible;
11060 11052
11061 XSETFRAME (frame, f); 11053 int original_left = f->left_pos;
11062 11054 int original_top = f->top_pos;
11063 original_left = f->left_pos;
11064 original_top = f->top_pos;
11065 11055
11066 /* This must come after we set COUNT. */ 11056 /* This must come after we set COUNT. */
11067 unblock_input (); 11057 unblock_input ();
@@ -11105,46 +11095,6 @@ x_make_frame_visible (struct frame *f)
11105 11095
11106 unblock_input (); 11096 unblock_input ();
11107 } 11097 }
11108
11109 /* Process X events until a MapNotify event has been seen. */
11110 while (!FRAME_VISIBLE_P (f))
11111 {
11112 /* Force processing of queued events. */
11113 x_sync (f);
11114
11115 /* If on another desktop, the deiconify/map may be ignored and the
11116 frame never becomes visible. XMonad does this.
11117 Prevent an endless loop. */
11118 if (FRAME_ICONIFIED_P (f) && ++tries > 100)
11119 break;
11120
11121 /* This hack is still in use at least for Cygwin. See
11122 http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00351.html.
11123
11124 Machines that do polling rather than SIGIO have been
11125 observed to go into a busy-wait here. So we'll fake an
11126 alarm signal to let the handler know that there's something
11127 to be read. We used to raise a real alarm, but it seems
11128 that the handler isn't always enabled here. This is
11129 probably a bug. */
11130 if (input_polling_used ())
11131 {
11132 /* It could be confusing if a real alarm arrives while
11133 processing the fake one. Turn it off and let the
11134 handler reset it. */
11135 int old_poll_suppress_count = poll_suppress_count;
11136 poll_suppress_count = 1;
11137 poll_for_input_1 ();
11138 poll_suppress_count = old_poll_suppress_count;
11139 }
11140
11141 if (XPending (FRAME_X_DISPLAY (f)))
11142 {
11143 XEvent xev;
11144 XNextEvent (FRAME_X_DISPLAY (f), &xev);
11145 x_dispatch_event (&xev, FRAME_X_DISPLAY (f));
11146 }
11147 }
11148 } 11098 }
11149} 11099}
11150 11100
@@ -12927,7 +12877,7 @@ keysyms. The default is nil, which is the same as `super'. */);
12927 Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900), 12877 Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
12928 make_float (DEFAULT_REHASH_SIZE), 12878 make_float (DEFAULT_REHASH_SIZE),
12929 make_float (DEFAULT_REHASH_THRESHOLD), 12879 make_float (DEFAULT_REHASH_THRESHOLD),
12930 Qnil); 12880 Qnil, Qnil);
12931 12881
12932 DEFVAR_BOOL ("x-frame-normalize-before-maximize", 12882 DEFVAR_BOOL ("x-frame-normalize-before-maximize",
12933 x_frame_normalize_before_maximize, 12883 x_frame_normalize_before_maximize,
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index a454471ae3b..1ffcd6ac0d0 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -45,8 +45,7 @@
45 (should-not (abbrev-table-p [])) 45 (should-not (abbrev-table-p []))
46 ;; Missing :abbrev-table-modiff counter: 46 ;; Missing :abbrev-table-modiff counter:
47 (should-not (abbrev-table-p (obarray-make))) 47 (should-not (abbrev-table-p (obarray-make)))
48 (let* ((table (obarray-make))) 48 (should (abbrev-table-empty-p (make-abbrev-table))))
49 (should (abbrev-table-empty-p (make-abbrev-table)))))
50 49
51(ert-deftest abbrev-make-abbrev-table-test () 50(ert-deftest abbrev-make-abbrev-table-test ()
52 ;; Table without properties: 51 ;; Table without properties:
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 3740b5c1836..61e3d720331 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -250,9 +250,9 @@ Body are forms defining the test."
250 (should (= 0 (cl-count -5 list))) 250 (should (= 0 (cl-count -5 list)))
251 (should (= 0 (cl-count 2 list :start 2 :end 4))) 251 (should (= 0 (cl-count 2 list :start 2 :end 4)))
252 (should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x) 'foo))))) 252 (should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x) 'foo)))))
253 (should (= 4 (cl-count 'foo list :test (lambda (a b) (cl-evenp b))))) 253 (should (= 4 (cl-count 'foo list :test (lambda (_a b) (cl-evenp b)))))
254 (should (equal (cl-count 'foo list :test (lambda (a b) (cl-oddp b))) 254 (should (equal (cl-count 'foo list :test (lambda (_a b) (cl-oddp b)))
255 (cl-count 'foo list :test-not (lambda (a b) (cl-evenp b))))))) 255 (cl-count 'foo list :test-not (lambda (_a b) (cl-evenp b)))))))
256 256
257;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end 257;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
258(ert-deftest cl-seq-mismatch-test () 258(ert-deftest cl-seq-mismatch-test ()
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el
index fbcde4e3cbf..d04645709e4 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -31,7 +31,7 @@
31 (.test-two (cdr (assq 'test-two symbol)))) 31 (.test-two (cdr (assq 'test-two symbol))))
32 (list .test-one .test-two 32 (list .test-one .test-two
33 .test-two .test-two))) 33 .test-two .test-two)))
34 (cl-letf (((symbol-function #'make-symbol) (lambda (x) 'symbol))) 34 (cl-letf (((symbol-function #'make-symbol) (lambda (_x) 'symbol)))
35 (macroexpand 35 (macroexpand
36 '(let-alist data (list .test-one .test-two 36 '(let-alist data (list .test-one .test-two
37 .test-two .test-two)))))) 37 .test-two .test-two))))))
@@ -51,8 +51,7 @@
51(ert-deftest let-alist-cons () 51(ert-deftest let-alist-cons ()
52 (should 52 (should
53 (equal 53 (equal
54 (let ((.external "ext") 54 (let ((.external "ext"))
55 (.external.too "et"))
56 (let-alist '((test-two . 0) 55 (let-alist '((test-two . 0)
57 (test-three . 1) 56 (test-three . 1)
58 (sublist . ((foo . 2) 57 (sublist . ((foo . 2)
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index a30ba25f8f0..2b3456d47f6 100644
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -23,13 +23,18 @@
23(require 'ert) 23(require 'ert)
24(require 'faces) 24(require 'faces)
25 25
26(defgroup faces--test nil ""
27 :group 'faces--test)
28
26(defface faces--test1 29(defface faces--test1
27 '((t :background "black" :foreground "black")) 30 '((t :background "black" :foreground "black"))
28 "") 31 ""
32 :group 'faces--test)
29 33
30(defface faces--test2 34(defface faces--test2
31 '((t :box 1)) 35 '((t :box 1))
32 "") 36 ""
37 :group 'faces--test)
33 38
34(ert-deftest faces--test-color-at-point () 39(ert-deftest faces--test-color-at-point ()
35 (with-temp-buffer 40 (with-temp-buffer
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index a3fe3502461..827d751be69 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -44,7 +44,7 @@ index 3d7cebadcf..ad4b70d737 100644
44 str 44 str
45 (make-string ffap-max-region-length #xa) 45 (make-string ffap-max-region-length #xa)
46 (format "%s ENDS HERE" file))) 46 (format "%s ENDS HERE" file)))
47 (mark-whole-buffer) 47 (call-interactively 'mark-whole-buffer)
48 (should (equal "" (ffap-string-at-point))) 48 (should (equal "" (ffap-string-at-point)))
49 (should (equal '(1 1) ffap-string-at-point-region))))) 49 (should (equal '(1 1) ffap-string-at-point-region)))))
50 (and (file-exists-p file) (delete-file file))))) 50 (and (file-exists-p file) (delete-file file)))))
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index d237d0cc06e..db7f55e8fc5 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -850,6 +850,13 @@ delivered."
850 ;; After deleting the parent directory, the descriptor must 850 ;; After deleting the parent directory, the descriptor must
851 ;; not be valid anymore. 851 ;; not be valid anymore.
852 (should-not (file-notify-valid-p file-notify--test-desc)) 852 (should-not (file-notify-valid-p file-notify--test-desc))
853 ;; w32notify doesn't generate 'stopped' events when the parent
854 ;; directory is deleted, which doesn't provide a chance for
855 ;; filenotify.el to remove the descriptor from the internal
856 ;; hash table it maintains. So we must remove the descriptor
857 ;; manually.
858 (if (string-equal (file-notify--test-library) "w32notify")
859 (file-notify--rm-descriptor file-notify--test-desc))
853 860
854 ;; The environment shall be cleaned up. 861 ;; The environment shall be cleaned up.
855 (file-notify--test-cleanup-p)) 862 (file-notify--test-cleanup-p))
@@ -906,6 +913,8 @@ delivered."
906 (file-notify--test-timeout) 913 (file-notify--test-timeout)
907 (not (file-notify-valid-p file-notify--test-desc))) 914 (not (file-notify-valid-p file-notify--test-desc)))
908 (should-not (file-notify-valid-p file-notify--test-desc)) 915 (should-not (file-notify-valid-p file-notify--test-desc))
916 (if (string-equal (file-notify--test-library) "w32notify")
917 (file-notify--rm-descriptor file-notify--test-desc))
909 918
910 ;; The environment shall be cleaned up. 919 ;; The environment shall be cleaned up.
911 (file-notify--test-cleanup-p)) 920 (file-notify--test-cleanup-p))
@@ -975,6 +984,8 @@ delivered."
975 (file-notify--test-read-event) 984 (file-notify--test-read-event)
976 (delete-file file))) 985 (delete-file file)))
977 (delete-directory file-notify--test-tmpfile) 986 (delete-directory file-notify--test-tmpfile)
987 (if (string-equal (file-notify--test-library) "w32notify")
988 (file-notify--rm-descriptor file-notify--test-desc))
978 989
979 ;; The environment shall be cleaned up. 990 ;; The environment shall be cleaned up.
980 (file-notify--test-cleanup-p)) 991 (file-notify--test-cleanup-p))
@@ -1184,6 +1195,9 @@ the file watch."
1184 (delete-directory file-notify--test-tmpfile 'recursive)) 1195 (delete-directory file-notify--test-tmpfile 'recursive))
1185 (should-not (file-notify-valid-p file-notify--test-desc1)) 1196 (should-not (file-notify-valid-p file-notify--test-desc1))
1186 (should-not (file-notify-valid-p file-notify--test-desc2)) 1197 (should-not (file-notify-valid-p file-notify--test-desc2))
1198 (when (string-equal (file-notify--test-library) "w32notify")
1199 (file-notify--rm-descriptor file-notify--test-desc1)
1200 (file-notify--rm-descriptor file-notify--test-desc2))
1187 1201
1188 ;; The environment shall be cleaned up. 1202 ;; The environment shall be cleaned up.
1189 (file-notify--test-cleanup-p)) 1203 (file-notify--test-cleanup-p))
diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el
index 15eb7c170c9..4a1d566e96c 100644
--- a/test/lisp/htmlfontify-tests.el
+++ b/test/lisp/htmlfontify-tests.el
@@ -30,5 +30,17 @@
30 (symbol-function 30 (symbol-function
31 'htmlfontify-load-rgb-file)))) 31 'htmlfontify-load-rgb-file))))
32 32
33(ert-deftest htmlfontify-bug25468 ()
34 "Tests that htmlfontify can be loaded even if no shell is
35available (Bug#25468)."
36 (should (equal (let ((process-environment
37 (cons "SHELL=/does/not/exist" process-environment)))
38 (call-process
39 (expand-file-name (invocation-name) (invocation-directory))
40 nil nil nil
41 "--quick" "--batch"
42 (concat "--load=" (locate-library "htmlfontify"))))
43 0)))
44
33(provide 'htmlfontify-tests) 45(provide 'htmlfontify-tests)
34;; htmlfontify-tests.el ends here 46;; htmlfontify-tests.el ends here
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index fb632e2073d..b9f7fe7cde8 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -23,6 +23,15 @@
23(eval-when-compile 23(eval-when-compile
24 (require 'ibuf-macs)) 24 (require 'ibuf-macs))
25 25
26(defvar ibuffer-filter-groups)
27(defvar ibuffer-filtering-alist)
28(defvar ibuffer-filtering-qualifiers)
29(defvar ibuffer-save-with-custom)
30(defvar ibuffer-saved-filter-groups)
31(defvar ibuffer-saved-filters)
32(declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier))
33(declare-function ibuffer-unary-operand "ibuf-ext" (filter))
34
26(ert-deftest ibuffer-autoload () 35(ert-deftest ibuffer-autoload ()
27 "Tests to see whether ibuffer has been autoloaded" 36 "Tests to see whether ibuffer has been autoloaded"
28 (skip-unless (not (featurep 'ibuf-ext))) 37 (skip-unless (not (featurep 'ibuf-ext)))
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index efed8f8bed4..7c5fcb4838f 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -28,7 +28,7 @@
28 28
29(ert-deftest completion-test1 () 29(ert-deftest completion-test1 ()
30 (with-temp-buffer 30 (with-temp-buffer
31 (cl-flet* ((test/completion-table (string pred action) 31 (cl-flet* ((test/completion-table (_string _pred action)
32 (if (eq action 'lambda) 32 (if (eq action 'lambda)
33 nil 33 nil
34 "test: ")) 34 "test: "))
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 525709b92e7..0a59e3b42d1 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -22,7 +22,8 @@
22(require 'ert) 22(require 'ert)
23(require 'dbus) 23(require 'dbus)
24 24
25(setq dbus-debug nil) 25(defvar dbus-debug nil)
26(declare-function dbus-get-unique-name "dbusbind.c" (bus))
26 27
27(defvar dbus--test-enabled-session-bus 28(defvar dbus--test-enabled-session-bus
28 (and (featurep 'dbusbind) 29 (and (featurep 'dbusbind)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 02e5d18b7fe..0c3068aeb09 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1991,12 +1991,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1991 (string-equal 1991 (string-equal
1992 (make-auto-save-file-name) 1992 (make-auto-save-file-name)
1993 ;; This is taken from original `make-auto-save-file-name'. 1993 ;; This is taken from original `make-auto-save-file-name'.
1994 (expand-file-name 1994 ;; We call `convert-standard-filename', because on
1995 (format 1995 ;; MS Windows the (local) colons must be replaced by
1996 "#%s#" 1996 ;; exclamation marks.
1997 (subst-char-in-string 1997 (convert-standard-filename
1998 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) 1998 (expand-file-name
1999 temporary-file-directory))))) 1999 (format
2000 "#%s#"
2001 (subst-char-in-string
2002 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
2003 temporary-file-directory))))))
2000 2004
2001 ;; No mapping. 2005 ;; No mapping.
2002 (let (tramp-auto-save-directory auto-save-file-name-transforms) 2006 (let (tramp-auto-save-directory auto-save-file-name-transforms)
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index 9bf7258eebe..84749efa45b 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -59,6 +59,32 @@
59 * Load the inspector's shared head.js for use by tests that need to 59 * Load the inspector's shared head.js for use by tests that need to
60 * open the something or other")))) 60 * open the something or other"))))
61 61
62(ert-deftest js-mode-regexp-syntax ()
63 (with-temp-buffer
64 ;; Normally indentation tests are done in manual/indent, but in
65 ;; this case we are specifically testing a case where the bug
66 ;; caused the indenter not to do anything, and manual/indent can
67 ;; only be used for already-correct files.
68 (insert "function f(start, value) {
69if (start - 1 === 0 || /[ (:,='\"]/.test(value)) {
70--start;
71}
72if (start - 1 === 0 && /[ (:,='\"]/.test(value)) {
73--start;
74}
75if (!/[ (:,='\"]/.test(value)) {
76--start;
77}
78}
79")
80 (js-mode)
81 (indent-region (point-min) (point-max))
82 (goto-char (point-min))
83 (dolist (x '(0 4 8 4 4 8 4 4 8 4 0))
84 (back-to-indentation)
85 (should (= (current-column) x))
86 (forward-line))))
87
62(provide 'js-tests) 88(provide 'js-tests)
63 89
64;;; js-tests.el ends here 90;;; js-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 2df1bbf50d8..1e6b867d30b 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1156,6 +1156,27 @@ if do:
1156 (python-tests-look-at "that)") 1156 (python-tests-look-at "that)")
1157 (should (= (current-indentation) 6)))) 1157 (should (= (current-indentation) 6))))
1158 1158
1159(ert-deftest python-indent-electric-colon-4 ()
1160 "Test indentation case where there is one more-indented previous open block."
1161 (python-tests-with-temp-buffer
1162 "
1163def f():
1164 if True:
1165 a = 5
1166
1167 if True:
1168 a = 10
1169
1170 b = 3
1171
1172else
1173"
1174 (python-tests-look-at "else")
1175 (goto-char (line-end-position))
1176 (python-tests-self-insert ":")
1177 (python-tests-look-at "else" -1)
1178 (should (= (current-indentation) 4))))
1179
1159(ert-deftest python-indent-region-1 () 1180(ert-deftest python-indent-region-1 ()
1160 "Test indentation case from Bug#18843." 1181 "Test indentation case from Bug#18843."
1161 (let ((contents " 1182 (let ((contents "
@@ -2457,7 +2478,7 @@ if x:
2457 (python-tests-with-temp-buffer 2478 (python-tests-with-temp-buffer
2458 " \"\n" 2479 " \"\n"
2459 (goto-char (point-min)) 2480 (goto-char (point-min))
2460 (font-lock-fontify-buffer))) 2481 (call-interactively 'font-lock-fontify-buffer)))
2461 2482
2462 2483
2463;;; Shell integration 2484;;; Shell integration
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 6194cada1c6..f4849c4b21d 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -30,8 +30,9 @@
30 (insert "(a b") 30 (insert "(a b")
31 (save-excursion (insert " c d)")) 31 (save-excursion (insert " c d)"))
32 ,@body 32 ,@body
33 (cons (buffer-substring (point-min) (point)) 33 (with-no-warnings
34 (buffer-substring (point) (point-max))))) 34 (cons (buffer-substring (point-min) (point))
35 (buffer-substring (point) (point-max))))))
35 36
36 37
37(defmacro simple-test--transpositions (&rest body) 38(defmacro simple-test--transpositions (&rest body)
@@ -266,7 +267,6 @@
266 (with-temp-buffer 267 (with-temp-buffer
267 (setq buffer-undo-list nil) 268 (setq buffer-undo-list nil)
268 (insert "hello") 269 (insert "hello")
269 (car buffer-undo-list)
270 (undo-auto--boundaries 'test)))) 270 (undo-auto--boundaries 'test))))
271 271
272;;; Transposition with negative args (bug#20698, bug#21885) 272;;; Transposition with negative args (bug#20698, bug#21885)
diff --git a/test/lisp/textmodes/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el
index 0a82b2521fb..f958fbc547a 100644
--- a/test/lisp/textmodes/tildify-tests.el
+++ b/test/lisp/textmodes/tildify-tests.el
@@ -226,7 +226,7 @@ The function must terminate as soon as callback returns nil."
226 226
227 227
228(defun tildify-space-undo-test--test 228(defun tildify-space-undo-test--test
229 (modes nbsp env-open &optional set-space-string) 229 (modes nbsp _env-open &optional set-space-string)
230 (with-temp-buffer 230 (with-temp-buffer
231 (setq-local buffer-file-coding-system 'utf-8) 231 (setq-local buffer-file-coding-system 'utf-8)
232 (dolist (mode modes) 232 (dolist (mode modes)
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 0f2182a6a75..d0da2094db7 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -134,6 +134,21 @@ Parser is called with and without 'symbol-qnames argument.")
134 (append xml-default-ns 134 (append xml-default-ns
135 '(("F" . "FOOBAR:")))))))))) 135 '(("F" . "FOOBAR:"))))))))))
136 136
137;; Test bug #23440 (proper expansion of default namespace)
138; Test data for default namespace
139(defvar xml-parse-test--default-namespace-qnames
140 (cons "<something xmlns=\"myns:\"><whatever></whatever></something>"
141 '((myns:something
142 ((("http://www.w3.org/2000/xmlns/" . "")
143 . "myns:"))
144 (myns:whatever nil)))))
145
146(ert-deftest xml-parse-test-default-namespace-qnames ()
147 (with-temp-buffer
148 (insert (car xml-parse-test--default-namespace-qnames))
149 (should (equal (cdr xml-parse-test--default-namespace-qnames)
150 (xml-parse-region nil nil nil nil 'symbol-qnames)))))
151
137;; Local Variables: 152;; Local Variables:
138;; no-byte-compile: t 153;; no-byte-compile: t
139;; End: 154;; End:
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index a1fe8ccd7d9..95655eac826 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -47,4 +47,14 @@ Bug#24912 and Bug#24913."
47 (let ((byte-compile-debug t)) 47 (let ((byte-compile-debug t))
48 (should-error (eval `(byte-compile (lambda ,args)) t))))) 48 (should-error (eval `(byte-compile (lambda ,args)) t)))))
49 49
50
51(dolist (form '(let let*))
52 (dolist (arg '(1 "a" [a]))
53 (eval
54 `(ert-deftest ,(intern (format "eval-tests--%s--%s" form (type-of arg))) ()
55 ,(format "Check that the first argument of `%s' cannot be a %s"
56 form (type-of arg))
57 (should-error (,form ,arg) :type 'wrong-type-argument))
58 t)))
59
50;;; eval-tests.el ends here 60;;; eval-tests.el ends here
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
new file mode 100644
index 00000000000..6edde0b137b
--- /dev/null
+++ b/test/src/syntax-tests.el
@@ -0,0 +1,85 @@
1;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Code:
21
22(require 'ert)
23
24(ert-deftest parse-partial-sexp-continue-over-comment-marker ()
25 "Continue a parse that stopped in the middle of a comment marker."
26 (with-temp-buffer
27 (let ((table (make-syntax-table)))
28 (modify-syntax-entry ?/ ". 124")
29 (modify-syntax-entry ?* ". 23b")
30 (set-syntax-table table))
31 (insert "/*C*/\nX")
32 (goto-char (point-min))
33 (let* ((pointC (progn (search-forward "C") (1- (point))))
34 (preC (1- pointC))
35 (pointX (progn (search-forward "X") (1- (point))))
36 (aftC (+ 2 pointC))
37 (ppsC (parse-partial-sexp (point-min) pointC))
38 (pps-preC (parse-partial-sexp (point-min) preC))
39 (pps-aftC (parse-partial-sexp (point-min) aftC))
40 (ppsX (parse-partial-sexp (point-min) pointX)))
41 ;; C should be inside comment.
42 (should (= (nth 0 ppsC) 0))
43 (should (eq (nth 4 ppsC) t))
44 (should (= (nth 8 ppsC) (- pointC 2)))
45 ;; X should not be in comment or list.
46 (should (= (nth 0 ppsX) 0))
47 (should-not (nth 4 ppsX))
48 ;; Try using OLDSTATE.
49 (should (equal (parse-partial-sexp preC pointC nil nil pps-preC)
50 ppsC))
51 (should (equal (parse-partial-sexp pointC aftC nil nil ppsC)
52 pps-aftC))
53 (should (equal (parse-partial-sexp preC aftC nil nil pps-preC)
54 pps-aftC))
55 (should (equal (parse-partial-sexp aftC pointX nil nil pps-aftC)
56 ppsX)))))
57
58(ert-deftest parse-partial-sexp-paren-comments ()
59 "Test syntax parsing with paren comment markers.
60Specifically, where the first character of the comment marker is
61also has open paren syntax (see Bug#24870)."
62 (with-temp-buffer
63 (let ((table (make-syntax-table)))
64 (modify-syntax-entry ?\{ "(}1nb" table)
65 (modify-syntax-entry ?\} "){4nb" table)
66 (modify-syntax-entry ?- ". 123" table)
67 (set-syntax-table table))
68 (insert "{-C-}\nX")
69 (goto-char (point-min))
70 (let* ((pointC (progn (search-forward "C") (1- (point))))
71 (pointX (progn (search-forward "X") (1- (point))))
72 (ppsC (parse-partial-sexp (point-min) pointC))
73 (ppsX (parse-partial-sexp (point-min) pointX)))
74 ;; C should be inside nestable comment, not list.
75 (should (= (nth 0 ppsC) 0))
76 (should (= (nth 4 ppsC) 1))
77 (should (= (nth 8 ppsC) (- pointC 2)))
78 ;; X should not be in comment or list.
79 (should (= (nth 0 ppsX) 0))
80 (should-not (nth 4 ppsX))
81 ;; Try using OLDSTATE.
82 (should (equal (parse-partial-sexp pointC pointX nil nil ppsC)
83 ppsX)))))
84
85;;; syntax-tests.el ends here
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index df8222a21aa..849b2e3dd1b 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -222,8 +222,15 @@
222 222
223(ert-deftest thread-errors () 223(ert-deftest thread-errors ()
224 "Test what happens when a thread signals an error." 224 "Test what happens when a thread signals an error."
225 (should (threadp (make-thread #'call-error "call-error"))) 225 (let (th1 th2)
226 (should (threadp (make-thread #'thread-custom "thread-custom")))) 226 (setq th1 (make-thread #'call-error "call-error"))
227 (should (threadp th1))
228 (while (thread-alive-p th1)
229 (thread-yield))
230 (should (equal (thread-last-error)
231 '(error "Error is called")))
232 (setq th2 (make-thread #'thread-custom "thread-custom"))
233 (should (threadp th2))))
227 234
228(ert-deftest thread-sticky-point () 235(ert-deftest thread-sticky-point ()
229 "Test bug #25165 with point movement in cloned buffer." 236 "Test bug #25165 with point movement in cloned buffer."
@@ -242,7 +249,8 @@
242 (while t (thread-yield)))))) 249 (while t (thread-yield))))))
243 (thread-signal thread 'error nil) 250 (thread-signal thread 'error nil)
244 (sit-for 1) 251 (sit-for 1)
245 (should-not (thread-alive-p thread)))) 252 (should-not (thread-alive-p thread))
253 (should (equal (thread-last-error) '(error)))))
246 254
247(defvar threads-condvar nil) 255(defvar threads-condvar nil)
248 256
@@ -287,6 +295,7 @@
287 (thread-signal new-thread 'error '("Die, die, die!")) 295 (thread-signal new-thread 'error '("Die, die, die!"))
288 (sleep-for 0.1) 296 (sleep-for 0.1)
289 ;; Make sure the thread died. 297 ;; Make sure the thread died.
290 (should (= (length (all-threads)) 1)))) 298 (should (= (length (all-threads)) 1))
299 (should (equal (thread-last-error) '(error "Die, die, die!")))))
291 300
292;;; threads.el ends here 301;;; threads.el ends here