diff options
| author | Vibhav Pant | 2017-01-30 18:35:43 +0530 |
|---|---|---|
| committer | Vibhav Pant | 2017-01-30 18:35:43 +0530 |
| commit | bf7f7c0d82a56ed1b76358657e74ca2833b19fe2 (patch) | |
| tree | 90f357b4a735ca7c90d1881ef9948186b9f919df | |
| parent | 25d38a06eceb0853190a2d9acf53d85686f524bd (diff) | |
| parent | 9c4dfdd1af9f97c6a8d7e922b68a39052116790c (diff) | |
| download | emacs-bf7f7c0d82a56ed1b76358657e74ca2833b19fe2.tar.gz emacs-bf7f7c0d82a56ed1b76358657e74ca2833b19fe2.zip | |
Merge remote-tracking branch 'origin/master' into feature/byte-switch
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 | |||
| 792 | occur via calls to @code{eval_sub} or @code{Feval}, either directly or | 792 | occur via calls to @code{eval_sub} or @code{Feval}, either directly or |
| 793 | indirectly. | 793 | indirectly. |
| 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 |
| 797 | checks whether the user pressed @kbd{C-g}, and if so, aborts the | 797 | checks whether the user pressed @kbd{C-g}, and if so, aborts the |
| 798 | processing. You should do that in any loop that can potentially | 798 | processing. You should do that in any loop that can potentially |
| 799 | require a large number of iterations; in this case, the list of | 799 | require 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}))} | |||
| 362 | or @code{(nthcdr 2 @var{cons-cell})}. | 362 | or @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 | ||
| 389 | In 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}, | ||
| 391 | where 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 | ||
| 393 | elements of a list, respectively. @file{cl-lib} provides the same | ||
| 394 | under the names @code{cl-second}, @code{cl-third}, and | ||
| 395 | @code{cl-fourth}. @xref{List Functions,,, cl, Common Lisp | ||
| 396 | Extensions}. | ||
| 397 | |||
| 365 | @defun butlast x &optional n | 398 | @defun butlast x &optional n |
| 366 | This function returns the list @var{x} with the last element, | 399 | This function returns the list @var{x} with the last element, |
| 367 | or the last @var{n} elements, removed. If @var{n} is greater | 400 | or 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. | |||
| 2414 | The connection type: @samp{plain} or @samp{tls}. | 2414 | The connection type: @samp{plain} or @samp{tls}. |
| 2415 | @end table | 2415 | @end table |
| 2416 | 2416 | ||
| 2417 | @item :shell-command @var{string-or-nil} | ||
| 2418 | If the connection @code{type} is @code{shell}, this parameter will be | ||
| 2419 | interpreted as a format-spec string that will be executed to make the | ||
| 2420 | connection. 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 | ||
| 2422 | to @samp{gateway} before making a plain connection, then this | ||
| 2423 | parameter 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 | |||
| 127 | by each invocation. | 127 | by each invocation. |
| 128 | @end defun | 128 | @end defun |
| 129 | 129 | ||
| 130 | When code run by a thread signals an error that is unhandled, the | ||
| 131 | thread exits. Other threads can access the error form which caused | ||
| 132 | the thread to exit using the following function. | ||
| 133 | |||
| 134 | @defun thread-last-error | ||
| 135 | This function returns the last error form recorded when a thread | ||
| 136 | exited due to an error. Each thread that exits abnormally overwrites | ||
| 137 | the form stored by the previous thread's error with a new value, so | ||
| 138 | only 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 |
| 3696 | This function is equivalent to @code{(car (cdr (cdr @var{x})))}. | 3696 | This function is equivalent to @code{(car (cdr (cdr @var{x})))}. |
| 3697 | Likewise, this package defines all 24 @code{c@var{xxx}r} functions | 3697 | Likewise, this package aliases all 24 @code{c@var{xxx}r} functions |
| 3698 | where @var{xxx} is up to four @samp{a}s and/or @samp{d}s. | 3698 | where @var{xxx} is up to four @samp{a}s and/or @samp{d}s. |
| 3699 | All of these functions are @code{setf}-able, and calls to them | 3699 | All of these functions are @code{setf}-able, and calls to them |
| 3700 | are expanded inline by the byte-compiler for maximum efficiency. | 3700 | are 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 | |||
| 654 | but that's not necessary unless the value contains white space. So | 654 | but 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 | ||
| 657 | If 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 | ||
| 659 | point after the opening two characters; i. e. @samp{<#!part ...>}. | ||
| 660 | |||
| 657 | The following parameters have meaning in @acronym{MML}; parameters that have no | 661 | The following parameters have meaning in @acronym{MML}; parameters that have no |
| 658 | meaning are ignored. The @acronym{MML} parameter names are the same as the | 662 | meaning 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 |
| 10198 | Sort by article length (@code{gnus-summary-sort-by-chars}). | 10198 | Sort 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 | ||
| 10203 | Sort 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 |
| 13517 | Mark the current server as unreachable | 13522 | Mark the current server as unreachable |
| 13518 | (@code{gnus-server-deny-server}). | 13523 | (@code{gnus-server-deny-server}). This will effectively disable the |
| 13524 | server. | ||
| 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 |
| 21863 | Allows you to create a mairix query or group based on the current | 21869 | Allows you to create a mairix query or group based on the current |
| 21864 | message using graphical widgets (same as @code{nnmairix-widget-search}) | 21870 | message 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 |
| 21870 | Interactively creates a new search group with query based on the current | 21876 | Interactively creates a new search group with query based on the current |
| 21871 | message, but uses the minibuffer instead of graphical widgets | 21877 | message, 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 |
| 21877 | Searches thread for the current article | 21883 | Searches 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 |
| 21879 | shortcut for calling @code{nnmairix-search} with @samp{m:msgid} of the | 21885 | shortcut for calling @code{nnmairix-search} with @samp{m:msgid} of the |
| 21880 | current article and enabled threads. | 21886 | current 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 |
| 21885 | Searches all messages from sender of the current article | 21891 | Searches 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 |
| 21887 | calling @code{nnmairix-search} with @samp{f:From}. | 21893 | calling @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 |
| 21893 | originally came from and displays the article in this group, so that, | 21899 | originally came from and displays the article in this group, so that, |
| @@ -21896,8 +21902,8 @@ parameters are applied (@code{nnmairix-goto-original-article}). This | |||
| 21896 | function will use the registry if available, but can also parse the | 21902 | function will use the registry if available, but can also parse the |
| 21897 | article file name as a fallback method. | 21903 | article 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 |
| 21902 | Remove possibly existing tick mark from original article | 21908 | Remove 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 | ||
| 22052 | So far so good---but how do you remove the tick marks in the @code{nnmairix} | 22058 | So far so good---but how do you remove the tick marks in the @code{nnmairix} |
| 22053 | group? There are two options: You may simply use | 22059 | group? 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 |
| 22055 | tick marks from the original article. The other possibility is to set | 22061 | tick 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 |
| 22057 | comments about this option. If it works for you, the tick marks should | 22063 | comments about this option. If it works for you, the tick marks should |
| @@ -225,7 +225,7 @@ this command: | |||
| 225 | handle SIGINT stop nopass | 225 | handle SIGINT stop nopass |
| 226 | 226 | ||
| 227 | After this 'handle' command, SIGINT will return control to GDB. If | 227 | After this 'handle' command, SIGINT will return control to GDB. If |
| 228 | you want the C-g to cause a QUIT within Emacs as well, omit the 'nopass'. | 228 | you want the C-g to cause a quit within Emacs as well, omit the 'nopass'. |
| 229 | See the GDB manual for more details about signal handling and the | 229 | See the GDB manual for more details about signal handling and the |
| 230 | 'handle' command. | 230 | 'handle' command. |
| 231 | 231 | ||
| @@ -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 |
| 117 | resizing graphical Emacs frames on the X Window System. This support | 117 | resizing graphical Emacs frames on the X Window System. This support |
| 118 | requires the DOUBLE-BUFFER extension, which major X servers have | 118 | requires the DOUBLE-BUFFER extension, which major X servers have |
| 119 | supported for many years. | 119 | supported for many years. If your system has this extension, but an |
| 120 | Emacs built with double buffering misbehaves on some displays you use, | ||
| 121 | you can disable the feature by adding | ||
| 122 | |||
| 123 | '(inhibit-double-buffering . t) | ||
| 124 | |||
| 125 | to default-frame-parameters. Or inject this parameter into the | ||
| 126 | selected frame by evaluating this form: | ||
| 127 | |||
| 128 | (modify-frame-parameters nil '((inhibit-double-buffering . t))) | ||
| 120 | 129 | ||
| 121 | --- | 130 | --- |
| 122 | The group 'wp', whose label was "text", is now deprecated. | 131 | The 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 | ||
| 355 | method is an NNTP select method. | ||
| 356 | |||
| 357 | +++ | ||
| 358 | *** A new command for sorting articles by readedness marks has been | ||
| 359 | added: `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 | |||
| 778 | that are not built-in primitives. We recommend using this new | 797 | that are not built-in primitives. We recommend using this new |
| 779 | function instead of 'subr-arity'. | 798 | function instead of 'subr-arity'. |
| 780 | 799 | ||
| 800 | ** New function 'region-bounds' can be used in the interactive spec | ||
| 801 | to provide region boundaries (for rectangular regions more than one) | ||
| 802 | to an interactively callable function as a single argument instead of | ||
| 803 | two 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 |
| 783 | non-nil when the last character scanned might be the first character | 807 | non-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 | |||
| 838 | collection). | 862 | collection). |
| 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' |
| 842 | can be used for creation of temporary files of remote or mounted directories. | 869 | can 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. | |||
| 987 | Within CMD, %i denotes the input file(s), and %o denotes the | 987 | Within CMD, %i denotes the input file(s), and %o denotes the |
| 988 | output file. %i path(s) are relative, while %o is absolute.") | 988 | output 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 | |||
| 171 | well-formed, such as \"user@host\" or \"<user@host>\"." | 171 | well-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. | ||
| 11947 | Argument 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. |
| 11930 | Argument REVERSE means reverse order." | 11953 | Argument REVERSE means reverse order." |
| @@ -11970,7 +11993,10 @@ save those articles instead. | |||
| 11970 | The variable `gnus-default-article-saver' specifies the saver function. | 11993 | The variable `gnus-default-article-saver' specifies the saver function. |
| 11971 | 11994 | ||
| 11972 | If the optional second argument NOT-SAVED is non-nil, articles saved | 11995 | If the optional second argument NOT-SAVED is non-nil, articles saved |
| 11973 | will not be marked as saved." | 11996 | will not be marked as saved. |
| 11997 | |||
| 11998 | The `gnus-prompt-before-saving' variable says how prompting is | ||
| 11999 | performed." | ||
| 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. |
| 2287 | With prefix-argument just set Follow-Up, don't cross-post." | 2287 | With 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. |
| 2362 | With prefix-argument just set Follow-Up, don't cross-post." | 2364 | With 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. |
| 3331 | Prefix arg means justify as well." | 3346 | Prefix 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 | |||
| 6644 | to continue editing a message already being composed. SWITCH-FUNCTION | 6668 | to continue editing a message already being composed. SWITCH-FUNCTION |
| 6645 | is a function used to switch to and display the mail buffer." | 6669 | is 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 | |||
| 1378 | is a one-line description of the attachment. The DISPOSITION | 1387 | is a one-line description of the attachment. The DISPOSITION |
| 1379 | specifies how the attachment is intended to be displayed. It can | 1388 | specifies how the attachment is intended to be displayed. It can |
| 1380 | be either \"inline\" (displayed automatically within the message | 1389 | be either \"inline\" (displayed automatically within the message |
| 1381 | body) or \"attachment\" (separate from the body)." | 1390 | body) or \"attachment\" (separate from the body). |
| 1391 | |||
| 1392 | If given a prefix interactively, no prompting will be done for | ||
| 1393 | the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults | ||
| 1394 | will 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. | ||
| 72 | This will only be used if the connection type is `shell'. See | ||
| 73 | the `open-network-stream' documentation for an explanation of | ||
| 74 | the 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 | ||
| 334 | The words preceding the quoted symbol can be used in doc strings to | 334 | The 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 | |||
| 189 | such overlays in all buffers except the current one." | 189 | such 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 |
| 140 | asynchronously, if possible. | 140 | asynchronously, if possible. |
| 141 | 141 | ||
| 142 | :shell-command is a format-spec string that can be used if :type | ||
| 143 | is `shell'. It has two specs, %s for host and %p for port | ||
| 144 | number. 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 |
| 143 | opening a TLS connection. The first element is the TLS | 147 | opening a TLS connection. The first element is the TLS |
| 144 | type (either `gnutls-x509pki' or `gnutls-anon'), and the | 148 | type (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. |
| 98 | May either be an integer specifying a fixed width in characters, | 98 | May either be an integer specifying a fixed width in characters, |
| 99 | or nil, meaning that the full width of the window should be | 99 | or nil, meaning that the full width of the window should be used. |
| 100 | used." | 100 | If `shr-use-fonts' is set, the mean character width is used to |
| 101 | compute 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. |
| 1016 | WIDTH and HEIGHT are the sizes given in the HTML data, if any." | 1018 | WIDTH and HEIGHT are the sizes given in the HTML data, if any. |
| 1019 | |||
| 1020 | The size of the displayed image will not exceed | ||
| 1021 | MAX-WIDTH/MAX-HEIGHT. If not given, use the current window | ||
| 1022 | width/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 | |||
| 276 | format of SERVICE." | 276 | format 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!") | |||
| 557 | just try dropping it.") | 557 | just 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.") | |||
| 774 | huge rocks sliding down from the ceiling, and blocking your way out.\n") | 774 | huge 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). |
| 902 | Here is some useful information (read carefully because there are one | 902 | Here 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 | |||
| 937 | My home page is http://www.driver-aces.com/ronnie.html | 937 | My 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 | |||
| 5005 | a known \"safe position\", i.e. outside of any string or comment." | 5018 | a 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'." | |||
| 3214 | Inside the lexical scope of `with-js', `js?', `js!', | 3214 | Inside 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. |
| 3670 | When called interactively, prompt for CONTEXT." | 3667 | When 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. |
| 87 | If non-nil, after writing `recentf-save-file', set its mode bits to | 87 | If non-nil, after writing `recentf-save-file', set its mode bits to |
| 88 | this value. By default give R/W access only to the user who owns that | 88 | this 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 | |||
| 544 | buffer." | 544 | buffer." |
| 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. |
| 5415 | An example is a rectangular region handled as a list of | 5419 | An example is a rectangular region handled as a list of |
| 5416 | separate contiguous regions for each line." | 5420 | separate 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. |
| 7574 | During execution of Lisp code, this character causes a quit directly. | 7578 | During 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. |
| 389 | If LIST is nil, return nil. | 509 | If 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, | |||
| 1006 | respectively. They may be nil if the respective thing is missing. | 1006 | respectively. They may be nil if the respective thing is missing. |
| 1007 | BEG-TXT is the beginning of the title line or the transition and | 1007 | BEG-TXT is the beginning of the title line or the transition and |
| 1008 | must be given. The end of the line is used as the end point. TXT | 1008 | must be given. The end of the line is used as the end point. TXT |
| 1009 | is the title text or nil. If TXT is given the indendation of the | 1009 | is the title text or nil. If TXT is given the indentation of the |
| 1010 | line containing BEG-TXT is used as indentation. Match group 0 is | 1010 | line containing BEG-TXT is used as indentation. Match group 0 is |
| 1011 | derived from the remaining information." | 1011 | derived 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'." | |||
| 1845 | HDRS reflects the order in which the headers appear in the | 1845 | HDRS reflects the order in which the headers appear in the |
| 1846 | buffer. Return a `rst-Hdr' list representing the hierarchy of | 1846 | buffer. Return a `rst-Hdr' list representing the hierarchy of |
| 1847 | headers in the buffer. Indentation is unified." | 1847 | headers 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. |
| 2454 | Style is defined by indentaton IND, TAG and suffix TAB. If | 2453 | Style is defined by indentation IND, TAG and suffix TAB. If |
| 2455 | PREFER-ROMAN roman numbering is preferred over using letters." | 2454 | PREFER-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. |
| 2552 | RST-RE-BEG is a `rst-re' argument and matched at the beginning of | 2551 | RST-RE-BEG is a `rst-re' argument and matched at the beginning of |
| 2553 | a line. Return a list of (POINT . COLUMN) where POINT gives the | 2552 | a line. Return a list of (POINT . COLUMN) where POINT gives the |
| 2554 | point after indentaton and COLUMN gives its column. The list is | 2553 | point after indentation and COLUMN gives its column. The list is |
| 2555 | ordererd by POINT." | 2554 | ordered 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. |
| 503 | If point is in a file header rather than a hunk, advance to the | 536 | If point is in a file header rather than a hunk, advance to the |
| 504 | next hunk if TRY-HARDER is non-nil; otherwise signal an error." | 537 | next 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. | ||
| 563 | Override the default diff-{hunk,file}-{next,prev} implementation | ||
| 564 | by skipping any lines that are associated with this hunk/file but | ||
| 565 | precede the hunk-start marker. For instance, a diff file could | ||
| 566 | contain | ||
| 567 | |||
| 568 | diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el | ||
| 569 | index 923de9a..6b1c24f 100644 | ||
| 570 | --- a/lisp/vc/diff-mode.el | ||
| 571 | +++ b/lisp/vc/diff-mode.el | ||
| 572 | @@ -590,6 +590,22 @@ | ||
| 573 | ....... | ||
| 574 | |||
| 575 | If a point is on 'index', then the point is considered to be in | ||
| 576 | this first hunk. Move the point to the @@... marker before | ||
| 577 | executing the default diff-hunk-next/prev implementation to move | ||
| 578 | to 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'. | |||
| 1764 | SWITCHED is non-nil if the patch is already applied. | 1697 | SWITCHED is non-nil if the patch is already applied. |
| 1765 | NOPROMPT, if non-nil, means not to prompt the user." | 1698 | NOPROMPT, 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 | ||
| 1839 | With a prefix argument, REVERSE the hunk." | 1771 | With 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. | ||
| 1992 | Return 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. |
| 648 | Leave point at the first non-blank character after the tag." | 648 | Leave 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 | ||
| 2873 | DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, | 2873 | DEFUN ("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. */ | ||
| 5439 | static struct Lisp_Hash_Table * | ||
| 5440 | purecopy_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 | |||
| 5467 | DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, | 5468 | DEFUN ("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. |
| 5469 | Recursively copies contents of vectors and cons cells. | 5470 | Recursively 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 | ||
| 5483 | struct pinned_object | ||
| 5484 | { | ||
| 5485 | Lisp_Object object; | ||
| 5486 | struct pinned_object *next; | ||
| 5487 | }; | ||
| 5488 | |||
| 5489 | /* Pinned objects are marked before every GC cycle. */ | ||
| 5490 | static struct pinned_object *pinned_objects; | ||
| 5491 | |||
| 5483 | static Lisp_Object | 5492 | static Lisp_Object |
| 5484 | purecopy (Lisp_Object obj) | 5493 | purecopy (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 | ||
| 5726 | static void | 5755 | static void |
| 5756 | mark_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 | |||
| 5765 | static void | ||
| 5727 | mark_pinned_symbols (void) | 5766 | mark_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 | ||
| 421 | static Lisp_Object | 420 | static Lisp_Object |
| 422 | assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list) | 421 | assoc_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) |
| @@ -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); | |||
| 1451 | static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, | 1450 | static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, |
| 1452 | Lisp_Object data); | 1451 | Lisp_Object data); |
| 1453 | 1452 | ||
| 1454 | void | 1453 | static void |
| 1455 | process_quit_flag (void) | 1454 | process_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 | ||
| 1465 | void | ||
| 1466 | maybe_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 | |||
| 1466 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, | 1474 | DEFUN ("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. |
| 1468 | This function does not return. | 1476 | This 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 | ||
| 2683 | DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, | 2683 | DEFUN ("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. |
| 2685 | The second argument STRING is used in the error message. | 2685 | The second argument STRING is prepended to the error message. |
| 2686 | If there is no error, returns nil. */) | 2686 | If 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; |
| @@ -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 | ||
| 38 | static void sort_vector_copy (Lisp_Object, ptrdiff_t, | 39 | static 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. */ | ||
| 88 | enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; | 90 | enum { 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 | ||
| 92 | static void | 96 | static void |
| 93 | CHECK_LIST_END (Lisp_Object x, Lisp_Object y) | 97 | rarely_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 | |||
| 98 | DEFUN ("length", Flength, Slength, 1, 1, 0, | 105 | DEFUN ("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. |
| 100 | A byte-code function object is also allowed. | 107 | A 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. | |||
| 1202 | Elements of ALIST that are not conses are also shared. */) | 1209 | Elements 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 | ||
| 1371 | DEFUN ("nth", Fnth, Snth, 2, 2, 0, | 1379 | DEFUN ("nth", Fnth, Snth, 2, 2, 0, |
| @@ -1392,66 +1400,61 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, | |||
| 1392 | DEFUN ("member", Fmember, Smember, 2, 2, 0, | 1400 | DEFUN ("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'. |
| 1394 | The value is actually the tail of LIST whose car is ELT. */) | 1402 | The 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 | ||
| 1410 | DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | 1417 | DEFUN ("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'. |
| 1412 | The value is actually the tail of LIST whose car is ELT. */) | 1419 | The 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 | ||
| 1436 | DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, | 1437 | DEFUN ("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'. |
| 1438 | The value is actually the tail of LIST whose car is ELT. */) | 1439 | The 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. | |||
| 1461 | Elements of LIST that are not conses are ignored. */) | 1464 | Elements 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 | ||
| 1493 | Lisp_Object | 1483 | Lisp_Object |
| 1494 | assq_no_quit (Lisp_Object key, Lisp_Object list) | 1484 | assq_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 | ||
| 1504 | DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | 1492 | DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, |
| @@ -1506,81 +1494,52 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | |||
| 1506 | The value is actually the first element of LIST whose car equals KEY. */) | 1494 | The 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 | ||
| 1543 | Lisp_Object | 1514 | Lisp_Object |
| 1544 | assoc_no_quit (Lisp_Object key, Lisp_Object list) | 1515 | assoc_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 | ||
| 1555 | DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, | 1527 | DEFUN ("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. |
| 1557 | The value is actually the first element of LIST whose cdr is KEY. */) | 1529 | The 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 | ||
| 1586 | DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, | 1545 | DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, |
| @@ -1588,35 +1547,18 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, | |||
| 1588 | The value is actually the first element of LIST whose cdr equals KEY. */) | 1547 | The 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 | ||
| 1622 | DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, | 1564 | DEFUN ("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, | |||
| 2130 | otherwise the new PROP VAL pair is added. The new plist is returned; | 2074 | otherwise the new PROP VAL pair is added. The new plist is returned; |
| 2131 | use `(setq x (plist-put x prop val))' to be sure to use the new value. | 2075 | use `(setq x (plist-put x prop val))' to be sure to use the new value. |
| 2132 | The PLIST is modified by side effects. */) | 2076 | The 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 | |||
| 2174 | one of the properties on the list. */) | 2118 | one 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, | |||
| 2199 | otherwise the new PROP VAL pair is added. The new plist is returned; | 2143 | otherwise the new PROP VAL pair is added. The new plist is returned; |
| 2200 | use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. | 2144 | use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. |
| 2201 | The PLIST is modified by side effects. */) | 2145 | The 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. | |||
| 2483 | usage: (nconc &rest LISTS) */) | 2426 | usage: (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. | |||
| 2927 | The value is actually the tail of PLIST whose car is PROP. */) | 2873 | The 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 | ||
| 3809 | Lisp_Object | 3760 | Lisp_Object |
| 3810 | make_hash_table (struct hash_table_test test, | 3761 | make_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 | |||
| 4514 | WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK | 4467 | WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK |
| 4515 | is nil. | 4468 | is nil. |
| 4516 | 4469 | ||
| 4470 | :purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied | ||
| 4471 | to pure storage when Emacs is being dumped, making the contents of the | ||
| 4472 | table read only. Any further changes to purified tables will result | ||
| 4473 | in an error. | ||
| 4474 | |||
| 4517 | usage: (make-hash-table &rest KEYWORD-ARGS) */) | 4475 | usage: (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 | ||
| 4026 | static void | 4026 | static 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"; | |||
| 87 | volatile int interrupt_input_blocked; | 87 | volatile 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. */ |
| 91 | volatile bool pending_signals; | 91 | volatile 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 | ||
| 10283 | static void | 10283 | static void |
| 10284 | handle_interrupt_signal (int sig) | 10284 | handle_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); | |||
| 486 | extern void add_user_signal (int, const char *); | 486 | extern void add_user_signal (int, const char *); |
| 487 | 487 | ||
| 488 | extern int tty_read_avail_input (struct terminal *, struct input_event *); | 488 | extern int tty_read_avail_input (struct terminal *, struct input_event *); |
| 489 | extern bool volatile pending_signals; | ||
| 490 | extern void process_pending_signals (void); | ||
| 489 | extern struct timespec timer_check (void); | 491 | extern struct timespec timer_check (void); |
| 490 | extern void mark_kboards (void); | 492 | extern 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 | ||
| 2753 | INLINE void | 2755 | INLINE void |
| 2754 | (CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) | 2756 | CHECK_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 | ||
| 2759 | INLINE void | 2761 | INLINE void |
| @@ -3121,34 +3123,25 @@ struct handler | |||
| 3121 | 3123 | ||
| 3122 | extern Lisp_Object memory_signal_data; | 3124 | extern 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 | |||
| 3140 | extern void process_pending_signals (void); | ||
| 3141 | extern bool volatile pending_signals; | ||
| 3142 | 3141 | ||
| 3143 | extern 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 | ||
| 3144 | extern 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); | |||
| 3375 | EMACS_UINT hash_string (char const *, ptrdiff_t); | 3368 | EMACS_UINT hash_string (char const *, ptrdiff_t); |
| 3376 | EMACS_UINT sxhash (Lisp_Object, int); | 3369 | EMACS_UINT sxhash (Lisp_Object, int); |
| 3377 | Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, | 3370 | Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, |
| 3378 | Lisp_Object, Lisp_Object); | 3371 | Lisp_Object, Lisp_Object, Lisp_Object); |
| 3379 | ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); | 3372 | ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); |
| 3380 | ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, | 3373 | ptrdiff_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. */ | ||
| 3099 | static bool | ||
| 3100 | in_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. */ |
| 145 | static int | 145 | static int |
| 146 | lisp_mutex_lock (lisp_mutex_t *mutex, int new_count) | 146 | lisp_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 | ||
| 180 | static int | ||
| 181 | lisp_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 | ||
| 413 | DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0, | 420 | DEFUN ("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 | ||
| 673 | static Lisp_Object last_thread_error; | ||
| 674 | |||
| 666 | static Lisp_Object | 675 | static Lisp_Object |
| 667 | do_nothing (Lisp_Object whatever) | 676 | record_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 | ||
| 672 | static void * | 682 | static 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 | ||
| 957 | DEFUN ("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 | ||
| 949 | bool | 966 | bool |
| @@ -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 | ||
| 11003 | void | 10999 | void |
| 11004 | x_make_frame_visible (struct frame *f) | 11000 | x_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 | ||
| 35 | available (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) { | ||
| 69 | if (start - 1 === 0 || /[ (:,='\"]/.test(value)) { | ||
| 70 | --start; | ||
| 71 | } | ||
| 72 | if (start - 1 === 0 && /[ (:,='\"]/.test(value)) { | ||
| 73 | --start; | ||
| 74 | } | ||
| 75 | if (!/[ (:,='\"]/.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 | " | ||
| 1163 | def f(): | ||
| 1164 | if True: | ||
| 1165 | a = 5 | ||
| 1166 | |||
| 1167 | if True: | ||
| 1168 | a = 10 | ||
| 1169 | |||
| 1170 | b = 3 | ||
| 1171 | |||
| 1172 | else | ||
| 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. | ||
| 60 | Specifically, where the first character of the comment marker is | ||
| 61 | also 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 |