diff options
| author | Alan Mackenzie | 2017-02-12 10:59:03 +0000 |
|---|---|---|
| committer | Alan Mackenzie | 2017-02-12 10:59:03 +0000 |
| commit | f4d5b687150810129b7a1d5b006e31ccf82b691b (patch) | |
| tree | 4229b13800349032697daae3904dc3773e6b7a80 | |
| parent | d5514332d4a6092673ce1f78fadcae0c57f7be64 (diff) | |
| parent | 148100d98319499f0ac6f57b8be08cbd14884a5c (diff) | |
| download | emacs-comment-cache.tar.gz emacs-comment-cache.zip | |
Merge branch 'master' into comment-cachecomment-cache
167 files changed, 4939 insertions, 2189 deletions
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index b58180e6fab..d0096adc6d2 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty | |||
| @@ -1239,9 +1239,8 @@ DIARY OF CHANGES | |||
| 1239 | (Update: OK, it all seems so easy now (NOT). Input could be done | 1239 | (Update: OK, it all seems so easy now (NOT). Input could be done |
| 1240 | synchronously (with wait_reading_process_input), or asynchronously | 1240 | synchronously (with wait_reading_process_input), or asynchronously |
| 1241 | by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag, | 1241 | by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag, |
| 1242 | signals a 'quit condition (when immediate_quit), or throws to | 1242 | signals a 'quit condition, or throws to 'getcjmp' when Emacs was |
| 1243 | 'getcjmp' when Emacs was waiting for input when the C-g event | 1243 | waiting for input when the C-g event arrived.) |
| 1244 | arrived.) | ||
| 1245 | 1244 | ||
| 1246 | -- Replace wrong_kboard_jmpbuf with a special return value of | 1245 | -- Replace wrong_kboard_jmpbuf with a special return value of |
| 1247 | read_char. It is absurd that we use setjmp/longjmp just to return | 1246 | read_char. It is absurd that we use setjmp/longjmp just to return |
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index c6e990d9082..15c700892bc 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi | |||
| @@ -285,13 +285,17 @@ multiple variables, the order of priority is: | |||
| 285 | @code{scroll-up-aggressively} / @code{scroll-down-aggressively}. | 285 | @code{scroll-up-aggressively} / @code{scroll-down-aggressively}. |
| 286 | 286 | ||
| 287 | @vindex scroll-margin | 287 | @vindex scroll-margin |
| 288 | @vindex maximum-scroll-margin | ||
| 288 | The variable @code{scroll-margin} restricts how close point can come | 289 | The variable @code{scroll-margin} restricts how close point can come |
| 289 | to the top or bottom of a window (even if aggressive scrolling | 290 | to the top or bottom of a window (even if aggressive scrolling |
| 290 | specifies a fraction @var{f} that is larger than the window portion | 291 | specifies a fraction @var{f} that is larger than the window portion |
| 291 | between the top and the bottom margins). Its value is a number of screen | 292 | between the top and the bottom margins). Its value is a number of |
| 292 | lines; if point comes within that many lines of the top or bottom of | 293 | screen lines; if point comes within that many lines of the top or |
| 293 | the window, Emacs performs automatic scrolling. By default, | 294 | bottom of the window, Emacs performs automatic scrolling. By default, |
| 294 | @code{scroll-margin} is 0. | 295 | @code{scroll-margin} is 0. The effective margin size is limited to a |
| 296 | quarter of the window height by default, but this limit can be | ||
| 297 | increased up to half (or decreased down to zero) by customizing | ||
| 298 | @code{maximum-scroll-margin}. | ||
| 295 | 299 | ||
| 296 | @node Horizontal Scrolling | 300 | @node Horizontal Scrolling |
| 297 | @section Horizontal Scrolling | 301 | @section Horizontal Scrolling |
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 5c582e571e2..2b09c69945c 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi | |||
| @@ -417,6 +417,12 @@ changes you would be saving. This calls the command | |||
| 417 | Display a help message about these options. | 417 | Display a help message about these options. |
| 418 | @end table | 418 | @end table |
| 419 | 419 | ||
| 420 | @noindent | ||
| 421 | @vindex save-some-buffers-default-predicate | ||
| 422 | You can customize the value of | ||
| 423 | @code{save-some-buffers-default-predicate} to control which buffers | ||
| 424 | Emacs will ask about. | ||
| 425 | |||
| 420 | @kbd{C-x C-c}, the key sequence to exit Emacs, invokes | 426 | @kbd{C-x C-c}, the key sequence to exit Emacs, invokes |
| 421 | @code{save-some-buffers} and therefore asks the same questions. | 427 | @code{save-some-buffers} and therefore asks the same questions. |
| 422 | 428 | ||
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index b7282589735..fa69ba48f6a 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi | |||
| @@ -1670,8 +1670,9 @@ replacing regexp matches in file names. | |||
| 1670 | Here are some other commands that find matches for a regular | 1670 | Here are some other commands that find matches for a regular |
| 1671 | expression. They all ignore case in matching, if the pattern contains | 1671 | expression. They all ignore case in matching, if the pattern contains |
| 1672 | no upper-case letters and @code{case-fold-search} is non-@code{nil}. | 1672 | no upper-case letters and @code{case-fold-search} is non-@code{nil}. |
| 1673 | Aside from @code{occur} and its variants, all operate on the text from | 1673 | Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers}, |
| 1674 | point to the end of the buffer, or on the region if it is active. | 1674 | which always search the whole buffer, all operate on the text from point |
| 1675 | to the end of the buffer, or on the region if it is active. | ||
| 1675 | 1676 | ||
| 1676 | @findex list-matching-lines | 1677 | @findex list-matching-lines |
| 1677 | @findex occur | 1678 | @findex occur |
| @@ -1714,6 +1715,8 @@ a multi-file incremental search is activated automatically. | |||
| 1714 | @cindex mode, Occur | 1715 | @cindex mode, Occur |
| 1715 | @cindex match (face name) | 1716 | @cindex match (face name) |
| 1716 | @vindex list-matching-lines-default-context-lines | 1717 | @vindex list-matching-lines-default-context-lines |
| 1718 | @vindex list-matching-lines-jump-to-current-line | ||
| 1719 | @cindex list-matching-lines-current-line-face (face name) | ||
| 1717 | @kindex M-s o | 1720 | @kindex M-s o |
| 1718 | @item M-x occur | 1721 | @item M-x occur |
| 1719 | @itemx M-s o | 1722 | @itemx M-s o |
| @@ -1721,11 +1724,14 @@ Prompt for a regexp, and display a list showing each line in the | |||
| 1721 | buffer that contains a match for it. If you type @kbd{M-n} at the | 1724 | buffer that contains a match for it. If you type @kbd{M-n} at the |
| 1722 | prompt, you can reuse search strings from previous incremental | 1725 | prompt, you can reuse search strings from previous incremental |
| 1723 | searches. The text that matched is highlighted using the @code{match} | 1726 | searches. The text that matched is highlighted using the @code{match} |
| 1724 | face. To limit the search to part of the buffer, narrow to that part | 1727 | face. A numeric argument @var{n} specifies that @var{n} lines of |
| 1725 | (@pxref{Narrowing}). A numeric argument @var{n} specifies that | 1728 | context are to be displayed before and after each matching line. |
| 1726 | @var{n} lines of context are to be displayed before and after each | 1729 | The default number of context lines is specified by the variable |
| 1727 | matching line. The default number of context lines is specified by | 1730 | @code{list-matching-lines-default-context-lines}. |
| 1728 | the variable @code{list-matching-lines-default-context-lines}. | 1731 | When @code{list-matching-lines-jump-to-current-line} is non-nil, |
| 1732 | the current line is shown highlighted with face | ||
| 1733 | @code{list-matching-lines-current-line-face} and the point is set | ||
| 1734 | at the first match after such line. | ||
| 1729 | 1735 | ||
| 1730 | You can also run @kbd{M-s o} when an incremental search is active; | 1736 | You can also run @kbd{M-s o} when an incremental search is active; |
| 1731 | this uses the current search string. | 1737 | this uses the current search string. |
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 830c072cf5e..36d767737df 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi | |||
| @@ -17151,9 +17151,11 @@ Here is another keybinding, with a comment: | |||
| 17151 | 17151 | ||
| 17152 | @findex occur | 17152 | @findex occur |
| 17153 | The @code{occur} command shows all the lines in the current buffer | 17153 | The @code{occur} command shows all the lines in the current buffer |
| 17154 | that contain a match for a regular expression. Matching lines are | 17154 | that contain a match for a regular expression. When the region is |
| 17155 | shown in a buffer called @file{*Occur*}. That buffer serves as a menu | 17155 | active, @code{occur} restricts matches to such region. Otherwise it |
| 17156 | to jump to occurrences. | 17156 | uses the entire buffer. |
| 17157 | Matching lines are shown in a buffer called @file{*Occur*}. | ||
| 17158 | That buffer serves as a menu to jump to occurrences. | ||
| 17157 | 17159 | ||
| 17158 | @findex global-unset-key | 17160 | @findex global-unset-key |
| 17159 | @cindex Unbinding key | 17161 | @cindex Unbinding key |
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index f6f73ea8947..da72c9b700c 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi | |||
| @@ -979,9 +979,13 @@ program. | |||
| 979 | 979 | ||
| 980 | @itemize @bullet | 980 | @itemize @bullet |
| 981 | @item | 981 | @item |
| 982 | @code{max-lisp-eval-depth} and @code{max-specpdl-size} are both | 982 | @vindex edebug-max-depth |
| 983 | increased to reduce Edebug's impact on the stack. You could, however, | 983 | @code{max-lisp-eval-depth} (@pxref{Eval}) and @code{max-specpdl-size} |
| 984 | still run out of stack space when using Edebug. | 984 | (@pxref{Local Variables}) are both increased to reduce Edebug's impact |
| 985 | on the stack. You could, however, still run out of stack space when | ||
| 986 | using Edebug. You can also enlarge the value of | ||
| 987 | @code{edebug-max-depth} if Edebug reaches the limit of recursion depth | ||
| 988 | instrumenting code that contains very large quoted lists. | ||
| 985 | 989 | ||
| 986 | @item | 990 | @item |
| 987 | The state of keyboard macro execution is saved and restored. While | 991 | The state of keyboard macro execution is saved and restored. While |
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 853e84477e2..ef373211415 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi | |||
| @@ -368,17 +368,21 @@ asks the user about each buffer. But if @var{save-silently-p} is | |||
| 368 | non-@code{nil}, it saves all the file-visiting buffers without querying | 368 | non-@code{nil}, it saves all the file-visiting buffers without querying |
| 369 | the user. | 369 | the user. |
| 370 | 370 | ||
| 371 | The optional @var{pred} argument controls which buffers to ask about | 371 | @vindex save-some-buffers-default-predicate |
| 372 | (or to save silently if @var{save-silently-p} is non-@code{nil}). | 372 | The optional @var{pred} argument provides a predicate that controls |
| 373 | If it is @code{nil}, that means to ask only about file-visiting buffers. | 373 | which buffers to ask about (or to save silently if |
| 374 | If it is @code{t}, that means also offer to save certain other non-file | 374 | @var{save-silently-p} is non-@code{nil}). If @var{pred} is |
| 375 | buffers---those that have a non-@code{nil} buffer-local value of | 375 | @code{nil}, that means to use the value of |
| 376 | @code{buffer-offer-save} (@pxref{Killing Buffers}). A user who says | 376 | @code{save-some-buffers-default-predicate} instead of @var{pred}. If |
| 377 | @samp{yes} to saving a non-file buffer is asked to specify the file | 377 | the result is @code{nil}, it means ask only about file-visiting |
| 378 | name to use. The @code{save-buffers-kill-emacs} function passes the | 378 | buffers. If it is @code{t}, that means also offer to save certain |
| 379 | value @code{t} for @var{pred}. | 379 | other non-file buffers---those that have a non-@code{nil} buffer-local |
| 380 | 380 | value of @code{buffer-offer-save} (@pxref{Killing Buffers}). A user | |
| 381 | If @var{pred} is neither @code{t} nor @code{nil}, then it should be | 381 | who says @samp{yes} to saving a non-file buffer is asked to specify |
| 382 | the file name to use. The @code{save-buffers-kill-emacs} function | ||
| 383 | passes the value @code{t} for @var{pred}. | ||
| 384 | |||
| 385 | If the predicate is neither @code{t} nor @code{nil}, then it should be | ||
| 382 | a function of no arguments. It will be called in each buffer to decide | 386 | a function of no arguments. It will be called in each buffer to decide |
| 383 | whether to offer to save that buffer. If it returns a non-@code{nil} | 387 | whether to offer to save that buffer. If it returns a non-@code{nil} |
| 384 | value in a certain buffer, that means do offer to save that buffer. | 388 | value in a certain buffer, that means do offer to save that buffer. |
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/windows.texi b/doc/lispref/windows.texi index 6f3de0c8a0e..affa28c9202 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi | |||
| @@ -3924,6 +3924,21 @@ redisplay scrolls the text automatically (if possible) to move point | |||
| 3924 | out of the margin, closer to the center of the window. | 3924 | out of the margin, closer to the center of the window. |
| 3925 | @end defopt | 3925 | @end defopt |
| 3926 | 3926 | ||
| 3927 | @defopt maximum-scroll-margin | ||
| 3928 | This variable limits the effective value of @code{scroll-margin} to a | ||
| 3929 | fraction of the current window line height. For example, if the | ||
| 3930 | current window has 20 lines and @code{maximum-scroll-margin} is 0.1, | ||
| 3931 | then the scroll margins will never be larger than 2 lines, no matter | ||
| 3932 | how big @code{scroll-margin} is. | ||
| 3933 | |||
| 3934 | @code{maximum-scroll-margin} itself has a maximum value of 0.5, which | ||
| 3935 | allows setting margins large to keep the cursor at the middle line of | ||
| 3936 | the window (or two middle lines if the window has an even number of | ||
| 3937 | lines). If it's set to a larger value (or any value other than a | ||
| 3938 | float between 0.0 and 0.5) then the default value of 0.25 will be used | ||
| 3939 | instead. | ||
| 3940 | @end defopt | ||
| 3941 | |||
| 3927 | @defopt scroll-conservatively | 3942 | @defopt scroll-conservatively |
| 3928 | This variable controls how scrolling is done automatically when point | 3943 | This variable controls how scrolling is done automatically when point |
| 3929 | moves off the screen (or into the scroll margin). If the value is a | 3944 | moves off the screen (or into the scroll margin). If the value is a |
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 68a16c0ed74..14981c9c58b 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi | |||
| @@ -4141,7 +4141,8 @@ Open brace of an enum or static array list. @ref{Brace List Symbols}. | |||
| 4141 | @item brace-list-close | 4141 | @item brace-list-close |
| 4142 | Close brace of an enum or static array list. @ref{Brace List Symbols}. | 4142 | Close brace of an enum or static array list. @ref{Brace List Symbols}. |
| 4143 | @item brace-list-intro | 4143 | @item brace-list-intro |
| 4144 | First line in an enum or static array list. @ref{Brace List Symbols}. | 4144 | First line after the opening @samp{@{} in an enum or static array |
| 4145 | list. @ref{Brace List Symbols}. | ||
| 4145 | @item brace-list-entry | 4146 | @item brace-list-entry |
| 4146 | Subsequent lines in an enum or static array list. @ref{Brace List | 4147 | Subsequent lines in an enum or static array list. @ref{Brace List |
| 4147 | Symbols}. | 4148 | Symbols}. |
| @@ -4635,11 +4636,18 @@ example: | |||
| 4635 | 4636 | ||
| 4636 | Here, you've already seen the analysis of lines 1, 2, 3, and 11. On | 4637 | Here, you've already seen the analysis of lines 1, 2, 3, and 11. On |
| 4637 | line 4, things get interesting; this line is assigned | 4638 | line 4, things get interesting; this line is assigned |
| 4638 | @code{brace-entry-open} syntactic symbol because it's a bracelist entry | 4639 | @code{brace-entry-open} syntactic symbol because it's a bracelist |
| 4639 | line that starts with an open brace. Lines 5 and 6 (and line 9) are | 4640 | entry line that starts with an open brace. Lines 5 and 6 are pretty |
| 4640 | pretty standard, and line 7 is a @code{brace-list-close} as you'd | 4641 | standard, and line 7 is a @code{brace-list-close} as you'd expect. |
| 4641 | expect. Once again, line 8 is assigned as @code{brace-entry-open} as is | 4642 | Once again, line 8 is assigned as @code{brace-entry-open} as is line |
| 4642 | line 10. | 4643 | 10. Line 9 is assigned two syntactic elements, @code{brace-list-intro} |
| 4644 | with anchor point at the @samp{@{} of line 8@footnote{This extra | ||
| 4645 | syntactic element was introduced in @ccmode{} 5.33.1 to allow extra | ||
| 4646 | flexibility in indenting the second line of such a construct. You can | ||
| 4647 | preserve the behaviour resulting from the former syntactic analysis by | ||
| 4648 | giving @code{brace-list-entry} an offset of | ||
| 4649 | @code{c-lineup-under-anchor} (@pxref{Misc Line-Up}).}, and | ||
| 4650 | @code{brace-list-entry} anchored on the @samp{1} of line 8. | ||
| 4643 | 4651 | ||
| 4644 | @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | 4652 | @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
| 4645 | @node External Scope Symbols, Paren List Symbols, Brace List Symbols, Syntactic Symbols | 4653 | @node External Scope Symbols, Paren List Symbols, Brace List Symbols, Syntactic Symbols |
| @@ -6288,6 +6296,17 @@ already has; think of it as an identity function for lineups. | |||
| 6288 | 6296 | ||
| 6289 | @comment ------------------------------------------------------------ | 6297 | @comment ------------------------------------------------------------ |
| 6290 | 6298 | ||
| 6299 | @defun c-lineup-under-anchor | ||
| 6300 | |||
| 6301 | Line up a line directly underneath its anchor point. This is like | ||
| 6302 | @samp{0}, except any previously calculated offset contributions are | ||
| 6303 | disregarded. | ||
| 6304 | |||
| 6305 | @workswith Any syntactic symbol which has an anchor point. | ||
| 6306 | @end defun | ||
| 6307 | |||
| 6308 | @comment ------------------------------------------------------------ | ||
| 6309 | |||
| 6291 | @defun c-lineup-cpp-define | 6310 | @defun c-lineup-cpp-define |
| 6292 | @findex lineup-cpp-define (c-) | 6311 | @findex lineup-cpp-define (c-) |
| 6293 | Line up macro continuation lines according to the indentation of the | 6312 | Line up macro continuation lines according to the indentation of the |
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 |
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index c8913ab918e..338bcf65040 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | % Load plain if necessary, i.e., if running under initex. | 3 | % Load plain if necessary, i.e., if running under initex. |
| 4 | \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi | 4 | \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi |
| 5 | % | 5 | % |
| 6 | \def\texinfoversion{2016-09-18.18} | 6 | \def\texinfoversion{2017-01-14.15} |
| 7 | % | 7 | % |
| 8 | % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, | 8 | % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, |
| 9 | % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, | 9 | % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, |
| @@ -165,6 +165,9 @@ | |||
| 165 | % Give the space character the catcode for a space. | 165 | % Give the space character the catcode for a space. |
| 166 | \def\spaceisspace{\catcode`\ =10\relax} | 166 | \def\spaceisspace{\catcode`\ =10\relax} |
| 167 | 167 | ||
| 168 | % Likewise for ^^M, the end of line character. | ||
| 169 | \def\endlineisspace{\catcode13=10\relax} | ||
| 170 | |||
| 168 | \chardef\dashChar = `\- | 171 | \chardef\dashChar = `\- |
| 169 | \chardef\slashChar = `\/ | 172 | \chardef\slashChar = `\/ |
| 170 | \chardef\underChar = `\_ | 173 | \chardef\underChar = `\_ |
| @@ -950,21 +953,14 @@ where each line of input produces a line of output.} | |||
| 950 | % @comment ...line which is ignored... | 953 | % @comment ...line which is ignored... |
| 951 | % @c is the same as @comment | 954 | % @c is the same as @comment |
| 952 | % @ignore ... @end ignore is another way to write a comment | 955 | % @ignore ... @end ignore is another way to write a comment |
| 953 | % | ||
| 954 | \def\comment{\begingroup \catcode`\^^M=\active% | ||
| 955 | \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other\commentxxx}% | ||
| 956 | 956 | ||
| 957 | {\catcode`\^^M=\active% | ||
| 958 | \gdef\commentxxx#1^^M{\endgroup% | ||
| 959 | \futurelet\nexttoken\commentxxxx}% | ||
| 960 | \gdef\commentxxxx{\ifx\nexttoken\aftermacro\expandafter\comment\fi}% | ||
| 961 | } | ||
| 962 | 957 | ||
| 963 | \def\c{\begingroup \catcode`\^^M=\active% | 958 | \def\c{\begingroup \catcode`\^^M=\active% |
| 964 | \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other% | 959 | \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other% |
| 965 | \cxxx} | 960 | \cxxx} |
| 966 | {\catcode`\^^M=\active \gdef\cxxx#1^^M{\endgroup}} | 961 | {\catcode`\^^M=\active \gdef\cxxx#1^^M{\endgroup}} |
| 967 | % See comment in \scanmacro about why the definitions of @c and @comment differ | 962 | % |
| 963 | \let\comment\c | ||
| 968 | 964 | ||
| 969 | % @paragraphindent NCHARS | 965 | % @paragraphindent NCHARS |
| 970 | % We'll use ems for NCHARS, close enough. | 966 | % We'll use ems for NCHARS, close enough. |
| @@ -8031,9 +8027,6 @@ end | |||
| 8031 | } | 8027 | } |
| 8032 | \fi | 8028 | \fi |
| 8033 | 8029 | ||
| 8034 | \let\aftermacroxxx\relax | ||
| 8035 | \def\aftermacro{\aftermacroxxx} | ||
| 8036 | |||
| 8037 | % alias because \c means cedilla in @tex or @math | 8030 | % alias because \c means cedilla in @tex or @math |
| 8038 | \let\texinfoc=\c | 8031 | \let\texinfoc=\c |
| 8039 | 8032 | ||
| @@ -8055,18 +8048,13 @@ end | |||
| 8055 | \catcode`\\=\active | 8048 | \catcode`\\=\active |
| 8056 | % | 8049 | % |
| 8057 | % Process the macro body under the current catcode regime. | 8050 | % Process the macro body under the current catcode regime. |
| 8058 | \scantokens{#1@texinfoc}\aftermacro% | 8051 | \scantokens{#1@texinfoc}% |
| 8059 | % | 8052 | % |
| 8060 | \catcode`\@=\savedcatcodeone | 8053 | \catcode`\@=\savedcatcodeone |
| 8061 | \catcode`\\=\savedcatcodetwo | 8054 | \catcode`\\=\savedcatcodetwo |
| 8062 | % | 8055 | % |
| 8063 | % The \texinfoc is to remove the \newlinechar added by \scantokens, and | 8056 | % The \texinfoc is to remove the \newlinechar added by \scantokens, and |
| 8064 | % can be noticed by \parsearg. | 8057 | % can be noticed by \parsearg. |
| 8065 | % The \aftermacro allows a \comment at the end of the macro definition | ||
| 8066 | % to duplicate itself past the final \newlinechar added by \scantokens: | ||
| 8067 | % this is used in the definition of \group to comment out a newline. We | ||
| 8068 | % don't do the same for \c to support Texinfo files with macros that ended | ||
| 8069 | % with a @c, which should no longer be necessary. | ||
| 8070 | % We avoid surrounding the call to \scantokens with \bgroup and \egroup | 8058 | % We avoid surrounding the call to \scantokens with \bgroup and \egroup |
| 8071 | % to allow macros to open or close groups themselves. | 8059 | % to allow macros to open or close groups themselves. |
| 8072 | } | 8060 | } |
| @@ -8538,6 +8526,13 @@ end | |||
| 8538 | \ifcase\paramno | 8526 | \ifcase\paramno |
| 8539 | % 0 | 8527 | % 0 |
| 8540 | \expandafter\xdef\csname\the\macname\endcsname{% | 8528 | \expandafter\xdef\csname\the\macname\endcsname{% |
| 8529 | \bgroup | ||
| 8530 | \noexpand\spaceisspace | ||
| 8531 | \noexpand\endlineisspace | ||
| 8532 | \noexpand\expandafter % skip any whitespace after the macro name. | ||
| 8533 | \expandafter\noexpand\csname\the\macname @@@\endcsname}% | ||
| 8534 | \expandafter\xdef\csname\the\macname @@@\endcsname{% | ||
| 8535 | \egroup | ||
| 8541 | \noexpand\scanmacro{\macrobody}}% | 8536 | \noexpand\scanmacro{\macrobody}}% |
| 8542 | \or % 1 | 8537 | \or % 1 |
| 8543 | \expandafter\xdef\csname\the\macname\endcsname{% | 8538 | \expandafter\xdef\csname\the\macname\endcsname{% |
| @@ -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. |
| @@ -298,10 +307,23 @@ local part of a remote file name. Thus, if you have a directory named | |||
| 298 | "/~" on the remote host "foo", you can prevent it from being | 307 | "/~" on the remote host "foo", you can prevent it from being |
| 299 | substituted by a home directory by writing it as "/foo:/:/~/file". | 308 | substituted by a home directory by writing it as "/foo:/:/~/file". |
| 300 | 309 | ||
| 310 | +++ | ||
| 311 | ** The new variable 'maximum-scroll-margin' allows having effective | ||
| 312 | settings of 'scroll-margin' up to half the window size, instead of | ||
| 313 | always restricting the margin to a quarter of the window. | ||
| 314 | |||
| 301 | 315 | ||
| 302 | * Editing Changes in Emacs 26.1 | 316 | * Editing Changes in Emacs 26.1 |
| 303 | 317 | ||
| 304 | +++ | 318 | +++ |
| 319 | ** Two new user options 'list-matching-lines-jump-to-current-line' and | ||
| 320 | 'list-matching-lines-current-line-face' to show highlighted the current | ||
| 321 | line in *Occur* buffer. | ||
| 322 | |||
| 323 | +++ | ||
| 324 | ** The 'occur' command can now operate on the region. | ||
| 325 | |||
| 326 | +++ | ||
| 305 | ** New bindings for 'query-replace-map'. | 327 | ** New bindings for 'query-replace-map'. |
| 306 | 'undo', undo the last replacement; bound to 'u'. | 328 | 'undo', undo the last replacement; bound to 'u'. |
| 307 | 'undo-all', undo all replacements; bound to 'U'. | 329 | 'undo-all', undo all replacements; bound to 'U'. |
| @@ -339,6 +361,16 @@ bound to 'Buffer-menu-unmark-all-buffers'. | |||
| 339 | *** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and | 361 | *** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and |
| 340 | 'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'. | 362 | 'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'. |
| 341 | 363 | ||
| 364 | ** Gnus | ||
| 365 | |||
| 366 | --- | ||
| 367 | *** The .newsrc file will now only be saved if the native select | ||
| 368 | method is an NNTP select method. | ||
| 369 | |||
| 370 | +++ | ||
| 371 | *** A new command for sorting articles by readedness marks has been | ||
| 372 | added: `C-c C-s C-m C-m'. | ||
| 373 | |||
| 342 | ** Ibuffer | 374 | ** Ibuffer |
| 343 | 375 | ||
| 344 | --- | 376 | --- |
| @@ -432,6 +464,11 @@ viewing HTML files and the like. | |||
| 432 | breakpoint (e.g. with "f" and "o") by customizing the new option | 464 | breakpoint (e.g. with "f" and "o") by customizing the new option |
| 433 | 'edebug-sit-on-break'. | 465 | 'edebug-sit-on-break'. |
| 434 | 466 | ||
| 467 | +++ | ||
| 468 | *** New customizable option 'edebug-max-depth' | ||
| 469 | This allows to enlarge the maximum recursion depth when instrumenting | ||
| 470 | code. | ||
| 471 | |||
| 435 | ** Eshell | 472 | ** Eshell |
| 436 | 473 | ||
| 437 | *** 'eshell-input-filter's value is now a named function | 474 | *** 'eshell-input-filter's value is now a named function |
| @@ -594,6 +631,13 @@ HTML tags, classes and IDs using the 'completion-at-point' command. | |||
| 594 | Completion candidates for HTML classes and IDs are retrieved from open | 631 | Completion candidates for HTML classes and IDs are retrieved from open |
| 595 | HTML mode buffers. | 632 | HTML mode buffers. |
| 596 | 633 | ||
| 634 | --- | ||
| 635 | *** CSS mode now binds 'C-h S' to a function that will show | ||
| 636 | information about a CSS construct (an at-rule, property, pseudo-class, | ||
| 637 | pseudo-element, with the default being guessed from context). By | ||
| 638 | default the information is looked up on the Mozilla Developer Network, | ||
| 639 | but this can be customized using 'css-lookup-url-format'. | ||
| 640 | |||
| 597 | +++ | 641 | +++ |
| 598 | ** Emacs now supports character name escape sequences in character and | 642 | ** Emacs now supports character name escape sequences in character and |
| 599 | string literals. The syntax variants \N{character name} and | 643 | string literals. The syntax variants \N{character name} and |
| @@ -719,6 +763,13 @@ instead. | |||
| 719 | 763 | ||
| 720 | * Lisp Changes in Emacs 26.1 | 764 | * Lisp Changes in Emacs 26.1 |
| 721 | 765 | ||
| 766 | +++ | ||
| 767 | ** 'save-some-buffers' now uses 'save-some-buffers-default-predicate' | ||
| 768 | to decide which buffers to ask about, if the PRED argument is nil. | ||
| 769 | The default value of 'save-some-buffers-default-predicate' is nil, | ||
| 770 | which means ask about all file-visiting buffers. | ||
| 771 | |||
| 772 | ** string-(to|as|make)-(uni|multi)byte are now declared obsolete. | ||
| 722 | ** New variable 'while-no-input-ignore-events' which allow | 773 | ** New variable 'while-no-input-ignore-events' which allow |
| 723 | setting which special events 'while-no-input' should ignore. | 774 | setting which special events 'while-no-input' should ignore. |
| 724 | It is a list of symbols. | 775 | It is a list of symbols. |
| @@ -778,6 +829,11 @@ of an arbitrary function. This generalizes 'subr-arity' for functions | |||
| 778 | that are not built-in primitives. We recommend using this new | 829 | that are not built-in primitives. We recommend using this new |
| 779 | function instead of 'subr-arity'. | 830 | function instead of 'subr-arity'. |
| 780 | 831 | ||
| 832 | ** New function 'region-bounds' can be used in the interactive spec | ||
| 833 | to provide region boundaries (for rectangular regions more than one) | ||
| 834 | to an interactively callable function as a single argument instead of | ||
| 835 | two separate arguments region-beginning and region-end. | ||
| 836 | |||
| 781 | +++ | 837 | +++ |
| 782 | ** 'parse-partial-sexp' state has a new element. Element 10 is | 838 | ** 'parse-partial-sexp' state has a new element. Element 10 is |
| 783 | non-nil when the last character scanned might be the first character | 839 | non-nil when the last character scanned might be the first character |
| @@ -838,6 +894,13 @@ ABBR is a time zone abbreviation. The affected functions are | |||
| 838 | collection). | 894 | collection). |
| 839 | 895 | ||
| 840 | +++ | 896 | +++ |
| 897 | ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. | ||
| 898 | |||
| 899 | --- | ||
| 900 | ** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. | ||
| 901 | The incumbent 'if-let' and 'when-let' are now aliases. | ||
| 902 | |||
| 903 | +++ | ||
| 841 | ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' | 904 | ** 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. | 905 | can be used for creation of temporary files of remote or mounted directories. |
| 843 | 906 | ||
diff --git a/lib/c-ctype.h b/lib/c-ctype.h index faf21581ca0..bcdba6b9962 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h | |||
| @@ -115,16 +115,16 @@ extern "C" { | |||
| 115 | 115 | ||
| 116 | /* Cases for lowercase hex letters, and lowercase letters, all offset by N. */ | 116 | /* Cases for lowercase hex letters, and lowercase letters, all offset by N. */ |
| 117 | 117 | ||
| 118 | #define _C_CTYPE_LOWER_A_THRU_F_N(n) \ | 118 | #define _C_CTYPE_LOWER_A_THRU_F_N(N) \ |
| 119 | case 'a' + (n): case 'b' + (n): case 'c' + (n): case 'd' + (n): \ | 119 | case 'a' + (N): case 'b' + (N): case 'c' + (N): case 'd' + (N): \ |
| 120 | case 'e' + (n): case 'f' + (n) | 120 | case 'e' + (N): case 'f' + (N) |
| 121 | #define _C_CTYPE_LOWER_N(n) \ | 121 | #define _C_CTYPE_LOWER_N(N) \ |
| 122 | _C_CTYPE_LOWER_A_THRU_F_N(n): \ | 122 | _C_CTYPE_LOWER_A_THRU_F_N(N): \ |
| 123 | case 'g' + (n): case 'h' + (n): case 'i' + (n): case 'j' + (n): \ | 123 | case 'g' + (N): case 'h' + (N): case 'i' + (N): case 'j' + (N): \ |
| 124 | case 'k' + (n): case 'l' + (n): case 'm' + (n): case 'n' + (n): \ | 124 | case 'k' + (N): case 'l' + (N): case 'm' + (N): case 'n' + (N): \ |
| 125 | case 'o' + (n): case 'p' + (n): case 'q' + (n): case 'r' + (n): \ | 125 | case 'o' + (N): case 'p' + (N): case 'q' + (N): case 'r' + (N): \ |
| 126 | case 's' + (n): case 't' + (n): case 'u' + (n): case 'v' + (n): \ | 126 | case 's' + (N): case 't' + (N): case 'u' + (N): case 'v' + (N): \ |
| 127 | case 'w' + (n): case 'x' + (n): case 'y' + (n): case 'z' + (n) | 127 | case 'w' + (N): case 'x' + (N): case 'y' + (N): case 'z' + (N) |
| 128 | 128 | ||
| 129 | /* Cases for hex letters, digits, lower, punct, and upper. */ | 129 | /* Cases for hex letters, digits, lower, punct, and upper. */ |
| 130 | 130 | ||
diff --git a/lib/strftime.c b/lib/strftime.c index 9aabcc6748c..e4d78ef7011 100644 --- a/lib/strftime.c +++ b/lib/strftime.c | |||
| @@ -739,11 +739,10 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | |||
| 739 | /* The mask is not what you might think. | 739 | /* The mask is not what you might think. |
| 740 | When the ordinal i'th bit is set, insert a colon | 740 | When the ordinal i'th bit is set, insert a colon |
| 741 | before the i'th digit of the time zone representation. */ | 741 | before the i'th digit of the time zone representation. */ |
| 742 | #define DO_TZ_OFFSET(d, negative, mask, v) \ | 742 | #define DO_TZ_OFFSET(d, mask, v) \ |
| 743 | do \ | 743 | do \ |
| 744 | { \ | 744 | { \ |
| 745 | digits = d; \ | 745 | digits = d; \ |
| 746 | negative_number = negative; \ | ||
| 747 | tz_colon_mask = mask; \ | 746 | tz_colon_mask = mask; \ |
| 748 | u_number_value = v; \ | 747 | u_number_value = v; \ |
| 749 | goto do_tz_offset; \ | 748 | goto do_tz_offset; \ |
| @@ -1444,6 +1443,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | |||
| 1444 | } | 1443 | } |
| 1445 | #endif | 1444 | #endif |
| 1446 | 1445 | ||
| 1446 | negative_number = diff < 0 || (diff == 0 && *zone == '-'); | ||
| 1447 | hour_diff = diff / 60 / 60; | 1447 | hour_diff = diff / 60 / 60; |
| 1448 | min_diff = diff / 60 % 60; | 1448 | min_diff = diff / 60 % 60; |
| 1449 | sec_diff = diff % 60; | 1449 | sec_diff = diff % 60; |
| @@ -1451,13 +1451,13 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | |||
| 1451 | switch (colons) | 1451 | switch (colons) |
| 1452 | { | 1452 | { |
| 1453 | case 0: /* +hhmm */ | 1453 | case 0: /* +hhmm */ |
| 1454 | DO_TZ_OFFSET (5, diff < 0, 0, hour_diff * 100 + min_diff); | 1454 | DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); |
| 1455 | 1455 | ||
| 1456 | case 1: tz_hh_mm: /* +hh:mm */ | 1456 | case 1: tz_hh_mm: /* +hh:mm */ |
| 1457 | DO_TZ_OFFSET (6, diff < 0, 04, hour_diff * 100 + min_diff); | 1457 | DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); |
| 1458 | 1458 | ||
| 1459 | case 2: tz_hh_mm_ss: /* +hh:mm:ss */ | 1459 | case 2: tz_hh_mm_ss: /* +hh:mm:ss */ |
| 1460 | DO_TZ_OFFSET (9, diff < 0, 024, | 1460 | DO_TZ_OFFSET (9, 024, |
| 1461 | hour_diff * 10000 + min_diff * 100 + sec_diff); | 1461 | hour_diff * 10000 + min_diff * 100 + sec_diff); |
| 1462 | 1462 | ||
| 1463 | case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ | 1463 | case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ |
| @@ -1465,7 +1465,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) | |||
| 1465 | goto tz_hh_mm_ss; | 1465 | goto tz_hh_mm_ss; |
| 1466 | if (min_diff != 0) | 1466 | if (min_diff != 0) |
| 1467 | goto tz_hh_mm; | 1467 | goto tz_hh_mm; |
| 1468 | DO_TZ_OFFSET (3, diff < 0, 0, hour_diff); | 1468 | DO_TZ_OFFSET (3, 0, hour_diff); |
| 1469 | 1469 | ||
| 1470 | default: | 1470 | default: |
| 1471 | goto bad_format; | 1471 | goto bad_format; |
diff --git a/lib/time-internal.h b/lib/time-internal.h index 79cb5621991..bf22834b2e1 100644 --- a/lib/time-internal.h +++ b/lib/time-internal.h | |||
| @@ -38,8 +38,8 @@ struct tm_zone | |||
| 38 | /* A sequence of null-terminated strings packed next to each other. | 38 | /* A sequence of null-terminated strings packed next to each other. |
| 39 | The strings are followed by an extra null byte. If TZ_IS_SET, | 39 | The strings are followed by an extra null byte. If TZ_IS_SET, |
| 40 | there must be at least one string and the first string (which is | 40 | there must be at least one string and the first string (which is |
| 41 | actually a TZ environment value value) may be empty. Otherwise | 41 | actually a TZ environment value) may be empty. Otherwise all |
| 42 | all strings must be nonempty. | 42 | strings must be nonempty. |
| 43 | 43 | ||
| 44 | Abbreviations are stored here because otherwise the values of | 44 | Abbreviations are stored here because otherwise the values of |
| 45 | tm_zone and/or tzname would be dead after changing TZ and calling | 45 | tm_zone and/or tzname would be dead after changing TZ and calling |
diff --git a/lib/verify.h b/lib/verify.h index dcaf7cab938..dcba9c8cb0a 100644 --- a/lib/verify.h +++ b/lib/verify.h | |||
| @@ -248,7 +248,12 @@ template <int w> | |||
| 248 | /* Verify requirement R at compile-time, as a declaration without a | 248 | /* Verify requirement R at compile-time, as a declaration without a |
| 249 | trailing ';'. */ | 249 | trailing ';'. */ |
| 250 | 250 | ||
| 251 | #define verify(R) _GL_VERIFY (R, "verify (" #R ")") | 251 | #ifdef __GNUC__ |
| 252 | # define verify(R) _GL_VERIFY (R, "verify (" #R ")") | ||
| 253 | #else | ||
| 254 | /* PGI barfs if R is long. Play it safe. */ | ||
| 255 | # define verify(R) _GL_VERIFY (R, "verify (...)") | ||
| 256 | #endif | ||
| 252 | 257 | ||
| 253 | #ifndef __has_builtin | 258 | #ifndef __has_builtin |
| 254 | # define __has_builtin(x) 0 | 259 | # define __has_builtin(x) 0 |
diff --git a/lisp/auth-source.el b/lisp/auth-source.el index c26935fcc97..7402ab21d74 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el | |||
| @@ -2129,7 +2129,7 @@ MODE can be \"login\" or \"password\"." | |||
| 2129 | (if user | 2129 | (if user |
| 2130 | (auth-source-search | 2130 | (auth-source-search |
| 2131 | :host host | 2131 | :host host |
| 2132 | :user "yourusername" | 2132 | :user user |
| 2133 | :max 1 | 2133 | :max 1 |
| 2134 | :require '(:user :secret) | 2134 | :require '(:user :secret) |
| 2135 | :create nil) | 2135 | :create nil) |
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/buff-menu.el b/lisp/buff-menu.el index 77b325ff25d..9f618bcb7de 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el | |||
| @@ -102,9 +102,6 @@ This is set by the prefix argument to `buffer-menu' and related | |||
| 102 | commands.") | 102 | commands.") |
| 103 | (make-variable-buffer-local 'Buffer-menu-files-only) | 103 | (make-variable-buffer-local 'Buffer-menu-files-only) |
| 104 | 104 | ||
| 105 | (defvar Info-current-file) ; from info.el | ||
| 106 | (defvar Info-current-node) ; from info.el | ||
| 107 | |||
| 108 | (defvar Buffer-menu-mode-map | 105 | (defvar Buffer-menu-mode-map |
| 109 | (let ((map (make-sparse-keymap)) | 106 | (let ((map (make-sparse-keymap)) |
| 110 | (menu-map (make-sparse-keymap))) | 107 | (menu-map (make-sparse-keymap))) |
| @@ -702,21 +699,7 @@ means list those buffers and no others." | |||
| 702 | (defun Buffer-menu--pretty-file-name (file) | 699 | (defun Buffer-menu--pretty-file-name (file) |
| 703 | (cond (file | 700 | (cond (file |
| 704 | (abbreviate-file-name file)) | 701 | (abbreviate-file-name file)) |
| 705 | ((and (boundp 'list-buffers-directory) | 702 | ((bound-and-true-p list-buffers-directory)) |
| 706 | list-buffers-directory) | ||
| 707 | list-buffers-directory) | ||
| 708 | ((eq major-mode 'Info-mode) | ||
| 709 | (Buffer-menu-info-node-description Info-current-file)) | ||
| 710 | (t ""))) | 703 | (t ""))) |
| 711 | 704 | ||
| 712 | (defun Buffer-menu-info-node-description (file) | ||
| 713 | (cond | ||
| 714 | ((equal file "dir") "*Info Directory*") | ||
| 715 | ((eq file 'apropos) "*Info Apropos*") | ||
| 716 | ((eq file 'history) "*Info History*") | ||
| 717 | ((eq file 'toc) "*Info TOC*") | ||
| 718 | ((not (stringp file)) "") ; Avoid errors | ||
| 719 | (t | ||
| 720 | (concat "(" (file-name-nondirectory file) ") " Info-current-node)))) | ||
| 721 | |||
| 722 | ;;; buff-menu.el ends here | 705 | ;;; buff-menu.el ends here |
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/calendar/parse-time.el b/lisp/calendar/parse-time.el index 7651c5da1f4..b781cb0eb48 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; parse-time.el --- parsing time strings | 1 | ;;; parse-time.el --- parsing time strings -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -203,12 +203,9 @@ any values that are unknown are returned as nil." | |||
| 203 | (time-second 2digit) | 203 | (time-second 2digit) |
| 204 | (time-secfrac "\\(\\.[0-9]+\\)?") | 204 | (time-secfrac "\\(\\.[0-9]+\\)?") |
| 205 | (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?")) | 205 | (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?")) |
| 206 | (time-offset (concat "Z" time-numoffset)) | ||
| 207 | (partial-time (concat time-hour colon time-minute colon time-second | 206 | (partial-time (concat time-hour colon time-minute colon time-second |
| 208 | time-secfrac)) | 207 | time-secfrac)) |
| 209 | (full-date (concat date-fullyear dash date-month dash date-mday)) | 208 | (full-date (concat date-fullyear dash date-month dash date-mday))) |
| 210 | (full-time (concat partial-time time-offset)) | ||
| 211 | (date-time (concat full-date "T" full-time))) | ||
| 212 | (list (concat "^" full-date) | 209 | (list (concat "^" full-date) |
| 213 | (concat "T" partial-time) | 210 | (concat "T" partial-time) |
| 214 | (concat "\\(Z\\|" time-numoffset "\\)"))) | 211 | (concat "\\(Z\\|" time-numoffset "\\)"))) |
| @@ -225,7 +222,7 @@ If DATE-STRING cannot be parsed, it falls back to | |||
| 225 | (time-re (nth 1 parse-time-iso8601-regexp)) | 222 | (time-re (nth 1 parse-time-iso8601-regexp)) |
| 226 | (tz-re (nth 2 parse-time-iso8601-regexp)) | 223 | (tz-re (nth 2 parse-time-iso8601-regexp)) |
| 227 | re-start | 224 | re-start |
| 228 | time seconds minute hour fractional-seconds | 225 | time seconds minute hour |
| 229 | day month year day-of-week dst tz) | 226 | day month year day-of-week dst tz) |
| 230 | ;; We need to populate 'time' with | 227 | ;; We need to populate 'time' with |
| 231 | ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) | 228 | ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) |
| @@ -240,9 +237,6 @@ If DATE-STRING cannot be parsed, it falls back to | |||
| 240 | (setq hour (string-to-number (match-string 1 date-string)) | 237 | (setq hour (string-to-number (match-string 1 date-string)) |
| 241 | minute (string-to-number (match-string 2 date-string)) | 238 | minute (string-to-number (match-string 2 date-string)) |
| 242 | seconds (string-to-number (match-string 3 date-string)) | 239 | seconds (string-to-number (match-string 3 date-string)) |
| 243 | fractional-seconds (string-to-number (or | ||
| 244 | (match-string 4 date-string) | ||
| 245 | "0")) | ||
| 246 | re-start (match-end 0)) | 240 | re-start (match-end 0)) |
| 247 | (when (string-match tz-re date-string re-start) | 241 | (when (string-match tz-re date-string re-start) |
| 248 | (if (string= "Z" (match-string 1 date-string)) | 242 | (if (string= "Z" (match-string 1 date-string)) |
diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a790419b86f..51c43c7d21a 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el | |||
| @@ -511,6 +511,7 @@ since it could result in memory overflow and make Emacs crash." | |||
| 511 | (scroll-step windows integer) | 511 | (scroll-step windows integer) |
| 512 | (scroll-conservatively windows integer) | 512 | (scroll-conservatively windows integer) |
| 513 | (scroll-margin windows integer) | 513 | (scroll-margin windows integer) |
| 514 | (maximum-scroll-margin windows float "26.1") | ||
| 514 | (hscroll-margin windows integer "22.1") | 515 | (hscroll-margin windows integer "22.1") |
| 515 | (hscroll-step windows number "22.1") | 516 | (hscroll-step windows number "22.1") |
| 516 | (truncate-partial-width-windows | 517 | (truncate-partial-width-windows |
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/dired.el b/lisp/dired.el index 350f6a7d2e3..2733372eb7b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -59,6 +59,10 @@ | |||
| 59 | May contain all other options that don't contradict `-l'; | 59 | May contain all other options that don't contradict `-l'; |
| 60 | may contain even `F', `b', `i' and `s'. See also the variable | 60 | may contain even `F', `b', `i' and `s'. See also the variable |
| 61 | `dired-ls-F-marks-symlinks' concerning the `F' switch. | 61 | `dired-ls-F-marks-symlinks' concerning the `F' switch. |
| 62 | Options that include embedded whitespace must be quoted | ||
| 63 | like this: \\\"--option=value with spaces\\\"; you can use | ||
| 64 | `combine-and-quote-strings' to produce the correct quoting of | ||
| 65 | each option. | ||
| 62 | On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp, | 66 | On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp, |
| 63 | some of the `ls' switches are not supported; see the doc string of | 67 | some of the `ls' switches are not supported; see the doc string of |
| 64 | `insert-directory' in `ls-lisp.el' for more details." | 68 | `insert-directory' in `ls-lisp.el' for more details." |
diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 2c11cd23a7f..172ea163c18 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el | |||
| @@ -442,6 +442,9 @@ Typically \"page-%s.png\".") | |||
| 442 | (defun doc-view-revert-buffer (&optional ignore-auto noconfirm) | 442 | (defun doc-view-revert-buffer (&optional ignore-auto noconfirm) |
| 443 | "Like `revert-buffer', but preserves the buffer's current modes." | 443 | "Like `revert-buffer', but preserves the buffer's current modes." |
| 444 | (interactive (list (not current-prefix-arg))) | 444 | (interactive (list (not current-prefix-arg))) |
| 445 | (if (< undo-outer-limit (* 2 (buffer-size))) | ||
| 446 | ;; It's normal for this operation to result in a very large undo entry. | ||
| 447 | (setq-local undo-outer-limit (* 2 (buffer-size)))) | ||
| 445 | (cl-labels ((revert () | 448 | (cl-labels ((revert () |
| 446 | (let (revert-buffer-function) | 449 | (let (revert-buffer-function) |
| 447 | (revert-buffer ignore-auto noconfirm 'preserve-modes)))) | 450 | (revert-buffer ignore-auto noconfirm 'preserve-modes)))) |
| @@ -1763,6 +1766,8 @@ toggle between displaying the document or editing it as text. | |||
| 1763 | (unless doc-view-doc-type | 1766 | (unless doc-view-doc-type |
| 1764 | (doc-view-set-doc-type)) | 1767 | (doc-view-set-doc-type)) |
| 1765 | (doc-view-set-up-single-converter) | 1768 | (doc-view-set-up-single-converter) |
| 1769 | (unless (memq doc-view-doc-type '(ps)) | ||
| 1770 | (setq-local require-final-newline nil)) | ||
| 1766 | 1771 | ||
| 1767 | (doc-view-make-safe-dir doc-view-cache-directory) | 1772 | (doc-view-make-safe-dir doc-view-cache-directory) |
| 1768 | ;; Handle compressed files, remote files, files inside archives | 1773 | ;; Handle compressed files, remote files, files inside archives |
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/edebug.el b/lisp/emacs-lisp/edebug.el index db54d1eeb20..ec0f08de356 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -112,6 +112,18 @@ and some not, use `def-edebug-spec' to specify an `edebug-form-spec'." | |||
| 112 | :type 'boolean | 112 | :type 'boolean |
| 113 | :group 'edebug) | 113 | :group 'edebug) |
| 114 | 114 | ||
| 115 | (defcustom edebug-max-depth 150 | ||
| 116 | "Maximum recursion depth when instrumenting code. | ||
| 117 | This limit is intended to stop recursion if an Edebug specification | ||
| 118 | contains an infinite loop. When Edebug is instrumenting code | ||
| 119 | containing very large quoted lists, it may reach this limit and give | ||
| 120 | the error message \"Too deep - perhaps infinite loop in spec?\". | ||
| 121 | Make this limit larger to countermand that, but you may also need to | ||
| 122 | increase `max-lisp-eval-depth' and `max-specpdl-size'." | ||
| 123 | :type 'integer | ||
| 124 | :group 'edebug | ||
| 125 | :version "26.1") | ||
| 126 | |||
| 115 | (defcustom edebug-save-windows t | 127 | (defcustom edebug-save-windows t |
| 116 | "If non-nil, Edebug saves and restores the window configuration. | 128 | "If non-nil, Edebug saves and restores the window configuration. |
| 117 | That takes some time, so if your program does not care what happens to | 129 | That takes some time, so if your program does not care what happens to |
| @@ -1452,7 +1464,6 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1452 | (defvar edebug-after-dotted-spec nil) | 1464 | (defvar edebug-after-dotted-spec nil) |
| 1453 | 1465 | ||
| 1454 | (defvar edebug-matching-depth 0) ;; initial value | 1466 | (defvar edebug-matching-depth 0) ;; initial value |
| 1455 | (defconst edebug-max-depth 150) ;; maximum number of matching recursions. | ||
| 1456 | 1467 | ||
| 1457 | 1468 | ||
| 1458 | ;;; Failure to match | 1469 | ;;; Failure to match |
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 7d99cb30274..4cf9d9609e9 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el | |||
| @@ -97,7 +97,7 @@ To be used in ERT tests. If BODY finishes successfully, the test | |||
| 97 | buffer is killed; if there is an error, the test buffer is kept | 97 | buffer is killed; if there is an error, the test buffer is kept |
| 98 | around on error for further inspection. Its name is derived from | 98 | around on error for further inspection. Its name is derived from |
| 99 | the name of the test and the result of NAME-FORM." | 99 | the name of the test and the result of NAME-FORM." |
| 100 | (declare (debug ((form) body)) | 100 | (declare (debug ((":name" form) body)) |
| 101 | (indent 1)) | 101 | (indent 1)) |
| 102 | `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) | 102 | `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) |
| 103 | 103 | ||
| @@ -285,6 +285,30 @@ BUFFER defaults to current buffer. Does not modify BUFFER." | |||
| 285 | (kill-buffer clone))))))) | 285 | (kill-buffer clone))))))) |
| 286 | 286 | ||
| 287 | 287 | ||
| 288 | (defmacro ert-with-message-capture (var &rest body) | ||
| 289 | "Execute BODY while collecting anything written with `message' in VAR. | ||
| 290 | |||
| 291 | Capture all messages produced by `message' when it is called from | ||
| 292 | Lisp, and concatenate them separated by newlines into one string. | ||
| 293 | |||
| 294 | This is useful for separating the issuance of messages by the | ||
| 295 | code under test from the behavior of the *Messages* buffer." | ||
| 296 | (declare (debug (symbolp body)) | ||
| 297 | (indent 1)) | ||
| 298 | (let ((g-advice (cl-gensym))) | ||
| 299 | `(let* ((,var "") | ||
| 300 | (,g-advice (lambda (func &rest args) | ||
| 301 | (if (or (null args) (equal (car args) "")) | ||
| 302 | (apply func args) | ||
| 303 | (let ((msg (apply #'format-message args))) | ||
| 304 | (setq ,var (concat ,var msg "\n")) | ||
| 305 | (funcall func "%s" msg)))))) | ||
| 306 | (advice-add 'message :around ,g-advice) | ||
| 307 | (unwind-protect | ||
| 308 | (progn ,@body) | ||
| 309 | (advice-remove 'message ,g-advice))))) | ||
| 310 | |||
| 311 | |||
| 288 | (provide 'ert-x) | 312 | (provide 'ert-x) |
| 289 | 313 | ||
| 290 | ;;; ert-x.el ends here | 314 | ;;; ert-x.el ends here |
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index a45fc0a05c3..cf82fe3ec63 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | 4 | ||
| 5 | ;; Author: Artur Malabarba <emacs@endlessparentheses.com> | 5 | ;; Author: Artur Malabarba <emacs@endlessparentheses.com> |
| 6 | ;; Package-Requires: ((emacs "24.1")) | 6 | ;; Package-Requires: ((emacs "24.1")) |
| 7 | ;; Version: 1.0.4 | 7 | ;; Version: 1.0.5 |
| 8 | ;; Keywords: extensions lisp | 8 | ;; Keywords: extensions lisp |
| 9 | ;; Prefix: let-alist | 9 | ;; Prefix: let-alist |
| 10 | ;; Separator: - | 10 | ;; Separator: - |
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 54678c5f324..46a5eedd150 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el | |||
| @@ -89,7 +89,8 @@ | |||
| 89 | (functionp &rest form) | 89 | (functionp &rest form) |
| 90 | sexp)) | 90 | sexp)) |
| 91 | 91 | ||
| 92 | (def-edebug-spec pcase-MACRO pcase--edebug-match-macro) | 92 | ;; See bug#24717 |
| 93 | (put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro) | ||
| 93 | 94 | ||
| 94 | ;; Only called from edebug. | 95 | ;; Only called from edebug. |
| 95 | (declare-function get-edebug-spec "edebug" (symbol)) | 96 | (declare-function get-edebug-spec "edebug" (symbol)) |
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7736225b5fa..f7a846927c0 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el | |||
| @@ -115,12 +115,16 @@ threading." | |||
| 115 | binding)) | 115 | binding)) |
| 116 | bindings))) | 116 | bindings))) |
| 117 | 117 | ||
| 118 | (defmacro if-let (bindings then &rest else) | 118 | (defmacro if-let* (bindings then &rest else) |
| 119 | "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. | 119 | "Bind variables according to VARLIST and eval THEN or ELSE. |
| 120 | Argument BINDINGS is a list of tuples whose car is a symbol to be | 120 | Each binding is evaluated in turn with `let*', and evaluation |
| 121 | bound and (optionally) used in THEN, and its cadr is a sexp to be | 121 | stops if a binding value is nil. If all are non-nil, the value |
| 122 | evalled to set symbol's value. In the special case you only want | 122 | of THEN is returned, or the last form in ELSE is returned. |
| 123 | to bind a single value, BINDINGS can just be a plain tuple." | 123 | Each element of VARLIST is a symbol (which is bound to nil) |
| 124 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). | ||
| 125 | In the special case you only want to bind a single value, | ||
| 126 | VARLIST can just be a plain tuple. | ||
| 127 | \n(fn VARLIST THEN ELSE...)" | ||
| 124 | (declare (indent 2) | 128 | (declare (indent 2) |
| 125 | (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) | 129 | (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) |
| 126 | (when (and (<= (length bindings) 2) | 130 | (when (and (<= (length bindings) 2) |
| @@ -132,15 +136,23 @@ to bind a single value, BINDINGS can just be a plain tuple." | |||
| 132 | ,then | 136 | ,then |
| 133 | ,@else))) | 137 | ,@else))) |
| 134 | 138 | ||
| 135 | (defmacro when-let (bindings &rest body) | 139 | (defmacro when-let* (bindings &rest body) |
| 136 | "Process BINDINGS and if all values are non-nil eval BODY. | 140 | "Bind variables according to VARLIST and conditionally eval BODY. |
| 137 | Argument BINDINGS is a list of tuples whose car is a symbol to be | 141 | Each binding is evaluated in turn with `let*', and evaluation |
| 138 | bound and (optionally) used in BODY, and its cadr is a sexp to be | 142 | stops if a binding value is nil. If all are non-nil, the value |
| 139 | evalled to set symbol's value. In the special case you only want | 143 | of the last form in BODY is returned. |
| 140 | to bind a single value, BINDINGS can just be a plain tuple." | 144 | Each element of VARLIST is a symbol (which is bound to nil) |
| 145 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). | ||
| 146 | In the special case you only want to bind a single value, | ||
| 147 | VARLIST can just be a plain tuple. | ||
| 148 | \n(fn VARLIST BODY...)" | ||
| 141 | (declare (indent 1) (debug if-let)) | 149 | (declare (indent 1) (debug if-let)) |
| 142 | (list 'if-let bindings (macroexp-progn body))) | 150 | (list 'if-let bindings (macroexp-progn body))) |
| 143 | 151 | ||
| 152 | (defalias 'if-let 'if-let*) | ||
| 153 | (defalias 'when-let 'when-let*) | ||
| 154 | (defalias 'and-let* 'when-let*) | ||
| 155 | |||
| 144 | (defsubst hash-table-empty-p (hash-table) | 156 | (defsubst hash-table-empty-p (hash-table) |
| 145 | "Check whether HASH-TABLE is empty (has 0 elements)." | 157 | "Check whether HASH-TABLE is empty (has 0 elements)." |
| 146 | (zerop (hash-table-count hash-table))) | 158 | (zerop (hash-table-count hash-table))) |
| @@ -214,6 +226,11 @@ user enters `recenter', `scroll-up', or `scroll-down' responses, | |||
| 214 | perform the requested window recentering or scrolling and ask | 226 | perform the requested window recentering or scrolling and ask |
| 215 | again. | 227 | again. |
| 216 | 228 | ||
| 229 | When `use-dialog-box' is t (the default), this function can pop | ||
| 230 | up a dialog window to collect the user input. That functionality | ||
| 231 | requires `display-popup-menus-p' to return t. Otherwise, a text | ||
| 232 | dialog will be used. | ||
| 233 | |||
| 217 | The return value is the matching entry from the CHOICES list. | 234 | The return value is the matching entry from the CHOICES list. |
| 218 | 235 | ||
| 219 | Usage example: | 236 | Usage example: |
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/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 24a8f039fa5..457ad55dd6c 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el | |||
| @@ -57,9 +57,9 @@ | |||
| 57 | ;; Usage: | 57 | ;; Usage: |
| 58 | 58 | ||
| 59 | ;; Simply load this file into emacs (version 19 or higher) | 59 | ;; Simply load this file into emacs (version 19 or higher) |
| 60 | ;; using the following command. | 60 | ;; and run the function edt-mapper, using the following command. |
| 61 | 61 | ||
| 62 | ;; emacs -q -l edt-mapper.el | 62 | ;; emacs -q -l edt-mapper -f edt-mapper |
| 63 | 63 | ||
| 64 | ;; The "-q" option prevents loading of your init file (commands | 64 | ;; The "-q" option prevents loading of your init file (commands |
| 65 | ;; therein might confuse this program). | 65 | ;; therein might confuse this program). |
| @@ -96,10 +96,6 @@ | |||
| 96 | 96 | ||
| 97 | ;;; Code: | 97 | ;;; Code: |
| 98 | 98 | ||
| 99 | ;; Otherwise it just hangs. This seems preferable. | ||
| 100 | (if noninteractive | ||
| 101 | (error "edt-mapper cannot be loaded in batch mode")) | ||
| 102 | |||
| 103 | ;;; | 99 | ;;; |
| 104 | ;;; Decide Emacs Variant, GNU Emacs or XEmacs (aka Lucid Emacs). | 100 | ;;; Decide Emacs Variant, GNU Emacs or XEmacs (aka Lucid Emacs). |
| 105 | ;;; Determine Window System, and X Server Vendor (if appropriate). | 101 | ;;; Determine Window System, and X Server Vendor (if appropriate). |
| @@ -124,6 +120,8 @@ | |||
| 124 | ;;; | 120 | ;;; |
| 125 | ;;; Key variables | 121 | ;;; Key variables |
| 126 | ;;; | 122 | ;;; |
| 123 | |||
| 124 | ;; FIXME some/all of these should be let-bound, not global. | ||
| 127 | (defvar edt-key nil) | 125 | (defvar edt-key nil) |
| 128 | (defvar edt-enter nil) | 126 | (defvar edt-enter nil) |
| 129 | (defvar edt-return nil) | 127 | (defvar edt-return nil) |
| @@ -137,88 +135,116 @@ | |||
| 137 | (defvar edt-save-function-key-map) | 135 | (defvar edt-save-function-key-map) |
| 138 | 136 | ||
| 139 | ;;; | 137 | ;;; |
| 140 | ;;; Determine Terminal Type (if appropriate). | 138 | ;;; Key mapping functions |
| 141 | ;;; | ||
| 142 | |||
| 143 | (if (and edt-window-system (not (eq edt-window-system 'tty))) | ||
| 144 | (setq edt-term nil) | ||
| 145 | (setq edt-term (getenv "TERM"))) | ||
| 146 | |||
| 147 | ;;; | ||
| 148 | ;;; Implements a workaround for a feature that was added to simple.el. | ||
| 149 | ;;; | ||
| 150 | ;;; Many function keys have no Emacs functions assigned to them by | ||
| 151 | ;;; default. A subset of these are typically assigned functions in the | ||
| 152 | ;;; EDT emulation. This includes all the keypad keys and a some others | ||
| 153 | ;;; like Delete. | ||
| 154 | ;;; | ||
| 155 | ;;; Logic in simple.el maps some of these unassigned function keys to | ||
| 156 | ;;; ordinary typing keys. Where this is the case, a call to | ||
| 157 | ;;; read-key-sequence, below, does not return the name of the function | ||
| 158 | ;;; key pressed by the user but, instead, it returns the name of the | ||
| 159 | ;;; key to which it has been mapped. It needs to know the name of the | ||
| 160 | ;;; key pressed by the user. As a workaround, we assign a function to | ||
| 161 | ;;; each of the unassigned function keys of interest, here. These | ||
| 162 | ;;; assignments override the mapping to other keys and are only | ||
| 163 | ;;; temporary since, when edt-mapper is finished executing, it causes | ||
| 164 | ;;; Emacs to exit. | ||
| 165 | ;;; | ||
| 166 | |||
| 167 | (mapc | ||
| 168 | (lambda (function-key) | ||
| 169 | (if (not (lookup-key (current-global-map) function-key)) | ||
| 170 | (define-key (current-global-map) function-key 'forward-char))) | ||
| 171 | '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] | ||
| 172 | [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] | ||
| 173 | [kp-space] | ||
| 174 | [kp-tab] | ||
| 175 | [kp-enter] | ||
| 176 | [kp-multiply] | ||
| 177 | [kp-add] | ||
| 178 | [kp-separator] | ||
| 179 | [kp-subtract] | ||
| 180 | [kp-decimal] | ||
| 181 | [kp-divide] | ||
| 182 | [kp-equal] | ||
| 183 | [backspace] | ||
| 184 | [delete] | ||
| 185 | [tab] | ||
| 186 | [linefeed] | ||
| 187 | [clear])) | ||
| 188 | |||
| 189 | ;;; | ||
| 190 | ;;; Make sure the window is big enough to display the instructions, | ||
| 191 | ;;; except where window cannot be re-sized. | ||
| 192 | ;;; | ||
| 193 | |||
| 194 | (if (and edt-window-system (not (eq edt-window-system 'tty))) | ||
| 195 | (set-frame-size (selected-frame) 80 36)) | ||
| 196 | |||
| 197 | ;;; | ||
| 198 | ;;; Create buffers - Directions and Keys | ||
| 199 | ;;; | 139 | ;;; |
| 200 | (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) | 140 | (defun edt-map-key (ident descrip) |
| 201 | (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) | 141 | (interactive) |
| 142 | (if (featurep 'xemacs) | ||
| 143 | (progn | ||
| 144 | (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) | ||
| 145 | (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) | ||
| 146 | (cond ((not (equal edt-key edt-return)) | ||
| 147 | (set-buffer "Keys") | ||
| 148 | (insert (format " (\"%s\" . %s)\n" ident edt-key)) | ||
| 149 | (set-buffer "Directions")) | ||
| 150 | ;; bogosity to get next prompt to come up, if the user hits <CR>! | ||
| 151 | ;; check periodically to see if this is still needed... | ||
| 152 | (t | ||
| 153 | (set-buffer "Keys") | ||
| 154 | (insert (format " (\"%s\" . \"\" )\n" ident)) | ||
| 155 | (set-buffer "Directions")))) | ||
| 156 | (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip))) | ||
| 157 | (cond ((not (equal edt-key edt-return)) | ||
| 158 | (set-buffer "Keys") | ||
| 159 | (insert (if (vectorp edt-key) | ||
| 160 | (format " (\"%s\" . %s)\n" ident edt-key) | ||
| 161 | (format " (\"%s\" . \"%s\")\n" ident edt-key))) | ||
| 162 | (set-buffer "Directions")) | ||
| 163 | ;; bogosity to get next prompt to come up, if the user hits <CR>! | ||
| 164 | ;; check periodically to see if this is still needed... | ||
| 165 | (t | ||
| 166 | (set-buffer "Keys") | ||
| 167 | (insert (format " (\"%s\" . \"\" )\n" ident)) | ||
| 168 | (set-buffer "Directions")))) | ||
| 169 | edt-key) | ||
| 202 | 170 | ||
| 203 | ;;; | 171 | (defun edt-mapper () |
| 204 | ;;; Put header in the Keys buffer | 172 | (if noninteractive |
| 205 | ;;; | 173 | (user-error "edt-mapper cannot be loaded in batch mode")) |
| 206 | (set-buffer "Keys") | 174 | ;; Determine Terminal Type (if appropriate). |
| 207 | (insert "\ | 175 | (if (and edt-window-system (not (eq edt-window-system 'tty))) |
| 176 | (setq edt-term nil) | ||
| 177 | (setq edt-term (getenv "TERM"))) | ||
| 178 | ;; | ||
| 179 | ;; Implements a workaround for a feature that was added to simple.el. | ||
| 180 | ;; | ||
| 181 | ;; Many function keys have no Emacs functions assigned to them by | ||
| 182 | ;; default. A subset of these are typically assigned functions in the | ||
| 183 | ;; EDT emulation. This includes all the keypad keys and a some others | ||
| 184 | ;; like Delete. | ||
| 185 | ;; | ||
| 186 | ;; Logic in simple.el maps some of these unassigned function keys to | ||
| 187 | ;; ordinary typing keys. Where this is the case, a call to | ||
| 188 | ;; read-key-sequence, below, does not return the name of the function | ||
| 189 | ;; key pressed by the user but, instead, it returns the name of the | ||
| 190 | ;; key to which it has been mapped. It needs to know the name of the | ||
| 191 | ;; key pressed by the user. As a workaround, we assign a function to | ||
| 192 | ;; each of the unassigned function keys of interest, here. These | ||
| 193 | ;; assignments override the mapping to other keys and are only | ||
| 194 | ;; temporary since, when edt-mapper is finished executing, it causes | ||
| 195 | ;; Emacs to exit. | ||
| 196 | ;; | ||
| 197 | (mapc | ||
| 198 | (lambda (function-key) | ||
| 199 | (if (not (lookup-key (current-global-map) function-key)) | ||
| 200 | (define-key (current-global-map) function-key 'forward-char))) | ||
| 201 | '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] | ||
| 202 | [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] | ||
| 203 | [kp-space] | ||
| 204 | [kp-tab] | ||
| 205 | [kp-enter] | ||
| 206 | [kp-multiply] | ||
| 207 | [kp-add] | ||
| 208 | [kp-separator] | ||
| 209 | [kp-subtract] | ||
| 210 | [kp-decimal] | ||
| 211 | [kp-divide] | ||
| 212 | [kp-equal] | ||
| 213 | [backspace] | ||
| 214 | [delete] | ||
| 215 | [tab] | ||
| 216 | [linefeed] | ||
| 217 | [clear])) | ||
| 218 | ;; | ||
| 219 | ;; Make sure the window is big enough to display the instructions, | ||
| 220 | ;; except where window cannot be re-sized. | ||
| 221 | ;; | ||
| 222 | (if (and edt-window-system (not (eq edt-window-system 'tty))) | ||
| 223 | (set-frame-size (selected-frame) 80 36)) | ||
| 224 | ;; | ||
| 225 | ;; Create buffers - Directions and Keys | ||
| 226 | ;; | ||
| 227 | (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) | ||
| 228 | (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) | ||
| 229 | ;; | ||
| 230 | ;; Put header in the Keys buffer | ||
| 231 | ;; | ||
| 232 | (set-buffer "Keys") | ||
| 233 | (insert "\ | ||
| 208 | ;; | 234 | ;; |
| 209 | ;; Key definitions for the EDT emulation within GNU Emacs | 235 | ;; Key definitions for the EDT emulation within GNU Emacs |
| 210 | ;; | 236 | ;; |
| 211 | 237 | ||
| 212 | (defconst *EDT-keys* | 238 | \(defconst *EDT-keys* |
| 213 | '( | 239 | '( |
| 214 | ") | 240 | ") |
| 215 | 241 | ||
| 216 | ;;; | 242 | ;; |
| 217 | ;;; Display directions | 243 | ;; Display directions |
| 218 | ;;; | 244 | ;; |
| 219 | (switch-to-buffer "Directions") | 245 | (switch-to-buffer "Directions") |
| 220 | (if (and edt-window-system (not (eq edt-window-system 'tty))) | 246 | (if (and edt-window-system (not (eq edt-window-system 'tty))) |
| 221 | (insert " | 247 | (insert " |
| 222 | EDT MAPPER | 248 | EDT MAPPER |
| 223 | 249 | ||
| 224 | You will be asked to press keys to create a custom mapping (under a | 250 | You will be asked to press keys to create a custom mapping (under a |
| @@ -240,7 +266,7 @@ | |||
| 240 | just press RETURN at the prompt. | 266 | just press RETURN at the prompt. |
| 241 | 267 | ||
| 242 | ") | 268 | ") |
| 243 | (insert " | 269 | (insert " |
| 244 | EDT MAPPER | 270 | EDT MAPPER |
| 245 | 271 | ||
| 246 | You will be asked to press keys to create a custom mapping of your | 272 | You will be asked to press keys to create a custom mapping of your |
| @@ -259,39 +285,39 @@ | |||
| 259 | 285 | ||
| 260 | ")) | 286 | ")) |
| 261 | 287 | ||
| 262 | (delete-other-windows) | 288 | (delete-other-windows) |
| 263 | 289 | ||
| 264 | ;;; | 290 | ;; |
| 265 | ;;; Save <CR> for future reference. | 291 | ;; Save <CR> for future reference. |
| 266 | ;;; | 292 | ;; |
| 267 | ;;; For GNU Emacs, running in a Window System, first hide bindings in | 293 | ;; For GNU Emacs, running in a Window System, first hide bindings in |
| 268 | ;;; function-key-map. | 294 | ;; function-key-map. |
| 269 | ;;; | 295 | ;; |
| 270 | (cond | 296 | (cond |
| 271 | ((featurep 'xemacs) | 297 | ((featurep 'xemacs) |
| 272 | (setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) | 298 | (setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) |
| 273 | (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) | 299 | (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) |
| 274 | (t | 300 | (t |
| 275 | (if edt-window-system | 301 | (if edt-window-system |
| 276 | (progn | 302 | (progn |
| 277 | (setq edt-save-function-key-map function-key-map) | 303 | (setq edt-save-function-key-map function-key-map) |
| 278 | (setq function-key-map (make-sparse-keymap)))) | 304 | (setq function-key-map (make-sparse-keymap)))) |
| 279 | (setq edt-return (read-key-sequence "Hit carriage-return <CR> to continue ")))) | 305 | (setq edt-return (read-key-sequence "Hit carriage-return <CR> to continue ")))) |
| 280 | 306 | ||
| 281 | ;;; | 307 | ;; |
| 282 | ;;; Remove prefix-key bindings to F1 and F2 in global-map so they can be | 308 | ;; Remove prefix-key bindings to F1 and F2 in global-map so they can be |
| 283 | ;;; bound in the EDT Emulation mode. | 309 | ;; bound in the EDT Emulation mode. |
| 284 | ;;; | 310 | ;; |
| 285 | (global-unset-key [f1]) | 311 | (global-unset-key [f1]) |
| 286 | (global-unset-key [f2]) | 312 | (global-unset-key [f2]) |
| 287 | 313 | ||
| 288 | ;;; | 314 | ;; |
| 289 | ;;; Display Keypad Diagram and Begin Prompting for Keys | 315 | ;; Display Keypad Diagram and Begin Prompting for Keys |
| 290 | ;;; | 316 | ;; |
| 291 | (set-buffer "Directions") | 317 | (set-buffer "Directions") |
| 292 | (delete-region (point-min) (point-max)) | 318 | (delete-region (point-min) (point-max)) |
| 293 | (if (and edt-window-system (not (eq edt-window-system 'tty))) | 319 | (if (and edt-window-system (not (eq edt-window-system 'tty))) |
| 294 | (insert " | 320 | (insert " |
| 295 | 321 | ||
| 296 | PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. | 322 | PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. |
| 297 | 323 | ||
| @@ -321,11 +347,11 @@ | |||
| 321 | REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY. | 347 | REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY. |
| 322 | 348 | ||
| 323 | ") | 349 | ") |
| 324 | (progn | 350 | (progn |
| 325 | (insert " | 351 | (insert " |
| 326 | GENERATING A CUSTOM CONFIGURATION FILE FOR TERMINAL TYPE: ") | 352 | GENERATING A CUSTOM CONFIGURATION FILE FOR TERMINAL TYPE: ") |
| 327 | (insert (format "%s." edt-term)) | 353 | (insert (format "%s." edt-term)) |
| 328 | (insert " | 354 | (insert " |
| 329 | 355 | ||
| 330 | PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. | 356 | PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. |
| 331 | 357 | ||
| @@ -347,142 +373,109 @@ | |||
| 347 | REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY."))) | 373 | REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY."))) |
| 348 | 374 | ||
| 349 | 375 | ||
| 350 | ;;; | ||
| 351 | ;;; Key mapping functions | ||
| 352 | ;;; | ||
| 353 | (defun edt-map-key (ident descrip) | ||
| 354 | (interactive) | ||
| 355 | (if (featurep 'xemacs) | ||
| 356 | (progn | ||
| 357 | (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) | ||
| 358 | (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) | ||
| 359 | (cond ((not (equal edt-key edt-return)) | ||
| 360 | (set-buffer "Keys") | ||
| 361 | (insert (format " (\"%s\" . %s)\n" ident edt-key)) | ||
| 362 | (set-buffer "Directions")) | ||
| 363 | ;; bogosity to get next prompt to come up, if the user hits <CR>! | ||
| 364 | ;; check periodically to see if this is still needed... | ||
| 365 | (t | ||
| 366 | (set-buffer "Keys") | ||
| 367 | (insert (format " (\"%s\" . \"\" )\n" ident)) | ||
| 368 | (set-buffer "Directions")))) | ||
| 369 | (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip))) | ||
| 370 | (cond ((not (equal edt-key edt-return)) | ||
| 371 | (set-buffer "Keys") | ||
| 372 | (insert (if (vectorp edt-key) | ||
| 373 | (format " (\"%s\" . %s)\n" ident edt-key) | ||
| 374 | (format " (\"%s\" . \"%s\")\n" ident edt-key))) | ||
| 375 | (set-buffer "Directions")) | ||
| 376 | ;; bogosity to get next prompt to come up, if the user hits <CR>! | ||
| 377 | ;; check periodically to see if this is still needed... | ||
| 378 | (t | ||
| 379 | (set-buffer "Keys") | ||
| 380 | (insert (format " (\"%s\" . \"\" )\n" ident)) | ||
| 381 | (set-buffer "Directions")))) | ||
| 382 | edt-key) | ||
| 383 | 376 | ||
| 384 | (set-buffer "Keys") | 377 | (set-buffer "Keys") |
| 385 | (insert " | 378 | (insert " |
| 386 | ;; | 379 | ;; |
| 387 | ;; Arrows | 380 | ;; Arrows |
| 388 | ;; | 381 | ;; |
| 389 | ") | 382 | ") |
| 390 | (set-buffer "Directions") | 383 | (set-buffer "Directions") |
| 391 | 384 | ||
| 392 | (edt-map-key "UP" " - The Up Arrow Key") | 385 | (edt-map-key "UP" " - The Up Arrow Key") |
| 393 | (edt-map-key "DOWN" " - The Down Arrow Key") | 386 | (edt-map-key "DOWN" " - The Down Arrow Key") |
| 394 | (edt-map-key "LEFT" " - The Left Arrow Key") | 387 | (edt-map-key "LEFT" " - The Left Arrow Key") |
| 395 | (edt-map-key "RIGHT" " - The Right Arrow Key") | 388 | (edt-map-key "RIGHT" " - The Right Arrow Key") |
| 396 | 389 | ||
| 397 | 390 | ||
| 398 | (set-buffer "Keys") | 391 | (set-buffer "Keys") |
| 399 | (insert " | 392 | (insert " |
| 400 | ;; | 393 | ;; |
| 401 | ;; PF keys | 394 | ;; PF keys |
| 402 | ;; | 395 | ;; |
| 403 | ") | 396 | ") |
| 404 | (set-buffer "Directions") | 397 | (set-buffer "Directions") |
| 405 | 398 | ||
| 406 | (edt-map-key "PF1" " - The PF1 (GOLD) Key") | 399 | (edt-map-key "PF1" " - The PF1 (GOLD) Key") |
| 407 | (edt-map-key "PF2" " - The Keypad PF2 Key") | 400 | (edt-map-key "PF2" " - The Keypad PF2 Key") |
| 408 | (edt-map-key "PF3" " - The Keypad PF3 Key") | 401 | (edt-map-key "PF3" " - The Keypad PF3 Key") |
| 409 | (edt-map-key "PF4" " - The Keypad PF4 Key") | 402 | (edt-map-key "PF4" " - The Keypad PF4 Key") |
| 410 | 403 | ||
| 411 | (set-buffer "Keys") | 404 | (set-buffer "Keys") |
| 412 | (insert " | 405 | (insert " |
| 413 | ;; | 406 | ;; |
| 414 | ;; KP0-9 KP- KP, KPP and KPE | 407 | ;; KP0-9 KP- KP, KPP and KPE |
| 415 | ;; | 408 | ;; |
| 416 | ") | 409 | ") |
| 417 | (set-buffer "Directions") | 410 | (set-buffer "Directions") |
| 418 | 411 | ||
| 419 | (edt-map-key "KP0" " - The Keypad 0 Key") | 412 | (edt-map-key "KP0" " - The Keypad 0 Key") |
| 420 | (edt-map-key "KP1" " - The Keypad 1 Key") | 413 | (edt-map-key "KP1" " - The Keypad 1 Key") |
| 421 | (edt-map-key "KP2" " - The Keypad 2 Key") | 414 | (edt-map-key "KP2" " - The Keypad 2 Key") |
| 422 | (edt-map-key "KP3" " - The Keypad 3 Key") | 415 | (edt-map-key "KP3" " - The Keypad 3 Key") |
| 423 | (edt-map-key "KP4" " - The Keypad 4 Key") | 416 | (edt-map-key "KP4" " - The Keypad 4 Key") |
| 424 | (edt-map-key "KP5" " - The Keypad 5 Key") | 417 | (edt-map-key "KP5" " - The Keypad 5 Key") |
| 425 | (edt-map-key "KP6" " - The Keypad 6 Key") | 418 | (edt-map-key "KP6" " - The Keypad 6 Key") |
| 426 | (edt-map-key "KP7" " - The Keypad 7 Key") | 419 | (edt-map-key "KP7" " - The Keypad 7 Key") |
| 427 | (edt-map-key "KP8" " - The Keypad 8 Key") | 420 | (edt-map-key "KP8" " - The Keypad 8 Key") |
| 428 | (edt-map-key "KP9" " - The Keypad 9 Key") | 421 | (edt-map-key "KP9" " - The Keypad 9 Key") |
| 429 | (edt-map-key "KP-" " - The Keypad - Key") | 422 | (edt-map-key "KP-" " - The Keypad - Key") |
| 430 | (edt-map-key "KP," " - The Keypad , Key") | 423 | (edt-map-key "KP," " - The Keypad , Key") |
| 431 | (edt-map-key "KPP" " - The Keypad . Key") | 424 | (edt-map-key "KPP" " - The Keypad . Key") |
| 432 | (edt-map-key "KPE" " - The Keypad Enter Key") | 425 | (edt-map-key "KPE" " - The Keypad Enter Key") |
| 433 | ;; Save the enter key | 426 | ;; Save the enter key |
| 434 | (setq edt-enter edt-key) | 427 | (setq edt-enter edt-key) |
| 435 | (setq edt-enter-seq edt-key-seq) | 428 | (setq edt-enter-seq edt-key-seq) |
| 436 | 429 | ||
| 437 | 430 | ||
| 438 | (set-buffer "Keys") | 431 | (set-buffer "Keys") |
| 439 | (insert " | 432 | (insert " |
| 440 | ;; | 433 | ;; |
| 441 | ;; Editing keypad (FIND, INSERT, REMOVE) | 434 | ;; Editing keypad (FIND, INSERT, REMOVE) |
| 442 | ;; (SELECT, PREVIOUS, NEXT) | 435 | ;; (SELECT, PREVIOUS, NEXT) |
| 443 | ;; | 436 | ;; |
| 444 | ") | 437 | ") |
| 445 | (set-buffer "Directions") | 438 | (set-buffer "Directions") |
| 446 | 439 | ||
| 447 | (edt-map-key "FIND" " - The Find key on the editing keypad") | 440 | (edt-map-key "FIND" " - The Find key on the editing keypad") |
| 448 | (edt-map-key "INSERT" " - The Insert key on the editing keypad") | 441 | (edt-map-key "INSERT" " - The Insert key on the editing keypad") |
| 449 | (edt-map-key "REMOVE" " - The Remove key on the editing keypad") | 442 | (edt-map-key "REMOVE" " - The Remove key on the editing keypad") |
| 450 | (edt-map-key "SELECT" " - The Select key on the editing keypad") | 443 | (edt-map-key "SELECT" " - The Select key on the editing keypad") |
| 451 | (edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") | 444 | (edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") |
| 452 | (edt-map-key "NEXT" " - The Next Scr key on the editing keypad") | 445 | (edt-map-key "NEXT" " - The Next Scr key on the editing keypad") |
| 453 | 446 | ||
| 454 | (set-buffer "Keys") | 447 | (set-buffer "Keys") |
| 455 | (insert " | 448 | (insert " |
| 456 | ;; | 449 | ;; |
| 457 | ;; F1-14 Help Do F17-F20 | 450 | ;; F1-14 Help Do F17-F20 |
| 458 | ;; | 451 | ;; |
| 459 | ") | 452 | ") |
| 460 | (set-buffer "Directions") | 453 | (set-buffer "Directions") |
| 461 | 454 | ||
| 462 | (edt-map-key "F1" " - F1 Function Key") | 455 | (edt-map-key "F1" " - F1 Function Key") |
| 463 | (edt-map-key "F2" " - F2 Function Key") | 456 | (edt-map-key "F2" " - F2 Function Key") |
| 464 | (edt-map-key "F3" " - F3 Function Key") | 457 | (edt-map-key "F3" " - F3 Function Key") |
| 465 | (edt-map-key "F4" " - F4 Function Key") | 458 | (edt-map-key "F4" " - F4 Function Key") |
| 466 | (edt-map-key "F5" " - F5 Function Key") | 459 | (edt-map-key "F5" " - F5 Function Key") |
| 467 | (edt-map-key "F6" " - F6 Function Key") | 460 | (edt-map-key "F6" " - F6 Function Key") |
| 468 | (edt-map-key "F7" " - F7 Function Key") | 461 | (edt-map-key "F7" " - F7 Function Key") |
| 469 | (edt-map-key "F8" " - F8 Function Key") | 462 | (edt-map-key "F8" " - F8 Function Key") |
| 470 | (edt-map-key "F9" " - F9 Function Key") | 463 | (edt-map-key "F9" " - F9 Function Key") |
| 471 | (edt-map-key "F10" " - F10 Function Key") | 464 | (edt-map-key "F10" " - F10 Function Key") |
| 472 | (edt-map-key "F11" " - F11 Function Key") | 465 | (edt-map-key "F11" " - F11 Function Key") |
| 473 | (edt-map-key "F12" " - F12 Function Key") | 466 | (edt-map-key "F12" " - F12 Function Key") |
| 474 | (edt-map-key "F13" " - F13 Function Key") | 467 | (edt-map-key "F13" " - F13 Function Key") |
| 475 | (edt-map-key "F14" " - F14 Function Key") | 468 | (edt-map-key "F14" " - F14 Function Key") |
| 476 | (edt-map-key "HELP" " - HELP Function Key") | 469 | (edt-map-key "HELP" " - HELP Function Key") |
| 477 | (edt-map-key "DO" " - DO Function Key") | 470 | (edt-map-key "DO" " - DO Function Key") |
| 478 | (edt-map-key "F17" " - F17 Function Key") | 471 | (edt-map-key "F17" " - F17 Function Key") |
| 479 | (edt-map-key "F18" " - F18 Function Key") | 472 | (edt-map-key "F18" " - F18 Function Key") |
| 480 | (edt-map-key "F19" " - F19 Function Key") | 473 | (edt-map-key "F19" " - F19 Function Key") |
| 481 | (edt-map-key "F20" " - F20 Function Key") | 474 | (edt-map-key "F20" " - F20 Function Key") |
| 482 | 475 | ||
| 483 | (set-buffer "Directions") | 476 | (set-buffer "Directions") |
| 484 | (delete-region (point-min) (point-max)) | 477 | (delete-region (point-min) (point-max)) |
| 485 | (insert " | 478 | (insert " |
| 486 | ADDITIONAL FUNCTION KEYS | 479 | ADDITIONAL FUNCTION KEYS |
| 487 | 480 | ||
| 488 | Your keyboard may have additional function keys which do not correspond | 481 | Your keyboard may have additional function keys which do not correspond |
| @@ -501,53 +494,53 @@ | |||
| 501 | 494 | ||
| 502 | When you are done, just press RETURN at the \"EDT Key Name:\" prompt. | 495 | When you are done, just press RETURN at the \"EDT Key Name:\" prompt. |
| 503 | ") | 496 | ") |
| 504 | (switch-to-buffer "Directions") | 497 | (switch-to-buffer "Directions") |
| 505 | ;;; | 498 | ;; |
| 506 | ;;; Add support for extras keys | 499 | ;; Add support for extras keys |
| 507 | ;;; | 500 | ;; |
| 508 | (set-buffer "Keys") | 501 | (set-buffer "Keys") |
| 509 | (insert "\ | 502 | (insert "\ |
| 510 | ;; | 503 | ;; |
| 511 | ;; Extra Keys | 504 | ;; Extra Keys |
| 512 | ;; | 505 | ;; |
| 513 | ") | 506 | ") |
| 514 | ;;; | 507 | ;; |
| 515 | ;;; Restore function-key-map. | 508 | ;; Restore function-key-map. |
| 516 | ;;; | 509 | ;; |
| 517 | (if (and edt-window-system (not (featurep 'xemacs))) | 510 | (if (and edt-window-system (not (featurep 'xemacs))) |
| 518 | (setq function-key-map edt-save-function-key-map)) | 511 | (setq function-key-map edt-save-function-key-map)) |
| 519 | (setq EDT-key-name "") | 512 | (setq EDT-key-name "") |
| 520 | (while (not | 513 | (while (not |
| 521 | (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) | 514 | (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) |
| 522 | (edt-map-key EDT-key-name "")) | 515 | (edt-map-key EDT-key-name "")) |
| 523 | 516 | ||
| 524 | ; | 517 | ;; |
| 525 | ; No more keys to add, so wrap up. | 518 | ;; No more keys to add, so wrap up. |
| 526 | ; | 519 | ;; |
| 527 | (set-buffer "Keys") | 520 | (set-buffer "Keys") |
| 528 | (insert "\ | 521 | (insert "\ |
| 529 | ) | 522 | ) |
| 530 | ) | 523 | ) |
| 531 | ") | 524 | ") |
| 532 | 525 | ||
| 533 | ;;; | 526 | ;; |
| 534 | ;;; Save the key mapping program | 527 | ;; Save the key mapping program |
| 535 | ;;; | 528 | ;; |
| 536 | ;;; | 529 | ;; |
| 537 | ;;; Save the key mapping file | 530 | ;; Save the key mapping file |
| 538 | ;;; | 531 | ;; |
| 539 | (let ((file (concat | 532 | (let ((file (concat |
| 540 | "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu") | 533 | "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu") |
| 541 | (if edt-term (concat "-" edt-term)) | 534 | (if edt-term (concat "-" edt-term)) |
| 542 | (if edt-xserver (concat "-" edt-xserver)) | 535 | (if edt-xserver (concat "-" edt-xserver)) |
| 543 | (if edt-window-system (concat "-" (upcase (symbol-name edt-window-system)))) | 536 | (if edt-window-system (concat "-" (upcase (symbol-name edt-window-system)))) |
| 544 | "-keys"))) | 537 | "-keys"))) |
| 545 | (set-visited-file-name | 538 | (set-visited-file-name |
| 546 | (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) | 539 | (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) |
| 547 | (save-buffer) | 540 | (save-buffer) |
| 548 | 541 | ||
| 549 | (message "That's it! Press any key to exit") | 542 | (message "That's it! Press any key to exit") |
| 550 | (sit-for 600) | 543 | (sit-for 600) |
| 551 | (kill-emacs t) | 544 | (kill-emacs t)) |
| 552 | 545 | ||
| 553 | ;;; edt-mapper.el ends here | 546 | ;;; edt-mapper.el ends here |
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 31f555b0326..a6b2d785ac5 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el | |||
| @@ -1928,6 +1928,8 @@ Optional argument NOT-YES changes the default to negative." | |||
| 1928 | ;;; INITIALIZATION COMMANDS. | 1928 | ;;; INITIALIZATION COMMANDS. |
| 1929 | ;;; | 1929 | ;;; |
| 1930 | 1930 | ||
| 1931 | (declare-function edt-mapper "edt-mapper" ()) | ||
| 1932 | |||
| 1931 | ;;; | 1933 | ;;; |
| 1932 | ;;; Function used to load LK-201 key mapping file generated by edt-mapper.el. | 1934 | ;;; Function used to load LK-201 key mapping file generated by edt-mapper.el. |
| 1933 | ;;; | 1935 | ;;; |
| @@ -1968,7 +1970,7 @@ created." | |||
| 1968 | You can do this by quitting Emacs and then invoking Emacs again as | 1970 | You can do this by quitting Emacs and then invoking Emacs again as |
| 1969 | follows: | 1971 | follows: |
| 1970 | 1972 | ||
| 1971 | emacs -q -l edt-mapper | 1973 | emacs -q -l edt-mapper -f edt-mapper |
| 1972 | 1974 | ||
| 1973 | [NOTE: If you do nothing out of the ordinary in your init file, and | 1975 | [NOTE: If you do nothing out of the ordinary in your init file, and |
| 1974 | the search for edt-mapper is successful, you can try running it now.] | 1976 | the search for edt-mapper is successful, you can try running it now.] |
| @@ -1983,7 +1985,9 @@ created." | |||
| 1983 | (insert (format | 1985 | (insert (format |
| 1984 | "Ah yes, there it is, in \n\n %s \n\n" path)) | 1986 | "Ah yes, there it is, in \n\n %s \n\n" path)) |
| 1985 | (if (edt-y-or-n-p "Do you want to run it now? ") | 1987 | (if (edt-y-or-n-p "Do you want to run it now? ") |
| 1986 | (load-file path) | 1988 | (progn |
| 1989 | (load-file path) | ||
| 1990 | (edt-mapper)) | ||
| 1987 | (error "EDT Emulation not configured"))) | 1991 | (error "EDT Emulation not configured"))) |
| 1988 | (insert (substitute-command-keys | 1992 | (insert (substitute-command-keys |
| 1989 | "Nope, I can't seem to find it. :-(\n\n")) | 1993 | "Nope, I can't seem to find it. :-(\n\n")) |
diff --git a/lisp/files.el b/lisp/files.el index f60282b775a..b7d104853c3 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 |
| @@ -5133,6 +5134,14 @@ Before and after saving the buffer, this function runs | |||
| 5133 | "Non-nil means `save-some-buffers' should save this buffer without asking.") | 5134 | "Non-nil means `save-some-buffers' should save this buffer without asking.") |
| 5134 | (make-variable-buffer-local 'buffer-save-without-query) | 5135 | (make-variable-buffer-local 'buffer-save-without-query) |
| 5135 | 5136 | ||
| 5137 | (defcustom save-some-buffers-default-predicate nil | ||
| 5138 | "Default predicate for `save-some-buffers'. | ||
| 5139 | This allows you to stop `save-some-buffers' from asking | ||
| 5140 | about certain files that you'd usually rather not save." | ||
| 5141 | :group 'auto-save | ||
| 5142 | :type 'function | ||
| 5143 | :version "26.1") | ||
| 5144 | |||
| 5136 | (defun save-some-buffers (&optional arg pred) | 5145 | (defun save-some-buffers (&optional arg pred) |
| 5137 | "Save some modified file-visiting buffers. Asks user about each one. | 5146 | "Save some modified file-visiting buffers. Asks user about each one. |
| 5138 | You can answer `y' to save, `n' not to save, `C-r' to look at the | 5147 | You can answer `y' to save, `n' not to save, `C-r' to look at the |
| @@ -5148,10 +5157,13 @@ If PRED is nil, all the file-visiting buffers are considered. | |||
| 5148 | If PRED is t, then certain non-file buffers will also be considered. | 5157 | If PRED is t, then certain non-file buffers will also be considered. |
| 5149 | If PRED is a zero-argument function, it indicates for each buffer whether | 5158 | If PRED is a zero-argument function, it indicates for each buffer whether |
| 5150 | to consider it or not when called with that buffer current. | 5159 | to consider it or not when called with that buffer current. |
| 5160 | PRED defaults to the value of `save-some-buffers-default-predicate'. | ||
| 5151 | 5161 | ||
| 5152 | See `save-some-buffers-action-alist' if you want to | 5162 | See `save-some-buffers-action-alist' if you want to |
| 5153 | change the additional actions you can take on files." | 5163 | change the additional actions you can take on files." |
| 5154 | (interactive "P") | 5164 | (interactive "P") |
| 5165 | (unless pred | ||
| 5166 | (setq pred save-some-buffers-default-predicate)) | ||
| 5155 | (save-window-excursion | 5167 | (save-window-excursion |
| 5156 | (let* (queried autosaved-buffers | 5168 | (let* (queried autosaved-buffers |
| 5157 | files-done abbrevs-done) | 5169 | files-done abbrevs-done) |
| @@ -6571,7 +6583,7 @@ normally equivalent short `-D' option is just passed on to | |||
| 6571 | (unless (equal switches "") | 6583 | (unless (equal switches "") |
| 6572 | ;; Split the switches at any spaces so we can | 6584 | ;; Split the switches at any spaces so we can |
| 6573 | ;; pass separate options as separate args. | 6585 | ;; pass separate options as separate args. |
| 6574 | (split-string switches))) | 6586 | (split-string-and-unquote switches))) |
| 6575 | ;; Avoid lossage if FILE starts with `-'. | 6587 | ;; Avoid lossage if FILE starts with `-'. |
| 6576 | '("--") | 6588 | '("--") |
| 6577 | (progn | 6589 | (progn |
| @@ -6811,6 +6823,8 @@ asks whether processes should be killed. | |||
| 6811 | Runs the members of `kill-emacs-query-functions' in turn and stops | 6823 | Runs the members of `kill-emacs-query-functions' in turn and stops |
| 6812 | if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." | 6824 | if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." |
| 6813 | (interactive "P") | 6825 | (interactive "P") |
| 6826 | ;; Don't use save-some-buffers-default-predicate, because we want | ||
| 6827 | ;; to ask about all the buffers before killing Emacs. | ||
| 6814 | (save-some-buffers arg t) | 6828 | (save-some-buffers arg t) |
| 6815 | (let ((confirm confirm-kill-emacs)) | 6829 | (let ((confirm confirm-kill-emacs)) |
| 6816 | (and | 6830 | (and |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index e1af859516c..a4ff840f755 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 |
| @@ -1708,9 +1713,10 @@ regexp." | |||
| 1708 | ;; (modify-syntax-entry ?- "w" table) | 1713 | ;; (modify-syntax-entry ?- "w" table) |
| 1709 | (modify-syntax-entry ?> ")<" table) | 1714 | (modify-syntax-entry ?> ")<" table) |
| 1710 | (modify-syntax-entry ?< "(>" table) | 1715 | (modify-syntax-entry ?< "(>" table) |
| 1711 | ;; make M-. in article buffers work for `foo' strings | 1716 | ;; make M-. in article buffers work for `foo' strings, |
| 1712 | (modify-syntax-entry ?' " " table) | 1717 | ;; and still allow C-s C-w to yank ' to the search ring |
| 1713 | (modify-syntax-entry ?` " " table) | 1718 | (modify-syntax-entry ?' "'" table) |
| 1719 | (modify-syntax-entry ?` "'" table) | ||
| 1714 | table) | 1720 | table) |
| 1715 | "Syntax table used in article mode buffers. | 1721 | "Syntax table used in article mode buffers. |
| 1716 | Initialized from `text-mode-syntax-table'.") | 1722 | Initialized from `text-mode-syntax-table'.") |
| @@ -6841,17 +6847,21 @@ then we display only bindings that start with that prefix." | |||
| 6841 | (let ((keymap (copy-keymap gnus-article-mode-map)) | 6847 | (let ((keymap (copy-keymap gnus-article-mode-map)) |
| 6842 | (map (copy-keymap gnus-article-send-map)) | 6848 | (map (copy-keymap gnus-article-send-map)) |
| 6843 | (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) | 6849 | (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) |
| 6850 | (summap (make-sparse-keymap)) | ||
| 6844 | parent agent draft) | 6851 | parent agent draft) |
| 6845 | (define-key keymap "S" map) | 6852 | (define-key keymap "S" map) |
| 6846 | (define-key map [t] nil) | 6853 | (define-key map [t] nil) |
| 6854 | (define-key summap [t] 'undefined) | ||
| 6847 | (with-current-buffer gnus-article-current-summary | 6855 | (with-current-buffer gnus-article-current-summary |
| 6856 | (dolist (key sumkeys) | ||
| 6857 | (define-key summap key (key-binding key (current-local-map)))) | ||
| 6848 | (set-keymap-parent | 6858 | (set-keymap-parent |
| 6849 | keymap | 6859 | keymap |
| 6850 | (if (setq parent (keymap-parent gnus-article-mode-map)) | 6860 | (if (setq parent (keymap-parent gnus-article-mode-map)) |
| 6851 | (prog1 | 6861 | (prog1 |
| 6852 | (setq parent (copy-keymap parent)) | 6862 | (setq parent (copy-keymap parent)) |
| 6853 | (set-keymap-parent parent (current-local-map))) | 6863 | (set-keymap-parent parent summap)) |
| 6854 | (current-local-map))) | 6864 | summap)) |
| 6855 | (set-keymap-parent map (key-binding "S")) | 6865 | (set-keymap-parent map (key-binding "S")) |
| 6856 | (let (key def gnus-pick-mode) | 6866 | (let (key def gnus-pick-mode) |
| 6857 | (while sumkeys | 6867 | (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/ibuffer.el b/lisp/ibuffer.el index c6e5e471a36..71bf1d6dcc2 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el | |||
| @@ -1319,13 +1319,14 @@ a new window in the current frame, splitting vertically." | |||
| 1319 | (cl-assert (derived-mode-p 'ibuffer-mode))) | 1319 | (cl-assert (derived-mode-p 'ibuffer-mode))) |
| 1320 | 1320 | ||
| 1321 | (defun ibuffer-buffer-file-name () | 1321 | (defun ibuffer-buffer-file-name () |
| 1322 | (or buffer-file-name | 1322 | (cond |
| 1323 | (let ((dirname (or (and (boundp 'dired-directory) | 1323 | ((buffer-file-name)) |
| 1324 | (if (stringp dired-directory) | 1324 | ((bound-and-true-p list-buffers-directory)) |
| 1325 | dired-directory | 1325 | ((let ((dirname (and (boundp 'dired-directory) |
| 1326 | (car dired-directory))) | 1326 | (if (stringp dired-directory) |
| 1327 | (bound-and-true-p list-buffers-directory)))) | 1327 | dired-directory |
| 1328 | (and dirname (expand-file-name dirname))))) | 1328 | (car dired-directory))))) |
| 1329 | (and dirname (expand-file-name dirname)))))) | ||
| 1329 | 1330 | ||
| 1330 | (define-ibuffer-op ibuffer-do-save () | 1331 | (define-ibuffer-op ibuffer-do-save () |
| 1331 | "Save marked buffers as with `save-buffer'." | 1332 | "Save marked buffers as with `save-buffer'." |
diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 901225fa2e9..2a4064560a7 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el | |||
| @@ -94,6 +94,7 @@ | |||
| 94 | ;; * WARNING: The "database" format used might be changed so keep a | 94 | ;; * WARNING: The "database" format used might be changed so keep a |
| 95 | ;; backup of `image-dired-db-file' when testing new versions. | 95 | ;; backup of `image-dired-db-file' when testing new versions. |
| 96 | ;; | 96 | ;; |
| 97 | ;; * `image-dired-display-image-mode' does not support animation | ||
| 97 | ;; | 98 | ;; |
| 98 | ;; TODO | 99 | ;; TODO |
| 99 | ;; ==== | 100 | ;; ==== |
| @@ -228,7 +229,7 @@ Used together with `image-dired-cmd-create-thumbnail-options'." | |||
| 228 | :group 'image-dired) | 229 | :group 'image-dired) |
| 229 | 230 | ||
| 230 | (defcustom image-dired-cmd-create-thumbnail-options | 231 | (defcustom image-dired-cmd-create-thumbnail-options |
| 231 | '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") | 232 | '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") |
| 232 | "Options of command used to create thumbnail image. | 233 | "Options of command used to create thumbnail image. |
| 233 | Used with `image-dired-cmd-create-thumbnail-program'. | 234 | Used with `image-dired-cmd-create-thumbnail-program'. |
| 234 | Available format specifiers are: %w which is replaced by | 235 | Available format specifiers are: %w which is replaced by |
| @@ -246,7 +247,7 @@ Used together with `image-dired-cmd-create-temp-image-options'." | |||
| 246 | :group 'image-dired) | 247 | :group 'image-dired) |
| 247 | 248 | ||
| 248 | (defcustom image-dired-cmd-create-temp-image-options | 249 | (defcustom image-dired-cmd-create-temp-image-options |
| 249 | '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") | 250 | '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") |
| 250 | "Options of command used to create temporary image for display window. | 251 | "Options of command used to create temporary image for display window. |
| 251 | Used together with `image-dired-cmd-create-temp-image-program', | 252 | Used together with `image-dired-cmd-create-temp-image-program', |
| 252 | Available format specifiers are: %w and %h which are replaced by | 253 | Available format specifiers are: %w and %h which are replaced by |
| @@ -316,7 +317,7 @@ Available format specifiers are described in | |||
| 316 | :group 'image-dired) | 317 | :group 'image-dired) |
| 317 | 318 | ||
| 318 | (defcustom image-dired-cmd-create-standard-thumbnail-options | 319 | (defcustom image-dired-cmd-create-standard-thumbnail-options |
| 319 | (append '("-size" "%wx%h" "%f") | 320 | (append '("-size" "%wx%h" "%f[0]") |
| 320 | (unless (or image-dired-cmd-pngcrush-program | 321 | (unless (or image-dired-cmd-pngcrush-program |
| 321 | image-dired-cmd-pngnq-program) | 322 | image-dired-cmd-pngnq-program) |
| 322 | (list | 323 | (list |
| @@ -1626,6 +1627,7 @@ Resized or in full-size." | |||
| 1626 | :group 'image-dired | 1627 | :group 'image-dired |
| 1627 | (buffer-disable-undo) | 1628 | (buffer-disable-undo) |
| 1628 | (image-mode-setup-winprops) | 1629 | (image-mode-setup-winprops) |
| 1630 | (setq cursor-type nil) | ||
| 1629 | (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) | 1631 | (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) |
| 1630 | 1632 | ||
| 1631 | (defvar image-dired-minor-mode-map | 1633 | (defvar image-dired-minor-mode-map |
diff --git a/lisp/indent.el b/lisp/indent.el index db31f0454ce..fdd184c7998 100644 --- a/lisp/indent.el +++ b/lisp/indent.el | |||
| @@ -487,9 +487,9 @@ line, but does not move past any whitespace that was explicitly inserted | |||
| 487 | (if (memq (current-justification) '(center right)) | 487 | (if (memq (current-justification) '(center right)) |
| 488 | (skip-chars-forward " \t"))) | 488 | (skip-chars-forward " \t"))) |
| 489 | 489 | ||
| 490 | (defvar indent-region-function nil | 490 | (defvar indent-region-function #'indent-region-line-by-line |
| 491 | "Short cut function to indent region using `indent-according-to-mode'. | 491 | "Short cut function to indent region using `indent-according-to-mode'. |
| 492 | A value of nil means really run `indent-according-to-mode' on each line.") | 492 | Default is to really run `indent-according-to-mode' on each line.") |
| 493 | 493 | ||
| 494 | (defun indent-region (start end &optional column) | 494 | (defun indent-region (start end &optional column) |
| 495 | "Indent each nonblank line in the region. | 495 | "Indent each nonblank line in the region. |
| @@ -541,24 +541,26 @@ column to indent to; if it is nil, use one of the three methods above." | |||
| 541 | (funcall indent-region-function start end)) | 541 | (funcall indent-region-function start end)) |
| 542 | ;; Else, use a default implementation that calls indent-line-function on | 542 | ;; Else, use a default implementation that calls indent-line-function on |
| 543 | ;; each line. | 543 | ;; each line. |
| 544 | (t | 544 | (t (indent-region-line-by-line start end))) |
| 545 | (save-excursion | ||
| 546 | (setq end (copy-marker end)) | ||
| 547 | (goto-char start) | ||
| 548 | (let ((pr (unless (minibufferp) | ||
| 549 | (make-progress-reporter "Indenting region..." (point) end)))) | ||
| 550 | (while (< (point) end) | ||
| 551 | (or (and (bolp) (eolp)) | ||
| 552 | (indent-according-to-mode)) | ||
| 553 | (forward-line 1) | ||
| 554 | (and pr (progress-reporter-update pr (point)))) | ||
| 555 | (and pr (progress-reporter-done pr)) | ||
| 556 | (move-marker end nil))))) | ||
| 557 | ;; In most cases, reindenting modifies the buffer, but it may also | 545 | ;; In most cases, reindenting modifies the buffer, but it may also |
| 558 | ;; leave it unmodified, in which case we have to deactivate the mark | 546 | ;; leave it unmodified, in which case we have to deactivate the mark |
| 559 | ;; by hand. | 547 | ;; by hand. |
| 560 | (setq deactivate-mark t)) | 548 | (setq deactivate-mark t)) |
| 561 | 549 | ||
| 550 | (defun indent-region-line-by-line (start end) | ||
| 551 | (save-excursion | ||
| 552 | (setq end (copy-marker end)) | ||
| 553 | (goto-char start) | ||
| 554 | (let ((pr (unless (minibufferp) | ||
| 555 | (make-progress-reporter "Indenting region..." (point) end)))) | ||
| 556 | (while (< (point) end) | ||
| 557 | (or (and (bolp) (eolp)) | ||
| 558 | (indent-according-to-mode)) | ||
| 559 | (forward-line 1) | ||
| 560 | (and pr (progress-reporter-update pr (point)))) | ||
| 561 | (and pr (progress-reporter-done pr)) | ||
| 562 | (move-marker end nil)))) | ||
| 563 | |||
| 562 | (define-obsolete-function-alias 'indent-relative-maybe | 564 | (define-obsolete-function-alias 'indent-relative-maybe |
| 563 | 'indent-relative-first-indent-point "26.1") | 565 | 'indent-relative-first-indent-point "26.1") |
| 564 | 566 | ||
diff --git a/lisp/info.el b/lisp/info.el index e32b6b35632..0cfcec32f82 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -1599,6 +1599,16 @@ escaped (\\\",\\\\)." | |||
| 1599 | parameter-alist)) | 1599 | parameter-alist)) |
| 1600 | parameter-alist)) | 1600 | parameter-alist)) |
| 1601 | 1601 | ||
| 1602 | (defun Info-node-description (file) | ||
| 1603 | (cond | ||
| 1604 | ((equal file "dir") "*Info Directory*") | ||
| 1605 | ((eq file 'apropos) "*Info Apropos*") | ||
| 1606 | ((eq file 'history) "*Info History*") | ||
| 1607 | ((eq file 'toc) "*Info TOC*") | ||
| 1608 | ((not (stringp file)) "") ; Avoid errors | ||
| 1609 | (t | ||
| 1610 | (concat "(" (file-name-nondirectory file) ") " Info-current-node)))) | ||
| 1611 | |||
| 1602 | (defun Info-display-images-node () | 1612 | (defun Info-display-images-node () |
| 1603 | "Display images in current node." | 1613 | "Display images in current node." |
| 1604 | (save-excursion | 1614 | (save-excursion |
| @@ -1693,6 +1703,7 @@ escaped (\\\",\\\\)." | |||
| 1693 | (setq Info-history-forward nil)) | 1703 | (setq Info-history-forward nil)) |
| 1694 | (if (not (eq Info-fontify-maximum-menu-size nil)) | 1704 | (if (not (eq Info-fontify-maximum-menu-size nil)) |
| 1695 | (Info-fontify-node)) | 1705 | (Info-fontify-node)) |
| 1706 | (setq list-buffers-directory (Info-node-description Info-current-file)) | ||
| 1696 | (Info-display-images-node) | 1707 | (Info-display-images-node) |
| 1697 | (Info-hide-cookies-node) | 1708 | (Info-hide-cookies-node) |
| 1698 | (run-hooks 'Info-selection-hook))))) | 1709 | (run-hooks 'Info-selection-hook))))) |
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/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index aae751e8d2d..3f3990e8695 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el | |||
| @@ -283,16 +283,6 @@ DOCSTRING arguments." | |||
| 283 | See documentation for `make-obsolete-variable' for a description | 283 | See documentation for `make-obsolete-variable' for a description |
| 284 | of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN | 284 | of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN |
| 285 | and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and | 285 | and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and |
| 286 | ACCESS-TYPE arguments." | ||
| 287 | (if (featurep 'xemacs) | ||
| 288 | `(make-obsolete-variable ,obsolete-name ,current-name) | ||
| 289 | `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))) | ||
| 290 | |||
| 291 | (defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type) | ||
| 292 | "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. | ||
| 293 | See documentation for `make-obsolete-variable' for a description | ||
| 294 | of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN | ||
| 295 | and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and | ||
| 296 | ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE, | 286 | ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE, |
| 297 | introduced in Emacs 24." | 287 | introduced in Emacs 24." |
| 298 | (if (featurep 'xemacs) | 288 | (if (featurep 'xemacs) |
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 fc7fdd30850..48dcd5edd11 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -3614,18 +3614,36 @@ connection buffer." | |||
| 3614 | 3614 | ||
| 3615 | ;;; Utility functions: | 3615 | ;;; Utility functions: |
| 3616 | 3616 | ||
| 3617 | (defun tramp-accept-process-output (&optional proc timeout timeout-msecs) | 3617 | (defun tramp-accept-process-output (proc timeout) |
| 3618 | "Like `accept-process-output' for Tramp processes. | 3618 | "Like `accept-process-output' for Tramp processes. |
| 3619 | This is needed in order to hide `last-coding-system-used', which is set | 3619 | This is needed in order to hide `last-coding-system-used', which is set |
| 3620 | for process communication also." | 3620 | for process communication also." |
| 3621 | ;; FIXME: There are problems, when an asynchronous process runs in | ||
| 3622 | ;; parallel, and also timers are active. See | ||
| 3623 | ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>. | ||
| 3624 | (when (and timer-event-last | ||
| 3625 | (string-prefix-p "*tramp/" (process-name proc)) | ||
| 3626 | (let (result) | ||
| 3627 | (maphash | ||
| 3628 | (lambda (key _value) | ||
| 3629 | (and (processp key) | ||
| 3630 | (not (string-prefix-p "*tramp/" (process-name key))) | ||
| 3631 | (tramp-compat-process-live-p key) | ||
| 3632 | (setq result t))) | ||
| 3633 | tramp-cache-data) | ||
| 3634 | result)) | ||
| 3635 | (sit-for 0.01 'nodisp)) | ||
| 3621 | (with-current-buffer (process-buffer proc) | 3636 | (with-current-buffer (process-buffer proc) |
| 3622 | (let (buffer-read-only last-coding-system-used) | 3637 | (let (buffer-read-only last-coding-system-used) |
| 3623 | ;; Under Windows XP, accept-process-output doesn't return | 3638 | ;; Under Windows XP, accept-process-output doesn't return |
| 3624 | ;; sometimes. So we add an additional timeout. | 3639 | ;; sometimes. So we add an additional timeout. JUST-THIS-ONE |
| 3625 | (with-timeout ((or timeout 1)) | 3640 | ;; is set due to Bug#12145. |
| 3626 | (accept-process-output proc timeout timeout-msecs (and proc t))) | 3641 | (tramp-message |
| 3627 | (tramp-message proc 10 "%s %s\n%s" | 3642 | proc 10 "%s %s %s\n%s" |
| 3628 | proc (process-status proc) (buffer-string))))) | 3643 | proc (process-status proc) |
| 3644 | (with-timeout (timeout) | ||
| 3645 | (accept-process-output proc timeout nil t)) | ||
| 3646 | (buffer-string))))) | ||
| 3629 | 3647 | ||
| 3630 | (defun tramp-check-for-regexp (proc regexp) | 3648 | (defun tramp-check-for-regexp (proc regexp) |
| 3631 | "Check, whether REGEXP is contained in process buffer of PROC. | 3649 | "Check, whether REGEXP is contained in process buffer of PROC. |
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 981b8464aaa..ed5b4c65068 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el | |||
| @@ -267,7 +267,7 @@ on your head.") | |||
| 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) | 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) |
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 7cb36c4396b..0f7e4b598dc 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el | |||
| @@ -1221,6 +1221,18 @@ Works with: arglist-cont, arglist-cont-nonempty." | |||
| 1221 | 1221 | ||
| 1222 | (vector (progn (goto-char alignto) (current-column))))))) | 1222 | (vector (progn (goto-char alignto) (current-column))))))) |
| 1223 | 1223 | ||
| 1224 | (defun c-lineup-under-anchor (langelem) | ||
| 1225 | "Line up the current line directly under the anchor position in LANGELEM. | ||
| 1226 | |||
| 1227 | This is like 0, except it supersedes any indentation already calculated for | ||
| 1228 | previous syntactic elements in the syntactic context. | ||
| 1229 | |||
| 1230 | Works with: Any syntactic symbol which has an anchor position." | ||
| 1231 | (save-excursion | ||
| 1232 | (goto-char (c-langelem-pos langelem)) | ||
| 1233 | (vector (current-column)))) | ||
| 1234 | |||
| 1235 | |||
| 1224 | (defun c-lineup-dont-change (langelem) | 1236 | (defun c-lineup-dont-change (langelem) |
| 1225 | "Do not change the indentation of the current line. | 1237 | "Do not change the indentation of the current line. |
| 1226 | 1238 | ||
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f214242bdd9..7f49557c7a6 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el | |||
| @@ -10260,13 +10260,22 @@ comment at the start of cc-engine.el for more info." | |||
| 10260 | (t nil))))) | 10260 | (t nil))))) |
| 10261 | 10261 | ||
| 10262 | (setq pos (point)) | 10262 | (setq pos (point)) |
| 10263 | (if (and after-type-id-pos | 10263 | (cond |
| 10264 | (goto-char after-type-id-pos) | 10264 | ((and after-type-id-pos |
| 10265 | (setq res (c-back-over-member-initializers)) | 10265 | (goto-char after-type-id-pos) |
| 10266 | (goto-char res) | 10266 | (setq res (c-back-over-member-initializers)) |
| 10267 | (eq (car (c-beginning-of-decl-1 lim)) 'same)) | 10267 | (goto-char res) |
| 10268 | (cons (point) nil) ; Return value. | 10268 | (eq (car (c-beginning-of-decl-1 lim)) 'same)) |
| 10269 | (cons (point) nil)) ; Return value. | ||
| 10270 | |||
| 10271 | ((and after-type-id-pos | ||
| 10272 | (progn | ||
| 10273 | (c-backward-syntactic-ws) | ||
| 10274 | (eq (char-before) ?\())) | ||
| 10275 | ;; Single identifier between '(' and '{'. We have a bracelist. | ||
| 10276 | (cons after-type-id-pos nil)) | ||
| 10269 | 10277 | ||
| 10278 | (t | ||
| 10270 | (goto-char pos) | 10279 | (goto-char pos) |
| 10271 | ;; Checks to do on all sexps before the brace, up to the | 10280 | ;; Checks to do on all sexps before the brace, up to the |
| 10272 | ;; beginning of the statement. | 10281 | ;; beginning of the statement. |
| @@ -10368,7 +10377,7 @@ comment at the start of cc-engine.el for more info." | |||
| 10368 | ; languages where | 10377 | ; languages where |
| 10369 | ; `c-opt-inexpr-brace-list-key' is | 10378 | ; `c-opt-inexpr-brace-list-key' is |
| 10370 | ; non-nil and we have macros. | 10379 | ; non-nil and we have macros. |
| 10371 | (t t))) ;; The caller can go up one level. | 10380 | (t t)))) ;; The caller can go up one level. |
| 10372 | ))) | 10381 | ))) |
| 10373 | 10382 | ||
| 10374 | (defun c-inside-bracelist-p (containing-sexp paren-state) | 10383 | (defun c-inside-bracelist-p (containing-sexp paren-state) |
| @@ -10493,6 +10502,30 @@ comment at the start of cc-engine.el for more info." | |||
| 10493 | (c-at-statement-start-p)) | 10502 | (c-at-statement-start-p)) |
| 10494 | (make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") | 10503 | (make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") |
| 10495 | 10504 | ||
| 10505 | (defun c-looking-at-statement-block () | ||
| 10506 | ;; Point is at an opening brace. If this is a statement block (i.e. the | ||
| 10507 | ;; elements in it are terminated by semicolons) return t. Otherwise, return | ||
| 10508 | ;; nil. | ||
| 10509 | (let ((here (point))) | ||
| 10510 | (prog1 | ||
| 10511 | (if (c-go-list-forward) | ||
| 10512 | (let ((there (point))) | ||
| 10513 | (backward-char) | ||
| 10514 | (c-syntactic-skip-backward | ||
| 10515 | "^;," here t) | ||
| 10516 | (cond | ||
| 10517 | ((eq (char-before) ?\;) t) | ||
| 10518 | ((eq (char-before) ?,) nil) | ||
| 10519 | (t (goto-char here) | ||
| 10520 | (forward-char) | ||
| 10521 | (and (c-syntactic-re-search-forward "{" there t t) | ||
| 10522 | (progn (backward-char) | ||
| 10523 | (c-looking-at-statement-block)))))) | ||
| 10524 | (forward-char) | ||
| 10525 | (and (c-syntactic-re-search-forward "[;,]" nil t t) | ||
| 10526 | (eq (char-before) ?\;))) | ||
| 10527 | (goto-char here)))) | ||
| 10528 | |||
| 10496 | (defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) | 10529 | (defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) |
| 10497 | ;; Return non-nil if we're looking at the beginning of a block | 10530 | ;; Return non-nil if we're looking at the beginning of a block |
| 10498 | ;; inside an expression. The value returned is actually a cons of | 10531 | ;; inside an expression. The value returned is actually a cons of |
| @@ -10648,15 +10681,7 @@ comment at the start of cc-engine.el for more info." | |||
| 10648 | (and (c-major-mode-is 'c++-mode) | 10681 | (and (c-major-mode-is 'c++-mode) |
| 10649 | (save-excursion | 10682 | (save-excursion |
| 10650 | (goto-char block-follows) | 10683 | (goto-char block-follows) |
| 10651 | (if (c-go-list-forward) | 10684 | (not (c-looking-at-statement-block))))) |
| 10652 | (progn | ||
| 10653 | (backward-char) | ||
| 10654 | (c-syntactic-skip-backward | ||
| 10655 | "^;," block-follows t) | ||
| 10656 | (not (eq (char-before) ?\;))) | ||
| 10657 | (or (not (c-syntactic-re-search-forward | ||
| 10658 | "[;,]" nil t t)) | ||
| 10659 | (not (eq (char-before) ?\;))))))) | ||
| 10660 | nil | 10685 | nil |
| 10661 | (cons 'inexpr-statement (point))))) | 10686 | (cons 'inexpr-statement (point))))) |
| 10662 | 10687 | ||
| @@ -10792,17 +10817,20 @@ comment at the start of cc-engine.el for more info." | |||
| 10792 | syntax-extra-args | 10817 | syntax-extra-args |
| 10793 | stop-at-boi-only | 10818 | stop-at-boi-only |
| 10794 | containing-sexp | 10819 | containing-sexp |
| 10795 | paren-state) | 10820 | paren-state |
| 10821 | &optional fixed-anchor) | ||
| 10796 | ;; Add the indicated SYNTAX-SYMBOL to `c-syntactic-context', extending it as | 10822 | ;; Add the indicated SYNTAX-SYMBOL to `c-syntactic-context', extending it as |
| 10797 | ;; needed with further syntax elements of the types `substatement', | 10823 | ;; needed with further syntax elements of the types `substatement', |
| 10798 | ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', and | 10824 | ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', |
| 10799 | ;; `defun-block-intro'. | 10825 | ;; `defun-block-intro', and `brace-list-intro'. |
| 10800 | ;; | 10826 | ;; |
| 10801 | ;; Do the generic processing to anchor the given syntax symbol on | 10827 | ;; Do the generic processing to anchor the given syntax symbol on the |
| 10802 | ;; the preceding statement: Skip over any labels and containing | 10828 | ;; preceding statement: First skip over any labels and containing statements |
| 10803 | ;; statements on the same line, and then search backward until we | 10829 | ;; on the same line. If FIXED-ANCHOR is non-nil, use this as the |
| 10804 | ;; find a statement or block start that begins at boi without a | 10830 | ;; anchor-point for the given syntactic symbol, and don't make syntactic |
| 10805 | ;; label or comment. | 10831 | ;; entries for constructs beginning on lines before that containing |
| 10832 | ;; ANCHOR-POINT. Otherwise search backward until we find a statement or | ||
| 10833 | ;; block start that begins at boi without a label or comment. | ||
| 10806 | ;; | 10834 | ;; |
| 10807 | ;; Point is assumed to be at the prospective anchor point for the | 10835 | ;; Point is assumed to be at the prospective anchor point for the |
| 10808 | ;; given SYNTAX-SYMBOL. More syntax entries are added if we need to | 10836 | ;; given SYNTAX-SYMBOL. More syntax entries are added if we need to |
| @@ -10831,6 +10859,7 @@ comment at the start of cc-engine.el for more info." | |||
| 10831 | 10859 | ||
| 10832 | (let ((syntax-last c-syntactic-context) | 10860 | (let ((syntax-last c-syntactic-context) |
| 10833 | (boi (c-point 'boi)) | 10861 | (boi (c-point 'boi)) |
| 10862 | (anchor-boi (c-point 'boi)) | ||
| 10834 | ;; Set when we're on a label, so that we don't stop there. | 10863 | ;; Set when we're on a label, so that we don't stop there. |
| 10835 | ;; FIXME: To be complete we should check if we're on a label | 10864 | ;; FIXME: To be complete we should check if we're on a label |
| 10836 | ;; now at the start. | 10865 | ;; now at the start. |
| @@ -10908,7 +10937,9 @@ comment at the start of cc-engine.el for more info." | |||
| 10908 | (c-add-syntax 'substatement nil)))) | 10937 | (c-add-syntax 'substatement nil)))) |
| 10909 | ))) | 10938 | ))) |
| 10910 | 10939 | ||
| 10911 | containing-sexp) | 10940 | containing-sexp |
| 10941 | (or (null fixed-anchor) | ||
| 10942 | (> containing-sexp anchor-boi))) | ||
| 10912 | 10943 | ||
| 10913 | ;; Now we have to go out of this block. | 10944 | ;; Now we have to go out of this block. |
| 10914 | (goto-char containing-sexp) | 10945 | (goto-char containing-sexp) |
| @@ -10982,6 +11013,14 @@ comment at the start of cc-engine.el for more info." | |||
| 10982 | (cdr (assoc (match-string 1) | 11013 | (cdr (assoc (match-string 1) |
| 10983 | c-other-decl-block-key-in-symbols-alist)) | 11014 | c-other-decl-block-key-in-symbols-alist)) |
| 10984 | (max (c-point 'boi paren-pos) (point)))) | 11015 | (max (c-point 'boi paren-pos) (point)))) |
| 11016 | ((save-excursion | ||
| 11017 | (goto-char paren-pos) | ||
| 11018 | (c-looking-at-or-maybe-in-bracelist containing-sexp)) | ||
| 11019 | (if (save-excursion | ||
| 11020 | (goto-char paren-pos) | ||
| 11021 | (c-looking-at-statement-block)) | ||
| 11022 | (c-add-syntax 'defun-block-intro nil) | ||
| 11023 | (c-add-syntax 'brace-list-intro nil))) | ||
| 10985 | (t (c-add-syntax 'defun-block-intro nil)))) | 11024 | (t (c-add-syntax 'defun-block-intro nil)))) |
| 10986 | 11025 | ||
| 10987 | (c-add-syntax 'statement-block-intro nil))) | 11026 | (c-add-syntax 'statement-block-intro nil))) |
| @@ -11001,7 +11040,10 @@ comment at the start of cc-engine.el for more info." | |||
| 11001 | (setq q (cdr (car p))) ; e.g. (nil 28) [from (arglist-cont-nonempty nil 28)] | 11040 | (setq q (cdr (car p))) ; e.g. (nil 28) [from (arglist-cont-nonempty nil 28)] |
| 11002 | (while q | 11041 | (while q |
| 11003 | (unless (car q) | 11042 | (unless (car q) |
| 11004 | (setcar q (point))) | 11043 | (setcar q (if (or (cdr p) |
| 11044 | (null fixed-anchor)) | ||
| 11045 | (point) | ||
| 11046 | fixed-anchor))) | ||
| 11005 | (setq q (cdr q))) | 11047 | (setq q (cdr q))) |
| 11006 | (setq p (cdr p)))) | 11048 | (setq p (cdr p)))) |
| 11007 | ))) | 11049 | ))) |
| @@ -12354,7 +12396,8 @@ comment at the start of cc-engine.el for more info." | |||
| 12354 | (c-forward-syntactic-ws (c-point 'eol)) | 12396 | (c-forward-syntactic-ws (c-point 'eol)) |
| 12355 | (c-looking-at-special-brace-list (point))))) | 12397 | (c-looking-at-special-brace-list (point))))) |
| 12356 | (c-add-syntax 'brace-entry-open (point)) | 12398 | (c-add-syntax 'brace-entry-open (point)) |
| 12357 | (c-add-syntax 'brace-list-entry (point)) | 12399 | (c-add-stmt-syntax 'brace-list-entry nil t containing-sexp |
| 12400 | paren-state (point)) | ||
| 12358 | )) | 12401 | )) |
| 12359 | )))) | 12402 | )))) |
| 12360 | 12403 | ||
| @@ -12848,7 +12891,7 @@ Cannot combine absolute offsets %S and %S in `add' method" | |||
| 12848 | ;; | 12891 | ;; |
| 12849 | ;; Note that topmost-intro always has an anchor position at bol, for | 12892 | ;; Note that topmost-intro always has an anchor position at bol, for |
| 12850 | ;; historical reasons. It's often used together with other symbols | 12893 | ;; historical reasons. It's often used together with other symbols |
| 12851 | ;; that has more sane positions. Since we always use the first | 12894 | ;; that have more sane positions. Since we always use the first |
| 12852 | ;; found anchor position, we rely on that these other symbols always | 12895 | ;; found anchor position, we rely on that these other symbols always |
| 12853 | ;; precede topmost-intro in the LANGELEMS list. | 12896 | ;; precede topmost-intro in the LANGELEMS list. |
| 12854 | ;; | 12897 | ;; |
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index d3505490505..b3848a74f97 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el | |||
| @@ -67,6 +67,7 @@ | |||
| 67 | (arglist-close . c-lineup-arglist) | 67 | (arglist-close . c-lineup-arglist) |
| 68 | (inline-open . 0) | 68 | (inline-open . 0) |
| 69 | (brace-list-open . +) | 69 | (brace-list-open . +) |
| 70 | (brace-list-intro . c-lineup-arglist-intro-after-paren) | ||
| 70 | (topmost-intro-cont | 71 | (topmost-intro-cont |
| 71 | . (first c-lineup-topmost-intro-cont | 72 | . (first c-lineup-topmost-intro-cont |
| 72 | c-lineup-gnu-DEFUN-intro-cont)))) | 73 | c-lineup-gnu-DEFUN-intro-cont)))) |
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index a6a96d15188..1114b21381d 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el | |||
| @@ -1115,7 +1115,7 @@ can always override the use of `c-default-style' by making calls to | |||
| 1115 | ;; Anchor pos: At the brace list decl start(*). | 1115 | ;; Anchor pos: At the brace list decl start(*). |
| 1116 | (brace-list-intro . +) | 1116 | (brace-list-intro . +) |
| 1117 | ;; Anchor pos: At the brace list decl start(*). | 1117 | ;; Anchor pos: At the brace list decl start(*). |
| 1118 | (brace-list-entry . 0) | 1118 | (brace-list-entry . c-lineup-under-anchor) |
| 1119 | ;; Anchor pos: At the first non-ws char after the open paren if | 1119 | ;; Anchor pos: At the first non-ws char after the open paren if |
| 1120 | ;; the first token is on the same line, otherwise boi at that | 1120 | ;; the first token is on the same line, otherwise boi at that |
| 1121 | ;; token. | 1121 | ;; token. |
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 2e5c6ae119b..e42e01481b6 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 |
| @@ -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) |
| @@ -3852,6 +3849,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." | |||
| 3852 | comment-start-skip "\\(//+\\|/\\*+\\)\\s *") | 3849 | comment-start-skip "\\(//+\\|/\\*+\\)\\s *") |
| 3853 | (setq-local comment-line-break-function #'c-indent-new-comment-line) | 3850 | (setq-local comment-line-break-function #'c-indent-new-comment-line) |
| 3854 | (setq-local c-block-comment-start-regexp "/\\*") | 3851 | (setq-local c-block-comment-start-regexp "/\\*") |
| 3852 | (setq-local comment-multi-line t) | ||
| 3855 | 3853 | ||
| 3856 | (setq-local electric-indent-chars | 3854 | (setq-local electric-indent-chars |
| 3857 | (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". | 3855 | (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". |
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..a8933b0103e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -918,7 +918,7 @@ 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 | (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " | 921 | (let* ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E" |
| 922 | grep-find-template t t)) | 922 | grep-find-template t t)) |
| 923 | (grep-highlight-matches nil) | 923 | (grep-highlight-matches nil) |
| 924 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) | 924 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) |
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/replace.el b/lisp/replace.el index ff917344453..a825040a979 100644 --- a/lisp/replace.el +++ b/lisp/replace.el | |||
| @@ -1304,6 +1304,19 @@ If the value is nil, don't highlight the buffer names specially." | |||
| 1304 | :type 'face | 1304 | :type 'face |
| 1305 | :group 'matching) | 1305 | :group 'matching) |
| 1306 | 1306 | ||
| 1307 | (defcustom list-matching-lines-current-line-face 'lazy-highlight | ||
| 1308 | "Face used by \\[list-matching-lines] to highlight the current line." | ||
| 1309 | :type 'face | ||
| 1310 | :group 'matching | ||
| 1311 | :version "26.1") | ||
| 1312 | |||
| 1313 | (defcustom list-matching-lines-jump-to-current-line nil | ||
| 1314 | "If non-nil, \\[list-matching-lines] shows the current line highlighted. | ||
| 1315 | Set the point right after such line when there are matches after it." | ||
| 1316 | :type 'boolean | ||
| 1317 | :group 'matching | ||
| 1318 | :version "26.1") | ||
| 1319 | |||
| 1307 | (defcustom list-matching-lines-prefix-face 'shadow | 1320 | (defcustom list-matching-lines-prefix-face 'shadow |
| 1308 | "Face used by \\[list-matching-lines] to show the prefix column. | 1321 | "Face used by \\[list-matching-lines] to show the prefix column. |
| 1309 | If the face doesn't differ from the default face, | 1322 | If the face doesn't differ from the default face, |
| @@ -1360,7 +1373,15 @@ invoke `occur'." | |||
| 1360 | "*") | 1373 | "*") |
| 1361 | (or unique-p (not interactive-p))))) | 1374 | (or unique-p (not interactive-p))))) |
| 1362 | 1375 | ||
| 1363 | (defun occur (regexp &optional nlines) | 1376 | ;; Region limits when `occur' applies on a region. |
| 1377 | (defvar occur--region-start nil) | ||
| 1378 | (defvar occur--region-end nil) | ||
| 1379 | (defvar occur--matches-threshold nil) | ||
| 1380 | (defvar occur--orig-line nil) | ||
| 1381 | (defvar occur--orig-line-str nil) | ||
| 1382 | (defvar occur--final-pos nil) | ||
| 1383 | |||
| 1384 | (defun occur (regexp &optional nlines region) | ||
| 1364 | "Show all lines in the current buffer containing a match for REGEXP. | 1385 | "Show all lines in the current buffer containing a match for REGEXP. |
| 1365 | If a match spreads across multiple lines, all those lines are shown. | 1386 | If a match spreads across multiple lines, all those lines are shown. |
| 1366 | 1387 | ||
| @@ -1369,9 +1390,17 @@ before if NLINES is negative. | |||
| 1369 | NLINES defaults to `list-matching-lines-default-context-lines'. | 1390 | NLINES defaults to `list-matching-lines-default-context-lines'. |
| 1370 | Interactively it is the prefix arg. | 1391 | Interactively it is the prefix arg. |
| 1371 | 1392 | ||
| 1393 | Optional arg REGION, if non-nil, mean restrict search to the | ||
| 1394 | specified region. Otherwise search the entire buffer. | ||
| 1395 | REGION must be a list of (START . END) positions as returned by | ||
| 1396 | `region-bounds'. | ||
| 1397 | |||
| 1372 | The lines are shown in a buffer named `*Occur*'. | 1398 | The lines are shown in a buffer named `*Occur*'. |
| 1373 | It serves as a menu to find any of the occurrences in this buffer. | 1399 | It serves as a menu to find any of the occurrences in this buffer. |
| 1374 | \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. | 1400 | \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. |
| 1401 | If `list-matching-lines-jump-to-current-line' is non-nil, then show | ||
| 1402 | the current line highlighted with `list-matching-lines-current-line-face' | ||
| 1403 | and set point at the first match after such line. | ||
| 1375 | 1404 | ||
| 1376 | If REGEXP contains upper case characters (excluding those preceded by `\\') | 1405 | If REGEXP contains upper case characters (excluding those preceded by `\\') |
| 1377 | and `search-upper-case' is non-nil, the matching is case-sensitive. | 1406 | and `search-upper-case' is non-nil, the matching is case-sensitive. |
| @@ -1386,8 +1415,30 @@ For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and | |||
| 1386 | program. When there is no parenthesized subexpressions in REGEXP | 1415 | program. When there is no parenthesized subexpressions in REGEXP |
| 1387 | the entire match is collected. In any case the searched buffer | 1416 | the entire match is collected. In any case the searched buffer |
| 1388 | is not modified." | 1417 | is not modified." |
| 1389 | (interactive (occur-read-primary-args)) | 1418 | (interactive |
| 1390 | (occur-1 regexp nlines (list (current-buffer)))) | 1419 | (nconc (occur-read-primary-args) |
| 1420 | (and (use-region-p) (list (region-bounds))))) | ||
| 1421 | (let* ((start (and (caar region) (max (caar region) (point-min)))) | ||
| 1422 | (end (and (cdar region) (min (cdar region) (point-max)))) | ||
| 1423 | (in-region-p (or start end))) | ||
| 1424 | (when in-region-p | ||
| 1425 | (or start (setq start (point-min))) | ||
| 1426 | (or end (setq end (point-max)))) | ||
| 1427 | (let ((occur--region-start start) | ||
| 1428 | (occur--region-end end) | ||
| 1429 | (occur--matches-threshold | ||
| 1430 | (and in-region-p | ||
| 1431 | (line-number-at-pos (min start end)))) | ||
| 1432 | (occur--orig-line | ||
| 1433 | (line-number-at-pos (point))) | ||
| 1434 | (occur--orig-line-str | ||
| 1435 | (buffer-substring-no-properties | ||
| 1436 | (line-beginning-position) | ||
| 1437 | (line-end-position)))) | ||
| 1438 | (save-excursion ; If no matches `occur-1' doesn't restore the point. | ||
| 1439 | (and in-region-p (narrow-to-region start end)) | ||
| 1440 | (occur-1 regexp nlines (list (current-buffer))) | ||
| 1441 | (and in-region-p (widen)))))) | ||
| 1391 | 1442 | ||
| 1392 | (defvar ido-ignore-item-temp-list) | 1443 | (defvar ido-ignore-item-temp-list) |
| 1393 | 1444 | ||
| @@ -1482,7 +1533,8 @@ See also `multi-occur'." | |||
| 1482 | (occur-mode)) | 1533 | (occur-mode)) |
| 1483 | (let ((inhibit-read-only t) | 1534 | (let ((inhibit-read-only t) |
| 1484 | ;; Don't generate undo entries for creation of the initial contents. | 1535 | ;; Don't generate undo entries for creation of the initial contents. |
| 1485 | (buffer-undo-list t)) | 1536 | (buffer-undo-list t) |
| 1537 | (occur--final-pos nil)) | ||
| 1486 | (erase-buffer) | 1538 | (erase-buffer) |
| 1487 | (let ((count | 1539 | (let ((count |
| 1488 | (if (stringp nlines) | 1540 | (if (stringp nlines) |
| @@ -1534,6 +1586,10 @@ See also `multi-occur'." | |||
| 1534 | (if (= count 0) | 1586 | (if (= count 0) |
| 1535 | (kill-buffer occur-buf) | 1587 | (kill-buffer occur-buf) |
| 1536 | (display-buffer occur-buf) | 1588 | (display-buffer occur-buf) |
| 1589 | (when occur--final-pos | ||
| 1590 | (set-window-point | ||
| 1591 | (get-buffer-window occur-buf 'all-frames) | ||
| 1592 | occur--final-pos)) | ||
| 1537 | (setq next-error-last-buffer occur-buf) | 1593 | (setq next-error-last-buffer occur-buf) |
| 1538 | (setq buffer-read-only t) | 1594 | (setq buffer-read-only t) |
| 1539 | (set-buffer-modified-p nil) | 1595 | (set-buffer-modified-p nil) |
| @@ -1545,19 +1601,26 @@ See also `multi-occur'." | |||
| 1545 | (let ((global-lines 0) ;; total count of matching lines | 1601 | (let ((global-lines 0) ;; total count of matching lines |
| 1546 | (global-matches 0) ;; total count of matches | 1602 | (global-matches 0) ;; total count of matches |
| 1547 | (coding nil) | 1603 | (coding nil) |
| 1548 | (case-fold-search case-fold)) | 1604 | (case-fold-search case-fold) |
| 1605 | (in-region-p (and occur--region-start occur--region-end)) | ||
| 1606 | (multi-occur-p (cdr buffers))) | ||
| 1549 | ;; Map over all the buffers | 1607 | ;; Map over all the buffers |
| 1550 | (dolist (buf buffers) | 1608 | (dolist (buf buffers) |
| 1551 | (when (buffer-live-p buf) | 1609 | (when (buffer-live-p buf) |
| 1552 | (let ((lines 0) ;; count of matching lines | 1610 | (let ((lines 0) ;; count of matching lines |
| 1553 | (matches 0) ;; count of matches | 1611 | (matches 0) ;; count of matches |
| 1554 | (curr-line 1) ;; line count | 1612 | (curr-line ;; line count |
| 1613 | (or occur--matches-threshold 1)) | ||
| 1614 | (orig-line occur--orig-line) | ||
| 1615 | (orig-line-str occur--orig-line-str) | ||
| 1616 | (orig-line-shown-p) | ||
| 1555 | (prev-line nil) ;; line number of prev match endpt | 1617 | (prev-line nil) ;; line number of prev match endpt |
| 1556 | (prev-after-lines nil) ;; context lines of prev match | 1618 | (prev-after-lines nil) ;; context lines of prev match |
| 1557 | (matchbeg 0) | 1619 | (matchbeg 0) |
| 1558 | (origpt nil) | 1620 | (origpt nil) |
| 1559 | (begpt nil) | 1621 | (begpt nil) |
| 1560 | (endpt nil) | 1622 | (endpt nil) |
| 1623 | (finalpt nil) | ||
| 1561 | (marker nil) | 1624 | (marker nil) |
| 1562 | (curstring "") | 1625 | (curstring "") |
| 1563 | (ret nil) | 1626 | (ret nil) |
| @@ -1658,6 +1721,18 @@ See also `multi-occur'." | |||
| 1658 | (nth 0 ret)))) | 1721 | (nth 0 ret)))) |
| 1659 | ;; Actually insert the match display data | 1722 | ;; Actually insert the match display data |
| 1660 | (with-current-buffer out-buf | 1723 | (with-current-buffer out-buf |
| 1724 | (when (and list-matching-lines-jump-to-current-line | ||
| 1725 | (not multi-occur-p) | ||
| 1726 | (not orig-line-shown-p) | ||
| 1727 | (>= curr-line orig-line)) | ||
| 1728 | (insert | ||
| 1729 | (concat | ||
| 1730 | (propertize | ||
| 1731 | (format "%7d:%s" orig-line orig-line-str) | ||
| 1732 | 'face list-matching-lines-current-line-face | ||
| 1733 | 'mouse-face 'mode-line-highlight | ||
| 1734 | 'help-echo "Current line") "\n")) | ||
| 1735 | (setq orig-line-shown-p t finalpt (point))) | ||
| 1661 | (insert data))) | 1736 | (insert data))) |
| 1662 | (goto-char endpt)) | 1737 | (goto-char endpt)) |
| 1663 | (if endpt | 1738 | (if endpt |
| @@ -1671,6 +1746,18 @@ See also `multi-occur'." | |||
| 1671 | (forward-line 1)) | 1746 | (forward-line 1)) |
| 1672 | (goto-char (point-max))) | 1747 | (goto-char (point-max))) |
| 1673 | (setq prev-line (1- curr-line))) | 1748 | (setq prev-line (1- curr-line))) |
| 1749 | ;; Insert original line if haven't done yet. | ||
| 1750 | (when (and list-matching-lines-jump-to-current-line | ||
| 1751 | (not multi-occur-p) | ||
| 1752 | (not orig-line-shown-p)) | ||
| 1753 | (with-current-buffer out-buf | ||
| 1754 | (insert | ||
| 1755 | (concat | ||
| 1756 | (propertize | ||
| 1757 | (format "%7d:%s" orig-line orig-line-str) | ||
| 1758 | 'face list-matching-lines-current-line-face | ||
| 1759 | 'mouse-face 'mode-line-highlight | ||
| 1760 | 'help-echo "Current line") "\n")))) | ||
| 1674 | ;; Flush remaining context after-lines. | 1761 | ;; Flush remaining context after-lines. |
| 1675 | (when prev-after-lines | 1762 | (when prev-after-lines |
| 1676 | (with-current-buffer out-buf | 1763 | (with-current-buffer out-buf |
| @@ -1684,7 +1771,7 @@ See also `multi-occur'." | |||
| 1684 | (let ((beg (point)) | 1771 | (let ((beg (point)) |
| 1685 | end) | 1772 | end) |
| 1686 | (insert (propertize | 1773 | (insert (propertize |
| 1687 | (format "%d match%s%s%s in buffer: %s\n" | 1774 | (format "%d match%s%s%s in buffer: %s%s\n" |
| 1688 | matches (if (= matches 1) "" "es") | 1775 | matches (if (= matches 1) "" "es") |
| 1689 | ;; Don't display the same number of lines | 1776 | ;; Don't display the same number of lines |
| 1690 | ;; and matches in case of 1 match per line. | 1777 | ;; and matches in case of 1 match per line. |
| @@ -1694,13 +1781,21 @@ See also `multi-occur'." | |||
| 1694 | ;; Don't display regexp for multi-buffer. | 1781 | ;; Don't display regexp for multi-buffer. |
| 1695 | (if (> (length buffers) 1) | 1782 | (if (> (length buffers) 1) |
| 1696 | "" (occur-regexp-descr regexp)) | 1783 | "" (occur-regexp-descr regexp)) |
| 1697 | (buffer-name buf)) | 1784 | (buffer-name buf) |
| 1785 | (if in-region-p | ||
| 1786 | (format " within region: %d-%d" | ||
| 1787 | occur--region-start | ||
| 1788 | occur--region-end) | ||
| 1789 | "")) | ||
| 1698 | 'read-only t)) | 1790 | 'read-only t)) |
| 1699 | (setq end (point)) | 1791 | (setq end (point)) |
| 1700 | (add-text-properties beg end `(occur-title ,buf)) | 1792 | (add-text-properties beg end `(occur-title ,buf)) |
| 1701 | (when title-face | 1793 | (when title-face |
| 1702 | (add-face-text-property beg end title-face))) | 1794 | (add-face-text-property beg end title-face)) |
| 1703 | (goto-char (point-min))))))) | 1795 | (goto-char (if finalpt |
| 1796 | (setq occur--final-pos | ||
| 1797 | (cl-incf finalpt (- end beg))) | ||
| 1798 | (point-min))))))))) | ||
| 1704 | ;; Display total match count and regexp for multi-buffer. | 1799 | ;; Display total match count and regexp for multi-buffer. |
| 1705 | (when (and (not (zerop global-lines)) (> (length buffers) 1)) | 1800 | (when (and (not (zerop global-lines)) (> (length buffers) 1)) |
| 1706 | (goto-char (point-min)) | 1801 | (goto-char (point-min)) |
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..a204577ddf9 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. |
| @@ -1297,8 +1417,10 @@ be a list of the form returned by `event-start' and `event-end'." | |||
| 1297 | ;; bug#23850 | 1417 | ;; bug#23850 |
| 1298 | (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") | 1418 | (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") |
| 1299 | (make-obsolete 'string-as-unibyte "use `encode-coding-string'." "26.1") | 1419 | (make-obsolete 'string-as-unibyte "use `encode-coding-string'." "26.1") |
| 1420 | (make-obsolete 'string-make-unibyte "use `encode-coding-string'." "26.1") | ||
| 1300 | (make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1") | 1421 | (make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1") |
| 1301 | (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") | 1422 | (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") |
| 1423 | (make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") | ||
| 1302 | 1424 | ||
| 1303 | (defun log10 (x) | 1425 | (defun log10 (x) |
| 1304 | "Return (log X 10), the log base 10 of X." | 1426 | "Return (log X 10), the log base 10 of X." |
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 c81c3f62e16..0c7d76f7924 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el | |||
| @@ -32,9 +32,11 @@ | |||
| 32 | 32 | ||
| 33 | ;;; Code: | 33 | ;;; Code: |
| 34 | 34 | ||
| 35 | (require 'eww) | ||
| 35 | (require 'seq) | 36 | (require 'seq) |
| 36 | (require 'sgml-mode) | 37 | (require 'sgml-mode) |
| 37 | (require 'smie) | 38 | (require 'smie) |
| 39 | (require 'subr-x) | ||
| 38 | 40 | ||
| 39 | (defgroup css nil | 41 | (defgroup css nil |
| 40 | "Cascading Style Sheets (CSS) editing mode." | 42 | "Cascading Style Sheets (CSS) editing mode." |
| @@ -621,6 +623,12 @@ cannot be completed sensibly: `custom-ident', | |||
| 621 | (modify-syntax-entry ?- "_" st) | 623 | (modify-syntax-entry ?- "_" st) |
| 622 | st)) | 624 | st)) |
| 623 | 625 | ||
| 626 | (defvar css-mode-map | ||
| 627 | (let ((map (make-sparse-keymap))) | ||
| 628 | (define-key map [remap info-lookup-symbol] 'css-lookup-symbol) | ||
| 629 | map) | ||
| 630 | "Keymap used in `css-mode'.") | ||
| 631 | |||
| 624 | (eval-and-compile | 632 | (eval-and-compile |
| 625 | (defconst css--uri-re | 633 | (defconst css--uri-re |
| 626 | (concat | 634 | (concat |
| @@ -734,7 +742,30 @@ cannot be completed sensibly: `custom-ident', | |||
| 734 | 742 | ||
| 735 | (defconst css-smie-grammar | 743 | (defconst css-smie-grammar |
| 736 | (smie-prec2->grammar | 744 | (smie-prec2->grammar |
| 737 | (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) | 745 | (smie-precs->prec2 |
| 746 | '((assoc ";") | ||
| 747 | ;; Colons that belong to a CSS property. These get a higher | ||
| 748 | ;; precedence than other colons, such as colons in selectors, | ||
| 749 | ;; which are represented by a plain ":" token. | ||
| 750 | (left ":-property") | ||
| 751 | (assoc ",") | ||
| 752 | (assoc ":"))))) | ||
| 753 | |||
| 754 | (defun css--colon-inside-selector-p () | ||
| 755 | "Return t if point looks to be inside a CSS selector. | ||
| 756 | This function is intended to be good enough to help SMIE during | ||
| 757 | tokenization, but should not be regarded as a reliable function | ||
| 758 | for determining whether point is within a selector." | ||
| 759 | (save-excursion | ||
| 760 | (re-search-forward "[{};)]" nil t) | ||
| 761 | (eq (char-before) ?\{))) | ||
| 762 | |||
| 763 | (defun css--colon-inside-funcall () | ||
| 764 | "Return t if point is inside a function call." | ||
| 765 | (when-let (opening-paren-pos (nth 1 (syntax-ppss))) | ||
| 766 | (save-excursion | ||
| 767 | (goto-char opening-paren-pos) | ||
| 768 | (eq (char-after) ?\()))) | ||
| 738 | 769 | ||
| 739 | (defun css-smie--forward-token () | 770 | (defun css-smie--forward-token () |
| 740 | (cond | 771 | (cond |
| @@ -748,7 +779,13 @@ cannot be completed sensibly: `custom-ident', | |||
| 748 | ";") | 779 | ";") |
| 749 | ((progn (forward-comment (point-max)) | 780 | ((progn (forward-comment (point-max)) |
| 750 | (looking-at "[;,:]")) | 781 | (looking-at "[;,:]")) |
| 751 | (forward-char 1) (match-string 0)) | 782 | (forward-char 1) |
| 783 | (if (equal (match-string 0) ":") | ||
| 784 | (if (or (css--colon-inside-selector-p) | ||
| 785 | (css--colon-inside-funcall)) | ||
| 786 | ":" | ||
| 787 | ":-property") | ||
| 788 | (match-string 0))) | ||
| 752 | (t (smie-default-forward-token)))) | 789 | (t (smie-default-forward-token)))) |
| 753 | 790 | ||
| 754 | (defun css-smie--backward-token () | 791 | (defun css-smie--backward-token () |
| @@ -759,7 +796,13 @@ cannot be completed sensibly: `custom-ident', | |||
| 759 | ((and (eq (char-before) ?\}) (scss-smie--not-interpolation-p) | 796 | ((and (eq (char-before) ?\}) (scss-smie--not-interpolation-p) |
| 760 | (> pos (point))) ";") | 797 | (> pos (point))) ";") |
| 761 | ((memq (char-before) '(?\; ?\, ?\:)) | 798 | ((memq (char-before) '(?\; ?\, ?\:)) |
| 762 | (forward-char -1) (string (char-after))) | 799 | (forward-char -1) |
| 800 | (if (eq (char-after) ?\:) | ||
| 801 | (if (or (css--colon-inside-selector-p) | ||
| 802 | (css--colon-inside-funcall)) | ||
| 803 | ":" | ||
| 804 | ":-property") | ||
| 805 | (string (char-after)))) | ||
| 763 | (t (smie-default-backward-token))))) | 806 | (t (smie-default-backward-token))))) |
| 764 | 807 | ||
| 765 | (defun css-smie-rules (kind token) | 808 | (defun css-smie-rules (kind token) |
| @@ -1087,5 +1130,112 @@ pseudo-elements, pseudo-classes, at-rules, and bang-rules." | |||
| 1087 | (setq-local font-lock-defaults | 1130 | (setq-local font-lock-defaults |
| 1088 | (list (scss-font-lock-keywords) nil t))) | 1131 | (list (scss-font-lock-keywords) nil t))) |
| 1089 | 1132 | ||
| 1133 | |||
| 1134 | |||
| 1135 | (defvar css--mdn-lookup-history nil) | ||
| 1136 | |||
| 1137 | (defcustom css-lookup-url-format | ||
| 1138 | "https://developer.mozilla.org/en-US/docs/Web/CSS/%s?raw¯os" | ||
| 1139 | "Format for a URL where CSS documentation can be found. | ||
| 1140 | The format should include a single \"%s\" substitution. | ||
| 1141 | The name of the CSS property, @-id, pseudo-class, or pseudo-element | ||
| 1142 | to look up will be substituted there." | ||
| 1143 | :version "26.1" | ||
| 1144 | :type 'string | ||
| 1145 | :group 'css) | ||
| 1146 | |||
| 1147 | (defun css--mdn-after-render () | ||
| 1148 | (setf header-line-format nil) | ||
| 1149 | (goto-char (point-min)) | ||
| 1150 | (let ((window (get-buffer-window (current-buffer) 'visible))) | ||
| 1151 | (when window | ||
| 1152 | (when (re-search-forward "^Summary" nil 'move) | ||
| 1153 | (beginning-of-line) | ||
| 1154 | (set-window-start window (point)))))) | ||
| 1155 | |||
| 1156 | (defconst css--mdn-symbol-regexp | ||
| 1157 | (concat "\\(" | ||
| 1158 | ;; @-ids. | ||
| 1159 | "\\(@" (regexp-opt css-at-ids) "\\)" | ||
| 1160 | "\\|" | ||
| 1161 | ;; ;; Known properties. | ||
| 1162 | (regexp-opt css-property-ids t) | ||
| 1163 | "\\|" | ||
| 1164 | ;; Pseudo-classes. | ||
| 1165 | "\\(:" (regexp-opt css-pseudo-class-ids) "\\)" | ||
| 1166 | "\\|" | ||
| 1167 | ;; Pseudo-elements with either one or two ":"s. | ||
| 1168 | "\\(::?" (regexp-opt css-pseudo-element-ids) "\\)" | ||
| 1169 | "\\)") | ||
| 1170 | "Regular expression to match the CSS symbol at point.") | ||
| 1171 | |||
| 1172 | (defconst css--mdn-property-regexp | ||
| 1173 | (concat "\\_<" (regexp-opt css-property-ids t) "\\s-*\\(?:\\=\\|:\\)") | ||
| 1174 | "Regular expression to match a CSS property.") | ||
| 1175 | |||
| 1176 | (defconst css--mdn-completion-list | ||
| 1177 | (nconc | ||
| 1178 | ;; @-ids. | ||
| 1179 | (mapcar (lambda (atrule) (concat "@" atrule)) css-at-ids) | ||
| 1180 | ;; Pseudo-classes. | ||
| 1181 | (mapcar (lambda (class) (concat ":" class)) css-pseudo-class-ids) | ||
| 1182 | ;; Pseudo-elements with either one or two ":"s. | ||
| 1183 | (mapcar (lambda (elt) (concat ":" elt)) css-pseudo-element-ids) | ||
| 1184 | (mapcar (lambda (elt) (concat "::" elt)) css-pseudo-element-ids) | ||
| 1185 | ;; Properties. | ||
| 1186 | css-property-ids) | ||
| 1187 | "List of all symbols available for lookup via MDN.") | ||
| 1188 | |||
| 1189 | (defun css--mdn-find-symbol () | ||
| 1190 | "A helper for `css-lookup-symbol' that finds the symbol at point. | ||
| 1191 | Returns the symbol, a string, or nil if none found." | ||
| 1192 | (save-excursion | ||
| 1193 | ;; Skip backward over a word first. | ||
| 1194 | (skip-chars-backward "-[:alnum:] \t") | ||
| 1195 | ;; Now skip ":" or "@" to see if it's a pseudo-element or at-id. | ||
| 1196 | (skip-chars-backward "@:") | ||
| 1197 | (if (looking-at css--mdn-symbol-regexp) | ||
| 1198 | (match-string-no-properties 0) | ||
| 1199 | (let ((bound (save-excursion | ||
| 1200 | (beginning-of-line) | ||
| 1201 | (point)))) | ||
| 1202 | (when (re-search-backward css--mdn-property-regexp bound t) | ||
| 1203 | (match-string-no-properties 1)))))) | ||
| 1204 | |||
| 1205 | ;;;###autoload | ||
| 1206 | (defun css-lookup-symbol (symbol) | ||
| 1207 | "Display the CSS documentation for SYMBOL, as found on MDN. | ||
| 1208 | When this command is used interactively, it picks a default | ||
| 1209 | symbol based on the CSS text before point -- either an @-keyword, | ||
| 1210 | a property name, a pseudo-class, or a pseudo-element, depending | ||
| 1211 | on what is seen near point." | ||
| 1212 | (interactive | ||
| 1213 | (list | ||
| 1214 | (let* ((sym (css--mdn-find-symbol)) | ||
| 1215 | (enable-recursive-minibuffers t) | ||
| 1216 | (value (completing-read | ||
| 1217 | (if sym | ||
| 1218 | (format "Describe CSS symbol (default %s): " sym) | ||
| 1219 | "Describe CSS symbol: ") | ||
| 1220 | css--mdn-completion-list nil nil nil | ||
| 1221 | 'css--mdn-lookup-history sym))) | ||
| 1222 | (if (equal value "") sym value)))) | ||
| 1223 | (when symbol | ||
| 1224 | ;; If we see a single-colon pseudo-element like ":after", turn it | ||
| 1225 | ;; into "::after". | ||
| 1226 | (when (and (eq (aref symbol 0) ?:) | ||
| 1227 | (member (substring symbol 1) css-pseudo-element-ids)) | ||
| 1228 | (setq symbol (concat ":" symbol))) | ||
| 1229 | (let ((url (format css-lookup-url-format symbol)) | ||
| 1230 | (buffer (get-buffer-create "*MDN CSS*"))) | ||
| 1231 | (save-selected-window | ||
| 1232 | ;; Make sure to display the buffer before calling `eww', as | ||
| 1233 | ;; that calls `pop-to-buffer-same-window'. | ||
| 1234 | (switch-to-buffer-other-window buffer) | ||
| 1235 | (with-current-buffer buffer | ||
| 1236 | (eww-mode) | ||
| 1237 | (add-hook 'eww-after-render-hook #'css--mdn-after-render nil t) | ||
| 1238 | (eww url)))))) | ||
| 1239 | |||
| 1090 | (provide 'css-mode) | 1240 | (provide 'css-mode) |
| 1091 | ;;; css-mode.el ends here | 1241 | ;;; css-mode.el ends here |
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/vc/diff-mode.el b/lisp/vc/diff-mode.el index b7ad8e8ebd8..31c33e6a720 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el | |||
| @@ -437,6 +437,9 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") | |||
| 437 | (defconst diff-hunk-header-re | 437 | (defconst diff-hunk-header-re |
| 438 | (concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$")) | 438 | (concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$")) |
| 439 | (defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* \n]\\).+\n" (substring diff-hunk-header-re 1))) | 439 | (defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* \n]\\).+\n" (substring diff-hunk-header-re 1))) |
| 440 | |||
| 441 | (defconst diff-separator-re "^--+ ?$") | ||
| 442 | |||
| 440 | (defvar diff-narrowed-to nil) | 443 | (defvar diff-narrowed-to nil) |
| 441 | 444 | ||
| 442 | (defun diff-hunk-style (&optional style) | 445 | (defun diff-hunk-style (&optional style) |
| @@ -501,7 +504,8 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") | |||
| 501 | ;; "index ", "old mode", "new mode", "new file mode" and | 504 | ;; "index ", "old mode", "new mode", "new file mode" and |
| 502 | ;; "deleted file mode" are output by git-diff. | 505 | ;; "deleted file mode" are output by git-diff. |
| 503 | (defconst diff-file-junk-re | 506 | (defconst diff-file-junk-re |
| 504 | "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file") | 507 | (concat "Index: \\|=\\{20,\\}\\|" ; SVN |
| 508 | "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file")) | ||
| 505 | 509 | ||
| 506 | ;; If point is in a diff header, then return beginning | 510 | ;; If point is in a diff header, then return beginning |
| 507 | ;; of hunk position otherwise return nil. | 511 | ;; of hunk position otherwise return nil. |
| @@ -545,7 +549,8 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." | |||
| 545 | (error "Can't find the beginning of the hunk"))) | 549 | (error "Can't find the beginning of the hunk"))) |
| 546 | ((re-search-backward regexp nil t)) ; In the middle of a hunk. | 550 | ((re-search-backward regexp nil t)) ; In the middle of a hunk. |
| 547 | ((re-search-forward regexp nil t) ; At first hunk header. | 551 | ((re-search-forward regexp nil t) ; At first hunk header. |
| 548 | (forward-line 0)) | 552 | (forward-line 0) |
| 553 | (point)) | ||
| 549 | (t (error "Can't find the beginning of the hunk")))))) | 554 | (t (error "Can't find the beginning of the hunk")))))) |
| 550 | 555 | ||
| 551 | (defun diff-unified-hunk-p () | 556 | (defun diff-unified-hunk-p () |
| @@ -645,28 +650,36 @@ If the prefix ARG is given, restrict the view to the current file instead." | |||
| 645 | (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) | 650 | (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) |
| 646 | (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) | 651 | (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) |
| 647 | 652 | ||
| 653 | (defun diff--some-hunks-p () | ||
| 654 | (save-excursion | ||
| 655 | (goto-char (point-min)) | ||
| 656 | (re-search-forward diff-hunk-header-re nil t))) | ||
| 657 | |||
| 648 | (defun diff-hunk-kill () | 658 | (defun diff-hunk-kill () |
| 649 | "Kill the hunk at point." | 659 | "Kill the hunk at point." |
| 650 | (interactive) | 660 | (interactive) |
| 651 | (let* ((hunk-bounds (diff-bounds-of-hunk)) | 661 | (if (not (diff--some-hunks-p)) |
| 652 | (file-bounds (ignore-errors (diff-bounds-of-file))) | 662 | (error "No hunks") |
| 653 | ;; If the current hunk is the only one for its file, kill the | 663 | (diff-beginning-of-hunk t) |
| 654 | ;; file header too. | 664 | (let* ((hunk-bounds (diff-bounds-of-hunk)) |
| 655 | (bounds (if (and file-bounds | 665 | (file-bounds (ignore-errors (diff-bounds-of-file))) |
| 656 | (progn (goto-char (car file-bounds)) | 666 | ;; If the current hunk is the only one for its file, kill the |
| 657 | (= (progn (diff-hunk-next) (point)) | 667 | ;; file header too. |
| 658 | (car hunk-bounds))) | 668 | (bounds (if (and file-bounds |
| 659 | (progn (goto-char (cadr hunk-bounds)) | 669 | (progn (goto-char (car file-bounds)) |
| 660 | ;; bzr puts a newline after the last hunk. | 670 | (= (progn (diff-hunk-next) (point)) |
| 661 | (while (looking-at "^\n") | 671 | (car hunk-bounds))) |
| 662 | (forward-char 1)) | 672 | (progn (goto-char (cadr hunk-bounds)) |
| 663 | (= (point) (cadr file-bounds)))) | 673 | ;; bzr puts a newline after the last hunk. |
| 664 | file-bounds | 674 | (while (looking-at "^\n") |
| 665 | hunk-bounds)) | 675 | (forward-char 1)) |
| 666 | (inhibit-read-only t)) | 676 | (= (point) (cadr file-bounds)))) |
| 667 | (apply 'kill-region bounds) | 677 | file-bounds |
| 668 | (goto-char (car bounds)) | 678 | hunk-bounds)) |
| 669 | (diff-beginning-of-hunk t))) | 679 | (inhibit-read-only t)) |
| 680 | (apply 'kill-region bounds) | ||
| 681 | (goto-char (car bounds)) | ||
| 682 | (ignore-errors (diff-beginning-of-hunk t))))) | ||
| 670 | 683 | ||
| 671 | (defun diff-beginning-of-file-and-junk () | 684 | (defun diff-beginning-of-file-and-junk () |
| 672 | "Go to the beginning of file-related diff-info. | 685 | "Go to the beginning of file-related diff-info. |
| @@ -718,9 +731,12 @@ data such as \"Index: ...\" and such." | |||
| 718 | (defun diff-file-kill () | 731 | (defun diff-file-kill () |
| 719 | "Kill current file's hunks." | 732 | "Kill current file's hunks." |
| 720 | (interactive) | 733 | (interactive) |
| 721 | (let ((inhibit-read-only t)) | 734 | (if (not (diff--some-hunks-p)) |
| 722 | (apply 'kill-region (diff-bounds-of-file))) | 735 | (error "No hunks") |
| 723 | (diff-beginning-of-hunk t)) | 736 | (diff-beginning-of-hunk t) |
| 737 | (let ((inhibit-read-only t)) | ||
| 738 | (apply 'kill-region (diff-bounds-of-file))) | ||
| 739 | (ignore-errors (diff-beginning-of-hunk t)))) | ||
| 724 | 740 | ||
| 725 | (defun diff-kill-junk () | 741 | (defun diff-kill-junk () |
| 726 | "Kill spurious empty diffs." | 742 | "Kill spurious empty diffs." |
| @@ -1535,15 +1551,20 @@ Only works for unified diffs." | |||
| 1535 | (pcase (char-after) | 1551 | (pcase (char-after) |
| 1536 | (?\s (cl-decf before) (cl-decf after) t) | 1552 | (?\s (cl-decf before) (cl-decf after) t) |
| 1537 | (?- | 1553 | (?- |
| 1538 | (if (and (looking-at diff-file-header-re) | 1554 | (cond |
| 1539 | (zerop before) (zerop after)) | 1555 | ((and (looking-at diff-separator-re) |
| 1540 | ;; No need to query: this is a case where two patches | 1556 | (zerop before) (zerop after)) |
| 1541 | ;; are concatenated and only counting the lines will | 1557 | nil) |
| 1542 | ;; give the right result. Let's just add an empty | 1558 | ((and (looking-at diff-file-header-re) |
| 1543 | ;; line so that our code which doesn't count lines | 1559 | (zerop before) (zerop after)) |
| 1544 | ;; will not get confused. | 1560 | ;; No need to query: this is a case where two patches |
| 1545 | (progn (save-excursion (insert "\n")) nil) | 1561 | ;; are concatenated and only counting the lines will |
| 1546 | (cl-decf before) t)) | 1562 | ;; give the right result. Let's just add an empty |
| 1563 | ;; line so that our code which doesn't count lines | ||
| 1564 | ;; will not get confused. | ||
| 1565 | (save-excursion (insert "\n")) nil) | ||
| 1566 | (t | ||
| 1567 | (cl-decf before) t))) | ||
| 1547 | (?+ (cl-decf after) t) | 1568 | (?+ (cl-decf after) t) |
| 1548 | (_ | 1569 | (_ |
| 1549 | (cond | 1570 | (cond |
| @@ -1998,57 +2019,58 @@ Return new point, if it was moved." | |||
| 1998 | "Highlight changes of hunk at point at a finer granularity." | 2019 | "Highlight changes of hunk at point at a finer granularity." |
| 1999 | (interactive) | 2020 | (interactive) |
| 2000 | (require 'smerge-mode) | 2021 | (require 'smerge-mode) |
| 2001 | (save-excursion | 2022 | (when (diff--some-hunks-p) |
| 2002 | (diff-beginning-of-hunk t) | 2023 | (save-excursion |
| 2003 | (let* ((start (point)) | 2024 | (diff-beginning-of-hunk t) |
| 2004 | (style (diff-hunk-style)) ;Skips the hunk header as well. | 2025 | (let* ((start (point)) |
| 2005 | (beg (point)) | 2026 | (style (diff-hunk-style)) ;Skips the hunk header as well. |
| 2006 | (props-c '((diff-mode . fine) (face diff-refine-changed))) | 2027 | (beg (point)) |
| 2007 | (props-r '((diff-mode . fine) (face diff-refine-removed))) | 2028 | (props-c '((diff-mode . fine) (face diff-refine-changed))) |
| 2008 | (props-a '((diff-mode . fine) (face diff-refine-added))) | 2029 | (props-r '((diff-mode . fine) (face diff-refine-removed))) |
| 2009 | ;; Be careful to go back to `start' so diff-end-of-hunk gets | 2030 | (props-a '((diff-mode . fine) (face diff-refine-added))) |
| 2010 | ;; to read the hunk header's line info. | 2031 | ;; Be careful to go back to `start' so diff-end-of-hunk gets |
| 2011 | (end (progn (goto-char start) (diff-end-of-hunk) (point)))) | 2032 | ;; to read the hunk header's line info. |
| 2012 | 2033 | (end (progn (goto-char start) (diff-end-of-hunk) (point)))) | |
| 2013 | (remove-overlays beg end 'diff-mode 'fine) | 2034 | |
| 2014 | 2035 | (remove-overlays beg end 'diff-mode 'fine) | |
| 2015 | (goto-char beg) | 2036 | |
| 2016 | (pcase style | 2037 | (goto-char beg) |
| 2017 | (`unified | 2038 | (pcase style |
| 2018 | (while (re-search-forward "^-" end t) | 2039 | (`unified |
| 2019 | (let ((beg-del (progn (beginning-of-line) (point))) | 2040 | (while (re-search-forward "^-" end t) |
| 2020 | beg-add end-add) | 2041 | (let ((beg-del (progn (beginning-of-line) (point))) |
| 2021 | (when (and (diff--forward-while-leading-char ?- end) | 2042 | beg-add end-add) |
| 2022 | ;; Allow for "\ No newline at end of file". | 2043 | (when (and (diff--forward-while-leading-char ?- end) |
| 2023 | (progn (diff--forward-while-leading-char ?\\ end) | 2044 | ;; Allow for "\ No newline at end of file". |
| 2024 | (setq beg-add (point))) | 2045 | (progn (diff--forward-while-leading-char ?\\ end) |
| 2025 | (diff--forward-while-leading-char ?+ end) | 2046 | (setq beg-add (point))) |
| 2026 | (progn (diff--forward-while-leading-char ?\\ end) | 2047 | (diff--forward-while-leading-char ?+ end) |
| 2027 | (setq end-add (point)))) | 2048 | (progn (diff--forward-while-leading-char ?\\ end) |
| 2028 | (smerge-refine-subst beg-del beg-add beg-add end-add | 2049 | (setq end-add (point)))) |
| 2029 | nil 'diff-refine-preproc props-r props-a))))) | 2050 | (smerge-refine-subst beg-del beg-add beg-add end-add |
| 2030 | (`context | 2051 | nil 'diff-refine-preproc props-r props-a))))) |
| 2031 | (let* ((middle (save-excursion (re-search-forward "^---"))) | 2052 | (`context |
| 2032 | (other middle)) | 2053 | (let* ((middle (save-excursion (re-search-forward "^---"))) |
| 2033 | (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) | 2054 | (other middle)) |
| 2034 | (smerge-refine-subst (match-beginning 0) (match-end 0) | 2055 | (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) |
| 2035 | (save-excursion | 2056 | (smerge-refine-subst (match-beginning 0) (match-end 0) |
| 2036 | (goto-char other) | 2057 | (save-excursion |
| 2037 | (re-search-forward "^\\(?:!.*\n\\)+" end) | 2058 | (goto-char other) |
| 2038 | (setq other (match-end 0)) | 2059 | (re-search-forward "^\\(?:!.*\n\\)+" end) |
| 2039 | (match-beginning 0)) | 2060 | (setq other (match-end 0)) |
| 2040 | other | 2061 | (match-beginning 0)) |
| 2041 | (if diff-use-changed-face props-c) | 2062 | other |
| 2042 | 'diff-refine-preproc | 2063 | (if diff-use-changed-face props-c) |
| 2043 | (unless diff-use-changed-face props-r) | 2064 | 'diff-refine-preproc |
| 2044 | (unless diff-use-changed-face props-a))))) | 2065 | (unless diff-use-changed-face props-r) |
| 2045 | (_ ;; Normal diffs. | 2066 | (unless diff-use-changed-face props-a))))) |
| 2046 | (let ((beg1 (1+ (point)))) | 2067 | (_ ;; Normal diffs. |
| 2047 | (when (re-search-forward "^---.*\n" end t) | 2068 | (let ((beg1 (1+ (point)))) |
| 2048 | ;; It's a combined add&remove, so there's something to do. | 2069 | (when (re-search-forward "^---.*\n" end t) |
| 2049 | (smerge-refine-subst beg1 (match-beginning 0) | 2070 | ;; It's a combined add&remove, so there's something to do. |
| 2050 | (match-end 0) end | 2071 | (smerge-refine-subst beg1 (match-beginning 0) |
| 2051 | nil 'diff-refine-preproc props-r props-a)))))))) | 2072 | (match-end 0) end |
| 2073 | nil 'diff-refine-preproc props-r props-a))))))))) | ||
| 2052 | 2074 | ||
| 2053 | (defun diff-undo (&optional arg) | 2075 | (defun diff-undo (&optional arg) |
| 2054 | "Perform `undo', ignoring the buffer's read-only status." | 2076 | "Perform `undo', ignoring the buffer's read-only status." |
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..62f43669f2a 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 | rarely_quit (size); |
| 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; |
| @@ -4917,12 +4887,19 @@ mark_memory (void *start, void *end) | |||
| 4917 | } | 4887 | } |
| 4918 | } | 4888 | } |
| 4919 | 4889 | ||
| 4920 | #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS | 4890 | #ifndef HAVE___BUILTIN_UNWIND_INIT |
| 4891 | |||
| 4892 | # ifdef GC_SETJMP_WORKS | ||
| 4893 | static void | ||
| 4894 | test_setjmp (void) | ||
| 4895 | { | ||
| 4896 | } | ||
| 4897 | # else | ||
| 4921 | 4898 | ||
| 4922 | static bool setjmp_tested_p; | 4899 | static bool setjmp_tested_p; |
| 4923 | static int longjmps_done; | 4900 | static int longjmps_done; |
| 4924 | 4901 | ||
| 4925 | #define SETJMP_WILL_LIKELY_WORK "\ | 4902 | # define SETJMP_WILL_LIKELY_WORK "\ |
| 4926 | \n\ | 4903 | \n\ |
| 4927 | Emacs garbage collector has been changed to use conservative stack\n\ | 4904 | Emacs garbage collector has been changed to use conservative stack\n\ |
| 4928 | marking. Emacs has determined that the method it uses to do the\n\ | 4905 | marking. Emacs has determined that the method it uses to do the\n\ |
| @@ -4935,7 +4912,7 @@ verify that the methods used are appropriate for your system.\n\ | |||
| 4935 | Please mail the result to <emacs-devel@gnu.org>.\n\ | 4912 | Please mail the result to <emacs-devel@gnu.org>.\n\ |
| 4936 | " | 4913 | " |
| 4937 | 4914 | ||
| 4938 | #define SETJMP_WILL_NOT_WORK "\ | 4915 | # define SETJMP_WILL_NOT_WORK "\ |
| 4939 | \n\ | 4916 | \n\ |
| 4940 | Emacs garbage collector has been changed to use conservative stack\n\ | 4917 | Emacs garbage collector has been changed to use conservative stack\n\ |
| 4941 | marking. Emacs has determined that the default method it uses to do the\n\ | 4918 | marking. Emacs has determined that the default method it uses to do the\n\ |
| @@ -4961,6 +4938,9 @@ Please mail the result to <emacs-devel@gnu.org>.\n\ | |||
| 4961 | static void | 4938 | static void |
| 4962 | test_setjmp (void) | 4939 | test_setjmp (void) |
| 4963 | { | 4940 | { |
| 4941 | if (setjmp_tested_p) | ||
| 4942 | return; | ||
| 4943 | setjmp_tested_p = true; | ||
| 4964 | char buf[10]; | 4944 | char buf[10]; |
| 4965 | register int x; | 4945 | register int x; |
| 4966 | sys_jmp_buf jbuf; | 4946 | sys_jmp_buf jbuf; |
| @@ -4997,9 +4977,60 @@ test_setjmp (void) | |||
| 4997 | if (longjmps_done == 1) | 4977 | if (longjmps_done == 1) |
| 4998 | sys_longjmp (jbuf, 1); | 4978 | sys_longjmp (jbuf, 1); |
| 4999 | } | 4979 | } |
| 4980 | # endif /* ! GC_SETJMP_WORKS */ | ||
| 4981 | #endif /* ! HAVE___BUILTIN_UNWIND_INIT */ | ||
| 5000 | 4982 | ||
| 5001 | #endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */ | 4983 | /* The type of an object near the stack top, whose address can be used |
| 4984 | as a stack scan limit. */ | ||
| 4985 | typedef union | ||
| 4986 | { | ||
| 4987 | /* Align the stack top properly. Even if !HAVE___BUILTIN_UNWIND_INIT, | ||
| 4988 | jmp_buf may not be aligned enough on darwin-ppc64. */ | ||
| 4989 | max_align_t o; | ||
| 4990 | #ifndef HAVE___BUILTIN_UNWIND_INIT | ||
| 4991 | sys_jmp_buf j; | ||
| 4992 | char c; | ||
| 4993 | #endif | ||
| 4994 | } stacktop_sentry; | ||
| 4995 | |||
| 4996 | /* Force callee-saved registers and register windows onto the stack. | ||
| 4997 | Use the platform-defined __builtin_unwind_init if available, | ||
| 4998 | obviating the need for machine dependent methods. */ | ||
| 4999 | #ifndef HAVE___BUILTIN_UNWIND_INIT | ||
| 5000 | # ifdef __sparc__ | ||
| 5001 | /* This trick flushes the register windows so that all the state of | ||
| 5002 | the process is contained in the stack. | ||
| 5003 | FreeBSD does not have a ta 3 handler, so handle it specially. | ||
| 5004 | FIXME: Code in the Boehm GC suggests flushing (with 'flushrs') is | ||
| 5005 | needed on ia64 too. See mach_dep.c, where it also says inline | ||
| 5006 | assembler doesn't work with relevant proprietary compilers. */ | ||
| 5007 | # if defined __sparc64__ && defined __FreeBSD__ | ||
| 5008 | # define __builtin_unwind_init() asm ("flushw") | ||
| 5009 | # else | ||
| 5010 | # define __builtin_unwind_init() asm ("ta 3") | ||
| 5011 | # endif | ||
| 5012 | # else | ||
| 5013 | # define __builtin_unwind_init() ((void) 0) | ||
| 5014 | # endif | ||
| 5015 | #endif | ||
| 5002 | 5016 | ||
| 5017 | /* Set *P to the address of the top of the stack. This must be a | ||
| 5018 | macro, not a function, so that it is executed in the caller’s | ||
| 5019 | environment. It is not inside a do-while so that its storage | ||
| 5020 | survives the macro. */ | ||
| 5021 | #ifdef HAVE___BUILTIN_UNWIND_INIT | ||
| 5022 | # define SET_STACK_TOP_ADDRESS(p) \ | ||
| 5023 | stacktop_sentry sentry; \ | ||
| 5024 | __builtin_unwind_init (); \ | ||
| 5025 | *(p) = &sentry | ||
| 5026 | #else | ||
| 5027 | # define SET_STACK_TOP_ADDRESS(p) \ | ||
| 5028 | stacktop_sentry sentry; \ | ||
| 5029 | __builtin_unwind_init (); \ | ||
| 5030 | test_setjmp (); \ | ||
| 5031 | sys_setjmp (sentry.j); \ | ||
| 5032 | *(p) = &sentry + (stack_bottom < &sentry.c) | ||
| 5033 | #endif | ||
| 5003 | 5034 | ||
| 5004 | /* Mark live Lisp objects on the C stack. | 5035 | /* Mark live Lisp objects on the C stack. |
| 5005 | 5036 | ||
| @@ -5011,12 +5042,7 @@ test_setjmp (void) | |||
| 5011 | We have to mark Lisp objects in CPU registers that can hold local | 5042 | We have to mark Lisp objects in CPU registers that can hold local |
| 5012 | variables or are used to pass parameters. | 5043 | variables or are used to pass parameters. |
| 5013 | 5044 | ||
| 5014 | If GC_SAVE_REGISTERS_ON_STACK is defined, it should expand to | 5045 | This code assumes that calling setjmp saves registers we need |
| 5015 | something that either saves relevant registers on the stack, or | ||
| 5016 | calls mark_maybe_object passing it each register's contents. | ||
| 5017 | |||
| 5018 | If GC_SAVE_REGISTERS_ON_STACK is not defined, the current | ||
| 5019 | implementation assumes that calling setjmp saves registers we need | ||
| 5020 | to see in a jmp_buf which itself lies on the stack. This doesn't | 5046 | to see in a jmp_buf which itself lies on the stack. This doesn't |
| 5021 | have to be true! It must be verified for each system, possibly | 5047 | have to be true! It must be verified for each system, possibly |
| 5022 | by taking a look at the source code of setjmp. | 5048 | by taking a look at the source code of setjmp. |
| @@ -5080,62 +5106,9 @@ flush_stack_call_func (void (*func) (void *arg), void *arg) | |||
| 5080 | { | 5106 | { |
| 5081 | void *end; | 5107 | void *end; |
| 5082 | struct thread_state *self = current_thread; | 5108 | struct thread_state *self = current_thread; |
| 5083 | 5109 | SET_STACK_TOP_ADDRESS (&end); | |
| 5084 | #ifdef HAVE___BUILTIN_UNWIND_INIT | ||
| 5085 | /* Force callee-saved registers and register windows onto the stack. | ||
| 5086 | This is the preferred method if available, obviating the need for | ||
| 5087 | machine dependent methods. */ | ||
| 5088 | __builtin_unwind_init (); | ||
| 5089 | end = &end; | ||
| 5090 | #else /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 5091 | #ifndef GC_SAVE_REGISTERS_ON_STACK | ||
| 5092 | /* jmp_buf may not be aligned enough on darwin-ppc64 */ | ||
| 5093 | union aligned_jmpbuf { | ||
| 5094 | Lisp_Object o; | ||
| 5095 | sys_jmp_buf j; | ||
| 5096 | } j; | ||
| 5097 | volatile bool stack_grows_down_p = (char *) &j > (char *) stack_bottom; | ||
| 5098 | #endif | ||
| 5099 | /* This trick flushes the register windows so that all the state of | ||
| 5100 | the process is contained in the stack. */ | ||
| 5101 | /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is | ||
| 5102 | needed on ia64 too. See mach_dep.c, where it also says inline | ||
| 5103 | assembler doesn't work with relevant proprietary compilers. */ | ||
| 5104 | #ifdef __sparc__ | ||
| 5105 | #if defined (__sparc64__) && defined (__FreeBSD__) | ||
| 5106 | /* FreeBSD does not have a ta 3 handler. */ | ||
| 5107 | asm ("flushw"); | ||
| 5108 | #else | ||
| 5109 | asm ("ta 3"); | ||
| 5110 | #endif | ||
| 5111 | #endif | ||
| 5112 | |||
| 5113 | /* Save registers that we need to see on the stack. We need to see | ||
| 5114 | registers used to hold register variables and registers used to | ||
| 5115 | pass parameters. */ | ||
| 5116 | #ifdef GC_SAVE_REGISTERS_ON_STACK | ||
| 5117 | GC_SAVE_REGISTERS_ON_STACK (end); | ||
| 5118 | #else /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 5119 | |||
| 5120 | #ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that | ||
| 5121 | setjmp will definitely work, test it | ||
| 5122 | and print a message with the result | ||
| 5123 | of the test. */ | ||
| 5124 | if (!setjmp_tested_p) | ||
| 5125 | { | ||
| 5126 | setjmp_tested_p = 1; | ||
| 5127 | test_setjmp (); | ||
| 5128 | } | ||
| 5129 | #endif /* GC_SETJMP_WORKS */ | ||
| 5130 | |||
| 5131 | sys_setjmp (j.j); | ||
| 5132 | end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; | ||
| 5133 | #endif /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 5134 | #endif /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 5135 | |||
| 5136 | self->stack_top = end; | 5110 | self->stack_top = end; |
| 5137 | (*func) (arg); | 5111 | func (arg); |
| 5138 | |||
| 5139 | eassert (current_thread == self); | 5112 | eassert (current_thread == self); |
| 5140 | } | 5113 | } |
| 5141 | 5114 | ||
| @@ -5464,6 +5437,38 @@ make_pure_vector (ptrdiff_t len) | |||
| 5464 | return new; | 5437 | return new; |
| 5465 | } | 5438 | } |
| 5466 | 5439 | ||
| 5440 | /* Copy all contents and parameters of TABLE to a new table allocated | ||
| 5441 | from pure space, return the purified table. */ | ||
| 5442 | static struct Lisp_Hash_Table * | ||
| 5443 | purecopy_hash_table (struct Lisp_Hash_Table *table) | ||
| 5444 | { | ||
| 5445 | eassert (NILP (table->weak)); | ||
| 5446 | eassert (!NILP (table->pure)); | ||
| 5447 | |||
| 5448 | struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); | ||
| 5449 | struct hash_table_test pure_test = table->test; | ||
| 5450 | |||
| 5451 | /* Purecopy the hash table test. */ | ||
| 5452 | pure_test.name = purecopy (table->test.name); | ||
| 5453 | pure_test.user_hash_function = purecopy (table->test.user_hash_function); | ||
| 5454 | pure_test.user_cmp_function = purecopy (table->test.user_cmp_function); | ||
| 5455 | |||
| 5456 | pure->test = pure_test; | ||
| 5457 | pure->header = table->header; | ||
| 5458 | pure->weak = purecopy (Qnil); | ||
| 5459 | pure->rehash_size = purecopy (table->rehash_size); | ||
| 5460 | pure->rehash_threshold = purecopy (table->rehash_threshold); | ||
| 5461 | pure->hash = purecopy (table->hash); | ||
| 5462 | pure->next = purecopy (table->next); | ||
| 5463 | pure->next_free = purecopy (table->next_free); | ||
| 5464 | pure->index = purecopy (table->index); | ||
| 5465 | pure->count = table->count; | ||
| 5466 | pure->key_and_value = purecopy (table->key_and_value); | ||
| 5467 | pure->pure = purecopy (table->pure); | ||
| 5468 | |||
| 5469 | return pure; | ||
| 5470 | } | ||
| 5471 | |||
| 5467 | DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, | 5472 | DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, |
| 5468 | doc: /* Make a copy of object OBJ in pure storage. | 5473 | doc: /* Make a copy of object OBJ in pure storage. |
| 5469 | Recursively copies contents of vectors and cons cells. | 5474 | Recursively copies contents of vectors and cons cells. |
| @@ -5472,14 +5477,20 @@ Does not copy symbols. Copies strings without text properties. */) | |||
| 5472 | { | 5477 | { |
| 5473 | if (NILP (Vpurify_flag)) | 5478 | if (NILP (Vpurify_flag)) |
| 5474 | return obj; | 5479 | return obj; |
| 5475 | else if (MARKERP (obj) || OVERLAYP (obj) | 5480 | else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj)) |
| 5476 | || HASH_TABLE_P (obj) || SYMBOLP (obj)) | ||
| 5477 | /* Can't purify those. */ | 5481 | /* Can't purify those. */ |
| 5478 | return obj; | 5482 | return obj; |
| 5479 | else | 5483 | else |
| 5480 | return purecopy (obj); | 5484 | return purecopy (obj); |
| 5481 | } | 5485 | } |
| 5482 | 5486 | ||
| 5487 | /* Pinned objects are marked before every GC cycle. */ | ||
| 5488 | static struct pinned_object | ||
| 5489 | { | ||
| 5490 | Lisp_Object object; | ||
| 5491 | struct pinned_object *next; | ||
| 5492 | } *pinned_objects; | ||
| 5493 | |||
| 5483 | static Lisp_Object | 5494 | static Lisp_Object |
| 5484 | purecopy (Lisp_Object obj) | 5495 | purecopy (Lisp_Object obj) |
| 5485 | { | 5496 | { |
| @@ -5507,7 +5518,27 @@ purecopy (Lisp_Object obj) | |||
| 5507 | obj = make_pure_string (SSDATA (obj), SCHARS (obj), | 5518 | obj = make_pure_string (SSDATA (obj), SCHARS (obj), |
| 5508 | SBYTES (obj), | 5519 | SBYTES (obj), |
| 5509 | STRING_MULTIBYTE (obj)); | 5520 | STRING_MULTIBYTE (obj)); |
| 5510 | else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj)) | 5521 | else if (HASH_TABLE_P (obj)) |
| 5522 | { | ||
| 5523 | struct Lisp_Hash_Table *table = XHASH_TABLE (obj); | ||
| 5524 | /* Do not purify hash tables which haven't been defined with | ||
| 5525 | :purecopy as non-nil or are weak - they aren't guaranteed to | ||
| 5526 | not change. */ | ||
| 5527 | if (!NILP (table->weak) || NILP (table->pure)) | ||
| 5528 | { | ||
| 5529 | /* Instead, add the hash table to the list of pinned objects, | ||
| 5530 | so that it will be marked during GC. */ | ||
| 5531 | struct pinned_object *o = xmalloc (sizeof *o); | ||
| 5532 | o->object = obj; | ||
| 5533 | o->next = pinned_objects; | ||
| 5534 | pinned_objects = o; | ||
| 5535 | return obj; /* Don't hash cons it. */ | ||
| 5536 | } | ||
| 5537 | |||
| 5538 | struct Lisp_Hash_Table *h = purecopy_hash_table (table); | ||
| 5539 | XSET_HASH_TABLE (obj, h); | ||
| 5540 | } | ||
| 5541 | else if (COMPILEDP (obj) || VECTORP (obj)) | ||
| 5511 | { | 5542 | { |
| 5512 | struct Lisp_Vector *objp = XVECTOR (obj); | 5543 | struct Lisp_Vector *objp = XVECTOR (obj); |
| 5513 | ptrdiff_t nbytes = vector_nbytes (objp); | 5544 | ptrdiff_t nbytes = vector_nbytes (objp); |
| @@ -5724,6 +5755,13 @@ compact_undo_list (Lisp_Object list) | |||
| 5724 | } | 5755 | } |
| 5725 | 5756 | ||
| 5726 | static void | 5757 | static void |
| 5758 | mark_pinned_objects (void) | ||
| 5759 | { | ||
| 5760 | for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next) | ||
| 5761 | mark_object (pobj->object); | ||
| 5762 | } | ||
| 5763 | |||
| 5764 | static void | ||
| 5727 | mark_pinned_symbols (void) | 5765 | mark_pinned_symbols (void) |
| 5728 | { | 5766 | { |
| 5729 | struct symbol_block *sblk; | 5767 | struct symbol_block *sblk; |
| @@ -5843,6 +5881,7 @@ garbage_collect_1 (void *end) | |||
| 5843 | for (i = 0; i < staticidx; i++) | 5881 | for (i = 0; i < staticidx; i++) |
| 5844 | mark_object (*staticvec[i]); | 5882 | mark_object (*staticvec[i]); |
| 5845 | 5883 | ||
| 5884 | mark_pinned_objects (); | ||
| 5846 | mark_pinned_symbols (); | 5885 | mark_pinned_symbols (); |
| 5847 | mark_terminals (); | 5886 | mark_terminals (); |
| 5848 | mark_kboards (); | 5887 | mark_kboards (); |
| @@ -6011,58 +6050,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 6011 | (void) | 6050 | (void) |
| 6012 | { | 6051 | { |
| 6013 | void *end; | 6052 | void *end; |
| 6014 | 6053 | SET_STACK_TOP_ADDRESS (&end); | |
| 6015 | #ifdef HAVE___BUILTIN_UNWIND_INIT | ||
| 6016 | /* Force callee-saved registers and register windows onto the stack. | ||
| 6017 | This is the preferred method if available, obviating the need for | ||
| 6018 | machine dependent methods. */ | ||
| 6019 | __builtin_unwind_init (); | ||
| 6020 | end = &end; | ||
| 6021 | #else /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 6022 | #ifndef GC_SAVE_REGISTERS_ON_STACK | ||
| 6023 | /* jmp_buf may not be aligned enough on darwin-ppc64 */ | ||
| 6024 | union aligned_jmpbuf { | ||
| 6025 | Lisp_Object o; | ||
| 6026 | sys_jmp_buf j; | ||
| 6027 | } j; | ||
| 6028 | volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base; | ||
| 6029 | #endif | ||
| 6030 | /* This trick flushes the register windows so that all the state of | ||
| 6031 | the process is contained in the stack. */ | ||
| 6032 | /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is | ||
| 6033 | needed on ia64 too. See mach_dep.c, where it also says inline | ||
| 6034 | assembler doesn't work with relevant proprietary compilers. */ | ||
| 6035 | #ifdef __sparc__ | ||
| 6036 | #if defined (__sparc64__) && defined (__FreeBSD__) | ||
| 6037 | /* FreeBSD does not have a ta 3 handler. */ | ||
| 6038 | asm ("flushw"); | ||
| 6039 | #else | ||
| 6040 | asm ("ta 3"); | ||
| 6041 | #endif | ||
| 6042 | #endif | ||
| 6043 | |||
| 6044 | /* Save registers that we need to see on the stack. We need to see | ||
| 6045 | registers used to hold register variables and registers used to | ||
| 6046 | pass parameters. */ | ||
| 6047 | #ifdef GC_SAVE_REGISTERS_ON_STACK | ||
| 6048 | GC_SAVE_REGISTERS_ON_STACK (end); | ||
| 6049 | #else /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 6050 | |||
| 6051 | #ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that | ||
| 6052 | setjmp will definitely work, test it | ||
| 6053 | and print a message with the result | ||
| 6054 | of the test. */ | ||
| 6055 | if (!setjmp_tested_p) | ||
| 6056 | { | ||
| 6057 | setjmp_tested_p = 1; | ||
| 6058 | test_setjmp (); | ||
| 6059 | } | ||
| 6060 | #endif /* GC_SETJMP_WORKS */ | ||
| 6061 | |||
| 6062 | sys_setjmp (j.j); | ||
| 6063 | end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; | ||
| 6064 | #endif /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 6065 | #endif /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 6066 | return garbage_collect_1 (end); | 6054 | return garbage_collect_1 (end); |
| 6067 | } | 6055 | } |
| 6068 | 6056 | ||
| @@ -7372,9 +7360,6 @@ init_alloc_once (void) | |||
| 7372 | void | 7360 | void |
| 7373 | init_alloc (void) | 7361 | init_alloc (void) |
| 7374 | { | 7362 | { |
| 7375 | #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS | ||
| 7376 | setjmp_tested_p = longjmps_done = 0; | ||
| 7377 | #endif | ||
| 7378 | Vgc_elapsed = make_float (0.0); | 7363 | Vgc_elapsed = make_float (0.0); |
| 7379 | gcs_done = 0; | 7364 | gcs_done = 0; |
| 7380 | 7365 | ||
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 0a317ad7d98..713c1e5b944 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -420,19 +420,16 @@ followed by the rest of the buffers. */) | |||
| 420 | } | 420 | } |
| 421 | 421 | ||
| 422 | /* Like Fassoc, but use Fstring_equal to compare | 422 | /* Like Fassoc, but use Fstring_equal to compare |
| 423 | (which ignores text properties), | 423 | (which ignores text properties), and don't ever quit. */ |
| 424 | and don't ever QUIT. */ | ||
| 425 | 424 | ||
| 426 | static Lisp_Object | 425 | static Lisp_Object |
| 427 | assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list) | 426 | assoc_ignore_text_properties (Lisp_Object key, Lisp_Object list) |
| 428 | { | 427 | { |
| 429 | register Lisp_Object tail; | 428 | Lisp_Object tail; |
| 430 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | 429 | for (tail = list; CONSP (tail); tail = XCDR (tail)) |
| 431 | { | 430 | { |
| 432 | register Lisp_Object elt, tem; | 431 | Lisp_Object elt = XCAR (tail); |
| 433 | elt = XCAR (tail); | 432 | if (!NILP (Fstring_equal (Fcar (elt), key))) |
| 434 | tem = Fstring_equal (Fcar (elt), key); | ||
| 435 | if (!NILP (tem)) | ||
| 436 | return elt; | 433 | return elt; |
| 437 | } | 434 | } |
| 438 | return Qnil; | 435 | return Qnil; |
diff --git a/src/bytecode.c b/src/bytecode.c index a64bc171d14..0f7420c19ee 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -679,7 +679,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 679 | { | 679 | { |
| 680 | quitcounter = 1; | 680 | quitcounter = 1; |
| 681 | maybe_gc (); | 681 | maybe_gc (); |
| 682 | QUIT; | 682 | maybe_quit (); |
| 683 | } | 683 | } |
| 684 | pc += op; | 684 | pc += op; |
| 685 | NEXT; | 685 | NEXT; |
| @@ -841,11 +841,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 841 | { | 841 | { |
| 842 | Lisp_Object v2 = POP, v1 = TOP; | 842 | Lisp_Object v2 = POP, v1 = TOP; |
| 843 | CHECK_NUMBER (v1); | 843 | CHECK_NUMBER (v1); |
| 844 | EMACS_INT n = XINT (v1); | 844 | for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) |
| 845 | immediate_quit = true; | 845 | { |
| 846 | while (--n >= 0 && CONSP (v2)) | 846 | v2 = XCDR (v2); |
| 847 | v2 = XCDR (v2); | 847 | rarely_quit (n); |
| 848 | immediate_quit = false; | 848 | } |
| 849 | TOP = CAR (v2); | 849 | TOP = CAR (v2); |
| 850 | NEXT; | 850 | NEXT; |
| 851 | } | 851 | } |
| @@ -1275,11 +1275,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1275 | /* Exchange args and then do nth. */ | 1275 | /* Exchange args and then do nth. */ |
| 1276 | Lisp_Object v2 = POP, v1 = TOP; | 1276 | Lisp_Object v2 = POP, v1 = TOP; |
| 1277 | CHECK_NUMBER (v2); | 1277 | CHECK_NUMBER (v2); |
| 1278 | EMACS_INT n = XINT (v2); | 1278 | for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) |
| 1279 | immediate_quit = true; | 1279 | { |
| 1280 | while (--n >= 0 && CONSP (v1)) | 1280 | v1 = XCDR (v1); |
| 1281 | v1 = XCDR (v1); | 1281 | rarely_quit (n); |
| 1282 | immediate_quit = false; | 1282 | } |
| 1283 | TOP = CAR (v1); | 1283 | TOP = CAR (v1); |
| 1284 | } | 1284 | } |
| 1285 | else | 1285 | else |
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..84324c48dcf 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 | |
| 202 | QUIT; | 202 | /* This will quit on C-g. */ |
| 203 | wait_for_termination (synch_process_pid, 0, 1); | 203 | wait_for_termination (synch_process_pid, 0, 1); |
| 204 | |||
| 204 | synch_process_pid = 0; | 205 | synch_process_pid = 0; |
| 205 | immediate_quit = 0; | ||
| 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,9 +726,6 @@ 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; | ||
| 730 | QUIT; | ||
| 731 | |||
| 732 | if (0 <= fd0) | 729 | if (0 <= fd0) |
| 733 | { | 730 | { |
| 734 | enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 }; | 731 | enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 }; |
| @@ -749,8 +746,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 749 | nread = carryover; | 746 | nread = carryover; |
| 750 | while (nread < bufsize - 1024) | 747 | while (nread < bufsize - 1024) |
| 751 | { | 748 | { |
| 752 | int this_read = emacs_read (fd0, buf + nread, | 749 | int this_read = emacs_read_quit (fd0, buf + nread, |
| 753 | bufsize - nread); | 750 | bufsize - nread); |
| 754 | 751 | ||
| 755 | if (this_read < 0) | 752 | if (this_read < 0) |
| 756 | goto give_up; | 753 | goto give_up; |
| @@ -769,7 +766,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 769 | } | 766 | } |
| 770 | 767 | ||
| 771 | /* Now NREAD is the total amount of data in the buffer. */ | 768 | /* Now NREAD is the total amount of data in the buffer. */ |
| 772 | immediate_quit = 0; | ||
| 773 | 769 | ||
| 774 | if (!nread) | 770 | if (!nread) |
| 775 | ; | 771 | ; |
| @@ -842,8 +838,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 842 | we should have already detected a coding system. */ | 838 | we should have already detected a coding system. */ |
| 843 | display_on_the_fly = true; | 839 | display_on_the_fly = true; |
| 844 | } | 840 | } |
| 845 | immediate_quit = true; | ||
| 846 | QUIT; | ||
| 847 | } | 841 | } |
| 848 | give_up: ; | 842 | give_up: ; |
| 849 | 843 | ||
| @@ -860,8 +854,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 860 | wait_for_termination (pid, &status, fd0 < 0); | 854 | wait_for_termination (pid, &status, fd0 < 0); |
| 861 | #endif | 855 | #endif |
| 862 | 856 | ||
| 863 | immediate_quit = 0; | ||
| 864 | |||
| 865 | /* Don't kill any children that the subprocess may have left behind | 857 | /* Don't kill any children that the subprocess may have left behind |
| 866 | when exiting. */ | 858 | when exiting. */ |
| 867 | synch_process_pid = 0; | 859 | synch_process_pid = 0; |
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..5ea00fb8db4 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,14 +248,11 @@ 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 | maybe_quit (); |
| 252 | QUIT; | ||
| 253 | 252 | ||
| 254 | bool wanted = (NILP (match) | 253 | bool wanted = (NILP (match) |
| 255 | || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); | 254 | || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); |
| 256 | 255 | ||
| 257 | immediate_quit = 0; | ||
| 258 | |||
| 259 | if (wanted) | 256 | if (wanted) |
| 260 | { | 257 | { |
| 261 | if (!NILP (full)) | 258 | if (!NILP (full)) |
| @@ -508,7 +505,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, | |||
| 508 | ptrdiff_t len = dirent_namelen (dp); | 505 | ptrdiff_t len = dirent_namelen (dp); |
| 509 | bool canexclude = 0; | 506 | bool canexclude = 0; |
| 510 | 507 | ||
| 511 | QUIT; | 508 | maybe_quit (); |
| 512 | if (len < SCHARS (encoded_file) | 509 | if (len < SCHARS (encoded_file) |
| 513 | || (scmp (dp->d_name, SSDATA (encoded_file), | 510 | || (scmp (dp->d_name, SSDATA (encoded_file), |
| 514 | SCHARS (encoded_file)) | 511 | SCHARS (encoded_file)) |
diff --git a/src/dispextern.h b/src/dispextern.h index 51222e636be..eb71a82311c 100644 --- a/src/dispextern.h +++ b/src/dispextern.h | |||
| @@ -3263,6 +3263,7 @@ void move_it_past_eol (struct it *); | |||
| 3263 | void move_it_in_display_line (struct it *it, | 3263 | void move_it_in_display_line (struct it *it, |
| 3264 | ptrdiff_t to_charpos, int to_x, | 3264 | ptrdiff_t to_charpos, int to_x, |
| 3265 | enum move_operation_enum op); | 3265 | enum move_operation_enum op); |
| 3266 | int partial_line_height (struct it *it_origin); | ||
| 3266 | bool in_display_vector_p (struct it *); | 3267 | bool in_display_vector_p (struct it *); |
| 3267 | int frame_mode_line_height (struct frame *); | 3268 | int frame_mode_line_height (struct frame *); |
| 3268 | extern bool redisplaying_p; | 3269 | extern bool redisplaying_p; |
| @@ -186,7 +186,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) | |||
| 186 | If we read the same block last time, maybe skip this? */ | 186 | If we read the same block last time, maybe skip this? */ |
| 187 | if (space_left > 1024 * 8) | 187 | if (space_left > 1024 * 8) |
| 188 | space_left = 1024 * 8; | 188 | space_left = 1024 * 8; |
| 189 | nread = emacs_read (fd, p, space_left); | 189 | nread = emacs_read_quit (fd, p, space_left); |
| 190 | if (nread < 0) | 190 | if (nread < 0) |
| 191 | report_file_error ("Read error on documentation file", file); | 191 | report_file_error ("Read error on documentation file", file); |
| 192 | p[nread] = 0; | 192 | p[nread] = 0; |
| @@ -590,16 +590,15 @@ the same file name is found in the `doc-directory'. */) | |||
| 590 | Vdoc_file_name = filename; | 590 | Vdoc_file_name = filename; |
| 591 | filled = 0; | 591 | filled = 0; |
| 592 | pos = 0; | 592 | pos = 0; |
| 593 | while (1) | 593 | while (true) |
| 594 | { | 594 | { |
| 595 | register char *end; | ||
| 596 | if (filled < 512) | 595 | if (filled < 512) |
| 597 | filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled); | 596 | filled += emacs_read_quit (fd, &buf[filled], sizeof buf - 1 - filled); |
| 598 | if (!filled) | 597 | if (!filled) |
| 599 | break; | 598 | break; |
| 600 | 599 | ||
| 601 | buf[filled] = 0; | 600 | buf[filled] = 0; |
| 602 | end = buf + (filled < 512 ? filled : filled - 128); | 601 | char *end = buf + (filled < 512 ? filled : filled - 128); |
| 603 | p = memchr (buf, '\037', end - buf); | 602 | p = memchr (buf, '\037', end - buf); |
| 604 | /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */ | 603 | /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */ |
| 605 | if (p) | 604 | if (p) |
diff --git a/src/editfns.c b/src/editfns.c index bee3bbc2cdd..4618164d008 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 |
| @@ -3060,8 +3060,6 @@ determines whether case is significant or ignored. */) | |||
| 3060 | characters, not just the bytes. */ | 3060 | characters, not just the bytes. */ |
| 3061 | int c1, c2; | 3061 | int c1, c2; |
| 3062 | 3062 | ||
| 3063 | QUIT; | ||
| 3064 | |||
| 3065 | if (! NILP (BVAR (bp1, enable_multibyte_characters))) | 3063 | if (! NILP (BVAR (bp1, enable_multibyte_characters))) |
| 3066 | { | 3064 | { |
| 3067 | c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); | 3065 | c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); |
| @@ -3093,12 +3091,12 @@ determines whether case is significant or ignored. */) | |||
| 3093 | c1 = char_table_translate (trt, c1); | 3091 | c1 = char_table_translate (trt, c1); |
| 3094 | c2 = char_table_translate (trt, c2); | 3092 | c2 = char_table_translate (trt, c2); |
| 3095 | } | 3093 | } |
| 3096 | if (c1 < c2) | 3094 | |
| 3097 | return make_number (- 1 - chars); | 3095 | if (c1 != c2) |
| 3098 | if (c1 > c2) | 3096 | return make_number (c1 < c2 ? -1 - chars : chars + 1); |
| 3099 | return make_number (chars + 1); | ||
| 3100 | 3097 | ||
| 3101 | chars++; | 3098 | chars++; |
| 3099 | rarely_quit (chars); | ||
| 3102 | } | 3100 | } |
| 3103 | 3101 | ||
| 3104 | /* The strings match as far as they go. | 3102 | /* The strings match as far as they go. |
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/emacs.c b/src/emacs.c index 28b395c4fb4..3083d0df302 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -688,7 +688,7 @@ main (int argc, char **argv) | |||
| 688 | dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0 | 688 | dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0 |
| 689 | || strcmp (argv[argc - 1], "bootstrap") == 0 ); | 689 | || strcmp (argv[argc - 1], "bootstrap") == 0 ); |
| 690 | 690 | ||
| 691 | generating_ldefs_boot = getenv ("GENERATE_LDEFS_BOOT"); | 691 | generating_ldefs_boot = !!getenv ("GENERATE_LDEFS_BOOT"); |
| 692 | 692 | ||
| 693 | 693 | ||
| 694 | /* True if address randomization interferes with memory allocation. */ | 694 | /* True if address randomization interferes with memory allocation. */ |
diff --git a/src/eval.c b/src/eval.c index c05c8d8f8de..22b02b49521 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -856,11 +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 | CHECK_LIST (varlist); | ||
| 861 | while (CONSP (varlist)) | ||
| 862 | { | 860 | { |
| 863 | QUIT; | 861 | maybe_quit (); |
| 864 | 862 | ||
| 865 | elt = XCAR (varlist); | 863 | elt = XCAR (varlist); |
| 866 | if (SYMBOLP (elt)) | 864 | if (SYMBOLP (elt)) |
| @@ -894,9 +892,8 @@ usage: (let* VARLIST BODY...) */) | |||
| 894 | } | 892 | } |
| 895 | else | 893 | else |
| 896 | specbind (var, val); | 894 | specbind (var, val); |
| 897 | |||
| 898 | varlist = XCDR (varlist); | ||
| 899 | } | 895 | } |
| 896 | CHECK_LIST_END (varlist, XCAR (args)); | ||
| 900 | 897 | ||
| 901 | val = Fprogn (XCDR (args)); | 898 | val = Fprogn (XCDR (args)); |
| 902 | return unbind_to (count, val); | 899 | return unbind_to (count, val); |
| @@ -928,7 +925,7 @@ usage: (let VARLIST BODY...) */) | |||
| 928 | 925 | ||
| 929 | for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) | 926 | for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) |
| 930 | { | 927 | { |
| 931 | QUIT; | 928 | maybe_quit (); |
| 932 | elt = XCAR (varlist); | 929 | elt = XCAR (varlist); |
| 933 | if (SYMBOLP (elt)) | 930 | if (SYMBOLP (elt)) |
| 934 | temps [argnum++] = Qnil; | 931 | temps [argnum++] = Qnil; |
| @@ -981,7 +978,7 @@ usage: (while TEST BODY...) */) | |||
| 981 | body = XCDR (args); | 978 | body = XCDR (args); |
| 982 | while (!NILP (eval_sub (test))) | 979 | while (!NILP (eval_sub (test))) |
| 983 | { | 980 | { |
| 984 | QUIT; | 981 | maybe_quit (); |
| 985 | prog_ignore (body); | 982 | prog_ignore (body); |
| 986 | } | 983 | } |
| 987 | 984 | ||
| @@ -1014,7 +1011,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) | |||
| 1014 | until we get a symbol that is not an alias. */ | 1011 | until we get a symbol that is not an alias. */ |
| 1015 | while (SYMBOLP (def)) | 1012 | while (SYMBOLP (def)) |
| 1016 | { | 1013 | { |
| 1017 | QUIT; | 1014 | maybe_quit (); |
| 1018 | sym = def; | 1015 | sym = def; |
| 1019 | tem = Fassq (sym, environment); | 1016 | tem = Fassq (sym, environment); |
| 1020 | if (NILP (tem)) | 1017 | if (NILP (tem)) |
| @@ -1134,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value) | |||
| 1134 | /* Restore certain special C variables. */ | 1131 | /* Restore certain special C variables. */ |
| 1135 | set_poll_suppress_count (catch->poll_suppress_count); | 1132 | set_poll_suppress_count (catch->poll_suppress_count); |
| 1136 | unblock_input_to (catch->interrupt_input_blocked); | 1133 | unblock_input_to (catch->interrupt_input_blocked); |
| 1137 | immediate_quit = 0; | ||
| 1138 | 1134 | ||
| 1139 | do | 1135 | do |
| 1140 | { | 1136 | { |
| @@ -1453,7 +1449,7 @@ static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object); | |||
| 1453 | static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, | 1449 | static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, |
| 1454 | Lisp_Object data); | 1450 | Lisp_Object data); |
| 1455 | 1451 | ||
| 1456 | void | 1452 | static void |
| 1457 | process_quit_flag (void) | 1453 | process_quit_flag (void) |
| 1458 | { | 1454 | { |
| 1459 | Lisp_Object flag = Vquit_flag; | 1455 | Lisp_Object flag = Vquit_flag; |
| @@ -1465,6 +1461,28 @@ process_quit_flag (void) | |||
| 1465 | quit (); | 1461 | quit (); |
| 1466 | } | 1462 | } |
| 1467 | 1463 | ||
| 1464 | /* Check quit-flag and quit if it is non-nil. Typing C-g does not | ||
| 1465 | directly cause a quit; it only sets Vquit_flag. So the program | ||
| 1466 | needs to call maybe_quit at times when it is safe to quit. Every | ||
| 1467 | loop that might run for a long time or might not exit ought to call | ||
| 1468 | maybe_quit at least once, at a safe place. Unless that is | ||
| 1469 | impossible, of course. But it is very desirable to avoid creating | ||
| 1470 | loops where maybe_quit is impossible. | ||
| 1471 | |||
| 1472 | If quit-flag is set to `kill-emacs' the SIGINT handler has received | ||
| 1473 | a request to exit Emacs when it is safe to do. | ||
| 1474 | |||
| 1475 | When not quitting, process any pending signals. */ | ||
| 1476 | |||
| 1477 | void | ||
| 1478 | maybe_quit (void) | ||
| 1479 | { | ||
| 1480 | if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) | ||
| 1481 | process_quit_flag (); | ||
| 1482 | else if (pending_signals) | ||
| 1483 | process_pending_signals (); | ||
| 1484 | } | ||
| 1485 | |||
| 1468 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, | 1486 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, |
| 1469 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. | 1487 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. |
| 1470 | This function does not return. | 1488 | This function does not return. |
| @@ -1508,10 +1526,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) | |||
| 1508 | Lisp_Object string; | 1526 | Lisp_Object string; |
| 1509 | Lisp_Object real_error_symbol | 1527 | Lisp_Object real_error_symbol |
| 1510 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); | 1528 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); |
| 1511 | register Lisp_Object clause = Qnil; | 1529 | Lisp_Object clause = Qnil; |
| 1512 | struct handler *h; | 1530 | struct handler *h; |
| 1513 | 1531 | ||
| 1514 | immediate_quit = 0; | ||
| 1515 | if (gc_in_progress || waiting_for_input) | 1532 | if (gc_in_progress || waiting_for_input) |
| 1516 | emacs_abort (); | 1533 | emacs_abort (); |
| 1517 | 1534 | ||
| @@ -2129,7 +2146,7 @@ eval_sub (Lisp_Object form) | |||
| 2129 | if (!CONSP (form)) | 2146 | if (!CONSP (form)) |
| 2130 | return form; | 2147 | return form; |
| 2131 | 2148 | ||
| 2132 | QUIT; | 2149 | maybe_quit (); |
| 2133 | 2150 | ||
| 2134 | maybe_gc (); | 2151 | maybe_gc (); |
| 2135 | 2152 | ||
| @@ -2715,7 +2732,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2715 | Lisp_Object val; | 2732 | Lisp_Object val; |
| 2716 | ptrdiff_t count; | 2733 | ptrdiff_t count; |
| 2717 | 2734 | ||
| 2718 | QUIT; | 2735 | maybe_quit (); |
| 2719 | 2736 | ||
| 2720 | if (++lisp_eval_depth > max_lisp_eval_depth) | 2737 | if (++lisp_eval_depth > max_lisp_eval_depth) |
| 2721 | { | 2738 | { |
| @@ -2960,7 +2977,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 2960 | bool previous_optional_or_rest = false; | 2977 | bool previous_optional_or_rest = false; |
| 2961 | for (; CONSP (syms_left); syms_left = XCDR (syms_left)) | 2978 | for (; CONSP (syms_left); syms_left = XCDR (syms_left)) |
| 2962 | { | 2979 | { |
| 2963 | QUIT; | 2980 | maybe_quit (); |
| 2964 | 2981 | ||
| 2965 | next = XCAR (syms_left); | 2982 | next = XCAR (syms_left); |
| 2966 | if (!SYMBOLP (next)) | 2983 | if (!SYMBOLP (next)) |
| @@ -3098,7 +3115,7 @@ lambda_arity (Lisp_Object fun) | |||
| 3098 | if (EQ (XCAR (fun), Qclosure)) | 3115 | if (EQ (XCAR (fun), Qclosure)) |
| 3099 | { | 3116 | { |
| 3100 | fun = XCDR (fun); /* Drop `closure'. */ | 3117 | fun = XCDR (fun); /* Drop `closure'. */ |
| 3101 | CHECK_LIST_CONS (fun, fun); | 3118 | CHECK_CONS (fun); |
| 3102 | } | 3119 | } |
| 3103 | syms_left = XCDR (fun); | 3120 | syms_left = XCDR (fun); |
| 3104 | if (CONSP (syms_left)) | 3121 | if (CONSP (syms_left)) |
diff --git a/src/fileio.c b/src/fileio.c index 8c8cba9e49c..38400623793 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,7 @@ 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; | ||
| 1964 | ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); | 1963 | ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); |
| 1965 | immediate_quit = 0; | ||
| 1966 | 1964 | ||
| 1967 | if (ifd < 0) | 1965 | if (ifd < 0) |
| 1968 | report_file_error ("Opening input file", file); | 1966 | report_file_error ("Opening input file", file); |
| @@ -2024,8 +2022,7 @@ permissions. */) | |||
| 2024 | oldsize = out_st.st_size; | 2022 | oldsize = out_st.st_size; |
| 2025 | } | 2023 | } |
| 2026 | 2024 | ||
| 2027 | immediate_quit = 1; | 2025 | maybe_quit (); |
| 2028 | QUIT; | ||
| 2029 | 2026 | ||
| 2030 | if (clone_file (ofd, ifd)) | 2027 | if (clone_file (ofd, ifd)) |
| 2031 | newsize = st.st_size; | 2028 | newsize = st.st_size; |
| @@ -2033,9 +2030,9 @@ permissions. */) | |||
| 2033 | { | 2030 | { |
| 2034 | char buf[MAX_ALLOCA]; | 2031 | char buf[MAX_ALLOCA]; |
| 2035 | ptrdiff_t n; | 2032 | ptrdiff_t n; |
| 2036 | for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf)); | 2033 | for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf)); |
| 2037 | newsize += n) | 2034 | newsize += n) |
| 2038 | if (emacs_write_sig (ofd, buf, n) != n) | 2035 | if (emacs_write_quit (ofd, buf, n) != n) |
| 2039 | report_file_error ("Write error", newname); | 2036 | report_file_error ("Write error", newname); |
| 2040 | if (n < 0) | 2037 | if (n < 0) |
| 2041 | report_file_error ("Read error", file); | 2038 | report_file_error ("Read error", file); |
| @@ -2047,8 +2044,6 @@ permissions. */) | |||
| 2047 | if (newsize < oldsize && ftruncate (ofd, newsize) != 0) | 2044 | if (newsize < oldsize && ftruncate (ofd, newsize) != 0) |
| 2048 | report_file_error ("Truncating output file", newname); | 2045 | report_file_error ("Truncating output file", newname); |
| 2049 | 2046 | ||
| 2050 | immediate_quit = 0; | ||
| 2051 | |||
| 2052 | #ifndef MSDOS | 2047 | #ifndef MSDOS |
| 2053 | /* Preserve the original file permissions, and if requested, also its | 2048 | /* Preserve the original file permissions, and if requested, also its |
| 2054 | owner and group. */ | 2049 | owner and group. */ |
| @@ -2682,7 +2677,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, | |||
| 2682 | 2677 | ||
| 2683 | DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, | 2678 | DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, |
| 2684 | doc: /* Access file FILENAME, and get an error if that does not work. | 2679 | doc: /* Access file FILENAME, and get an error if that does not work. |
| 2685 | The second argument STRING is used in the error message. | 2680 | The second argument STRING is prepended to the error message. |
| 2686 | If there is no error, returns nil. */) | 2681 | If there is no error, returns nil. */) |
| 2687 | (Lisp_Object filename, Lisp_Object string) | 2682 | (Lisp_Object filename, Lisp_Object string) |
| 2688 | { | 2683 | { |
| @@ -2815,7 +2810,17 @@ really is a readable and searchable directory. */) | |||
| 2815 | if (!NILP (handler)) | 2810 | if (!NILP (handler)) |
| 2816 | { | 2811 | { |
| 2817 | Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname); | 2812 | Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname); |
| 2818 | errno = 0; | 2813 | |
| 2814 | /* Set errno in case the handler failed. EACCES might be a lie | ||
| 2815 | (e.g., the directory might not exist, or be a regular file), | ||
| 2816 | but at least it does TRT in the "usual" case of an existing | ||
| 2817 | directory that is not accessible by the current user, and | ||
| 2818 | avoids reporting "Success" for a failed operation. Perhaps | ||
| 2819 | someday we can fix this in a better way, by improving | ||
| 2820 | file-accessible-directory-p's API; see Bug#25419. */ | ||
| 2821 | if (!EQ (r, Qt)) | ||
| 2822 | errno = EACCES; | ||
| 2823 | |||
| 2819 | return r; | 2824 | return r; |
| 2820 | } | 2825 | } |
| 2821 | 2826 | ||
| @@ -3391,15 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data) | |||
| 3391 | static Lisp_Object | 3396 | static Lisp_Object |
| 3392 | read_non_regular (Lisp_Object state) | 3397 | read_non_regular (Lisp_Object state) |
| 3393 | { | 3398 | { |
| 3394 | int nbytes; | 3399 | int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0), |
| 3395 | 3400 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE | |
| 3396 | immediate_quit = 1; | 3401 | + XSAVE_INTEGER (state, 1)), |
| 3397 | QUIT; | 3402 | XSAVE_INTEGER (state, 2)); |
| 3398 | nbytes = emacs_read (XSAVE_INTEGER (state, 0), | ||
| 3399 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE | ||
| 3400 | + XSAVE_INTEGER (state, 1)), | ||
| 3401 | XSAVE_INTEGER (state, 2)); | ||
| 3402 | immediate_quit = 0; | ||
| 3403 | /* Fast recycle this object for the likely next call. */ | 3403 | /* Fast recycle this object for the likely next call. */ |
| 3404 | free_misc (state); | 3404 | free_misc (state); |
| 3405 | return make_number (nbytes); | 3405 | return make_number (nbytes); |
| @@ -3743,17 +3743,17 @@ by calling `format-decode', which see. */) | |||
| 3743 | int nread; | 3743 | int nread; |
| 3744 | 3744 | ||
| 3745 | if (st.st_size <= (1024 * 4)) | 3745 | if (st.st_size <= (1024 * 4)) |
| 3746 | nread = emacs_read (fd, read_buf, 1024 * 4); | 3746 | nread = emacs_read_quit (fd, read_buf, 1024 * 4); |
| 3747 | else | 3747 | else |
| 3748 | { | 3748 | { |
| 3749 | nread = emacs_read (fd, read_buf, 1024); | 3749 | nread = emacs_read_quit (fd, read_buf, 1024); |
| 3750 | if (nread == 1024) | 3750 | if (nread == 1024) |
| 3751 | { | 3751 | { |
| 3752 | int ntail; | 3752 | int ntail; |
| 3753 | if (lseek (fd, - (1024 * 3), SEEK_END) < 0) | 3753 | if (lseek (fd, - (1024 * 3), SEEK_END) < 0) |
| 3754 | report_file_error ("Setting file position", | 3754 | report_file_error ("Setting file position", |
| 3755 | orig_filename); | 3755 | orig_filename); |
| 3756 | ntail = emacs_read (fd, read_buf + nread, 1024 * 3); | 3756 | ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3); |
| 3757 | nread = ntail < 0 ? ntail : nread + ntail; | 3757 | nread = ntail < 0 ? ntail : nread + ntail; |
| 3758 | } | 3758 | } |
| 3759 | } | 3759 | } |
| @@ -3858,15 +3858,11 @@ by calling `format-decode', which see. */) | |||
| 3858 | report_file_error ("Setting file position", orig_filename); | 3858 | report_file_error ("Setting file position", orig_filename); |
| 3859 | } | 3859 | } |
| 3860 | 3860 | ||
| 3861 | immediate_quit = 1; | ||
| 3862 | QUIT; | ||
| 3863 | /* Count how many chars at the start of the file | 3861 | /* Count how many chars at the start of the file |
| 3864 | match the text at the beginning of the buffer. */ | 3862 | match the text at the beginning of the buffer. */ |
| 3865 | while (1) | 3863 | while (true) |
| 3866 | { | 3864 | { |
| 3867 | int nread, bufpos; | 3865 | int nread = emacs_read_quit (fd, read_buf, sizeof read_buf); |
| 3868 | |||
| 3869 | nread = emacs_read (fd, read_buf, sizeof read_buf); | ||
| 3870 | if (nread < 0) | 3866 | if (nread < 0) |
| 3871 | report_file_error ("Read error", orig_filename); | 3867 | report_file_error ("Read error", orig_filename); |
| 3872 | else if (nread == 0) | 3868 | else if (nread == 0) |
| @@ -3888,7 +3884,7 @@ by calling `format-decode', which see. */) | |||
| 3888 | break; | 3884 | break; |
| 3889 | } | 3885 | } |
| 3890 | 3886 | ||
| 3891 | bufpos = 0; | 3887 | int bufpos = 0; |
| 3892 | while (bufpos < nread && same_at_start < ZV_BYTE | 3888 | while (bufpos < nread && same_at_start < ZV_BYTE |
| 3893 | && FETCH_BYTE (same_at_start) == read_buf[bufpos]) | 3889 | && FETCH_BYTE (same_at_start) == read_buf[bufpos]) |
| 3894 | same_at_start++, bufpos++; | 3890 | same_at_start++, bufpos++; |
| @@ -3897,7 +3893,6 @@ by calling `format-decode', which see. */) | |||
| 3897 | if (bufpos != nread) | 3893 | if (bufpos != nread) |
| 3898 | break; | 3894 | break; |
| 3899 | } | 3895 | } |
| 3900 | immediate_quit = false; | ||
| 3901 | /* If the file matches the buffer completely, | 3896 | /* If the file matches the buffer completely, |
| 3902 | there's no need to replace anything. */ | 3897 | there's no need to replace anything. */ |
| 3903 | if (same_at_start - BEGV_BYTE == end_offset - beg_offset) | 3898 | if (same_at_start - BEGV_BYTE == end_offset - beg_offset) |
| @@ -3909,8 +3904,7 @@ by calling `format-decode', which see. */) | |||
| 3909 | del_range_1 (same_at_start, same_at_end, 0, 0); | 3904 | del_range_1 (same_at_start, same_at_end, 0, 0); |
| 3910 | goto handled; | 3905 | goto handled; |
| 3911 | } | 3906 | } |
| 3912 | immediate_quit = true; | 3907 | |
| 3913 | QUIT; | ||
| 3914 | /* Count how many chars at the end of the file | 3908 | /* Count how many chars at the end of the file |
| 3915 | match the text at the end of the buffer. But, if we have | 3909 | match the text at the end of the buffer. But, if we have |
| 3916 | already found that decoding is necessary, don't waste time. */ | 3910 | already found that decoding is necessary, don't waste time. */ |
| @@ -3932,7 +3926,8 @@ by calling `format-decode', which see. */) | |||
| 3932 | total_read = nread = 0; | 3926 | total_read = nread = 0; |
| 3933 | while (total_read < trial) | 3927 | while (total_read < trial) |
| 3934 | { | 3928 | { |
| 3935 | nread = emacs_read (fd, read_buf + total_read, trial - total_read); | 3929 | nread = emacs_read_quit (fd, read_buf + total_read, |
| 3930 | trial - total_read); | ||
| 3936 | if (nread < 0) | 3931 | if (nread < 0) |
| 3937 | report_file_error ("Read error", orig_filename); | 3932 | report_file_error ("Read error", orig_filename); |
| 3938 | else if (nread == 0) | 3933 | else if (nread == 0) |
| @@ -3967,7 +3962,6 @@ by calling `format-decode', which see. */) | |||
| 3967 | if (nread == 0) | 3962 | if (nread == 0) |
| 3968 | break; | 3963 | break; |
| 3969 | } | 3964 | } |
| 3970 | immediate_quit = 0; | ||
| 3971 | 3965 | ||
| 3972 | if (! giveup_match_end) | 3966 | if (! giveup_match_end) |
| 3973 | { | 3967 | { |
| @@ -4059,18 +4053,13 @@ by calling `format-decode', which see. */) | |||
| 4059 | inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ | 4053 | inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ |
| 4060 | unprocessed = 0; /* Bytes not processed in previous loop. */ | 4054 | unprocessed = 0; /* Bytes not processed in previous loop. */ |
| 4061 | 4055 | ||
| 4062 | while (1) | 4056 | while (true) |
| 4063 | { | 4057 | { |
| 4064 | /* Read at most READ_BUF_SIZE bytes at a time, to allow | 4058 | /* Read at most READ_BUF_SIZE bytes at a time, to allow |
| 4065 | quitting while reading a huge file. */ | 4059 | quitting while reading a huge file. */ |
| 4066 | 4060 | ||
| 4067 | /* Allow quitting out of the actual I/O. */ | 4061 | this = emacs_read_quit (fd, read_buf + unprocessed, |
| 4068 | immediate_quit = 1; | 4062 | READ_BUF_SIZE - unprocessed); |
| 4069 | QUIT; | ||
| 4070 | this = emacs_read (fd, read_buf + unprocessed, | ||
| 4071 | READ_BUF_SIZE - unprocessed); | ||
| 4072 | immediate_quit = 0; | ||
| 4073 | |||
| 4074 | if (this <= 0) | 4063 | if (this <= 0) |
| 4075 | break; | 4064 | break; |
| 4076 | 4065 | ||
| @@ -4284,13 +4273,10 @@ by calling `format-decode', which see. */) | |||
| 4284 | /* Allow quitting out of the actual I/O. We don't make text | 4273 | /* 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 | 4274 | part of the buffer until all the reading is done, so a C-g |
| 4286 | here doesn't do any harm. */ | 4275 | here doesn't do any harm. */ |
| 4287 | immediate_quit = 1; | 4276 | this = emacs_read_quit (fd, |
| 4288 | QUIT; | 4277 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE |
| 4289 | this = emacs_read (fd, | 4278 | + inserted), |
| 4290 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE | 4279 | trytry); |
| 4291 | + inserted), | ||
| 4292 | trytry); | ||
| 4293 | immediate_quit = 0; | ||
| 4294 | } | 4280 | } |
| 4295 | 4281 | ||
| 4296 | if (this <= 0) | 4282 | if (this <= 0) |
| @@ -4602,7 +4588,7 @@ by calling `format-decode', which see. */) | |||
| 4602 | } | 4588 | } |
| 4603 | } | 4589 | } |
| 4604 | 4590 | ||
| 4605 | QUIT; | 4591 | maybe_quit (); |
| 4606 | p = XCDR (p); | 4592 | p = XCDR (p); |
| 4607 | } | 4593 | } |
| 4608 | 4594 | ||
| @@ -4992,8 +4978,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, | |||
| 4992 | } | 4978 | } |
| 4993 | } | 4979 | } |
| 4994 | 4980 | ||
| 4995 | immediate_quit = 1; | ||
| 4996 | |||
| 4997 | if (STRINGP (start)) | 4981 | if (STRINGP (start)) |
| 4998 | ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); | 4982 | ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); |
| 4999 | else if (XINT (start) != XINT (end)) | 4983 | else if (XINT (start) != XINT (end)) |
| @@ -5016,8 +5000,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, | |||
| 5016 | save_errno = errno; | 5000 | save_errno = errno; |
| 5017 | } | 5001 | } |
| 5018 | 5002 | ||
| 5019 | immediate_quit = 0; | ||
| 5020 | |||
| 5021 | /* fsync is not crucial for temporary files. Nor for auto-save | 5003 | /* fsync is not crucial for temporary files. Nor for auto-save |
| 5022 | files, since they might lose some work anyway. */ | 5004 | files, since they might lose some work anyway. */ |
| 5023 | if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) | 5005 | if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) |
| @@ -5407,7 +5389,7 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end, | |||
| 5407 | : (STRINGP (coding->dst_object) | 5389 | : (STRINGP (coding->dst_object) |
| 5408 | ? SSDATA (coding->dst_object) | 5390 | ? SSDATA (coding->dst_object) |
| 5409 | : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); | 5391 | : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); |
| 5410 | coding->produced -= emacs_write_sig (desc, buf, coding->produced); | 5392 | coding->produced -= emacs_write_quit (desc, buf, coding->produced); |
| 5411 | 5393 | ||
| 5412 | if (coding->raw_destination) | 5394 | if (coding->raw_destination) |
| 5413 | { | 5395 | { |
diff --git a/src/filelock.c b/src/filelock.c index 886ab61c7aa..67e8dbd34ed 100644 --- a/src/filelock.c +++ b/src/filelock.c | |||
| @@ -407,9 +407,7 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) | |||
| 407 | fcntl (fd, F_SETFD, FD_CLOEXEC); | 407 | fcntl (fd, F_SETFD, FD_CLOEXEC); |
| 408 | lock_info_len = strlen (lock_info_str); | 408 | lock_info_len = strlen (lock_info_str); |
| 409 | err = 0; | 409 | err = 0; |
| 410 | /* Use 'write', not 'emacs_write', as garbage collection | 410 | if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len |
| 411 | might signal an error, which would leak FD. */ | ||
| 412 | if (write (fd, lock_info_str, lock_info_len) != lock_info_len | ||
| 413 | || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0) | 411 | || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0) |
| 414 | err = errno; | 412 | err = errno; |
| 415 | /* There is no need to call fsync here, as the contents of | 413 | /* There is no need to call fsync here, as the contents of |
| @@ -490,8 +488,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) | |||
| 490 | int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0); | 488 | int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0); |
| 491 | if (0 <= fd) | 489 | if (0 <= fd) |
| 492 | { | 490 | { |
| 493 | /* Use read, not emacs_read, since FD isn't unwind-protected. */ | 491 | ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1); |
| 494 | ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1); | ||
| 495 | int read_errno = errno; | 492 | int read_errno = errno; |
| 496 | if (emacs_close (fd) != 0) | 493 | if (emacs_close (fd) != 0) |
| 497 | return -1; | 494 | return -1; |
| @@ -505,7 +502,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) | |||
| 505 | /* readlinkat saw a non-symlink, but emacs_open saw a symlink. | 502 | /* readlinkat saw a non-symlink, but emacs_open saw a symlink. |
| 506 | The former must have been removed and replaced by the latter. | 503 | The former must have been removed and replaced by the latter. |
| 507 | Try again. */ | 504 | Try again. */ |
| 508 | QUIT; | 505 | maybe_quit (); |
| 509 | } | 506 | } |
| 510 | 507 | ||
| 511 | return nbytes; | 508 | 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); |
| @@ -83,18 +84,8 @@ See Info node `(elisp)Random Numbers' for more details. */) | |||
| 83 | return make_number (val); | 84 | return make_number (val); |
| 84 | } | 85 | } |
| 85 | 86 | ||
| 86 | /* 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 | enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; | ||
| 89 | |||
| 90 | /* Random data-structure functions. */ | 87 | /* Random data-structure functions. */ |
| 91 | 88 | ||
| 92 | static void | ||
| 93 | CHECK_LIST_END (Lisp_Object x, Lisp_Object y) | ||
| 94 | { | ||
| 95 | CHECK_TYPE (NILP (x), Qlistp, y); | ||
| 96 | } | ||
| 97 | |||
| 98 | DEFUN ("length", Flength, Slength, 1, 1, 0, | 89 | DEFUN ("length", Flength, Slength, 1, 1, 0, |
| 99 | doc: /* Return the length of vector, list or string SEQUENCE. | 90 | doc: /* Return the length of vector, list or string SEQUENCE. |
| 100 | A byte-code function object is also allowed. | 91 | A byte-code function object is also allowed. |
| @@ -126,7 +117,7 @@ To get the number of bytes, use `string-bytes'. */) | |||
| 126 | { | 117 | { |
| 127 | if (MOST_POSITIVE_FIXNUM < i) | 118 | if (MOST_POSITIVE_FIXNUM < i) |
| 128 | error ("List too long"); | 119 | error ("List too long"); |
| 129 | QUIT; | 120 | maybe_quit (); |
| 130 | } | 121 | } |
| 131 | sequence = XCDR (sequence); | 122 | sequence = XCDR (sequence); |
| 132 | } | 123 | } |
| @@ -172,7 +163,7 @@ which is at least the number of distinct elements. */) | |||
| 172 | halftail = XCDR (halftail); | 163 | halftail = XCDR (halftail); |
| 173 | if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0) | 164 | if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0) |
| 174 | { | 165 | { |
| 175 | QUIT; | 166 | maybe_quit (); |
| 176 | if (lolen == 0) | 167 | if (lolen == 0) |
| 177 | hilen += UINTMAX_MAX + 1.0; | 168 | hilen += UINTMAX_MAX + 1.0; |
| 178 | } | 169 | } |
| @@ -1202,17 +1193,12 @@ are shared, however. | |||
| 1202 | Elements of ALIST that are not conses are also shared. */) | 1193 | Elements of ALIST that are not conses are also shared. */) |
| 1203 | (Lisp_Object alist) | 1194 | (Lisp_Object alist) |
| 1204 | { | 1195 | { |
| 1205 | register Lisp_Object tem; | ||
| 1206 | |||
| 1207 | CHECK_LIST (alist); | ||
| 1208 | if (NILP (alist)) | 1196 | if (NILP (alist)) |
| 1209 | return alist; | 1197 | return alist; |
| 1210 | alist = concat (1, &alist, Lisp_Cons, 0); | 1198 | alist = concat (1, &alist, Lisp_Cons, false); |
| 1211 | for (tem = alist; CONSP (tem); tem = XCDR (tem)) | 1199 | for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem)) |
| 1212 | { | 1200 | { |
| 1213 | register Lisp_Object car; | 1201 | Lisp_Object car = XCAR (tem); |
| 1214 | car = XCAR (tem); | ||
| 1215 | |||
| 1216 | if (CONSP (car)) | 1202 | if (CONSP (car)) |
| 1217 | XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); | 1203 | XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); |
| 1218 | } | 1204 | } |
| @@ -1356,16 +1342,19 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, | |||
| 1356 | doc: /* Take cdr N times on LIST, return the result. */) | 1342 | doc: /* Take cdr N times on LIST, return the result. */) |
| 1357 | (Lisp_Object n, Lisp_Object list) | 1343 | (Lisp_Object n, Lisp_Object list) |
| 1358 | { | 1344 | { |
| 1359 | EMACS_INT i, num; | ||
| 1360 | CHECK_NUMBER (n); | 1345 | CHECK_NUMBER (n); |
| 1361 | num = XINT (n); | 1346 | Lisp_Object tail = list; |
| 1362 | for (i = 0; i < num && !NILP (list); i++) | 1347 | for (EMACS_INT num = XINT (n); 0 < num; num--) |
| 1363 | { | 1348 | { |
| 1364 | QUIT; | 1349 | if (! CONSP (tail)) |
| 1365 | CHECK_LIST_CONS (list, list); | 1350 | { |
| 1366 | list = XCDR (list); | 1351 | CHECK_LIST_END (tail, list); |
| 1352 | return Qnil; | ||
| 1353 | } | ||
| 1354 | tail = XCDR (tail); | ||
| 1355 | rarely_quit (num); | ||
| 1367 | } | 1356 | } |
| 1368 | return list; | 1357 | return tail; |
| 1369 | } | 1358 | } |
| 1370 | 1359 | ||
| 1371 | DEFUN ("nth", Fnth, Snth, 2, 2, 0, | 1360 | DEFUN ("nth", Fnth, Snth, 2, 2, 0, |
| @@ -1392,66 +1381,55 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, | |||
| 1392 | DEFUN ("member", Fmember, Smember, 2, 2, 0, | 1381 | DEFUN ("member", Fmember, Smember, 2, 2, 0, |
| 1393 | doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. | 1382 | 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. */) | 1383 | The value is actually the tail of LIST whose car is ELT. */) |
| 1395 | (register Lisp_Object elt, Lisp_Object list) | 1384 | (Lisp_Object elt, Lisp_Object list) |
| 1396 | { | 1385 | { |
| 1397 | register Lisp_Object tail; | 1386 | unsigned short int quit_count = 0; |
| 1398 | for (tail = list; !NILP (tail); tail = XCDR (tail)) | 1387 | Lisp_Object tail; |
| 1388 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | ||
| 1399 | { | 1389 | { |
| 1400 | register Lisp_Object tem; | 1390 | 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; | 1391 | return tail; |
| 1405 | QUIT; | 1392 | rarely_quit (++quit_count); |
| 1406 | } | 1393 | } |
| 1394 | CHECK_LIST_END (tail, list); | ||
| 1407 | return Qnil; | 1395 | return Qnil; |
| 1408 | } | 1396 | } |
| 1409 | 1397 | ||
| 1410 | DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | 1398 | DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, |
| 1411 | doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. | 1399 | 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. */) | 1400 | The value is actually the tail of LIST whose car is ELT. */) |
| 1413 | (register Lisp_Object elt, Lisp_Object list) | 1401 | (Lisp_Object elt, Lisp_Object list) |
| 1414 | { | 1402 | { |
| 1415 | while (1) | 1403 | unsigned short int quit_count = 0; |
| 1404 | Lisp_Object tail; | ||
| 1405 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | ||
| 1416 | { | 1406 | { |
| 1417 | if (!CONSP (list) || EQ (XCAR (list), elt)) | 1407 | if (EQ (XCAR (tail), elt)) |
| 1418 | break; | 1408 | return tail; |
| 1419 | 1409 | rarely_quit (++quit_count); | |
| 1420 | list = XCDR (list); | ||
| 1421 | if (!CONSP (list) || EQ (XCAR (list), elt)) | ||
| 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 | } | 1410 | } |
| 1431 | 1411 | CHECK_LIST_END (tail, list); | |
| 1432 | CHECK_LIST (list); | 1412 | return Qnil; |
| 1433 | return list; | ||
| 1434 | } | 1413 | } |
| 1435 | 1414 | ||
| 1436 | DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, | 1415 | DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, |
| 1437 | doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. | 1416 | 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. */) | 1417 | The value is actually the tail of LIST whose car is ELT. */) |
| 1439 | (register Lisp_Object elt, Lisp_Object list) | 1418 | (Lisp_Object elt, Lisp_Object list) |
| 1440 | { | 1419 | { |
| 1441 | register Lisp_Object tail; | ||
| 1442 | |||
| 1443 | if (!FLOATP (elt)) | 1420 | if (!FLOATP (elt)) |
| 1444 | return Fmemq (elt, list); | 1421 | return Fmemq (elt, list); |
| 1445 | 1422 | ||
| 1446 | for (tail = list; !NILP (tail); tail = XCDR (tail)) | 1423 | unsigned short int quit_count = 0; |
| 1424 | Lisp_Object tail; | ||
| 1425 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | ||
| 1447 | { | 1426 | { |
| 1448 | register Lisp_Object tem; | 1427 | 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)) | 1428 | if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) |
| 1452 | return tail; | 1429 | return tail; |
| 1453 | QUIT; | 1430 | rarely_quit (++quit_count); |
| 1454 | } | 1431 | } |
| 1432 | CHECK_LIST_END (tail, list); | ||
| 1455 | return Qnil; | 1433 | return Qnil; |
| 1456 | } | 1434 | } |
| 1457 | 1435 | ||
| @@ -1461,44 +1439,28 @@ The value is actually the first element of LIST whose car is KEY. | |||
| 1461 | Elements of LIST that are not conses are ignored. */) | 1439 | Elements of LIST that are not conses are ignored. */) |
| 1462 | (Lisp_Object key, Lisp_Object list) | 1440 | (Lisp_Object key, Lisp_Object list) |
| 1463 | { | 1441 | { |
| 1464 | while (1) | 1442 | unsigned short int quit_count = 0; |
| 1443 | Lisp_Object tail; | ||
| 1444 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | ||
| 1465 | { | 1445 | { |
| 1466 | if (!CONSP (list) | 1446 | if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) |
| 1467 | || (CONSP (XCAR (list)) | 1447 | return XCAR (tail); |
| 1468 | && EQ (XCAR (XCAR (list)), key))) | 1448 | rarely_quit (++quit_count); |
| 1469 | break; | ||
| 1470 | |||
| 1471 | list = XCDR (list); | ||
| 1472 | if (!CONSP (list) | ||
| 1473 | || (CONSP (XCAR (list)) | ||
| 1474 | && EQ (XCAR (XCAR (list)), key))) | ||
| 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 | } | 1449 | } |
| 1486 | 1450 | CHECK_LIST_END (tail, list); | |
| 1487 | return CAR (list); | 1451 | return Qnil; |
| 1488 | } | 1452 | } |
| 1489 | 1453 | ||
| 1490 | /* Like Fassq but never report an error and do not allow quits. | 1454 | /* Like Fassq but never report an error and do not allow quits. |
| 1491 | Use only on lists known never to be circular. */ | 1455 | Use only on objects known to be non-circular lists. */ |
| 1492 | 1456 | ||
| 1493 | Lisp_Object | 1457 | Lisp_Object |
| 1494 | assq_no_quit (Lisp_Object key, Lisp_Object list) | 1458 | assq_no_quit (Lisp_Object key, Lisp_Object list) |
| 1495 | { | 1459 | { |
| 1496 | while (CONSP (list) | 1460 | for (; ! NILP (list); list = XCDR (list)) |
| 1497 | && (!CONSP (XCAR (list)) | 1461 | if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key)) |
| 1498 | || !EQ (XCAR (XCAR (list)), key))) | 1462 | return XCAR (list); |
| 1499 | list = XCDR (list); | 1463 | return Qnil; |
| 1500 | |||
| 1501 | return CAR_SAFE (list); | ||
| 1502 | } | 1464 | } |
| 1503 | 1465 | ||
| 1504 | DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | 1466 | DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, |
| @@ -1506,81 +1468,51 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | |||
| 1506 | The value is actually the first element of LIST whose car equals KEY. */) | 1468 | The value is actually the first element of LIST whose car equals KEY. */) |
| 1507 | (Lisp_Object key, Lisp_Object list) | 1469 | (Lisp_Object key, Lisp_Object list) |
| 1508 | { | 1470 | { |
| 1509 | Lisp_Object car; | 1471 | unsigned short int quit_count = 0; |
| 1510 | 1472 | Lisp_Object tail; | |
| 1511 | while (1) | 1473 | for (tail = list; CONSP (tail); tail = XCDR (tail)) |
| 1512 | { | 1474 | { |
| 1513 | if (!CONSP (list) | 1475 | Lisp_Object car = XCAR (tail); |
| 1514 | || (CONSP (XCAR (list)) | 1476 | if (CONSP (car) |
| 1515 | && (car = XCAR (XCAR (list)), | 1477 | && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) |
| 1516 | EQ (car, key) || !NILP (Fequal (car, key))))) | 1478 | return car; |
| 1517 | break; | 1479 | 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 | } | 1480 | } |
| 1536 | 1481 | CHECK_LIST_END (tail, list); | |
| 1537 | return CAR (list); | 1482 | return Qnil; |
| 1538 | } | 1483 | } |
| 1539 | 1484 | ||
| 1540 | /* Like Fassoc but never report an error and do not allow quits. | 1485 | /* Like Fassoc but never report an error and do not allow quits. |
| 1541 | Use only on lists known never to be circular. */ | 1486 | Use only on objects known to be non-circular lists. */ |
| 1542 | 1487 | ||
| 1543 | Lisp_Object | 1488 | Lisp_Object |
| 1544 | assoc_no_quit (Lisp_Object key, Lisp_Object list) | 1489 | assoc_no_quit (Lisp_Object key, Lisp_Object list) |
| 1545 | { | 1490 | { |
| 1546 | while (CONSP (list) | 1491 | for (; ! NILP (list); list = XCDR (list)) |
| 1547 | && (!CONSP (XCAR (list)) | 1492 | { |
| 1548 | || (!EQ (XCAR (XCAR (list)), key) | 1493 | Lisp_Object car = XCAR (list); |
| 1549 | && NILP (Fequal (XCAR (XCAR (list)), key))))) | 1494 | if (CONSP (car) |
| 1550 | list = XCDR (list); | 1495 | && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) |
| 1551 | 1496 | return car; | |
| 1552 | return CONSP (list) ? XCAR (list) : Qnil; | 1497 | } |
| 1498 | return Qnil; | ||
| 1553 | } | 1499 | } |
| 1554 | 1500 | ||
| 1555 | DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, | 1501 | DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, |
| 1556 | doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. | 1502 | 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. */) | 1503 | The value is actually the first element of LIST whose cdr is KEY. */) |
| 1558 | (register Lisp_Object key, Lisp_Object list) | 1504 | (Lisp_Object key, Lisp_Object list) |
| 1559 | { | 1505 | { |
| 1560 | while (1) | 1506 | unsigned short int quit_count = 0; |
| 1507 | Lisp_Object tail; | ||
| 1508 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | ||
| 1561 | { | 1509 | { |
| 1562 | if (!CONSP (list) | 1510 | if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) |
| 1563 | || (CONSP (XCAR (list)) | 1511 | return XCAR (tail); |
| 1564 | && EQ (XCDR (XCAR (list)), key))) | 1512 | rarely_quit (++quit_count); |
| 1565 | break; | ||
| 1566 | |||
| 1567 | list = XCDR (list); | ||
| 1568 | if (!CONSP (list) | ||
| 1569 | || (CONSP (XCAR (list)) | ||
| 1570 | && EQ (XCDR (XCAR (list)), key))) | ||
| 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 | } | 1513 | } |
| 1582 | 1514 | CHECK_LIST_END (tail, list); | |
| 1583 | return CAR (list); | 1515 | return Qnil; |
| 1584 | } | 1516 | } |
| 1585 | 1517 | ||
| 1586 | DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, | 1518 | DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, |
| @@ -1588,35 +1520,18 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, | |||
| 1588 | The value is actually the first element of LIST whose cdr equals KEY. */) | 1520 | The value is actually the first element of LIST whose cdr equals KEY. */) |
| 1589 | (Lisp_Object key, Lisp_Object list) | 1521 | (Lisp_Object key, Lisp_Object list) |
| 1590 | { | 1522 | { |
| 1591 | Lisp_Object cdr; | 1523 | unsigned short int quit_count = 0; |
| 1592 | 1524 | Lisp_Object tail; | |
| 1593 | while (1) | 1525 | for (tail = list; CONSP (tail); tail = XCDR (tail)) |
| 1594 | { | 1526 | { |
| 1595 | if (!CONSP (list) | 1527 | Lisp_Object car = XCAR (tail); |
| 1596 | || (CONSP (XCAR (list)) | 1528 | if (CONSP (car) |
| 1597 | && (cdr = XCDR (XCAR (list)), | 1529 | && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) |
| 1598 | EQ (cdr, key) || !NILP (Fequal (cdr, key))))) | 1530 | return car; |
| 1599 | break; | 1531 | 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 | } | 1532 | } |
| 1618 | 1533 | CHECK_LIST_END (tail, list); | |
| 1619 | return CAR (list); | 1534 | return Qnil; |
| 1620 | } | 1535 | } |
| 1621 | 1536 | ||
| 1622 | DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, | 1537 | DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, |
| @@ -1647,6 +1562,7 @@ argument. */) | |||
| 1647 | else | 1562 | else |
| 1648 | prev = tail; | 1563 | prev = tail; |
| 1649 | } | 1564 | } |
| 1565 | CHECK_LIST_END (tail, list); | ||
| 1650 | return list; | 1566 | return list; |
| 1651 | } | 1567 | } |
| 1652 | 1568 | ||
| @@ -1754,12 +1670,11 @@ changing the value of a sequence `foo'. */) | |||
| 1754 | } | 1670 | } |
| 1755 | else | 1671 | else |
| 1756 | { | 1672 | { |
| 1673 | unsigned short int quit_count = 0; | ||
| 1757 | Lisp_Object tail, prev; | 1674 | Lisp_Object tail, prev; |
| 1758 | 1675 | ||
| 1759 | for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) | 1676 | for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail)) |
| 1760 | { | 1677 | { |
| 1761 | CHECK_LIST_CONS (tail, seq); | ||
| 1762 | |||
| 1763 | if (!NILP (Fequal (elt, XCAR (tail)))) | 1678 | if (!NILP (Fequal (elt, XCAR (tail)))) |
| 1764 | { | 1679 | { |
| 1765 | if (NILP (prev)) | 1680 | if (NILP (prev)) |
| @@ -1769,8 +1684,9 @@ changing the value of a sequence `foo'. */) | |||
| 1769 | } | 1684 | } |
| 1770 | else | 1685 | else |
| 1771 | prev = tail; | 1686 | prev = tail; |
| 1772 | QUIT; | 1687 | rarely_quit (++quit_count); |
| 1773 | } | 1688 | } |
| 1689 | CHECK_LIST_END (tail, seq); | ||
| 1774 | } | 1690 | } |
| 1775 | 1691 | ||
| 1776 | return seq; | 1692 | return seq; |
| @@ -1788,16 +1704,17 @@ This function may destructively modify SEQ to produce the value. */) | |||
| 1788 | return Freverse (seq); | 1704 | return Freverse (seq); |
| 1789 | else if (CONSP (seq)) | 1705 | else if (CONSP (seq)) |
| 1790 | { | 1706 | { |
| 1707 | unsigned short int quit_count = 0; | ||
| 1791 | Lisp_Object prev, tail, next; | 1708 | Lisp_Object prev, tail, next; |
| 1792 | 1709 | ||
| 1793 | for (prev = Qnil, tail = seq; !NILP (tail); tail = next) | 1710 | for (prev = Qnil, tail = seq; CONSP (tail); tail = next) |
| 1794 | { | 1711 | { |
| 1795 | QUIT; | ||
| 1796 | CHECK_LIST_CONS (tail, tail); | ||
| 1797 | next = XCDR (tail); | 1712 | next = XCDR (tail); |
| 1798 | Fsetcdr (tail, prev); | 1713 | Fsetcdr (tail, prev); |
| 1799 | prev = tail; | 1714 | prev = tail; |
| 1715 | rarely_quit (++quit_count); | ||
| 1800 | } | 1716 | } |
| 1717 | CHECK_LIST_END (tail, seq); | ||
| 1801 | seq = prev; | 1718 | seq = prev; |
| 1802 | } | 1719 | } |
| 1803 | else if (VECTORP (seq)) | 1720 | else if (VECTORP (seq)) |
| @@ -1838,10 +1755,11 @@ See also the function `nreverse', which is used more often. */) | |||
| 1838 | return Qnil; | 1755 | return Qnil; |
| 1839 | else if (CONSP (seq)) | 1756 | else if (CONSP (seq)) |
| 1840 | { | 1757 | { |
| 1758 | unsigned short int quit_count = 0; | ||
| 1841 | for (new = Qnil; CONSP (seq); seq = XCDR (seq)) | 1759 | for (new = Qnil; CONSP (seq); seq = XCDR (seq)) |
| 1842 | { | 1760 | { |
| 1843 | QUIT; | ||
| 1844 | new = Fcons (XCAR (seq), new); | 1761 | new = Fcons (XCAR (seq), new); |
| 1762 | rarely_quit (++quit_count); | ||
| 1845 | } | 1763 | } |
| 1846 | CHECK_LIST_END (seq, seq); | 1764 | CHECK_LIST_END (seq, seq); |
| 1847 | } | 1765 | } |
| @@ -2130,12 +2048,11 @@ 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; | 2048 | 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. | 2049 | use `(setq x (plist-put x prop val))' to be sure to use the new value. |
| 2132 | The PLIST is modified by side effects. */) | 2050 | The PLIST is modified by side effects. */) |
| 2133 | (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) | 2051 | (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) |
| 2134 | { | 2052 | { |
| 2135 | register Lisp_Object tail, prev; | 2053 | unsigned short int quit_count = 0; |
| 2136 | Lisp_Object newcell; | 2054 | Lisp_Object prev = Qnil; |
| 2137 | prev = Qnil; | 2055 | for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
| 2138 | for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); | ||
| 2139 | tail = XCDR (XCDR (tail))) | 2056 | tail = XCDR (XCDR (tail))) |
| 2140 | { | 2057 | { |
| 2141 | if (EQ (prop, XCAR (tail))) | 2058 | if (EQ (prop, XCAR (tail))) |
| @@ -2145,13 +2062,13 @@ The PLIST is modified by side effects. */) | |||
| 2145 | } | 2062 | } |
| 2146 | 2063 | ||
| 2147 | prev = tail; | 2064 | prev = tail; |
| 2148 | QUIT; | 2065 | rarely_quit (++quit_count); |
| 2149 | } | 2066 | } |
| 2150 | newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); | 2067 | Lisp_Object newcell |
| 2068 | = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); | ||
| 2151 | if (NILP (prev)) | 2069 | if (NILP (prev)) |
| 2152 | return newcell; | 2070 | return newcell; |
| 2153 | else | 2071 | Fsetcdr (XCDR (prev), newcell); |
| 2154 | Fsetcdr (XCDR (prev), newcell); | ||
| 2155 | return plist; | 2072 | return plist; |
| 2156 | } | 2073 | } |
| 2157 | 2074 | ||
| @@ -2174,6 +2091,7 @@ corresponding to the given PROP, or nil if PROP is not | |||
| 2174 | one of the properties on the list. */) | 2091 | one of the properties on the list. */) |
| 2175 | (Lisp_Object plist, Lisp_Object prop) | 2092 | (Lisp_Object plist, Lisp_Object prop) |
| 2176 | { | 2093 | { |
| 2094 | unsigned short int quit_count = 0; | ||
| 2177 | Lisp_Object tail; | 2095 | Lisp_Object tail; |
| 2178 | 2096 | ||
| 2179 | for (tail = plist; | 2097 | for (tail = plist; |
| @@ -2182,8 +2100,7 @@ one of the properties on the list. */) | |||
| 2182 | { | 2100 | { |
| 2183 | if (! NILP (Fequal (prop, XCAR (tail)))) | 2101 | if (! NILP (Fequal (prop, XCAR (tail)))) |
| 2184 | return XCAR (XCDR (tail)); | 2102 | return XCAR (XCDR (tail)); |
| 2185 | 2103 | rarely_quit (++quit_count); | |
| 2186 | QUIT; | ||
| 2187 | } | 2104 | } |
| 2188 | 2105 | ||
| 2189 | CHECK_LIST_END (tail, prop); | 2106 | CHECK_LIST_END (tail, prop); |
| @@ -2199,12 +2116,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; | 2116 | 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. | 2117 | 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. */) | 2118 | The PLIST is modified by side effects. */) |
| 2202 | (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) | 2119 | (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) |
| 2203 | { | 2120 | { |
| 2204 | register Lisp_Object tail, prev; | 2121 | unsigned short int quit_count = 0; |
| 2205 | Lisp_Object newcell; | 2122 | Lisp_Object prev = Qnil; |
| 2206 | prev = Qnil; | 2123 | for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
| 2207 | for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); | ||
| 2208 | tail = XCDR (XCDR (tail))) | 2124 | tail = XCDR (XCDR (tail))) |
| 2209 | { | 2125 | { |
| 2210 | if (! NILP (Fequal (prop, XCAR (tail)))) | 2126 | if (! NILP (Fequal (prop, XCAR (tail)))) |
| @@ -2214,13 +2130,12 @@ The PLIST is modified by side effects. */) | |||
| 2214 | } | 2130 | } |
| 2215 | 2131 | ||
| 2216 | prev = tail; | 2132 | prev = tail; |
| 2217 | QUIT; | 2133 | rarely_quit (++quit_count); |
| 2218 | } | 2134 | } |
| 2219 | newcell = list2 (prop, val); | 2135 | Lisp_Object newcell = list2 (prop, val); |
| 2220 | if (NILP (prev)) | 2136 | if (NILP (prev)) |
| 2221 | return newcell; | 2137 | return newcell; |
| 2222 | else | 2138 | Fsetcdr (XCDR (prev), newcell); |
| 2223 | Fsetcdr (XCDR (prev), newcell); | ||
| 2224 | return plist; | 2139 | return plist; |
| 2225 | } | 2140 | } |
| 2226 | 2141 | ||
| @@ -2293,8 +2208,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, | |||
| 2293 | } | 2208 | } |
| 2294 | } | 2209 | } |
| 2295 | 2210 | ||
| 2211 | unsigned short int quit_count = 0; | ||
| 2296 | tail_recurse: | 2212 | tail_recurse: |
| 2297 | QUIT; | 2213 | rarely_quit (++quit_count); |
| 2298 | if (EQ (o1, o2)) | 2214 | if (EQ (o1, o2)) |
| 2299 | return 1; | 2215 | return 1; |
| 2300 | if (XTYPE (o1) != XTYPE (o2)) | 2216 | if (XTYPE (o1) != XTYPE (o2)) |
| @@ -2483,14 +2399,12 @@ Only the last argument is not altered, and need not be a list. | |||
| 2483 | usage: (nconc &rest LISTS) */) | 2399 | usage: (nconc &rest LISTS) */) |
| 2484 | (ptrdiff_t nargs, Lisp_Object *args) | 2400 | (ptrdiff_t nargs, Lisp_Object *args) |
| 2485 | { | 2401 | { |
| 2486 | ptrdiff_t argnum; | 2402 | unsigned short int quit_count = 0; |
| 2487 | register Lisp_Object tail, tem, val; | 2403 | Lisp_Object val = Qnil; |
| 2488 | |||
| 2489 | val = tail = Qnil; | ||
| 2490 | 2404 | ||
| 2491 | for (argnum = 0; argnum < nargs; argnum++) | 2405 | for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) |
| 2492 | { | 2406 | { |
| 2493 | tem = args[argnum]; | 2407 | Lisp_Object tem = args[argnum]; |
| 2494 | if (NILP (tem)) continue; | 2408 | if (NILP (tem)) continue; |
| 2495 | 2409 | ||
| 2496 | if (NILP (val)) | 2410 | if (NILP (val)) |
| @@ -2498,14 +2412,16 @@ usage: (nconc &rest LISTS) */) | |||
| 2498 | 2412 | ||
| 2499 | if (argnum + 1 == nargs) break; | 2413 | if (argnum + 1 == nargs) break; |
| 2500 | 2414 | ||
| 2501 | CHECK_LIST_CONS (tem, tem); | 2415 | CHECK_CONS (tem); |
| 2502 | 2416 | ||
| 2503 | while (CONSP (tem)) | 2417 | Lisp_Object tail; |
| 2418 | do | ||
| 2504 | { | 2419 | { |
| 2505 | tail = tem; | 2420 | tail = tem; |
| 2506 | tem = XCDR (tail); | 2421 | tem = XCDR (tail); |
| 2507 | QUIT; | 2422 | rarely_quit (++quit_count); |
| 2508 | } | 2423 | } |
| 2424 | while (CONSP (tem)); | ||
| 2509 | 2425 | ||
| 2510 | tem = args[argnum + 1]; | 2426 | tem = args[argnum + 1]; |
| 2511 | Fsetcdr (tail, tem); | 2427 | Fsetcdr (tail, tem); |
| @@ -2927,11 +2843,12 @@ property and a property with the value nil. | |||
| 2927 | The value is actually the tail of PLIST whose car is PROP. */) | 2843 | The value is actually the tail of PLIST whose car is PROP. */) |
| 2928 | (Lisp_Object plist, Lisp_Object prop) | 2844 | (Lisp_Object plist, Lisp_Object prop) |
| 2929 | { | 2845 | { |
| 2846 | unsigned short int quit_count = 0; | ||
| 2930 | while (CONSP (plist) && !EQ (XCAR (plist), prop)) | 2847 | while (CONSP (plist) && !EQ (XCAR (plist), prop)) |
| 2931 | { | 2848 | { |
| 2932 | plist = XCDR (plist); | 2849 | plist = XCDR (plist); |
| 2933 | plist = CDR (plist); | 2850 | plist = CDR (plist); |
| 2934 | QUIT; | 2851 | rarely_quit (++quit_count); |
| 2935 | } | 2852 | } |
| 2936 | return plist; | 2853 | return plist; |
| 2937 | } | 2854 | } |
| @@ -3804,12 +3721,17 @@ allocate_hash_table (void) | |||
| 3804 | (table size) is >= REHASH_THRESHOLD. | 3721 | (table size) is >= REHASH_THRESHOLD. |
| 3805 | 3722 | ||
| 3806 | WEAK specifies the weakness of the table. If non-nil, it must be | 3723 | 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'. */ | 3724 | one of the symbols `key', `value', `key-or-value', or `key-and-value'. |
| 3725 | |||
| 3726 | If PURECOPY is non-nil, the table can be copied to pure storage via | ||
| 3727 | `purecopy' when Emacs is being dumped. Such tables can no longer be | ||
| 3728 | changed after purecopy. */ | ||
| 3808 | 3729 | ||
| 3809 | Lisp_Object | 3730 | Lisp_Object |
| 3810 | make_hash_table (struct hash_table_test test, | 3731 | make_hash_table (struct hash_table_test test, |
| 3811 | Lisp_Object size, Lisp_Object rehash_size, | 3732 | Lisp_Object size, Lisp_Object rehash_size, |
| 3812 | Lisp_Object rehash_threshold, Lisp_Object weak) | 3733 | Lisp_Object rehash_threshold, Lisp_Object weak, |
| 3734 | Lisp_Object pure) | ||
| 3813 | { | 3735 | { |
| 3814 | struct Lisp_Hash_Table *h; | 3736 | struct Lisp_Hash_Table *h; |
| 3815 | Lisp_Object table; | 3737 | Lisp_Object table; |
| @@ -3850,6 +3772,7 @@ make_hash_table (struct hash_table_test test, | |||
| 3850 | h->hash = Fmake_vector (size, Qnil); | 3772 | h->hash = Fmake_vector (size, Qnil); |
| 3851 | h->next = Fmake_vector (size, Qnil); | 3773 | h->next = Fmake_vector (size, Qnil); |
| 3852 | h->index = Fmake_vector (make_number (index_size), Qnil); | 3774 | h->index = Fmake_vector (make_number (index_size), Qnil); |
| 3775 | h->pure = pure; | ||
| 3853 | 3776 | ||
| 3854 | /* Set up the free list. */ | 3777 | /* Set up the free list. */ |
| 3855 | for (i = 0; i < sz - 1; ++i) | 3778 | for (i = 0; i < sz - 1; ++i) |
| @@ -4514,10 +4437,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 | 4437 | WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK |
| 4515 | is nil. | 4438 | is nil. |
| 4516 | 4439 | ||
| 4440 | :purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied | ||
| 4441 | to pure storage when Emacs is being dumped, making the contents of the | ||
| 4442 | table read only. Any further changes to purified tables will result | ||
| 4443 | in an error. | ||
| 4444 | |||
| 4517 | usage: (make-hash-table &rest KEYWORD-ARGS) */) | 4445 | usage: (make-hash-table &rest KEYWORD-ARGS) */) |
| 4518 | (ptrdiff_t nargs, Lisp_Object *args) | 4446 | (ptrdiff_t nargs, Lisp_Object *args) |
| 4519 | { | 4447 | { |
| 4520 | Lisp_Object test, size, rehash_size, rehash_threshold, weak; | 4448 | Lisp_Object test, size, rehash_size, rehash_threshold, weak, pure; |
| 4521 | struct hash_table_test testdesc; | 4449 | struct hash_table_test testdesc; |
| 4522 | ptrdiff_t i; | 4450 | ptrdiff_t i; |
| 4523 | USE_SAFE_ALLOCA; | 4451 | USE_SAFE_ALLOCA; |
| @@ -4551,6 +4479,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) | |||
| 4551 | testdesc.cmpfn = cmpfn_user_defined; | 4479 | testdesc.cmpfn = cmpfn_user_defined; |
| 4552 | } | 4480 | } |
| 4553 | 4481 | ||
| 4482 | /* See if there's a `:purecopy PURECOPY' argument. */ | ||
| 4483 | i = get_key_arg (QCpurecopy, nargs, args, used); | ||
| 4484 | pure = i ? args[i] : Qnil; | ||
| 4554 | /* See if there's a `:size SIZE' argument. */ | 4485 | /* See if there's a `:size SIZE' argument. */ |
| 4555 | i = get_key_arg (QCsize, nargs, args, used); | 4486 | i = get_key_arg (QCsize, nargs, args, used); |
| 4556 | size = i ? args[i] : Qnil; | 4487 | size = i ? args[i] : Qnil; |
| @@ -4592,7 +4523,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) | |||
| 4592 | signal_error ("Invalid argument list", args[i]); | 4523 | signal_error ("Invalid argument list", args[i]); |
| 4593 | 4524 | ||
| 4594 | SAFE_FREE (); | 4525 | SAFE_FREE (); |
| 4595 | return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak); | 4526 | return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak, |
| 4527 | pure); | ||
| 4596 | } | 4528 | } |
| 4597 | 4529 | ||
| 4598 | 4530 | ||
| @@ -4671,7 +4603,9 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, | |||
| 4671 | doc: /* Clear hash table TABLE and return it. */) | 4603 | doc: /* Clear hash table TABLE and return it. */) |
| 4672 | (Lisp_Object table) | 4604 | (Lisp_Object table) |
| 4673 | { | 4605 | { |
| 4674 | hash_clear (check_hash_table (table)); | 4606 | struct Lisp_Hash_Table *h = check_hash_table (table); |
| 4607 | CHECK_IMPURE (table, h); | ||
| 4608 | hash_clear (h); | ||
| 4675 | /* Be compatible with XEmacs. */ | 4609 | /* Be compatible with XEmacs. */ |
| 4676 | return table; | 4610 | return table; |
| 4677 | } | 4611 | } |
| @@ -4695,9 +4629,10 @@ VALUE. In any case, return VALUE. */) | |||
| 4695 | (Lisp_Object key, Lisp_Object value, Lisp_Object table) | 4629 | (Lisp_Object key, Lisp_Object value, Lisp_Object table) |
| 4696 | { | 4630 | { |
| 4697 | struct Lisp_Hash_Table *h = check_hash_table (table); | 4631 | struct Lisp_Hash_Table *h = check_hash_table (table); |
| 4632 | CHECK_IMPURE (table, h); | ||
| 4633 | |||
| 4698 | ptrdiff_t i; | 4634 | ptrdiff_t i; |
| 4699 | EMACS_UINT hash; | 4635 | EMACS_UINT hash; |
| 4700 | |||
| 4701 | i = hash_lookup (h, key, &hash); | 4636 | i = hash_lookup (h, key, &hash); |
| 4702 | if (i >= 0) | 4637 | if (i >= 0) |
| 4703 | set_hash_value_slot (h, i, value); | 4638 | set_hash_value_slot (h, i, value); |
| @@ -4713,6 +4648,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, | |||
| 4713 | (Lisp_Object key, Lisp_Object table) | 4648 | (Lisp_Object key, Lisp_Object table) |
| 4714 | { | 4649 | { |
| 4715 | struct Lisp_Hash_Table *h = check_hash_table (table); | 4650 | struct Lisp_Hash_Table *h = check_hash_table (table); |
| 4651 | CHECK_IMPURE (table, h); | ||
| 4716 | hash_remove_from_table (h, key); | 4652 | hash_remove_from_table (h, key); |
| 4717 | return Qnil; | 4653 | return Qnil; |
| 4718 | } | 4654 | } |
| @@ -5083,6 +5019,7 @@ syms_of_fns (void) | |||
| 5083 | DEFSYM (Qequal, "equal"); | 5019 | DEFSYM (Qequal, "equal"); |
| 5084 | DEFSYM (QCtest, ":test"); | 5020 | DEFSYM (QCtest, ":test"); |
| 5085 | DEFSYM (QCsize, ":size"); | 5021 | DEFSYM (QCsize, ":size"); |
| 5022 | DEFSYM (QCpurecopy, ":purecopy"); | ||
| 5086 | DEFSYM (QCrehash_size, ":rehash-size"); | 5023 | DEFSYM (QCrehash_size, ":rehash-size"); |
| 5087 | DEFSYM (QCrehash_threshold, ":rehash-threshold"); | 5024 | DEFSYM (QCrehash_threshold, ":rehash-threshold"); |
| 5088 | DEFSYM (QCweakness, ":weakness"); | 5025 | 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..f630ebb847c 100644 --- a/src/indent.c +++ b/src/indent.c | |||
| @@ -1200,9 +1200,6 @@ 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; | ||
| 1204 | QUIT; | ||
| 1205 | |||
| 1206 | /* It's just impossible to be too paranoid here. */ | 1203 | /* It's just impossible to be too paranoid here. */ |
| 1207 | eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); | 1204 | eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); |
| 1208 | 1205 | ||
| @@ -1214,8 +1211,12 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, | |||
| 1214 | cmp_it.id = -1; | 1211 | cmp_it.id = -1; |
| 1215 | composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); | 1212 | composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); |
| 1216 | 1213 | ||
| 1217 | while (1) | 1214 | unsigned short int quit_count = 0; |
| 1215 | |||
| 1216 | while (true) | ||
| 1218 | { | 1217 | { |
| 1218 | rarely_quit (++quit_count); | ||
| 1219 | |||
| 1219 | while (pos == next_boundary) | 1220 | while (pos == next_boundary) |
| 1220 | { | 1221 | { |
| 1221 | ptrdiff_t pos_here = pos; | 1222 | ptrdiff_t pos_here = pos; |
| @@ -1280,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, | |||
| 1280 | pos = newpos; | 1281 | pos = newpos; |
| 1281 | pos_byte = CHAR_TO_BYTE (pos); | 1282 | pos_byte = CHAR_TO_BYTE (pos); |
| 1282 | } | 1283 | } |
| 1284 | |||
| 1285 | rarely_quit (++quit_count); | ||
| 1283 | } | 1286 | } |
| 1284 | 1287 | ||
| 1285 | /* Handle right margin. */ | 1288 | /* Handle right margin. */ |
| @@ -1602,6 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, | |||
| 1602 | pos = find_before_next_newline (pos, to, 1, &pos_byte); | 1605 | pos = find_before_next_newline (pos, to, 1, &pos_byte); |
| 1603 | if (pos < to) | 1606 | if (pos < to) |
| 1604 | INC_BOTH (pos, pos_byte); | 1607 | INC_BOTH (pos, pos_byte); |
| 1608 | rarely_quit (++quit_count); | ||
| 1605 | } | 1609 | } |
| 1606 | while (pos < to | 1610 | while (pos < to |
| 1607 | && indented_beyond_p (pos, pos_byte, | 1611 | && indented_beyond_p (pos, pos_byte, |
| @@ -1694,7 +1698,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, | |||
| 1694 | /* Nonzero if have just continued a line */ | 1698 | /* Nonzero if have just continued a line */ |
| 1695 | val_compute_motion.contin = (contin_hpos && prev_hpos == 0); | 1699 | val_compute_motion.contin = (contin_hpos && prev_hpos == 0); |
| 1696 | 1700 | ||
| 1697 | immediate_quit = 0; | ||
| 1698 | return &val_compute_motion; | 1701 | return &val_compute_motion; |
| 1699 | } | 1702 | } |
| 1700 | 1703 | ||
diff --git a/src/insdel.c b/src/insdel.c index ce4960447f2..4627bd54b0b 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..a86e7c5f8e4 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 |
| @@ -169,9 +169,6 @@ struct kboard *echo_kboard; | |||
| 169 | 169 | ||
| 170 | Lisp_Object echo_message_buffer; | 170 | Lisp_Object echo_message_buffer; |
| 171 | 171 | ||
| 172 | /* True means C-g should cause immediate error-signal. */ | ||
| 173 | bool immediate_quit; | ||
| 174 | |||
| 175 | /* Character that causes a quit. Normally C-g. | 172 | /* Character that causes a quit. Normally C-g. |
| 176 | 173 | ||
| 177 | If we are running on an ordinary terminal, this must be an ordinary | 174 | If we are running on an ordinary terminal, this must be an ordinary |
| @@ -1416,7 +1413,7 @@ command_loop_1 (void) | |||
| 1416 | if (!NILP (Vquit_flag)) | 1413 | if (!NILP (Vquit_flag)) |
| 1417 | { | 1414 | { |
| 1418 | Vexecuting_kbd_macro = Qt; | 1415 | Vexecuting_kbd_macro = Qt; |
| 1419 | QUIT; /* Make some noise. */ | 1416 | maybe_quit (); /* Make some noise. */ |
| 1420 | /* Will return since macro now empty. */ | 1417 | /* Will return since macro now empty. */ |
| 1421 | } | 1418 | } |
| 1422 | } | 1419 | } |
| @@ -3584,16 +3581,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, | |||
| 3584 | as input, set quit-flag to cause an interrupt. */ | 3581 | as input, set quit-flag to cause an interrupt. */ |
| 3585 | if (!NILP (Vthrow_on_input) | 3582 | if (!NILP (Vthrow_on_input) |
| 3586 | && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) | 3583 | && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) |
| 3587 | { | 3584 | Vquit_flag = Vthrow_on_input; |
| 3588 | Vquit_flag = Vthrow_on_input; | ||
| 3589 | /* If we're inside a function that wants immediate quits, | ||
| 3590 | do it now. */ | ||
| 3591 | if (immediate_quit && NILP (Vinhibit_quit)) | ||
| 3592 | { | ||
| 3593 | immediate_quit = false; | ||
| 3594 | QUIT; | ||
| 3595 | } | ||
| 3596 | } | ||
| 3597 | } | 3585 | } |
| 3598 | 3586 | ||
| 3599 | 3587 | ||
| @@ -7053,40 +7041,22 @@ tty_read_avail_input (struct terminal *terminal, | |||
| 7053 | 7041 | ||
| 7054 | /* Now read; for one reason or another, this will not block. | 7042 | /* Now read; for one reason or another, this will not block. |
| 7055 | NREAD is set to the number of chars read. */ | 7043 | NREAD is set to the number of chars read. */ |
| 7056 | do | 7044 | nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); |
| 7057 | { | 7045 | /* POSIX infers that processes which are not in the session leader's |
| 7058 | nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); | 7046 | process group won't get SIGHUPs at logout time. BSDI adheres to |
| 7059 | /* POSIX infers that processes which are not in the session leader's | 7047 | this part standard and returns -1 from read (0) with errno==EIO |
| 7060 | process group won't get SIGHUPs at logout time. BSDI adheres to | 7048 | when the control tty is taken away. |
| 7061 | this part standard and returns -1 from read (0) with errno==EIO | 7049 | Jeffrey Honig <jch@bsdi.com> says this is generally safe. */ |
| 7062 | when the control tty is taken away. | 7050 | if (nread == -1 && errno == EIO) |
| 7063 | Jeffrey Honig <jch@bsdi.com> says this is generally safe. */ | 7051 | return -2; /* Close this terminal. */ |
| 7064 | if (nread == -1 && errno == EIO) | 7052 | #if defined AIX && defined _BSD |
| 7065 | return -2; /* Close this terminal. */ | 7053 | /* The kernel sometimes fails to deliver SIGHUP for ptys. |
| 7066 | #if defined (AIX) && defined (_BSD) | 7054 | This looks incorrect, but it isn't, because _BSD causes |
| 7067 | /* The kernel sometimes fails to deliver SIGHUP for ptys. | 7055 | O_NDELAY to be defined in fcntl.h as O_NONBLOCK, |
| 7068 | This looks incorrect, but it isn't, because _BSD causes | 7056 | and that causes a value other than 0 when there is no input. */ |
| 7069 | O_NDELAY to be defined in fcntl.h as O_NONBLOCK, | 7057 | if (nread == 0) |
| 7070 | and that causes a value other than 0 when there is no input. */ | 7058 | return -2; /* Close this terminal. */ |
| 7071 | if (nread == 0) | ||
| 7072 | return -2; /* Close this terminal. */ | ||
| 7073 | #endif | ||
| 7074 | } | ||
| 7075 | while ( | ||
| 7076 | /* We used to retry the read if it was interrupted. | ||
| 7077 | But this does the wrong thing when O_NONBLOCK causes | ||
| 7078 | an EAGAIN error. Does anybody know of a situation | ||
| 7079 | where a retry is actually needed? */ | ||
| 7080 | #if 0 | ||
| 7081 | nread < 0 && (errno == EAGAIN || errno == EFAULT | ||
| 7082 | #ifdef EBADSLT | ||
| 7083 | || errno == EBADSLT | ||
| 7084 | #endif | ||
| 7085 | ) | ||
| 7086 | #else | ||
| 7087 | 0 | ||
| 7088 | #endif | 7059 | #endif |
| 7089 | ); | ||
| 7090 | 7060 | ||
| 7091 | #ifndef USABLE_FIONREAD | 7061 | #ifndef USABLE_FIONREAD |
| 7092 | #if defined (USG) || defined (CYGWIN) | 7062 | #if defined (USG) || defined (CYGWIN) |
| @@ -7426,7 +7396,7 @@ menu_bar_items (Lisp_Object old) | |||
| 7426 | USE_SAFE_ALLOCA; | 7396 | USE_SAFE_ALLOCA; |
| 7427 | 7397 | ||
| 7428 | /* In order to build the menus, we need to call the keymap | 7398 | /* In order to build the menus, we need to call the keymap |
| 7429 | accessors. They all call QUIT. But this function is called | 7399 | accessors. They all call maybe_quit. But this function is called |
| 7430 | during redisplay, during which a quit is fatal. So inhibit | 7400 | during redisplay, during which a quit is fatal. So inhibit |
| 7431 | quitting while building the menus. | 7401 | quitting while building the menus. |
| 7432 | We do this instead of specbind because (1) errors will clear it anyway | 7402 | We do this instead of specbind because (1) errors will clear it anyway |
| @@ -7987,7 +7957,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems) | |||
| 7987 | *nitems = 0; | 7957 | *nitems = 0; |
| 7988 | 7958 | ||
| 7989 | /* In order to build the menus, we need to call the keymap | 7959 | /* In order to build the menus, we need to call the keymap |
| 7990 | accessors. They all call QUIT. But this function is called | 7960 | accessors. They all call maybe_quit. But this function is called |
| 7991 | during redisplay, during which a quit is fatal. So inhibit | 7961 | during redisplay, during which a quit is fatal. So inhibit |
| 7992 | quitting while building the menus. We do this instead of | 7962 | quitting while building the menus. We do this instead of |
| 7993 | specbind because (1) errors will clear it anyway and (2) this | 7963 | specbind because (1) errors will clear it anyway and (2) this |
| @@ -9806,7 +9776,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo, | |||
| 9806 | 9776 | ||
| 9807 | if (!NILP (prompt)) | 9777 | if (!NILP (prompt)) |
| 9808 | CHECK_STRING (prompt); | 9778 | CHECK_STRING (prompt); |
| 9809 | QUIT; | 9779 | maybe_quit (); |
| 9810 | 9780 | ||
| 9811 | specbind (Qinput_method_exit_on_first_char, | 9781 | specbind (Qinput_method_exit_on_first_char, |
| 9812 | (NILP (cmd_loop) ? Qt : Qnil)); | 9782 | (NILP (cmd_loop) ? Qt : Qnil)); |
| @@ -9840,7 +9810,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo, | |||
| 9840 | if (i == -1) | 9810 | if (i == -1) |
| 9841 | { | 9811 | { |
| 9842 | Vquit_flag = Qt; | 9812 | Vquit_flag = Qt; |
| 9843 | QUIT; | 9813 | maybe_quit (); |
| 9844 | } | 9814 | } |
| 9845 | 9815 | ||
| 9846 | return unbind_to (count, | 9816 | return unbind_to (count, |
| @@ -10278,7 +10248,7 @@ clear_waiting_for_input (void) | |||
| 10278 | 10248 | ||
| 10279 | If we have a frame on the controlling tty, we assume that the | 10249 | 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. | 10250 | SIGINT was generated by C-g, so we call handle_interrupt. |
| 10281 | Otherwise, tell QUIT to kill Emacs. */ | 10251 | Otherwise, tell maybe_quit to kill Emacs. */ |
| 10282 | 10252 | ||
| 10283 | static void | 10253 | static void |
| 10284 | handle_interrupt_signal (int sig) | 10254 | handle_interrupt_signal (int sig) |
| @@ -10289,7 +10259,7 @@ handle_interrupt_signal (int sig) | |||
| 10289 | { | 10259 | { |
| 10290 | /* If there are no frames there, let's pretend that we are a | 10260 | /* 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 | 10261 | 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 | 10262 | in a signal handler, so tell maybe_quit to exit when it is |
| 10293 | safe. */ | 10263 | safe. */ |
| 10294 | Vquit_flag = Qkill_emacs; | 10264 | Vquit_flag = Qkill_emacs; |
| 10295 | } | 10265 | } |
| @@ -10445,30 +10415,12 @@ handle_interrupt (bool in_signal_handler) | |||
| 10445 | } | 10415 | } |
| 10446 | else | 10416 | else |
| 10447 | { | 10417 | { |
| 10448 | /* If executing a function that wants to be interrupted out of | 10418 | /* Request quit when it's safe. */ |
| 10449 | and the user has not deferred quitting by binding `inhibit-quit' | 10419 | int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1; |
| 10450 | then quit right away. */ | 10420 | force_quit_count = count; |
| 10451 | if (immediate_quit && NILP (Vinhibit_quit)) | 10421 | if (count == 3) |
| 10452 | { | 10422 | Vinhibit_quit = Qnil; |
| 10453 | struct gl_state_s saved; | 10423 | Vquit_flag = Qt; |
| 10454 | |||
| 10455 | immediate_quit = false; | ||
| 10456 | pthread_sigmask (SIG_SETMASK, &empty_mask, 0); | ||
| 10457 | saved = gl_state; | ||
| 10458 | quit (); | ||
| 10459 | gl_state = saved; | ||
| 10460 | } | ||
| 10461 | else | ||
| 10462 | { /* Else request quit when it's safe. */ | ||
| 10463 | int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1; | ||
| 10464 | force_quit_count = count; | ||
| 10465 | if (count == 3) | ||
| 10466 | { | ||
| 10467 | immediate_quit = true; | ||
| 10468 | Vinhibit_quit = Qnil; | ||
| 10469 | } | ||
| 10470 | Vquit_flag = Qt; | ||
| 10471 | } | ||
| 10472 | } | 10424 | } |
| 10473 | 10425 | ||
| 10474 | pthread_sigmask (SIG_SETMASK, &empty_mask, 0); | 10426 | pthread_sigmask (SIG_SETMASK, &empty_mask, 0); |
| @@ -10907,7 +10859,6 @@ init_keyboard (void) | |||
| 10907 | { | 10859 | { |
| 10908 | /* This is correct before outermost invocation of the editor loop. */ | 10860 | /* This is correct before outermost invocation of the editor loop. */ |
| 10909 | command_loop_level = -1; | 10861 | command_loop_level = -1; |
| 10910 | immediate_quit = false; | ||
| 10911 | quit_char = Ctl ('g'); | 10862 | quit_char = Ctl ('g'); |
| 10912 | Vunread_command_events = Qnil; | 10863 | Vunread_command_events = Qnil; |
| 10913 | timer_idleness_start_time = invalid_timespec (); | 10864 | timer_idleness_start_time = invalid_timespec (); |
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 005d1e7c746..2a32db62326 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. The table cannot be | ||
| 1999 | changed afterwards. */ | ||
| 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,38 +3123,28 @@ 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 | extern void maybe_quit (void); |
| 3125 | Typing C-g does not directly cause a quit; it only sets Vquit_flag. | ||
| 3126 | So the program needs to do QUIT at times when it is safe to quit. | ||
| 3127 | Every loop that might run for a long time or might not exit | ||
| 3128 | ought to do QUIT at least once, at a safe place. | ||
| 3129 | Unless that is impossible, of course. | ||
| 3130 | But it is very desirable to avoid creating loops where QUIT is impossible. | ||
| 3131 | |||
| 3132 | Exception: if you set immediate_quit to true, | ||
| 3133 | then the handler that responds to the C-g does the quit itself. | ||
| 3134 | This is a good thing to do around a loop that has no side effects | ||
| 3135 | and (in particular) cannot call arbitrary Lisp code. | ||
| 3136 | 3127 | ||
| 3137 | If quit-flag is set to `kill-emacs' the SIGINT handler has received | 3128 | /* True if ought to quit now. */ |
| 3138 | a request to exit Emacs when it is safe to do. */ | ||
| 3139 | 3129 | ||
| 3140 | extern void process_pending_signals (void); | 3130 | #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) |
| 3141 | extern bool volatile pending_signals; | ||
| 3142 | 3131 | ||
| 3143 | extern void process_quit_flag (void); | 3132 | /* Heuristic on how many iterations of a tight loop can be safely done |
| 3144 | #define QUIT \ | 3133 | before it's time to do a quit. This must be a power of 2. It |
| 3145 | do { \ | 3134 | is nice but not necessary for it to equal USHRT_MAX + 1. */ |
| 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 | 3135 | ||
| 3136 | enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; | ||
| 3152 | 3137 | ||
| 3153 | /* True if ought to quit now. */ | 3138 | /* Process a quit rarely, based on a counter COUNT, for efficiency. |
| 3139 | "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 | ||
| 3140 | times, whichever is smaller (somewhat arbitrary, but often faster). */ | ||
| 3154 | 3141 | ||
| 3155 | #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) | 3142 | INLINE void |
| 3143 | rarely_quit (unsigned short int count) | ||
| 3144 | { | ||
| 3145 | if (! (count & (QUIT_COUNT_HEURISTIC - 1))) | ||
| 3146 | maybe_quit (); | ||
| 3147 | } | ||
| 3156 | 3148 | ||
| 3157 | extern Lisp_Object Vascii_downcase_table; | 3149 | extern Lisp_Object Vascii_downcase_table; |
| 3158 | extern Lisp_Object Vascii_canon_table; | 3150 | extern Lisp_Object Vascii_canon_table; |
| @@ -3375,7 +3367,7 @@ extern void sweep_weak_hash_tables (void); | |||
| 3375 | EMACS_UINT hash_string (char const *, ptrdiff_t); | 3367 | EMACS_UINT hash_string (char const *, ptrdiff_t); |
| 3376 | EMACS_UINT sxhash (Lisp_Object, int); | 3368 | EMACS_UINT sxhash (Lisp_Object, int); |
| 3377 | Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, | 3369 | Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, |
| 3378 | Lisp_Object, Lisp_Object); | 3370 | Lisp_Object, Lisp_Object, Lisp_Object); |
| 3379 | ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); | 3371 | 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, | 3372 | ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, |
| 3381 | EMACS_UINT); | 3373 | EMACS_UINT); |
| @@ -4233,8 +4225,10 @@ extern int emacs_open (const char *, int, int); | |||
| 4233 | extern int emacs_pipe (int[2]); | 4225 | extern int emacs_pipe (int[2]); |
| 4234 | extern int emacs_close (int); | 4226 | extern int emacs_close (int); |
| 4235 | extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); | 4227 | extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); |
| 4228 | extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t); | ||
| 4236 | extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); | 4229 | extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); |
| 4237 | extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); | 4230 | extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); |
| 4231 | extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t); | ||
| 4238 | extern void emacs_perror (char const *); | 4232 | extern void emacs_perror (char const *); |
| 4239 | 4233 | ||
| 4240 | extern void unlock_all_files (void); | 4234 | extern void unlock_all_files (void); |
| @@ -4360,9 +4354,6 @@ extern char my_edata[]; | |||
| 4360 | extern char my_endbss[]; | 4354 | extern char my_endbss[]; |
| 4361 | extern char *my_endbss_static; | 4355 | extern char *my_endbss_static; |
| 4362 | 4356 | ||
| 4363 | /* True means ^G can quit instantly. */ | ||
| 4364 | extern bool immediate_quit; | ||
| 4365 | |||
| 4366 | extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); | 4357 | extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); |
| 4367 | extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); | 4358 | extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); |
| 4368 | extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); | 4359 | extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); |
| @@ -4549,7 +4540,7 @@ enum | |||
| 4549 | use these only in macros like AUTO_CONS that declare a local | 4540 | use these only in macros like AUTO_CONS that declare a local |
| 4550 | variable whose lifetime will be clear to the programmer. */ | 4541 | variable whose lifetime will be clear to the programmer. */ |
| 4551 | #define STACK_CONS(a, b) \ | 4542 | #define STACK_CONS(a, b) \ |
| 4552 | make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons) | 4543 | make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons) |
| 4553 | #define AUTO_CONS_EXPR(a, b) \ | 4544 | #define AUTO_CONS_EXPR(a, b) \ |
| 4554 | (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) | 4545 | (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) |
| 4555 | 4546 | ||
| @@ -4595,8 +4586,7 @@ enum | |||
| 4595 | Lisp_Object name = \ | 4586 | Lisp_Object name = \ |
| 4596 | (USE_STACK_STRING \ | 4587 | (USE_STACK_STRING \ |
| 4597 | ? (make_lisp_ptr \ | 4588 | ? (make_lisp_ptr \ |
| 4598 | ((&(union Aligned_String) \ | 4589 | ((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \ |
| 4599 | {{len, -1, 0, (unsigned char *) (str)}}.s), \ | ||
| 4600 | Lisp_String)) \ | 4590 | Lisp_String)) \ |
| 4601 | : make_unibyte_string (str, len)) | 4591 | : make_unibyte_string (str, len)) |
| 4602 | 4592 | ||
diff --git a/src/lread.c b/src/lread.c index 284fd1aafbc..094aa628eec 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); |
| @@ -910,7 +910,7 @@ safe_to_load_version (int fd) | |||
| 910 | 910 | ||
| 911 | /* Read the first few bytes from the file, and look for a line | 911 | /* Read the first few bytes from the file, and look for a line |
| 912 | specifying the byte compiler version used. */ | 912 | specifying the byte compiler version used. */ |
| 913 | nbytes = emacs_read (fd, buf, sizeof buf); | 913 | nbytes = emacs_read_quit (fd, buf, sizeof buf); |
| 914 | if (nbytes > 0) | 914 | if (nbytes > 0) |
| 915 | { | 915 | { |
| 916 | /* Skip to the next newline, skipping over the initial `ELC' | 916 | /* Skip to the next newline, skipping over the initial `ELC' |
| @@ -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..434a3955b2c 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -3431,16 +3431,14 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, | |||
| 3431 | break; | 3431 | break; |
| 3432 | } | 3432 | } |
| 3433 | 3433 | ||
| 3434 | immediate_quit = 1; | 3434 | maybe_quit (); |
| 3435 | QUIT; | ||
| 3436 | 3435 | ||
| 3437 | ret = connect (s, sa, addrlen); | 3436 | ret = connect (s, sa, addrlen); |
| 3438 | xerrno = errno; | 3437 | xerrno = errno; |
| 3439 | 3438 | ||
| 3440 | if (ret == 0 || xerrno == EISCONN) | 3439 | if (ret == 0 || xerrno == EISCONN) |
| 3441 | { | 3440 | { |
| 3442 | /* The unwind-protect will be discarded afterwards. | 3441 | /* The unwind-protect will be discarded afterwards. */ |
| 3443 | Likewise for immediate_quit. */ | ||
| 3444 | break; | 3442 | break; |
| 3445 | } | 3443 | } |
| 3446 | 3444 | ||
| @@ -3459,7 +3457,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, | |||
| 3459 | retry_select: | 3457 | retry_select: |
| 3460 | FD_ZERO (&fdset); | 3458 | FD_ZERO (&fdset); |
| 3461 | FD_SET (s, &fdset); | 3459 | FD_SET (s, &fdset); |
| 3462 | QUIT; | 3460 | maybe_quit (); |
| 3463 | sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL); | 3461 | sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL); |
| 3464 | if (sc == -1) | 3462 | if (sc == -1) |
| 3465 | { | 3463 | { |
| @@ -3481,8 +3479,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, | |||
| 3481 | } | 3479 | } |
| 3482 | #endif /* !WINDOWSNT */ | 3480 | #endif /* !WINDOWSNT */ |
| 3483 | 3481 | ||
| 3484 | immediate_quit = 0; | ||
| 3485 | |||
| 3486 | /* Discard the unwind protect closing S. */ | 3482 | /* Discard the unwind protect closing S. */ |
| 3487 | specpdl_ptr = specpdl + count; | 3483 | specpdl_ptr = specpdl + count; |
| 3488 | emacs_close (s); | 3484 | emacs_close (s); |
| @@ -3539,8 +3535,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, | |||
| 3539 | #endif | 3535 | #endif |
| 3540 | } | 3536 | } |
| 3541 | 3537 | ||
| 3542 | immediate_quit = 0; | ||
| 3543 | |||
| 3544 | if (s < 0) | 3538 | if (s < 0) |
| 3545 | { | 3539 | { |
| 3546 | /* If non-blocking got this far - and failed - assume non-blocking is | 3540 | /* If non-blocking got this far - and failed - assume non-blocking is |
| @@ -4012,8 +4006,7 @@ usage: (make-network-process &rest ARGS) */) | |||
| 4012 | struct addrinfo *res, *lres; | 4006 | struct addrinfo *res, *lres; |
| 4013 | int ret; | 4007 | int ret; |
| 4014 | 4008 | ||
| 4015 | immediate_quit = 1; | 4009 | maybe_quit (); |
| 4016 | QUIT; | ||
| 4017 | 4010 | ||
| 4018 | struct addrinfo hints; | 4011 | struct addrinfo hints; |
| 4019 | memset (&hints, 0, sizeof hints); | 4012 | memset (&hints, 0, sizeof hints); |
| @@ -4034,7 +4027,6 @@ usage: (make-network-process &rest ARGS) */) | |||
| 4034 | #else | 4027 | #else |
| 4035 | error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); | 4028 | error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); |
| 4036 | #endif | 4029 | #endif |
| 4037 | immediate_quit = 0; | ||
| 4038 | 4030 | ||
| 4039 | for (lres = res; lres; lres = lres->ai_next) | 4031 | for (lres = res; lres; lres = lres->ai_next) |
| 4040 | addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); | 4032 | addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); |
| @@ -5020,7 +5012,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. | 5012 | since we want to return C-g as an input character. |
| 5021 | Otherwise, do pending quit if requested. */ | 5013 | Otherwise, do pending quit if requested. */ |
| 5022 | if (read_kbd >= 0) | 5014 | if (read_kbd >= 0) |
| 5023 | QUIT; | 5015 | maybe_quit (); |
| 5024 | else if (pending_signals) | 5016 | else if (pending_signals) |
| 5025 | process_pending_signals (); | 5017 | process_pending_signals (); |
| 5026 | 5018 | ||
| @@ -5748,7 +5740,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, | |||
| 5748 | { | 5740 | { |
| 5749 | /* Prevent input_pending from remaining set if we quit. */ | 5741 | /* Prevent input_pending from remaining set if we quit. */ |
| 5750 | clear_input_pending (); | 5742 | clear_input_pending (); |
| 5751 | QUIT; | 5743 | maybe_quit (); |
| 5752 | } | 5744 | } |
| 5753 | 5745 | ||
| 5754 | return got_some_output; | 5746 | return got_some_output; |
| @@ -7486,7 +7478,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. | 7478 | since we want to return C-g as an input character. |
| 7487 | Otherwise, do pending quit if requested. */ | 7479 | Otherwise, do pending quit if requested. */ |
| 7488 | if (read_kbd >= 0) | 7480 | if (read_kbd >= 0) |
| 7489 | QUIT; | 7481 | maybe_quit (); |
| 7490 | 7482 | ||
| 7491 | /* Exit now if the cell we're waiting for became non-nil. */ | 7483 | /* Exit now if the cell we're waiting for became non-nil. */ |
| 7492 | if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) | 7484 | 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..796f868d1c2 100644 --- a/src/regex.c +++ b/src/regex.c | |||
| @@ -1728,13 +1728,8 @@ typedef struct | |||
| 1728 | 1728 | ||
| 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 | #ifndef emacs |
| 1732 | # define IMMEDIATE_QUIT_CHECK \ | 1732 | static void maybe_quit (void) {} |
| 1733 | do { \ | ||
| 1734 | if (immediate_quit) QUIT; \ | ||
| 1735 | } while (0) | ||
| 1736 | #else | ||
| 1737 | # define IMMEDIATE_QUIT_CHECK ((void)0) | ||
| 1738 | #endif | 1733 | #endif |
| 1739 | 1734 | ||
| 1740 | /* Structure to manage work area for range table. */ | 1735 | /* Structure to manage work area for range table. */ |
| @@ -5823,7 +5818,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, | |||
| 5823 | /* Unconditionally jump (without popping any failure points). */ | 5818 | /* Unconditionally jump (without popping any failure points). */ |
| 5824 | case jump: | 5819 | case jump: |
| 5825 | unconditional_jump: | 5820 | unconditional_jump: |
| 5826 | IMMEDIATE_QUIT_CHECK; | 5821 | maybe_quit (); |
| 5827 | EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ | 5822 | EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ |
| 5828 | DEBUG_PRINT ("EXECUTING jump %d ", mcnt); | 5823 | DEBUG_PRINT ("EXECUTING jump %d ", mcnt); |
| 5829 | p += mcnt; /* Do the jump. */ | 5824 | p += mcnt; /* Do the jump. */ |
| @@ -6171,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, | |||
| 6171 | 6166 | ||
| 6172 | /* We goto here if a matching operation fails. */ | 6167 | /* We goto here if a matching operation fails. */ |
| 6173 | fail: | 6168 | fail: |
| 6174 | IMMEDIATE_QUIT_CHECK; | 6169 | maybe_quit (); |
| 6175 | if (!FAIL_STACK_EMPTY ()) | 6170 | if (!FAIL_STACK_EMPTY ()) |
| 6176 | { | 6171 | { |
| 6177 | re_char *str, *pat; | 6172 | re_char *str, *pat; |
diff --git a/src/search.c b/src/search.c index d3045108705..33cb02aa7af 100644 --- a/src/search.c +++ b/src/search.c | |||
| @@ -99,6 +99,25 @@ matcher_overflow (void) | |||
| 99 | error ("Stack overflow in regexp matcher"); | 99 | error ("Stack overflow in regexp matcher"); |
| 100 | } | 100 | } |
| 101 | 101 | ||
| 102 | static void | ||
| 103 | freeze_buffer_relocation (void) | ||
| 104 | { | ||
| 105 | #ifdef REL_ALLOC | ||
| 106 | /* Prevent ralloc.c from relocating the current buffer while | ||
| 107 | searching it. */ | ||
| 108 | r_alloc_inhibit_buffer_relocation (1); | ||
| 109 | record_unwind_protect_int (r_alloc_inhibit_buffer_relocation, 0); | ||
| 110 | #endif | ||
| 111 | } | ||
| 112 | |||
| 113 | static void | ||
| 114 | thaw_buffer_relocation (void) | ||
| 115 | { | ||
| 116 | #ifdef REL_ALLOC | ||
| 117 | unbind_to (SPECPDL_INDEX () - 1, Qnil); | ||
| 118 | #endif | ||
| 119 | } | ||
| 120 | |||
| 102 | /* Compile a regexp and signal a Lisp error if anything goes wrong. | 121 | /* Compile a regexp and signal a Lisp error if anything goes wrong. |
| 103 | PATTERN is the pattern to compile. | 122 | PATTERN is the pattern to compile. |
| 104 | CP is the place to put the result. | 123 | CP is the place to put the result. |
| @@ -276,8 +295,8 @@ looking_at_1 (Lisp_Object string, bool posix) | |||
| 276 | posix, | 295 | posix, |
| 277 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); | 296 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 278 | 297 | ||
| 279 | immediate_quit = 1; | 298 | /* Do a pending quit right away, to avoid paradoxical behavior */ |
| 280 | QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ | 299 | maybe_quit (); |
| 281 | 300 | ||
| 282 | /* Get pointers and sizes of the two strings | 301 | /* Get pointers and sizes of the two strings |
| 283 | that make up the visible portion of the buffer. */ | 302 | that make up the visible portion of the buffer. */ |
| @@ -300,20 +319,13 @@ looking_at_1 (Lisp_Object string, bool posix) | |||
| 300 | 319 | ||
| 301 | re_match_object = Qnil; | 320 | re_match_object = Qnil; |
| 302 | 321 | ||
| 303 | #ifdef REL_ALLOC | 322 | freeze_buffer_relocation (); |
| 304 | /* Prevent ralloc.c from relocating the current buffer while | ||
| 305 | searching it. */ | ||
| 306 | r_alloc_inhibit_buffer_relocation (1); | ||
| 307 | #endif | ||
| 308 | i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, | 323 | i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, |
| 309 | PT_BYTE - BEGV_BYTE, | 324 | PT_BYTE - BEGV_BYTE, |
| 310 | (NILP (Vinhibit_changing_match_data) | 325 | (NILP (Vinhibit_changing_match_data) |
| 311 | ? &search_regs : NULL), | 326 | ? &search_regs : NULL), |
| 312 | ZV_BYTE - BEGV_BYTE); | 327 | ZV_BYTE - BEGV_BYTE); |
| 313 | immediate_quit = 0; | 328 | thaw_buffer_relocation (); |
| 314 | #ifdef REL_ALLOC | ||
| 315 | r_alloc_inhibit_buffer_relocation (0); | ||
| 316 | #endif | ||
| 317 | 329 | ||
| 318 | if (i == -2) | 330 | if (i == -2) |
| 319 | matcher_overflow (); | 331 | matcher_overflow (); |
| @@ -398,7 +410,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, | |||
| 398 | ? BVAR (current_buffer, case_canon_table) : Qnil), | 410 | ? BVAR (current_buffer, case_canon_table) : Qnil), |
| 399 | posix, | 411 | posix, |
| 400 | STRING_MULTIBYTE (string)); | 412 | STRING_MULTIBYTE (string)); |
| 401 | immediate_quit = 1; | ||
| 402 | re_match_object = string; | 413 | re_match_object = string; |
| 403 | 414 | ||
| 404 | val = re_search (bufp, SSDATA (string), | 415 | val = re_search (bufp, SSDATA (string), |
| @@ -406,7 +417,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, | |||
| 406 | SBYTES (string) - pos_byte, | 417 | SBYTES (string) - pos_byte, |
| 407 | (NILP (Vinhibit_changing_match_data) | 418 | (NILP (Vinhibit_changing_match_data) |
| 408 | ? &search_regs : NULL)); | 419 | ? &search_regs : NULL)); |
| 409 | immediate_quit = 0; | ||
| 410 | 420 | ||
| 411 | /* Set last_thing_searched only when match data is changed. */ | 421 | /* Set last_thing_searched only when match data is changed. */ |
| 412 | if (NILP (Vinhibit_changing_match_data)) | 422 | if (NILP (Vinhibit_changing_match_data)) |
| @@ -470,13 +480,11 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, | |||
| 470 | 480 | ||
| 471 | bufp = compile_pattern (regexp, 0, table, | 481 | bufp = compile_pattern (regexp, 0, table, |
| 472 | 0, STRING_MULTIBYTE (string)); | 482 | 0, STRING_MULTIBYTE (string)); |
| 473 | immediate_quit = 1; | ||
| 474 | re_match_object = string; | 483 | re_match_object = string; |
| 475 | 484 | ||
| 476 | val = re_search (bufp, SSDATA (string), | 485 | val = re_search (bufp, SSDATA (string), |
| 477 | SBYTES (string), 0, | 486 | SBYTES (string), 0, |
| 478 | SBYTES (string), 0); | 487 | SBYTES (string), 0); |
| 479 | immediate_quit = 0; | ||
| 480 | return val; | 488 | return val; |
| 481 | } | 489 | } |
| 482 | 490 | ||
| @@ -497,9 +505,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, | |||
| 497 | bufp = compile_pattern (regexp, 0, | 505 | bufp = compile_pattern (regexp, 0, |
| 498 | Vascii_canon_table, 0, | 506 | Vascii_canon_table, 0, |
| 499 | 0); | 507 | 0); |
| 500 | immediate_quit = 1; | ||
| 501 | val = re_search (bufp, string, len, 0, len, 0); | 508 | val = re_search (bufp, string, len, 0, len, 0); |
| 502 | immediate_quit = 0; | ||
| 503 | return val; | 509 | return val; |
| 504 | } | 510 | } |
| 505 | 511 | ||
| @@ -560,18 +566,10 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 560 | } | 566 | } |
| 561 | 567 | ||
| 562 | buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); | 568 | buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); |
| 563 | immediate_quit = 1; | 569 | freeze_buffer_relocation (); |
| 564 | #ifdef REL_ALLOC | ||
| 565 | /* Prevent ralloc.c from relocating the current buffer while | ||
| 566 | searching it. */ | ||
| 567 | r_alloc_inhibit_buffer_relocation (1); | ||
| 568 | #endif | ||
| 569 | len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, | 570 | len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, |
| 570 | pos_byte, NULL, limit_byte); | 571 | pos_byte, NULL, limit_byte); |
| 571 | #ifdef REL_ALLOC | 572 | thaw_buffer_relocation (); |
| 572 | r_alloc_inhibit_buffer_relocation (0); | ||
| 573 | #endif | ||
| 574 | immediate_quit = 0; | ||
| 575 | 573 | ||
| 576 | return len; | 574 | return len; |
| 577 | } | 575 | } |
| @@ -648,7 +646,7 @@ newline_cache_on_off (struct buffer *buf) | |||
| 648 | If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding | 646 | If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding |
| 649 | to the returned character position. | 647 | to the returned character position. |
| 650 | 648 | ||
| 651 | If ALLOW_QUIT, set immediate_quit. That's good to do | 649 | If ALLOW_QUIT, check for quitting. That's good to do |
| 652 | except when inside redisplay. */ | 650 | except when inside redisplay. */ |
| 653 | 651 | ||
| 654 | ptrdiff_t | 652 | ptrdiff_t |
| @@ -684,8 +682,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 684 | if (shortage != 0) | 682 | if (shortage != 0) |
| 685 | *shortage = 0; | 683 | *shortage = 0; |
| 686 | 684 | ||
| 687 | immediate_quit = allow_quit; | ||
| 688 | |||
| 689 | if (count > 0) | 685 | if (count > 0) |
| 690 | while (start != end) | 686 | while (start != end) |
| 691 | { | 687 | { |
| @@ -703,7 +699,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 703 | ptrdiff_t next_change; | 699 | ptrdiff_t next_change; |
| 704 | int result = 1; | 700 | int result = 1; |
| 705 | 701 | ||
| 706 | immediate_quit = 0; | ||
| 707 | while (start < end && result) | 702 | while (start < end && result) |
| 708 | { | 703 | { |
| 709 | ptrdiff_t lim1; | 704 | ptrdiff_t lim1; |
| @@ -756,7 +751,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 756 | start_byte = end_byte; | 751 | start_byte = end_byte; |
| 757 | break; | 752 | break; |
| 758 | } | 753 | } |
| 759 | immediate_quit = allow_quit; | ||
| 760 | 754 | ||
| 761 | /* START should never be after END. */ | 755 | /* START should never be after END. */ |
| 762 | if (start_byte > ceiling_byte) | 756 | if (start_byte > ceiling_byte) |
| @@ -809,11 +803,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 809 | 803 | ||
| 810 | if (--count == 0) | 804 | if (--count == 0) |
| 811 | { | 805 | { |
| 812 | immediate_quit = 0; | ||
| 813 | if (bytepos) | 806 | if (bytepos) |
| 814 | *bytepos = lim_byte + next; | 807 | *bytepos = lim_byte + next; |
| 815 | return BYTE_TO_CHAR (lim_byte + next); | 808 | return BYTE_TO_CHAR (lim_byte + next); |
| 816 | } | 809 | } |
| 810 | if (allow_quit) | ||
| 811 | maybe_quit (); | ||
| 817 | } | 812 | } |
| 818 | 813 | ||
| 819 | start_byte = lim_byte; | 814 | start_byte = lim_byte; |
| @@ -832,7 +827,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 832 | ptrdiff_t next_change; | 827 | ptrdiff_t next_change; |
| 833 | int result = 1; | 828 | int result = 1; |
| 834 | 829 | ||
| 835 | immediate_quit = 0; | ||
| 836 | while (start > end && result) | 830 | while (start > end && result) |
| 837 | { | 831 | { |
| 838 | ptrdiff_t lim1; | 832 | ptrdiff_t lim1; |
| @@ -869,7 +863,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 869 | start_byte = end_byte; | 863 | start_byte = end_byte; |
| 870 | break; | 864 | break; |
| 871 | } | 865 | } |
| 872 | immediate_quit = allow_quit; | ||
| 873 | 866 | ||
| 874 | /* Start should never be at or before end. */ | 867 | /* Start should never be at or before end. */ |
| 875 | if (start_byte <= ceiling_byte) | 868 | if (start_byte <= ceiling_byte) |
| @@ -917,11 +910,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 917 | 910 | ||
| 918 | if (++count >= 0) | 911 | if (++count >= 0) |
| 919 | { | 912 | { |
| 920 | immediate_quit = 0; | ||
| 921 | if (bytepos) | 913 | if (bytepos) |
| 922 | *bytepos = ceiling_byte + prev + 1; | 914 | *bytepos = ceiling_byte + prev + 1; |
| 923 | return BYTE_TO_CHAR (ceiling_byte + prev + 1); | 915 | return BYTE_TO_CHAR (ceiling_byte + prev + 1); |
| 924 | } | 916 | } |
| 917 | if (allow_quit) | ||
| 918 | maybe_quit (); | ||
| 925 | } | 919 | } |
| 926 | 920 | ||
| 927 | start_byte = ceiling_byte; | 921 | start_byte = ceiling_byte; |
| @@ -929,7 +923,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 929 | } | 923 | } |
| 930 | } | 924 | } |
| 931 | 925 | ||
| 932 | immediate_quit = 0; | ||
| 933 | if (shortage) | 926 | if (shortage) |
| 934 | *shortage = count * direction; | 927 | *shortage = count * direction; |
| 935 | if (bytepos) | 928 | if (bytepos) |
| @@ -953,7 +946,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 953 | the number of line boundaries left unfound, and position at | 946 | the number of line boundaries left unfound, and position at |
| 954 | the limit we bumped up against. | 947 | the limit we bumped up against. |
| 955 | 948 | ||
| 956 | If ALLOW_QUIT, set immediate_quit. That's good to do | 949 | If ALLOW_QUIT, check for quitting. That's good to do |
| 957 | except in special cases. */ | 950 | except in special cases. */ |
| 958 | 951 | ||
| 959 | ptrdiff_t | 952 | ptrdiff_t |
| @@ -1196,10 +1189,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1196 | trt, posix, | 1189 | trt, posix, |
| 1197 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); | 1190 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 1198 | 1191 | ||
| 1199 | immediate_quit = 1; /* Quit immediately if user types ^G, | 1192 | maybe_quit (); /* Do a pending quit right away, |
| 1200 | because letting this function finish | ||
| 1201 | can take too long. */ | ||
| 1202 | QUIT; /* Do a pending quit right away, | ||
| 1203 | to avoid paradoxical behavior */ | 1193 | to avoid paradoxical behavior */ |
| 1204 | /* Get pointers and sizes of the two strings | 1194 | /* Get pointers and sizes of the two strings |
| 1205 | that make up the visible portion of the buffer. */ | 1195 | that make up the visible portion of the buffer. */ |
| @@ -1221,11 +1211,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1221 | } | 1211 | } |
| 1222 | re_match_object = Qnil; | 1212 | re_match_object = Qnil; |
| 1223 | 1213 | ||
| 1224 | #ifdef REL_ALLOC | 1214 | freeze_buffer_relocation (); |
| 1225 | /* Prevent ralloc.c from relocating the current buffer while | ||
| 1226 | searching it. */ | ||
| 1227 | r_alloc_inhibit_buffer_relocation (1); | ||
| 1228 | #endif | ||
| 1229 | 1215 | ||
| 1230 | while (n < 0) | 1216 | while (n < 0) |
| 1231 | { | 1217 | { |
| @@ -1267,13 +1253,11 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1267 | } | 1253 | } |
| 1268 | else | 1254 | else |
| 1269 | { | 1255 | { |
| 1270 | immediate_quit = 0; | 1256 | thaw_buffer_relocation (); |
| 1271 | #ifdef REL_ALLOC | ||
| 1272 | r_alloc_inhibit_buffer_relocation (0); | ||
| 1273 | #endif | ||
| 1274 | return (n); | 1257 | return (n); |
| 1275 | } | 1258 | } |
| 1276 | n++; | 1259 | n++; |
| 1260 | maybe_quit (); | ||
| 1277 | } | 1261 | } |
| 1278 | while (n > 0) | 1262 | while (n > 0) |
| 1279 | { | 1263 | { |
| @@ -1312,18 +1296,13 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1312 | } | 1296 | } |
| 1313 | else | 1297 | else |
| 1314 | { | 1298 | { |
| 1315 | immediate_quit = 0; | 1299 | thaw_buffer_relocation (); |
| 1316 | #ifdef REL_ALLOC | ||
| 1317 | r_alloc_inhibit_buffer_relocation (0); | ||
| 1318 | #endif | ||
| 1319 | return (0 - n); | 1300 | return (0 - n); |
| 1320 | } | 1301 | } |
| 1321 | n--; | 1302 | n--; |
| 1303 | maybe_quit (); | ||
| 1322 | } | 1304 | } |
| 1323 | immediate_quit = 0; | 1305 | thaw_buffer_relocation (); |
| 1324 | #ifdef REL_ALLOC | ||
| 1325 | r_alloc_inhibit_buffer_relocation (0); | ||
| 1326 | #endif | ||
| 1327 | return (pos); | 1306 | return (pos); |
| 1328 | } | 1307 | } |
| 1329 | else /* non-RE case */ | 1308 | else /* non-RE case */ |
| @@ -1927,7 +1906,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat, | |||
| 1927 | < 0) | 1906 | < 0) |
| 1928 | return (n * (0 - direction)); | 1907 | return (n * (0 - direction)); |
| 1929 | /* First we do the part we can by pointers (maybe nothing) */ | 1908 | /* First we do the part we can by pointers (maybe nothing) */ |
| 1930 | QUIT; | 1909 | maybe_quit (); |
| 1931 | pat = base_pat; | 1910 | pat = base_pat; |
| 1932 | limit = pos_byte - dirlen + direction; | 1911 | limit = pos_byte - dirlen + direction; |
| 1933 | if (direction > 0) | 1912 | if (direction > 0) |
| @@ -3230,8 +3209,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 3230 | if (shortage != 0) | 3209 | if (shortage != 0) |
| 3231 | *shortage = 0; | 3210 | *shortage = 0; |
| 3232 | 3211 | ||
| 3233 | immediate_quit = allow_quit; | ||
| 3234 | |||
| 3235 | if (count > 0) | 3212 | if (count > 0) |
| 3236 | while (start != end) | 3213 | while (start != end) |
| 3237 | { | 3214 | { |
| @@ -3274,11 +3251,12 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 3274 | 3251 | ||
| 3275 | if (--count == 0) | 3252 | if (--count == 0) |
| 3276 | { | 3253 | { |
| 3277 | immediate_quit = 0; | ||
| 3278 | if (bytepos) | 3254 | if (bytepos) |
| 3279 | *bytepos = lim_byte + next; | 3255 | *bytepos = lim_byte + next; |
| 3280 | return BYTE_TO_CHAR (lim_byte + next); | 3256 | return BYTE_TO_CHAR (lim_byte + next); |
| 3281 | } | 3257 | } |
| 3258 | if (allow_quit) | ||
| 3259 | maybe_quit (); | ||
| 3282 | } | 3260 | } |
| 3283 | 3261 | ||
| 3284 | start_byte = lim_byte; | 3262 | start_byte = lim_byte; |
| @@ -3286,7 +3264,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 3286 | } | 3264 | } |
| 3287 | } | 3265 | } |
| 3288 | 3266 | ||
| 3289 | immediate_quit = 0; | ||
| 3290 | if (shortage) | 3267 | if (shortage) |
| 3291 | *shortage = count; | 3268 | *shortage = count; |
| 3292 | if (bytepos) | 3269 | if (bytepos) |
diff --git a/src/syntax.c b/src/syntax.c index 5bc0efa8a41..34a9e632b3c 100644 --- a/src/syntax.c +++ b/src/syntax.c | |||
| @@ -1672,29 +1672,23 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, | |||
| 1672 | COUNT negative means scan backward and stop at word beginning. */ | 1672 | COUNT negative means scan backward and stop at word beginning. */ |
| 1673 | 1673 | ||
| 1674 | ptrdiff_t | 1674 | ptrdiff_t |
| 1675 | scan_words (register ptrdiff_t from, register EMACS_INT count) | 1675 | scan_words (ptrdiff_t from, EMACS_INT count) |
| 1676 | { | 1676 | { |
| 1677 | register ptrdiff_t beg = BEGV; | 1677 | ptrdiff_t beg = BEGV; |
| 1678 | register ptrdiff_t end = ZV; | 1678 | ptrdiff_t end = ZV; |
| 1679 | register ptrdiff_t from_byte = CHAR_TO_BYTE (from); | 1679 | ptrdiff_t from_byte = CHAR_TO_BYTE (from); |
| 1680 | register enum syntaxcode code; | 1680 | enum syntaxcode code; |
| 1681 | int ch0, ch1; | 1681 | int ch0, ch1; |
| 1682 | Lisp_Object func, pos; | 1682 | Lisp_Object func, pos; |
| 1683 | 1683 | ||
| 1684 | immediate_quit = 1; | ||
| 1685 | QUIT; | ||
| 1686 | |||
| 1687 | SETUP_SYNTAX_TABLE (from, count); | 1684 | SETUP_SYNTAX_TABLE (from, count); |
| 1688 | 1685 | ||
| 1689 | while (count > 0) | 1686 | while (count > 0) |
| 1690 | { | 1687 | { |
| 1691 | while (1) | 1688 | while (true) |
| 1692 | { | 1689 | { |
| 1693 | if (from == end) | 1690 | if (from == end) |
| 1694 | { | 1691 | return 0; |
| 1695 | immediate_quit = 0; | ||
| 1696 | return 0; | ||
| 1697 | } | ||
| 1698 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 1692 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| 1699 | ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 1693 | ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 1700 | code = SYNTAX (ch0); | 1694 | code = SYNTAX (ch0); |
| @@ -1704,6 +1698,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1704 | break; | 1698 | break; |
| 1705 | if (code == Sword) | 1699 | if (code == Sword) |
| 1706 | break; | 1700 | break; |
| 1701 | rarely_quit (from); | ||
| 1707 | } | 1702 | } |
| 1708 | /* Now CH0 is a character which begins a word and FROM is the | 1703 | /* Now CH0 is a character which begins a word and FROM is the |
| 1709 | position of the next character. */ | 1704 | position of the next character. */ |
| @@ -1732,19 +1727,17 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1732 | break; | 1727 | break; |
| 1733 | INC_BOTH (from, from_byte); | 1728 | INC_BOTH (from, from_byte); |
| 1734 | ch0 = ch1; | 1729 | ch0 = ch1; |
| 1730 | rarely_quit (from); | ||
| 1735 | } | 1731 | } |
| 1736 | } | 1732 | } |
| 1737 | count--; | 1733 | count--; |
| 1738 | } | 1734 | } |
| 1739 | while (count < 0) | 1735 | while (count < 0) |
| 1740 | { | 1736 | { |
| 1741 | while (1) | 1737 | while (true) |
| 1742 | { | 1738 | { |
| 1743 | if (from == beg) | 1739 | if (from == beg) |
| 1744 | { | 1740 | return 0; |
| 1745 | immediate_quit = 0; | ||
| 1746 | return 0; | ||
| 1747 | } | ||
| 1748 | DEC_BOTH (from, from_byte); | 1741 | DEC_BOTH (from, from_byte); |
| 1749 | UPDATE_SYNTAX_TABLE_BACKWARD (from); | 1742 | UPDATE_SYNTAX_TABLE_BACKWARD (from); |
| 1750 | ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 1743 | ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| @@ -1754,6 +1747,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1754 | break; | 1747 | break; |
| 1755 | if (code == Sword) | 1748 | if (code == Sword) |
| 1756 | break; | 1749 | break; |
| 1750 | rarely_quit (from); | ||
| 1757 | } | 1751 | } |
| 1758 | /* Now CH1 is a character which ends a word and FROM is the | 1752 | /* Now CH1 is a character which ends a word and FROM is the |
| 1759 | position of it. */ | 1753 | position of it. */ |
| @@ -1786,13 +1780,12 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1786 | break; | 1780 | break; |
| 1787 | } | 1781 | } |
| 1788 | ch1 = ch0; | 1782 | ch1 = ch0; |
| 1783 | rarely_quit (from); | ||
| 1789 | } | 1784 | } |
| 1790 | } | 1785 | } |
| 1791 | count++; | 1786 | count++; |
| 1792 | } | 1787 | } |
| 1793 | 1788 | ||
| 1794 | immediate_quit = 0; | ||
| 1795 | |||
| 1796 | return from; | 1789 | return from; |
| 1797 | } | 1790 | } |
| 1798 | 1791 | ||
| @@ -2176,7 +2169,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2176 | stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; | 2169 | stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; |
| 2177 | } | 2170 | } |
| 2178 | 2171 | ||
| 2179 | immediate_quit = 1; | ||
| 2180 | /* This code may look up syntax tables using functions that rely on the | 2172 | /* This code may look up syntax tables using functions that rely on the |
| 2181 | gl_state object. To make sure this object is not out of date, | 2173 | gl_state object. To make sure this object is not out of date, |
| 2182 | let's initialize it manually. | 2174 | let's initialize it manually. |
| @@ -2226,9 +2218,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2226 | } | 2218 | } |
| 2227 | fwd_ok: | 2219 | fwd_ok: |
| 2228 | p += nbytes, pos++, pos_byte += nbytes; | 2220 | p += nbytes, pos++, pos_byte += nbytes; |
| 2221 | rarely_quit (pos); | ||
| 2229 | } | 2222 | } |
| 2230 | else | 2223 | else |
| 2231 | while (1) | 2224 | while (true) |
| 2232 | { | 2225 | { |
| 2233 | if (p >= stop) | 2226 | if (p >= stop) |
| 2234 | { | 2227 | { |
| @@ -2250,15 +2243,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2250 | break; | 2243 | break; |
| 2251 | fwd_unibyte_ok: | 2244 | fwd_unibyte_ok: |
| 2252 | p++, pos++, pos_byte++; | 2245 | p++, pos++, pos_byte++; |
| 2246 | rarely_quit (pos); | ||
| 2253 | } | 2247 | } |
| 2254 | } | 2248 | } |
| 2255 | else | 2249 | else |
| 2256 | { | 2250 | { |
| 2257 | if (multibyte) | 2251 | if (multibyte) |
| 2258 | while (1) | 2252 | while (true) |
| 2259 | { | 2253 | { |
| 2260 | unsigned char *prev_p; | ||
| 2261 | |||
| 2262 | if (p <= stop) | 2254 | if (p <= stop) |
| 2263 | { | 2255 | { |
| 2264 | if (p <= endp) | 2256 | if (p <= endp) |
| @@ -2266,8 +2258,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2266 | p = GPT_ADDR; | 2258 | p = GPT_ADDR; |
| 2267 | stop = endp; | 2259 | stop = endp; |
| 2268 | } | 2260 | } |
| 2269 | prev_p = p; | 2261 | unsigned char *prev_p = p; |
| 2270 | while (--p >= stop && ! CHAR_HEAD_P (*p)); | 2262 | do |
| 2263 | p--; | ||
| 2264 | while (stop <= p && ! CHAR_HEAD_P (*p)); | ||
| 2265 | |||
| 2271 | c = STRING_CHAR (p); | 2266 | c = STRING_CHAR (p); |
| 2272 | 2267 | ||
| 2273 | if (! NILP (iso_classes) && in_classes (c, iso_classes)) | 2268 | if (! NILP (iso_classes) && in_classes (c, iso_classes)) |
| @@ -2291,9 +2286,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2291 | } | 2286 | } |
| 2292 | back_ok: | 2287 | back_ok: |
| 2293 | pos--, pos_byte -= prev_p - p; | 2288 | pos--, pos_byte -= prev_p - p; |
| 2289 | rarely_quit (pos); | ||
| 2294 | } | 2290 | } |
| 2295 | else | 2291 | else |
| 2296 | while (1) | 2292 | while (true) |
| 2297 | { | 2293 | { |
| 2298 | if (p <= stop) | 2294 | if (p <= stop) |
| 2299 | { | 2295 | { |
| @@ -2315,11 +2311,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2315 | break; | 2311 | break; |
| 2316 | back_unibyte_ok: | 2312 | back_unibyte_ok: |
| 2317 | p--, pos--, pos_byte--; | 2313 | p--, pos--, pos_byte--; |
| 2314 | rarely_quit (pos); | ||
| 2318 | } | 2315 | } |
| 2319 | } | 2316 | } |
| 2320 | 2317 | ||
| 2321 | SET_PT_BOTH (pos, pos_byte); | 2318 | SET_PT_BOTH (pos, pos_byte); |
| 2322 | immediate_quit = 0; | ||
| 2323 | 2319 | ||
| 2324 | SAFE_FREE (); | 2320 | SAFE_FREE (); |
| 2325 | return make_number (PT - start_point); | 2321 | return make_number (PT - start_point); |
| @@ -2393,7 +2389,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2393 | ptrdiff_t pos_byte = PT_BYTE; | 2389 | ptrdiff_t pos_byte = PT_BYTE; |
| 2394 | unsigned char *p, *endp, *stop; | 2390 | unsigned char *p, *endp, *stop; |
| 2395 | 2391 | ||
| 2396 | immediate_quit = 1; | ||
| 2397 | SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); | 2392 | SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); |
| 2398 | 2393 | ||
| 2399 | if (forwardp) | 2394 | if (forwardp) |
| @@ -2422,6 +2417,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2422 | if (! fastmap[SYNTAX (c)]) | 2417 | if (! fastmap[SYNTAX (c)]) |
| 2423 | goto done; | 2418 | goto done; |
| 2424 | p += nbytes, pos++, pos_byte += nbytes; | 2419 | p += nbytes, pos++, pos_byte += nbytes; |
| 2420 | rarely_quit (pos); | ||
| 2425 | } | 2421 | } |
| 2426 | while (!parse_sexp_lookup_properties | 2422 | while (!parse_sexp_lookup_properties |
| 2427 | || pos < gl_state.e_property); | 2423 | || pos < gl_state.e_property); |
| @@ -2438,10 +2434,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2438 | 2434 | ||
| 2439 | if (multibyte) | 2435 | if (multibyte) |
| 2440 | { | 2436 | { |
| 2441 | while (1) | 2437 | while (true) |
| 2442 | { | 2438 | { |
| 2443 | unsigned char *prev_p; | ||
| 2444 | |||
| 2445 | if (p <= stop) | 2439 | if (p <= stop) |
| 2446 | { | 2440 | { |
| 2447 | if (p <= endp) | 2441 | if (p <= endp) |
| @@ -2450,17 +2444,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2450 | stop = endp; | 2444 | stop = endp; |
| 2451 | } | 2445 | } |
| 2452 | UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); | 2446 | UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); |
| 2453 | prev_p = p; | 2447 | |
| 2454 | while (--p >= stop && ! CHAR_HEAD_P (*p)); | 2448 | unsigned char *prev_p = p; |
| 2449 | do | ||
| 2450 | p--; | ||
| 2451 | while (stop <= p && ! CHAR_HEAD_P (*p)); | ||
| 2452 | |||
| 2455 | c = STRING_CHAR (p); | 2453 | c = STRING_CHAR (p); |
| 2456 | if (! fastmap[SYNTAX (c)]) | 2454 | if (! fastmap[SYNTAX (c)]) |
| 2457 | break; | 2455 | break; |
| 2458 | pos--, pos_byte -= prev_p - p; | 2456 | pos--, pos_byte -= prev_p - p; |
| 2457 | rarely_quit (pos); | ||
| 2459 | } | 2458 | } |
| 2460 | } | 2459 | } |
| 2461 | else | 2460 | else |
| 2462 | { | 2461 | { |
| 2463 | while (1) | 2462 | while (true) |
| 2464 | { | 2463 | { |
| 2465 | if (p <= stop) | 2464 | if (p <= stop) |
| 2466 | { | 2465 | { |
| @@ -2473,13 +2472,13 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2473 | if (! fastmap[SYNTAX (p[-1])]) | 2472 | if (! fastmap[SYNTAX (p[-1])]) |
| 2474 | break; | 2473 | break; |
| 2475 | p--, pos--, pos_byte--; | 2474 | p--, pos--, pos_byte--; |
| 2475 | rarely_quit (pos); | ||
| 2476 | } | 2476 | } |
| 2477 | } | 2477 | } |
| 2478 | } | 2478 | } |
| 2479 | 2479 | ||
| 2480 | done: | 2480 | done: |
| 2481 | SET_PT_BOTH (pos, pos_byte); | 2481 | SET_PT_BOTH (pos, pos_byte); |
| 2482 | immediate_quit = 0; | ||
| 2483 | 2482 | ||
| 2484 | return make_number (PT - start_point); | 2483 | return make_number (PT - start_point); |
| 2485 | } | 2484 | } |
| @@ -2541,9 +2540,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, | |||
| 2541 | ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, | 2540 | ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, |
| 2542 | EMACS_INT *incomment_ptr, int *last_syntax_ptr) | 2541 | EMACS_INT *incomment_ptr, int *last_syntax_ptr) |
| 2543 | { | 2542 | { |
| 2544 | register int c, c1; | 2543 | unsigned short int quit_count = 0; |
| 2545 | register enum syntaxcode code; | 2544 | int c, c1; |
| 2546 | register int syntax, other_syntax; | 2545 | enum syntaxcode code; |
| 2546 | int syntax, other_syntax; | ||
| 2547 | 2547 | ||
| 2548 | if (nesting <= 0) nesting = -1; | 2548 | if (nesting <= 0) nesting = -1; |
| 2549 | 2549 | ||
| @@ -2635,6 +2635,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, | |||
| 2635 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 2635 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| 2636 | nesting++; | 2636 | nesting++; |
| 2637 | } | 2637 | } |
| 2638 | |||
| 2639 | rarely_quit (++quit_count); | ||
| 2638 | } | 2640 | } |
| 2639 | *charpos_ptr = from; | 2641 | *charpos_ptr = from; |
| 2640 | *bytepos_ptr = from_byte; | 2642 | *bytepos_ptr = from_byte; |
| @@ -2662,14 +2664,12 @@ between them, return t; otherwise return nil. */) | |||
| 2662 | ptrdiff_t out_charpos, out_bytepos; | 2664 | ptrdiff_t out_charpos, out_bytepos; |
| 2663 | EMACS_INT dummy; | 2665 | EMACS_INT dummy; |
| 2664 | int dummy2; | 2666 | int dummy2; |
| 2667 | unsigned short int quit_count = 0; | ||
| 2665 | 2668 | ||
| 2666 | CHECK_NUMBER (count); | 2669 | CHECK_NUMBER (count); |
| 2667 | count1 = XINT (count); | 2670 | count1 = XINT (count); |
| 2668 | stop = count1 > 0 ? ZV : BEGV; | 2671 | stop = count1 > 0 ? ZV : BEGV; |
| 2669 | 2672 | ||
| 2670 | immediate_quit = 1; | ||
| 2671 | QUIT; | ||
| 2672 | |||
| 2673 | from = PT; | 2673 | from = PT; |
| 2674 | from_byte = PT_BYTE; | 2674 | from_byte = PT_BYTE; |
| 2675 | 2675 | ||
| @@ -2684,7 +2684,6 @@ between them, return t; otherwise return nil. */) | |||
| 2684 | if (from == stop) | 2684 | if (from == stop) |
| 2685 | { | 2685 | { |
| 2686 | SET_PT_BOTH (from, from_byte); | 2686 | SET_PT_BOTH (from, from_byte); |
| 2687 | immediate_quit = 0; | ||
| 2688 | return Qnil; | 2687 | return Qnil; |
| 2689 | } | 2688 | } |
| 2690 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 2689 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| @@ -2711,6 +2710,7 @@ between them, return t; otherwise return nil. */) | |||
| 2711 | INC_BOTH (from, from_byte); | 2710 | INC_BOTH (from, from_byte); |
| 2712 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 2711 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| 2713 | } | 2712 | } |
| 2713 | rarely_quit (++quit_count); | ||
| 2714 | } | 2714 | } |
| 2715 | while (code == Swhitespace || (code == Sendcomment && c == '\n')); | 2715 | while (code == Swhitespace || (code == Sendcomment && c == '\n')); |
| 2716 | 2716 | ||
| @@ -2718,7 +2718,6 @@ between them, return t; otherwise return nil. */) | |||
| 2718 | comstyle = ST_COMMENT_STYLE; | 2718 | comstyle = ST_COMMENT_STYLE; |
| 2719 | else if (code != Scomment) | 2719 | else if (code != Scomment) |
| 2720 | { | 2720 | { |
| 2721 | immediate_quit = 0; | ||
| 2722 | DEC_BOTH (from, from_byte); | 2721 | DEC_BOTH (from, from_byte); |
| 2723 | SET_PT_BOTH (from, from_byte); | 2722 | SET_PT_BOTH (from, from_byte); |
| 2724 | return Qnil; | 2723 | return Qnil; |
| @@ -2729,7 +2728,6 @@ between them, return t; otherwise return nil. */) | |||
| 2729 | from = out_charpos; from_byte = out_bytepos; | 2728 | from = out_charpos; from_byte = out_bytepos; |
| 2730 | if (!found) | 2729 | if (!found) |
| 2731 | { | 2730 | { |
| 2732 | immediate_quit = 0; | ||
| 2733 | SET_PT_BOTH (from, from_byte); | 2731 | SET_PT_BOTH (from, from_byte); |
| 2734 | return Qnil; | 2732 | return Qnil; |
| 2735 | } | 2733 | } |
| @@ -2741,23 +2739,19 @@ between them, return t; otherwise return nil. */) | |||
| 2741 | 2739 | ||
| 2742 | while (count1 < 0) | 2740 | while (count1 < 0) |
| 2743 | { | 2741 | { |
| 2744 | while (1) | 2742 | while (true) |
| 2745 | { | 2743 | { |
| 2746 | bool quoted; | ||
| 2747 | int syntax; | ||
| 2748 | |||
| 2749 | if (from <= stop) | 2744 | if (from <= stop) |
| 2750 | { | 2745 | { |
| 2751 | SET_PT_BOTH (BEGV, BEGV_BYTE); | 2746 | SET_PT_BOTH (BEGV, BEGV_BYTE); |
| 2752 | immediate_quit = 0; | ||
| 2753 | return Qnil; | 2747 | return Qnil; |
| 2754 | } | 2748 | } |
| 2755 | 2749 | ||
| 2756 | DEC_BOTH (from, from_byte); | 2750 | DEC_BOTH (from, from_byte); |
| 2757 | /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ | 2751 | /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ |
| 2758 | quoted = char_quoted (from, from_byte); | 2752 | bool quoted = char_quoted (from, from_byte); |
| 2759 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 2753 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 2760 | syntax = SYNTAX_WITH_FLAGS (c); | 2754 | int syntax = SYNTAX_WITH_FLAGS (c); |
| 2761 | code = SYNTAX (c); | 2755 | code = SYNTAX (c); |
| 2762 | comstyle = 0; | 2756 | comstyle = 0; |
| 2763 | comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); | 2757 | comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); |
| @@ -2800,6 +2794,7 @@ between them, return t; otherwise return nil. */) | |||
| 2800 | } | 2794 | } |
| 2801 | else if (from == stop) | 2795 | else if (from == stop) |
| 2802 | break; | 2796 | break; |
| 2797 | rarely_quit (++quit_count); | ||
| 2803 | } | 2798 | } |
| 2804 | if (fence_found == 0) | 2799 | if (fence_found == 0) |
| 2805 | { | 2800 | { |
| @@ -2842,18 +2837,18 @@ between them, return t; otherwise return nil. */) | |||
| 2842 | else if (code != Swhitespace || quoted) | 2837 | else if (code != Swhitespace || quoted) |
| 2843 | { | 2838 | { |
| 2844 | leave: | 2839 | leave: |
| 2845 | immediate_quit = 0; | ||
| 2846 | INC_BOTH (from, from_byte); | 2840 | INC_BOTH (from, from_byte); |
| 2847 | SET_PT_BOTH (from, from_byte); | 2841 | SET_PT_BOTH (from, from_byte); |
| 2848 | return Qnil; | 2842 | return Qnil; |
| 2849 | } | 2843 | } |
| 2844 | |||
| 2845 | rarely_quit (++quit_count); | ||
| 2850 | } | 2846 | } |
| 2851 | 2847 | ||
| 2852 | count1++; | 2848 | count1++; |
| 2853 | } | 2849 | } |
| 2854 | 2850 | ||
| 2855 | SET_PT_BOTH (from, from_byte); | 2851 | SET_PT_BOTH (from, from_byte); |
| 2856 | immediate_quit = 0; | ||
| 2857 | return Qt; | 2852 | return Qt; |
| 2858 | } | 2853 | } |
| 2859 | 2854 | ||
| @@ -2887,6 +2882,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2887 | EMACS_INT dummy; | 2882 | EMACS_INT dummy; |
| 2888 | int dummy2; | 2883 | int dummy2; |
| 2889 | bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; | 2884 | bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; |
| 2885 | unsigned short int quit_count = 0; | ||
| 2890 | 2886 | ||
| 2891 | if (depth > 0) min_depth = 0; | 2887 | if (depth > 0) min_depth = 0; |
| 2892 | 2888 | ||
| @@ -2895,14 +2891,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2895 | 2891 | ||
| 2896 | from_byte = CHAR_TO_BYTE (from); | 2892 | from_byte = CHAR_TO_BYTE (from); |
| 2897 | 2893 | ||
| 2898 | immediate_quit = 1; | 2894 | maybe_quit (); |
| 2899 | QUIT; | ||
| 2900 | 2895 | ||
| 2901 | SETUP_SYNTAX_TABLE (from, count); | 2896 | SETUP_SYNTAX_TABLE (from, count); |
| 2902 | while (count > 0) | 2897 | while (count > 0) |
| 2903 | { | 2898 | { |
| 2904 | while (from < stop) | 2899 | while (from < stop) |
| 2905 | { | 2900 | { |
| 2901 | rarely_quit (++quit_count); | ||
| 2906 | bool comstart_first, prefix; | 2902 | bool comstart_first, prefix; |
| 2907 | int syntax, other_syntax; | 2903 | int syntax, other_syntax; |
| 2908 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 2904 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| @@ -2971,6 +2967,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2971 | goto done; | 2967 | goto done; |
| 2972 | } | 2968 | } |
| 2973 | INC_BOTH (from, from_byte); | 2969 | INC_BOTH (from, from_byte); |
| 2970 | rarely_quit (++quit_count); | ||
| 2974 | } | 2971 | } |
| 2975 | goto done; | 2972 | goto done; |
| 2976 | 2973 | ||
| @@ -3042,6 +3039,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3042 | if (c_code == Scharquote || c_code == Sescape) | 3039 | if (c_code == Scharquote || c_code == Sescape) |
| 3043 | INC_BOTH (from, from_byte); | 3040 | INC_BOTH (from, from_byte); |
| 3044 | INC_BOTH (from, from_byte); | 3041 | INC_BOTH (from, from_byte); |
| 3042 | rarely_quit (++quit_count); | ||
| 3045 | } | 3043 | } |
| 3046 | INC_BOTH (from, from_byte); | 3044 | INC_BOTH (from, from_byte); |
| 3047 | if (!depth && sexpflag) goto done; | 3045 | if (!depth && sexpflag) goto done; |
| @@ -3056,7 +3054,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3056 | if (depth) | 3054 | if (depth) |
| 3057 | goto lose; | 3055 | goto lose; |
| 3058 | 3056 | ||
| 3059 | immediate_quit = 0; | ||
| 3060 | return Qnil; | 3057 | return Qnil; |
| 3061 | 3058 | ||
| 3062 | /* End of object reached */ | 3059 | /* End of object reached */ |
| @@ -3068,11 +3065,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3068 | { | 3065 | { |
| 3069 | while (from > stop) | 3066 | while (from > stop) |
| 3070 | { | 3067 | { |
| 3071 | int syntax; | 3068 | rarely_quit (++quit_count); |
| 3072 | DEC_BOTH (from, from_byte); | 3069 | DEC_BOTH (from, from_byte); |
| 3073 | UPDATE_SYNTAX_TABLE_BACKWARD (from); | 3070 | UPDATE_SYNTAX_TABLE_BACKWARD (from); |
| 3074 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 3071 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 3075 | syntax= SYNTAX_WITH_FLAGS (c); | 3072 | int syntax = SYNTAX_WITH_FLAGS (c); |
| 3076 | code = syntax_multibyte (c, multibyte_symbol_p); | 3073 | code = syntax_multibyte (c, multibyte_symbol_p); |
| 3077 | if (depth == min_depth) | 3074 | if (depth == min_depth) |
| 3078 | last_good = from; | 3075 | last_good = from; |
| @@ -3144,6 +3141,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3144 | default: goto done2; | 3141 | default: goto done2; |
| 3145 | } | 3142 | } |
| 3146 | DEC_BOTH (from, from_byte); | 3143 | DEC_BOTH (from, from_byte); |
| 3144 | rarely_quit (++quit_count); | ||
| 3147 | } | 3145 | } |
| 3148 | goto done2; | 3146 | goto done2; |
| 3149 | 3147 | ||
| @@ -3206,13 +3204,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3206 | if (syntax_multibyte (c, multibyte_symbol_p) == code) | 3204 | if (syntax_multibyte (c, multibyte_symbol_p) == code) |
| 3207 | break; | 3205 | break; |
| 3208 | } | 3206 | } |
| 3207 | rarely_quit (++quit_count); | ||
| 3209 | } | 3208 | } |
| 3210 | if (code == Sstring_fence && !depth && sexpflag) goto done2; | 3209 | if (code == Sstring_fence && !depth && sexpflag) goto done2; |
| 3211 | break; | 3210 | break; |
| 3212 | 3211 | ||
| 3213 | case Sstring: | 3212 | case Sstring: |
| 3214 | stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 3213 | stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 3215 | while (1) | 3214 | while (true) |
| 3216 | { | 3215 | { |
| 3217 | if (from == stop) | 3216 | if (from == stop) |
| 3218 | goto lose; | 3217 | goto lose; |
| @@ -3226,6 +3225,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3226 | == Sstring)) | 3225 | == Sstring)) |
| 3227 | break; | 3226 | break; |
| 3228 | } | 3227 | } |
| 3228 | rarely_quit (++quit_count); | ||
| 3229 | } | 3229 | } |
| 3230 | if (!depth && sexpflag) goto done2; | 3230 | if (!depth && sexpflag) goto done2; |
| 3231 | break; | 3231 | break; |
| @@ -3239,7 +3239,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3239 | if (depth) | 3239 | if (depth) |
| 3240 | goto lose; | 3240 | goto lose; |
| 3241 | 3241 | ||
| 3242 | immediate_quit = 0; | ||
| 3243 | return Qnil; | 3242 | return Qnil; |
| 3244 | 3243 | ||
| 3245 | done2: | 3244 | done2: |
| @@ -3247,7 +3246,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 3247 | } | 3246 | } |
| 3248 | 3247 | ||
| 3249 | 3248 | ||
| 3250 | immediate_quit = 0; | ||
| 3251 | XSETFASTINT (val, from); | 3249 | XSETFASTINT (val, from); |
| 3252 | return val; | 3250 | return val; |
| 3253 | 3251 | ||
| @@ -3340,6 +3338,7 @@ the prefix syntax flag (p). */) | |||
| 3340 | if (pos <= beg) | 3338 | if (pos <= beg) |
| 3341 | break; | 3339 | break; |
| 3342 | DEC_BOTH (pos, pos_byte); | 3340 | DEC_BOTH (pos, pos_byte); |
| 3341 | rarely_quit (pos); | ||
| 3343 | } | 3342 | } |
| 3344 | 3343 | ||
| 3345 | SET_PT_BOTH (opoint, opoint_byte); | 3344 | SET_PT_BOTH (opoint, opoint_byte); |
| @@ -3347,6 +3346,36 @@ the prefix syntax flag (p). */) | |||
| 3347 | return Qnil; | 3346 | return Qnil; |
| 3348 | } | 3347 | } |
| 3349 | 3348 | ||
| 3349 | |||
| 3350 | /* If the character at FROM_BYTE is the second part of a 2-character | ||
| 3351 | comment opener based on PREV_FROM_SYNTAX, update STATE and return | ||
| 3352 | true. */ | ||
| 3353 | static bool | ||
| 3354 | in_2char_comment_start (struct lisp_parse_state *state, | ||
| 3355 | int prev_from_syntax, | ||
| 3356 | ptrdiff_t prev_from, | ||
| 3357 | ptrdiff_t from_byte) | ||
| 3358 | { | ||
| 3359 | int c1, syntax; | ||
| 3360 | if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) | ||
| 3361 | && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), | ||
| 3362 | syntax = SYNTAX_WITH_FLAGS (c1), | ||
| 3363 | SYNTAX_FLAGS_COMSTART_SECOND (syntax))) | ||
| 3364 | { | ||
| 3365 | /* Record the comment style we have entered so that only | ||
| 3366 | the comment-end sequence of the same style actually | ||
| 3367 | terminates the comment section. */ | ||
| 3368 | state->comstyle | ||
| 3369 | = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax); | ||
| 3370 | bool comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) | ||
| 3371 | | SYNTAX_FLAGS_COMMENT_NESTED (syntax)); | ||
| 3372 | state->incomment = comnested ? 1 : -1; | ||
| 3373 | state->comstr_start = prev_from; | ||
| 3374 | return true; | ||
| 3375 | } | ||
| 3376 | return false; | ||
| 3377 | } | ||
| 3378 | |||
| 3350 | /* Parse forward from FROM / FROM_BYTE to END, | 3379 | /* Parse forward from FROM / FROM_BYTE to END, |
| 3351 | assuming that FROM has state STATE, | 3380 | assuming that FROM has state STATE, |
| 3352 | and return a description of the state of the parse at END. | 3381 | and return a description of the state of the parse at END. |
| @@ -3362,8 +3391,6 @@ scan_sexps_forward (struct lisp_parse_state *state, | |||
| 3362 | int commentstop) | 3391 | int commentstop) |
| 3363 | { | 3392 | { |
| 3364 | enum syntaxcode code; | 3393 | enum syntaxcode code; |
| 3365 | int c1; | ||
| 3366 | bool comnested; | ||
| 3367 | struct level { ptrdiff_t last, prev; }; | 3394 | struct level { ptrdiff_t last, prev; }; |
| 3368 | struct level levelstart[100]; | 3395 | struct level levelstart[100]; |
| 3369 | struct level *curlevel = levelstart; | 3396 | struct level *curlevel = levelstart; |
| @@ -3377,12 +3404,12 @@ scan_sexps_forward (struct lisp_parse_state *state, | |||
| 3377 | ptrdiff_t prev_from; /* Keep one character before FROM. */ | 3404 | ptrdiff_t prev_from; /* Keep one character before FROM. */ |
| 3378 | ptrdiff_t prev_from_byte; | 3405 | ptrdiff_t prev_from_byte; |
| 3379 | int prev_from_syntax, prev_prev_from_syntax; | 3406 | int prev_from_syntax, prev_prev_from_syntax; |
| 3380 | int syntax; | ||
| 3381 | bool boundary_stop = commentstop == -1; | 3407 | bool boundary_stop = commentstop == -1; |
| 3382 | bool nofence; | 3408 | bool nofence; |
| 3383 | bool found; | 3409 | bool found; |
| 3384 | ptrdiff_t out_bytepos, out_charpos; | 3410 | ptrdiff_t out_bytepos, out_charpos; |
| 3385 | int temp; | 3411 | int temp; |
| 3412 | unsigned short int quit_count = 0; | ||
| 3386 | 3413 | ||
| 3387 | prev_from = from; | 3414 | prev_from = from; |
| 3388 | prev_from_byte = from_byte; | 3415 | prev_from_byte = from_byte; |
| @@ -3401,8 +3428,7 @@ do { prev_from = from; \ | |||
| 3401 | UPDATE_SYNTAX_TABLE_FORWARD (from); \ | 3428 | UPDATE_SYNTAX_TABLE_FORWARD (from); \ |
| 3402 | } while (0) | 3429 | } while (0) |
| 3403 | 3430 | ||
| 3404 | immediate_quit = 1; | 3431 | maybe_quit (); |
| 3405 | QUIT; | ||
| 3406 | 3432 | ||
| 3407 | depth = state->depth; | 3433 | depth = state->depth; |
| 3408 | start_quoted = state->quoted; | 3434 | start_quoted = state->quoted; |
| @@ -3442,53 +3468,32 @@ do { prev_from = from; \ | |||
| 3442 | } | 3468 | } |
| 3443 | else if (start_quoted) | 3469 | else if (start_quoted) |
| 3444 | goto startquoted; | 3470 | goto startquoted; |
| 3471 | else if ((from < end) | ||
| 3472 | && (in_2char_comment_start (state, prev_from_syntax, | ||
| 3473 | prev_from, from_byte))) | ||
| 3474 | { | ||
| 3475 | INC_FROM; | ||
| 3476 | prev_from_syntax = Smax; /* the syntax has already been "used up". */ | ||
| 3477 | goto atcomment; | ||
| 3478 | } | ||
| 3445 | 3479 | ||
| 3446 | while (from < end) | 3480 | while (from < end) |
| 3447 | { | 3481 | { |
| 3448 | if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) | 3482 | rarely_quit (++quit_count); |
| 3449 | && (c1 = FETCH_CHAR (from_byte), | 3483 | INC_FROM; |
| 3450 | syntax = SYNTAX_WITH_FLAGS (c1), | 3484 | |
| 3451 | SYNTAX_FLAGS_COMSTART_SECOND (syntax))) | 3485 | if ((from < end) |
| 3452 | { | 3486 | && (in_2char_comment_start (state, prev_from_syntax, |
| 3453 | /* Record the comment style we have entered so that only | 3487 | prev_from, from_byte))) |
| 3454 | the comment-end sequence of the same style actually | ||
| 3455 | terminates the comment section. */ | ||
| 3456 | state->comstyle | ||
| 3457 | = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax); | ||
| 3458 | comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) | ||
| 3459 | | SYNTAX_FLAGS_COMMENT_NESTED (syntax)); | ||
| 3460 | state->incomment = comnested ? 1 : -1; | ||
| 3461 | state->comstr_start = prev_from; | ||
| 3462 | INC_FROM; | ||
| 3463 | prev_from_syntax = Smax; /* the syntax has already been | ||
| 3464 | "used up". */ | ||
| 3465 | code = Scomment; | ||
| 3466 | } | ||
| 3467 | else | ||
| 3468 | { | 3488 | { |
| 3469 | INC_FROM; | 3489 | INC_FROM; |
| 3470 | code = prev_from_syntax & 0xff; | 3490 | prev_from_syntax = Smax; /* the syntax has already been "used up". */ |
| 3471 | if (code == Scomment_fence) | 3491 | goto atcomment; |
| 3472 | { | ||
| 3473 | /* Record the comment style we have entered so that only | ||
| 3474 | the comment-end sequence of the same style actually | ||
| 3475 | terminates the comment section. */ | ||
| 3476 | state->comstyle = ST_COMMENT_STYLE; | ||
| 3477 | state->incomment = -1; | ||
| 3478 | state->comstr_start = prev_from; | ||
| 3479 | code = Scomment; | ||
| 3480 | } | ||
| 3481 | else if (code == Scomment) | ||
| 3482 | { | ||
| 3483 | state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0); | ||
| 3484 | state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? | ||
| 3485 | 1 : -1); | ||
| 3486 | state->comstr_start = prev_from; | ||
| 3487 | } | ||
| 3488 | } | 3492 | } |
| 3489 | 3493 | ||
| 3490 | if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) | 3494 | if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) |
| 3491 | continue; | 3495 | continue; |
| 3496 | code = prev_from_syntax & 0xff; | ||
| 3492 | switch (code) | 3497 | switch (code) |
| 3493 | { | 3498 | { |
| 3494 | case Sescape: | 3499 | case Sescape: |
| @@ -3507,24 +3512,15 @@ do { prev_from = from; \ | |||
| 3507 | symstarted: | 3512 | symstarted: |
| 3508 | while (from < end) | 3513 | while (from < end) |
| 3509 | { | 3514 | { |
| 3510 | int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 3515 | if (in_2char_comment_start (state, prev_from_syntax, |
| 3511 | 3516 | prev_from, from_byte)) | |
| 3512 | if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) | ||
| 3513 | && (syntax = SYNTAX_WITH_FLAGS (symchar), | ||
| 3514 | SYNTAX_FLAGS_COMSTART_SECOND (syntax))) | ||
| 3515 | { | 3517 | { |
| 3516 | state->comstyle | ||
| 3517 | = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax); | ||
| 3518 | comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) | ||
| 3519 | | SYNTAX_FLAGS_COMMENT_NESTED (syntax)); | ||
| 3520 | state->incomment = comnested ? 1 : -1; | ||
| 3521 | state->comstr_start = prev_from; | ||
| 3522 | INC_FROM; | 3518 | INC_FROM; |
| 3523 | prev_from_syntax = Smax; | 3519 | prev_from_syntax = Smax; /* the syntax has already been "used up". */ |
| 3524 | code = Scomment; | ||
| 3525 | goto atcomment; | 3520 | goto atcomment; |
| 3526 | } | 3521 | } |
| 3527 | 3522 | ||
| 3523 | int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); | ||
| 3528 | switch (SYNTAX (symchar)) | 3524 | switch (SYNTAX (symchar)) |
| 3529 | { | 3525 | { |
| 3530 | case Scharquote: | 3526 | case Scharquote: |
| @@ -3540,13 +3536,25 @@ do { prev_from = from; \ | |||
| 3540 | goto symdone; | 3536 | goto symdone; |
| 3541 | } | 3537 | } |
| 3542 | INC_FROM; | 3538 | INC_FROM; |
| 3539 | rarely_quit (++quit_count); | ||
| 3543 | } | 3540 | } |
| 3544 | symdone: | 3541 | symdone: |
| 3545 | curlevel->prev = curlevel->last; | 3542 | curlevel->prev = curlevel->last; |
| 3546 | break; | 3543 | break; |
| 3547 | 3544 | ||
| 3548 | case Scomment_fence: /* Can't happen because it's handled above. */ | 3545 | case Scomment_fence: |
| 3546 | /* Record the comment style we have entered so that only | ||
| 3547 | the comment-end sequence of the same style actually | ||
| 3548 | terminates the comment section. */ | ||
| 3549 | state->comstyle = ST_COMMENT_STYLE; | ||
| 3550 | state->incomment = -1; | ||
| 3551 | state->comstr_start = prev_from; | ||
| 3552 | goto atcomment; | ||
| 3549 | case Scomment: | 3553 | case Scomment: |
| 3554 | state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0); | ||
| 3555 | state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? | ||
| 3556 | 1 : -1); | ||
| 3557 | state->comstr_start = prev_from; | ||
| 3550 | atcomment: | 3558 | atcomment: |
| 3551 | if (commentstop || boundary_stop) goto done; | 3559 | if (commentstop || boundary_stop) goto done; |
| 3552 | startincomment: | 3560 | startincomment: |
| @@ -3639,6 +3647,7 @@ do { prev_from = from; \ | |||
| 3639 | break; | 3647 | break; |
| 3640 | } | 3648 | } |
| 3641 | INC_FROM; | 3649 | INC_FROM; |
| 3650 | rarely_quit (++quit_count); | ||
| 3642 | } | 3651 | } |
| 3643 | } | 3652 | } |
| 3644 | string_end: | 3653 | string_end: |
| @@ -3680,7 +3689,6 @@ do { prev_from = from; \ | |||
| 3680 | state->levelstarts); | 3689 | state->levelstarts); |
| 3681 | state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) | 3690 | state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) |
| 3682 | || state->quoted) ? prev_from_syntax : Smax; | 3691 | || state->quoted) ? prev_from_syntax : Smax; |
| 3683 | immediate_quit = 0; | ||
| 3684 | } | 3692 | } |
| 3685 | 3693 | ||
| 3686 | /* Convert a (lisp) parse state to the internal form used in | 3694 | /* Convert a (lisp) parse state to the internal form used in |
diff --git a/src/sysdep.c b/src/sysdep.c index 4316c21a1c7..91b2a5cb943 100644 --- a/src/sysdep.c +++ b/src/sysdep.c | |||
| @@ -382,19 +382,23 @@ get_child_status (pid_t child, int *status, int options, bool interruptible) | |||
| 382 | so that another thread running glib won't find them. */ | 382 | so that another thread running glib won't find them. */ |
| 383 | eassert (child > 0); | 383 | eassert (child > 0); |
| 384 | 384 | ||
| 385 | while ((pid = waitpid (child, status, options)) < 0) | 385 | while (true) |
| 386 | { | 386 | { |
| 387 | /* Note: the MS-Windows emulation of waitpid calls maybe_quit | ||
| 388 | internally. */ | ||
| 389 | if (interruptible) | ||
| 390 | maybe_quit (); | ||
| 391 | |||
| 392 | pid = waitpid (child, status, options); | ||
| 393 | if (0 <= pid) | ||
| 394 | break; | ||
| 395 | |||
| 387 | /* Check that CHILD is a child process that has not been reaped, | 396 | /* Check that CHILD is a child process that has not been reaped, |
| 388 | and that STATUS and OPTIONS are valid. Otherwise abort, | 397 | and that STATUS and OPTIONS are valid. Otherwise abort, |
| 389 | as continuing after this internal error could cause Emacs to | 398 | as continuing after this internal error could cause Emacs to |
| 390 | become confused and kill innocent-victim processes. */ | 399 | become confused and kill innocent-victim processes. */ |
| 391 | if (errno != EINTR) | 400 | if (errno != EINTR) |
| 392 | emacs_abort (); | 401 | emacs_abort (); |
| 393 | |||
| 394 | /* Note: the MS-Windows emulation of waitpid calls QUIT | ||
| 395 | internally. */ | ||
| 396 | if (interruptible) | ||
| 397 | QUIT; | ||
| 398 | } | 402 | } |
| 399 | 403 | ||
| 400 | /* If successful and status is requested, tell wait_reading_process_output | 404 | /* If successful and status is requested, tell wait_reading_process_output |
| @@ -2383,7 +2387,7 @@ emacs_open (const char *file, int oflags, int mode) | |||
| 2383 | oflags |= O_BINARY; | 2387 | oflags |= O_BINARY; |
| 2384 | oflags |= O_CLOEXEC; | 2388 | oflags |= O_CLOEXEC; |
| 2385 | while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) | 2389 | while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) |
| 2386 | QUIT; | 2390 | maybe_quit (); |
| 2387 | if (! O_CLOEXEC && 0 <= fd) | 2391 | if (! O_CLOEXEC && 0 <= fd) |
| 2388 | fcntl (fd, F_SETFD, FD_CLOEXEC); | 2392 | fcntl (fd, F_SETFD, FD_CLOEXEC); |
| 2389 | return fd; | 2393 | return fd; |
| @@ -2503,78 +2507,113 @@ emacs_close (int fd) | |||
| 2503 | #define MAX_RW_COUNT (INT_MAX >> 18 << 18) | 2507 | #define MAX_RW_COUNT (INT_MAX >> 18 << 18) |
| 2504 | #endif | 2508 | #endif |
| 2505 | 2509 | ||
| 2506 | /* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted. | 2510 | /* Read from FD to a buffer BUF with size NBYTE. |
| 2511 | If interrupted, process any quits and pending signals immediately | ||
| 2512 | if INTERRUPTIBLE, and then retry the read unless quitting. | ||
| 2507 | Return the number of bytes read, which might be less than NBYTE. | 2513 | Return the number of bytes read, which might be less than NBYTE. |
| 2508 | On error, set errno and return -1. */ | 2514 | On error, set errno to a value other than EINTR, and return -1. */ |
| 2509 | ptrdiff_t | 2515 | static ptrdiff_t |
| 2510 | emacs_read (int fildes, void *buf, ptrdiff_t nbyte) | 2516 | emacs_intr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible) |
| 2511 | { | 2517 | { |
| 2512 | ssize_t rtnval; | 2518 | ssize_t result; |
| 2513 | 2519 | ||
| 2514 | /* There is no need to check against MAX_RW_COUNT, since no caller ever | 2520 | /* There is no need to check against MAX_RW_COUNT, since no caller ever |
| 2515 | passes a size that large to emacs_read. */ | 2521 | passes a size that large to emacs_read. */ |
| 2522 | do | ||
| 2523 | { | ||
| 2524 | if (interruptible) | ||
| 2525 | maybe_quit (); | ||
| 2526 | result = read (fd, buf, nbyte); | ||
| 2527 | } | ||
| 2528 | while (result < 0 && errno == EINTR); | ||
| 2516 | 2529 | ||
| 2517 | while ((rtnval = read (fildes, buf, nbyte)) == -1 | 2530 | return result; |
| 2518 | && (errno == EINTR)) | ||
| 2519 | QUIT; | ||
| 2520 | return (rtnval); | ||
| 2521 | } | 2531 | } |
| 2522 | 2532 | ||
| 2523 | /* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted | 2533 | /* Read from FD to a buffer BUF with size NBYTE. |
| 2524 | or if a partial write occurs. If interrupted, process pending | 2534 | If interrupted, retry the read. Return the number of bytes read, |
| 2525 | signals if PROCESS SIGNALS. Return the number of bytes written, setting | 2535 | which might be less than NBYTE. On error, set errno to a value |
| 2526 | errno if this is less than NBYTE. */ | 2536 | other than EINTR, and return -1. */ |
| 2537 | ptrdiff_t | ||
| 2538 | emacs_read (int fd, void *buf, ptrdiff_t nbyte) | ||
| 2539 | { | ||
| 2540 | return emacs_intr_read (fd, buf, nbyte, false); | ||
| 2541 | } | ||
| 2542 | |||
| 2543 | /* Like emacs_read, but also process quits and pending signals. */ | ||
| 2544 | ptrdiff_t | ||
| 2545 | emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte) | ||
| 2546 | { | ||
| 2547 | return emacs_intr_read (fd, buf, nbyte, true); | ||
| 2548 | } | ||
| 2549 | |||
| 2550 | /* Write to FILEDES from a buffer BUF with size NBYTE, retrying if | ||
| 2551 | interrupted or if a partial write occurs. Process any quits | ||
| 2552 | immediately if INTERRUPTIBLE is positive, and process any pending | ||
| 2553 | signals immediately if INTERRUPTIBLE is nonzero. Return the number | ||
| 2554 | of bytes written; if this is less than NBYTE, set errno to a value | ||
| 2555 | other than EINTR. */ | ||
| 2527 | static ptrdiff_t | 2556 | static ptrdiff_t |
| 2528 | emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte, | 2557 | emacs_full_write (int fd, char const *buf, ptrdiff_t nbyte, |
| 2529 | bool process_signals) | 2558 | int interruptible) |
| 2530 | { | 2559 | { |
| 2531 | ptrdiff_t bytes_written = 0; | 2560 | ptrdiff_t bytes_written = 0; |
| 2532 | 2561 | ||
| 2533 | while (nbyte > 0) | 2562 | while (nbyte > 0) |
| 2534 | { | 2563 | { |
| 2535 | ssize_t n = write (fildes, buf, min (nbyte, MAX_RW_COUNT)); | 2564 | ssize_t n = write (fd, buf, min (nbyte, MAX_RW_COUNT)); |
| 2536 | 2565 | ||
| 2537 | if (n < 0) | 2566 | if (n < 0) |
| 2538 | { | 2567 | { |
| 2539 | if (errno == EINTR) | 2568 | if (errno != EINTR) |
| 2569 | break; | ||
| 2570 | |||
| 2571 | if (interruptible) | ||
| 2540 | { | 2572 | { |
| 2541 | /* I originally used `QUIT' but that might cause files to | 2573 | if (0 < interruptible) |
| 2542 | be truncated if you hit C-g in the middle of it. --Stef */ | 2574 | maybe_quit (); |
| 2543 | if (process_signals && pending_signals) | 2575 | if (pending_signals) |
| 2544 | process_pending_signals (); | 2576 | process_pending_signals (); |
| 2545 | continue; | ||
| 2546 | } | 2577 | } |
| 2547 | else | ||
| 2548 | break; | ||
| 2549 | } | 2578 | } |
| 2550 | 2579 | else | |
| 2551 | buf += n; | 2580 | { |
| 2552 | nbyte -= n; | 2581 | buf += n; |
| 2553 | bytes_written += n; | 2582 | nbyte -= n; |
| 2583 | bytes_written += n; | ||
| 2584 | } | ||
| 2554 | } | 2585 | } |
| 2555 | 2586 | ||
| 2556 | return bytes_written; | 2587 | return bytes_written; |
| 2557 | } | 2588 | } |
| 2558 | 2589 | ||
| 2559 | /* Write to FILEDES from a buffer BUF with size NBYTE, retrying if | 2590 | /* Write to FD from a buffer BUF with size NBYTE, retrying if |
| 2560 | interrupted or if a partial write occurs. Return the number of | 2591 | interrupted or if a partial write occurs. Do not process quits or |
| 2561 | bytes written, setting errno if this is less than NBYTE. */ | 2592 | pending signals. Return the number of bytes written, setting errno |
| 2593 | if this is less than NBYTE. */ | ||
| 2594 | ptrdiff_t | ||
| 2595 | emacs_write (int fd, void const *buf, ptrdiff_t nbyte) | ||
| 2596 | { | ||
| 2597 | return emacs_full_write (fd, buf, nbyte, 0); | ||
| 2598 | } | ||
| 2599 | |||
| 2600 | /* Like emacs_write, but also process pending signals. */ | ||
| 2562 | ptrdiff_t | 2601 | ptrdiff_t |
| 2563 | emacs_write (int fildes, void const *buf, ptrdiff_t nbyte) | 2602 | emacs_write_sig (int fd, void const *buf, ptrdiff_t nbyte) |
| 2564 | { | 2603 | { |
| 2565 | return emacs_full_write (fildes, buf, nbyte, 0); | 2604 | return emacs_full_write (fd, buf, nbyte, -1); |
| 2566 | } | 2605 | } |
| 2567 | 2606 | ||
| 2568 | /* Like emacs_write, but also process pending signals if interrupted. */ | 2607 | /* Like emacs_write, but also process quits and pending signals. */ |
| 2569 | ptrdiff_t | 2608 | ptrdiff_t |
| 2570 | emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte) | 2609 | emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte) |
| 2571 | { | 2610 | { |
| 2572 | return emacs_full_write (fildes, buf, nbyte, 1); | 2611 | return emacs_full_write (fd, buf, nbyte, 1); |
| 2573 | } | 2612 | } |
| 2574 | 2613 | ||
| 2575 | /* Write a diagnostic to standard error that contains MESSAGE and a | 2614 | /* Write a diagnostic to standard error that contains MESSAGE and a |
| 2576 | string derived from errno. Preserve errno. Do not buffer stderr. | 2615 | string derived from errno. Preserve errno. Do not buffer stderr. |
| 2577 | Do not process pending signals if interrupted. */ | 2616 | Do not process quits or pending signals if interrupted. */ |
| 2578 | void | 2617 | void |
| 2579 | emacs_perror (char const *message) | 2618 | emacs_perror (char const *message) |
| 2580 | { | 2619 | { |
| @@ -3168,7 +3207,7 @@ system_process_attributes (Lisp_Object pid) | |||
| 3168 | else | 3207 | else |
| 3169 | { | 3208 | { |
| 3170 | record_unwind_protect_int (close_file_unwind, fd); | 3209 | record_unwind_protect_int (close_file_unwind, fd); |
| 3171 | nread = emacs_read (fd, procbuf, sizeof procbuf - 1); | 3210 | nread = emacs_read_quit (fd, procbuf, sizeof procbuf - 1); |
| 3172 | } | 3211 | } |
| 3173 | if (0 < nread) | 3212 | if (0 < nread) |
| 3174 | { | 3213 | { |
| @@ -3289,7 +3328,7 @@ system_process_attributes (Lisp_Object pid) | |||
| 3289 | /* Leave room even if every byte needs escaping below. */ | 3328 | /* Leave room even if every byte needs escaping below. */ |
| 3290 | readsize = (cmdline_size >> 1) - nread; | 3329 | readsize = (cmdline_size >> 1) - nread; |
| 3291 | 3330 | ||
| 3292 | nread_incr = emacs_read (fd, cmdline + nread, readsize); | 3331 | nread_incr = emacs_read_quit (fd, cmdline + nread, readsize); |
| 3293 | nread += max (0, nread_incr); | 3332 | nread += max (0, nread_incr); |
| 3294 | } | 3333 | } |
| 3295 | while (nread_incr == readsize); | 3334 | while (nread_incr == readsize); |
| @@ -3402,7 +3441,7 @@ system_process_attributes (Lisp_Object pid) | |||
| 3402 | else | 3441 | else |
| 3403 | { | 3442 | { |
| 3404 | record_unwind_protect_int (close_file_unwind, fd); | 3443 | record_unwind_protect_int (close_file_unwind, fd); |
| 3405 | nread = emacs_read (fd, &pinfo, sizeof pinfo); | 3444 | nread = emacs_read_quit (fd, &pinfo, sizeof pinfo); |
| 3406 | } | 3445 | } |
| 3407 | 3446 | ||
| 3408 | if (nread == sizeof pinfo) | 3447 | if (nread == sizeof pinfo) |
diff --git a/src/textprop.c b/src/textprop.c index bf77f84ab79..116bf3f2c93 100644 --- a/src/textprop.c +++ b/src/textprop.c | |||
| @@ -212,7 +212,7 @@ validate_plist (Lisp_Object list) | |||
| 212 | if (! CONSP (tail)) | 212 | if (! CONSP (tail)) |
| 213 | error ("Odd length text property list"); | 213 | error ("Odd length text property list"); |
| 214 | tail = XCDR (tail); | 214 | tail = XCDR (tail); |
| 215 | QUIT; | 215 | maybe_quit (); |
| 216 | } | 216 | } |
| 217 | while (CONSP (tail)); | 217 | while (CONSP (tail)); |
| 218 | 218 | ||
diff --git a/src/w32fns.c b/src/w32fns.c index c24fce11fc8..1b628b0b42e 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,18 +3166,9 @@ 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. */ |
| 3172 | #if 0 | ||
| 3173 | /* If we're inside a function that wants immediate quits, | ||
| 3174 | do it now. */ | ||
| 3175 | if (immediate_quit && NILP (Vinhibit_quit)) | ||
| 3176 | { | ||
| 3177 | immediate_quit = 0; | ||
| 3178 | QUIT; | ||
| 3179 | } | ||
| 3180 | #endif | ||
| 3181 | } | 3172 | } |
| 3182 | } | 3173 | } |
| 3183 | 3174 | ||
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..95690443f8e 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; |
| @@ -4769,7 +4770,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) | |||
| 4769 | { | 4770 | { |
| 4770 | ptrdiff_t count = SPECPDL_INDEX (); | 4771 | ptrdiff_t count = SPECPDL_INDEX (); |
| 4771 | 4772 | ||
| 4772 | immediate_quit = true; | ||
| 4773 | n = clip_to_bounds (INT_MIN, n, INT_MAX); | 4773 | n = clip_to_bounds (INT_MIN, n, INT_MAX); |
| 4774 | 4774 | ||
| 4775 | wset_redisplay (XWINDOW (window)); | 4775 | wset_redisplay (XWINDOW (window)); |
| @@ -4788,7 +4788,36 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) | |||
| 4788 | 4788 | ||
| 4789 | /* Bug#15957. */ | 4789 | /* Bug#15957. */ |
| 4790 | XWINDOW (window)->window_end_valid = false; | 4790 | XWINDOW (window)->window_end_valid = false; |
| 4791 | immediate_quit = false; | 4791 | } |
| 4792 | |||
| 4793 | /* Compute scroll margin for WINDOW. | ||
| 4794 | We scroll when point is within this distance from the top or bottom | ||
| 4795 | of the window. The result is measured in lines or in pixels | ||
| 4796 | depending on the second parameter. */ | ||
| 4797 | int | ||
| 4798 | window_scroll_margin (struct window *window, enum margin_unit unit) | ||
| 4799 | { | ||
| 4800 | if (scroll_margin > 0) | ||
| 4801 | { | ||
| 4802 | int frame_line_height = default_line_pixel_height (window); | ||
| 4803 | int window_lines = window_box_height (window) / frame_line_height; | ||
| 4804 | |||
| 4805 | double ratio = 0.25; | ||
| 4806 | if (FLOATP (Vmaximum_scroll_margin)) | ||
| 4807 | { | ||
| 4808 | ratio = XFLOAT_DATA (Vmaximum_scroll_margin); | ||
| 4809 | ratio = max (0.0, ratio); | ||
| 4810 | ratio = min (ratio, 0.5); | ||
| 4811 | } | ||
| 4812 | int max_margin = min ((window_lines - 1)/2, | ||
| 4813 | (int) (window_lines * ratio)); | ||
| 4814 | int margin = clip_to_bounds (0, scroll_margin, max_margin); | ||
| 4815 | return (unit == MARGIN_IN_PIXELS) | ||
| 4816 | ? margin * frame_line_height | ||
| 4817 | : margin; | ||
| 4818 | } | ||
| 4819 | else | ||
| 4820 | return 0; | ||
| 4792 | } | 4821 | } |
| 4793 | 4822 | ||
| 4794 | 4823 | ||
| @@ -4807,7 +4836,6 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 4807 | bool vscrolled = false; | 4836 | bool vscrolled = false; |
| 4808 | int x, y, rtop, rbot, rowh, vpos; | 4837 | int x, y, rtop, rbot, rowh, vpos; |
| 4809 | void *itdata = NULL; | 4838 | void *itdata = NULL; |
| 4810 | int window_total_lines; | ||
| 4811 | int frame_line_height = default_line_pixel_height (w); | 4839 | int frame_line_height = default_line_pixel_height (w); |
| 4812 | bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window), | 4840 | bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window), |
| 4813 | Fwindow_old_point (window))); | 4841 | Fwindow_old_point (window))); |
| @@ -5063,12 +5091,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 5063 | /* Move PT out of scroll margins. | 5091 | /* Move PT out of scroll margins. |
| 5064 | This code wants current_y to be zero at the window start position | 5092 | This code wants current_y to be zero at the window start position |
| 5065 | even if there is a header line. */ | 5093 | even if there is a header line. */ |
| 5066 | window_total_lines | 5094 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 5067 | = w->total_lines * WINDOW_FRAME_LINE_HEIGHT (w) / frame_line_height; | ||
| 5068 | this_scroll_margin = max (0, scroll_margin); | ||
| 5069 | this_scroll_margin | ||
| 5070 | = min (this_scroll_margin, window_total_lines / 4); | ||
| 5071 | this_scroll_margin *= frame_line_height; | ||
| 5072 | 5095 | ||
| 5073 | if (n > 0) | 5096 | if (n > 0) |
| 5074 | { | 5097 | { |
| @@ -5124,7 +5147,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 5124 | in the scroll margin at the bottom. */ | 5147 | in the scroll margin at the bottom. */ |
| 5125 | move_it_to (&it, PT, -1, | 5148 | move_it_to (&it, PT, -1, |
| 5126 | (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w) | 5149 | (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w) |
| 5127 | - this_scroll_margin - 1), | 5150 | - partial_line_height (&it) - this_scroll_margin - 1), |
| 5128 | -1, | 5151 | -1, |
| 5129 | MOVE_TO_POS | MOVE_TO_Y); | 5152 | MOVE_TO_POS | MOVE_TO_Y); |
| 5130 | 5153 | ||
| @@ -5291,9 +5314,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 5291 | 5314 | ||
| 5292 | if (pos < ZV) | 5315 | if (pos < ZV) |
| 5293 | { | 5316 | { |
| 5294 | /* Don't use a scroll margin that is negative or too large. */ | 5317 | int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); |
| 5295 | int this_scroll_margin = | ||
| 5296 | max (0, min (scroll_margin, w->total_lines / 4)); | ||
| 5297 | 5318 | ||
| 5298 | set_marker_restricted_both (w->start, w->contents, pos, pos_byte); | 5319 | set_marker_restricted_both (w->start, w->contents, pos, pos_byte); |
| 5299 | w->start_at_line_beg = !NILP (bolp); | 5320 | w->start_at_line_beg = !NILP (bolp); |
| @@ -5723,8 +5744,7 @@ and redisplay normally--don't erase and redraw the frame. */) | |||
| 5723 | 5744 | ||
| 5724 | /* Do this after making BUF current | 5745 | /* Do this after making BUF current |
| 5725 | in case scroll_margin is buffer-local. */ | 5746 | in case scroll_margin is buffer-local. */ |
| 5726 | this_scroll_margin | 5747 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); |
| 5727 | = max (0, min (scroll_margin, w->total_lines / 4)); | ||
| 5728 | 5748 | ||
| 5729 | /* Don't use redisplay code for initial frames, as the necessary | 5749 | /* Don't use redisplay code for initial frames, as the necessary |
| 5730 | data structures might not be set up yet then. */ | 5750 | data structures might not be set up yet then. */ |
| @@ -5963,10 +5983,6 @@ from the top of the window. */) | |||
| 5963 | 5983 | ||
| 5964 | lines = displayed_window_lines (w); | 5984 | lines = displayed_window_lines (w); |
| 5965 | 5985 | ||
| 5966 | #if false | ||
| 5967 | this_scroll_margin = max (0, min (scroll_margin, lines / 4)); | ||
| 5968 | #endif | ||
| 5969 | |||
| 5970 | if (NILP (arg)) | 5986 | if (NILP (arg)) |
| 5971 | XSETFASTINT (arg, lines / 2); | 5987 | XSETFASTINT (arg, lines / 2); |
| 5972 | else | 5988 | else |
| @@ -5982,6 +5998,8 @@ from the top of the window. */) | |||
| 5982 | it is probably better not to install it. However, it is here | 5998 | it is probably better not to install it. However, it is here |
| 5983 | inside #if false so as not to lose it. -- rms. */ | 5999 | inside #if false so as not to lose it. -- rms. */ |
| 5984 | 6000 | ||
| 6001 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); | ||
| 6002 | |||
| 5985 | /* Don't let it get into the margin at either top or bottom. */ | 6003 | /* Don't let it get into the margin at either top or bottom. */ |
| 5986 | iarg = max (iarg, this_scroll_margin); | 6004 | iarg = max (iarg, this_scroll_margin); |
| 5987 | iarg = min (iarg, lines - this_scroll_margin - 1); | 6005 | iarg = min (iarg, lines - this_scroll_margin - 1); |
diff --git a/src/window.h b/src/window.h index 061cf244943..acb8a5cabfa 100644 --- a/src/window.h +++ b/src/window.h | |||
| @@ -1120,6 +1120,8 @@ extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); | |||
| 1120 | extern void mark_window_cursors_off (struct window *); | 1120 | extern void mark_window_cursors_off (struct window *); |
| 1121 | extern int window_internal_height (struct window *); | 1121 | extern int window_internal_height (struct window *); |
| 1122 | extern int window_body_width (struct window *w, bool); | 1122 | extern int window_body_width (struct window *w, bool); |
| 1123 | enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS }; | ||
| 1124 | extern int window_scroll_margin (struct window *, enum margin_unit); | ||
| 1123 | extern void temp_output_buffer_show (Lisp_Object); | 1125 | extern void temp_output_buffer_show (Lisp_Object); |
| 1124 | extern void replace_buffer_in_windows (Lisp_Object); | 1126 | extern void replace_buffer_in_windows (Lisp_Object); |
| 1125 | extern void replace_buffer_in_windows_safely (Lisp_Object); | 1127 | extern void replace_buffer_in_windows_safely (Lisp_Object); |
diff --git a/src/xdisp.c b/src/xdisp.c index 168922ef06b..0e329dfe6e9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -9859,6 +9859,32 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) | |||
| 9859 | } | 9859 | } |
| 9860 | } | 9860 | } |
| 9861 | 9861 | ||
| 9862 | int | ||
| 9863 | partial_line_height (struct it *it_origin) | ||
| 9864 | { | ||
| 9865 | int partial_height; | ||
| 9866 | void *it_data = NULL; | ||
| 9867 | struct it it; | ||
| 9868 | SAVE_IT (it, *it_origin, it_data); | ||
| 9869 | move_it_to (&it, ZV, -1, it.last_visible_y, -1, | ||
| 9870 | MOVE_TO_POS | MOVE_TO_Y); | ||
| 9871 | if (it.what == IT_EOB) | ||
| 9872 | { | ||
| 9873 | int vis_height = it.last_visible_y - it.current_y; | ||
| 9874 | int height = it.ascent + it.descent; | ||
| 9875 | partial_height = (vis_height < height) ? vis_height : 0; | ||
| 9876 | } | ||
| 9877 | else | ||
| 9878 | { | ||
| 9879 | int last_line_y = it.current_y; | ||
| 9880 | move_it_by_lines (&it, 1); | ||
| 9881 | partial_height = (it.current_y > it.last_visible_y) | ||
| 9882 | ? it.last_visible_y - last_line_y : 0; | ||
| 9883 | } | ||
| 9884 | RESTORE_IT (&it, &it, it_data); | ||
| 9885 | return partial_height; | ||
| 9886 | } | ||
| 9887 | |||
| 9862 | /* Return true if IT points into the middle of a display vector. */ | 9888 | /* Return true if IT points into the middle of a display vector. */ |
| 9863 | 9889 | ||
| 9864 | bool | 9890 | bool |
| @@ -15316,7 +15342,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, | |||
| 15316 | bool temp_scroll_step, bool last_line_misfit) | 15342 | bool temp_scroll_step, bool last_line_misfit) |
| 15317 | { | 15343 | { |
| 15318 | struct window *w = XWINDOW (window); | 15344 | struct window *w = XWINDOW (window); |
| 15319 | struct frame *f = XFRAME (w->frame); | ||
| 15320 | struct text_pos pos, startp; | 15345 | struct text_pos pos, startp; |
| 15321 | struct it it; | 15346 | struct it it; |
| 15322 | int this_scroll_margin, scroll_max, rc, height; | 15347 | int this_scroll_margin, scroll_max, rc, height; |
| @@ -15327,8 +15352,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, | |||
| 15327 | /* We will never try scrolling more than this number of lines. */ | 15352 | /* We will never try scrolling more than this number of lines. */ |
| 15328 | int scroll_limit = SCROLL_LIMIT; | 15353 | int scroll_limit = SCROLL_LIMIT; |
| 15329 | int frame_line_height = default_line_pixel_height (w); | 15354 | int frame_line_height = default_line_pixel_height (w); |
| 15330 | int window_total_lines | ||
| 15331 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; | ||
| 15332 | 15355 | ||
| 15333 | #ifdef GLYPH_DEBUG | 15356 | #ifdef GLYPH_DEBUG |
| 15334 | debug_method_add (w, "try_scrolling"); | 15357 | debug_method_add (w, "try_scrolling"); |
| @@ -15336,13 +15359,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, | |||
| 15336 | 15359 | ||
| 15337 | SET_TEXT_POS_FROM_MARKER (startp, w->start); | 15360 | SET_TEXT_POS_FROM_MARKER (startp, w->start); |
| 15338 | 15361 | ||
| 15339 | /* Compute scroll margin height in pixels. We scroll when point is | 15362 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 15340 | within this distance from the top or bottom of the window. */ | ||
| 15341 | if (scroll_margin > 0) | ||
| 15342 | this_scroll_margin = min (scroll_margin, window_total_lines / 4) | ||
| 15343 | * frame_line_height; | ||
| 15344 | else | ||
| 15345 | this_scroll_margin = 0; | ||
| 15346 | 15363 | ||
| 15347 | /* Force arg_scroll_conservatively to have a reasonable value, to | 15364 | /* Force arg_scroll_conservatively to have a reasonable value, to |
| 15348 | avoid scrolling too far away with slow move_it_* functions. Note | 15365 | avoid scrolling too far away with slow move_it_* functions. Note |
| @@ -15377,7 +15394,8 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, | |||
| 15377 | /* Compute the pixel ypos of the scroll margin, then move IT to | 15394 | /* Compute the pixel ypos of the scroll margin, then move IT to |
| 15378 | either that ypos or PT, whichever comes first. */ | 15395 | either that ypos or PT, whichever comes first. */ |
| 15379 | start_display (&it, w, startp); | 15396 | start_display (&it, w, startp); |
| 15380 | scroll_margin_y = it.last_visible_y - this_scroll_margin | 15397 | scroll_margin_y = it.last_visible_y - partial_line_height (&it) |
| 15398 | - this_scroll_margin | ||
| 15381 | - frame_line_height * extra_scroll_margin_lines; | 15399 | - frame_line_height * extra_scroll_margin_lines; |
| 15382 | move_it_to (&it, PT, -1, scroll_margin_y - 1, -1, | 15400 | move_it_to (&it, PT, -1, scroll_margin_y - 1, -1, |
| 15383 | (MOVE_TO_POS | MOVE_TO_Y)); | 15401 | (MOVE_TO_POS | MOVE_TO_Y)); |
| @@ -15816,23 +15834,12 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, | |||
| 15816 | { | 15834 | { |
| 15817 | int this_scroll_margin, top_scroll_margin; | 15835 | int this_scroll_margin, top_scroll_margin; |
| 15818 | struct glyph_row *row = NULL; | 15836 | struct glyph_row *row = NULL; |
| 15819 | int frame_line_height = default_line_pixel_height (w); | ||
| 15820 | int window_total_lines | ||
| 15821 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; | ||
| 15822 | 15837 | ||
| 15823 | #ifdef GLYPH_DEBUG | 15838 | #ifdef GLYPH_DEBUG |
| 15824 | debug_method_add (w, "cursor movement"); | 15839 | debug_method_add (w, "cursor movement"); |
| 15825 | #endif | 15840 | #endif |
| 15826 | 15841 | ||
| 15827 | /* Scroll if point within this distance from the top or bottom | 15842 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 15828 | of the window. This is a pixel value. */ | ||
| 15829 | if (scroll_margin > 0) | ||
| 15830 | { | ||
| 15831 | this_scroll_margin = min (scroll_margin, window_total_lines / 4); | ||
| 15832 | this_scroll_margin *= frame_line_height; | ||
| 15833 | } | ||
| 15834 | else | ||
| 15835 | this_scroll_margin = 0; | ||
| 15836 | 15843 | ||
| 15837 | top_scroll_margin = this_scroll_margin; | 15844 | top_scroll_margin = this_scroll_margin; |
| 15838 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 15845 | if (WINDOW_WANTS_HEADER_LINE_P (w)) |
| @@ -16280,7 +16287,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 16280 | int centering_position = -1; | 16287 | int centering_position = -1; |
| 16281 | bool last_line_misfit = false; | 16288 | bool last_line_misfit = false; |
| 16282 | ptrdiff_t beg_unchanged, end_unchanged; | 16289 | ptrdiff_t beg_unchanged, end_unchanged; |
| 16283 | int frame_line_height; | 16290 | int frame_line_height, margin; |
| 16284 | bool use_desired_matrix; | 16291 | bool use_desired_matrix; |
| 16285 | void *itdata = NULL; | 16292 | void *itdata = NULL; |
| 16286 | 16293 | ||
| @@ -16310,6 +16317,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 16310 | restart: | 16317 | restart: |
| 16311 | reconsider_clip_changes (w); | 16318 | reconsider_clip_changes (w); |
| 16312 | frame_line_height = default_line_pixel_height (w); | 16319 | frame_line_height = default_line_pixel_height (w); |
| 16320 | margin = window_scroll_margin (w, MARGIN_IN_LINES); | ||
| 16321 | |||
| 16313 | 16322 | ||
| 16314 | /* Has the mode line to be updated? */ | 16323 | /* Has the mode line to be updated? */ |
| 16315 | update_mode_line = (w->update_mode_line | 16324 | update_mode_line = (w->update_mode_line |
| @@ -16614,10 +16623,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 16614 | /* Some people insist on not letting point enter the scroll | 16623 | /* Some people insist on not letting point enter the scroll |
| 16615 | margin, even though this part handles windows that didn't | 16624 | margin, even though this part handles windows that didn't |
| 16616 | scroll at all. */ | 16625 | scroll at all. */ |
| 16617 | int window_total_lines | 16626 | int pixel_margin = margin * frame_line_height; |
| 16618 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; | ||
| 16619 | int margin = min (scroll_margin, window_total_lines / 4); | ||
| 16620 | int pixel_margin = margin * frame_line_height; | ||
| 16621 | bool header_line = WINDOW_WANTS_HEADER_LINE_P (w); | 16627 | bool header_line = WINDOW_WANTS_HEADER_LINE_P (w); |
| 16622 | 16628 | ||
| 16623 | /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop | 16629 | /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop |
| @@ -16901,12 +16907,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 16901 | it.current_y = it.last_visible_y; | 16907 | it.current_y = it.last_visible_y; |
| 16902 | if (centering_position < 0) | 16908 | if (centering_position < 0) |
| 16903 | { | 16909 | { |
| 16904 | int window_total_lines | ||
| 16905 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; | ||
| 16906 | int margin | ||
| 16907 | = scroll_margin > 0 | ||
| 16908 | ? min (scroll_margin, window_total_lines / 4) | ||
| 16909 | : 0; | ||
| 16910 | ptrdiff_t margin_pos = CHARPOS (startp); | 16910 | ptrdiff_t margin_pos = CHARPOS (startp); |
| 16911 | Lisp_Object aggressive; | 16911 | Lisp_Object aggressive; |
| 16912 | bool scrolling_up; | 16912 | bool scrolling_up; |
| @@ -17150,10 +17150,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) | |||
| 17150 | { | 17150 | { |
| 17151 | int window_total_lines | 17151 | int window_total_lines |
| 17152 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; | 17152 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; |
| 17153 | int margin = | ||
| 17154 | scroll_margin > 0 | ||
| 17155 | ? min (scroll_margin, window_total_lines / 4) | ||
| 17156 | : 0; | ||
| 17157 | bool move_down = w->cursor.vpos >= window_total_lines / 2; | 17153 | bool move_down = w->cursor.vpos >= window_total_lines / 2; |
| 17158 | 17154 | ||
| 17159 | move_it_by_lines (&it, move_down ? margin + 1 : -(margin + 1)); | 17155 | move_it_by_lines (&it, move_down ? margin + 1 : -(margin + 1)); |
| @@ -17359,7 +17355,6 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) | |||
| 17359 | struct it it; | 17355 | struct it it; |
| 17360 | struct glyph_row *last_text_row = NULL; | 17356 | struct glyph_row *last_text_row = NULL; |
| 17361 | struct frame *f = XFRAME (w->frame); | 17357 | struct frame *f = XFRAME (w->frame); |
| 17362 | int frame_line_height = default_line_pixel_height (w); | ||
| 17363 | 17358 | ||
| 17364 | /* Make POS the new window start. */ | 17359 | /* Make POS the new window start. */ |
| 17365 | set_marker_both (w->start, Qnil, CHARPOS (pos), BYTEPOS (pos)); | 17360 | set_marker_both (w->start, Qnil, CHARPOS (pos), BYTEPOS (pos)); |
| @@ -17385,17 +17380,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) | |||
| 17385 | if ((flags & TRY_WINDOW_CHECK_MARGINS) | 17380 | if ((flags & TRY_WINDOW_CHECK_MARGINS) |
| 17386 | && !MINI_WINDOW_P (w)) | 17381 | && !MINI_WINDOW_P (w)) |
| 17387 | { | 17382 | { |
| 17388 | int this_scroll_margin; | 17383 | int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 17389 | int window_total_lines | ||
| 17390 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; | ||
| 17391 | |||
| 17392 | if (scroll_margin > 0) | ||
| 17393 | { | ||
| 17394 | this_scroll_margin = min (scroll_margin, window_total_lines / 4); | ||
| 17395 | this_scroll_margin *= frame_line_height; | ||
| 17396 | } | ||
| 17397 | else | ||
| 17398 | this_scroll_margin = 0; | ||
| 17399 | 17384 | ||
| 17400 | if ((w->cursor.y >= 0 /* not vscrolled */ | 17385 | if ((w->cursor.y >= 0 /* not vscrolled */ |
| 17401 | && w->cursor.y < this_scroll_margin | 17386 | && w->cursor.y < this_scroll_margin |
| @@ -18679,15 +18664,8 @@ try_window_id (struct window *w) | |||
| 18679 | 18664 | ||
| 18680 | /* Don't let the cursor end in the scroll margins. */ | 18665 | /* Don't let the cursor end in the scroll margins. */ |
| 18681 | { | 18666 | { |
| 18682 | int this_scroll_margin, cursor_height; | 18667 | int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 18683 | int frame_line_height = default_line_pixel_height (w); | 18668 | int cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; |
| 18684 | int window_total_lines | ||
| 18685 | = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (it.f) / frame_line_height; | ||
| 18686 | |||
| 18687 | this_scroll_margin = | ||
| 18688 | max (0, min (scroll_margin, window_total_lines / 4)); | ||
| 18689 | this_scroll_margin *= frame_line_height; | ||
| 18690 | cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; | ||
| 18691 | 18669 | ||
| 18692 | if ((w->cursor.y < this_scroll_margin | 18670 | if ((w->cursor.y < this_scroll_margin |
| 18693 | && CHARPOS (start) > BEGV) | 18671 | && CHARPOS (start) > BEGV) |
| @@ -22635,7 +22613,7 @@ move_elt_to_front (Lisp_Object elt, Lisp_Object list) | |||
| 22635 | else | 22613 | else |
| 22636 | prev = tail; | 22614 | prev = tail; |
| 22637 | tail = XCDR (tail); | 22615 | tail = XCDR (tail); |
| 22638 | QUIT; | 22616 | maybe_quit (); |
| 22639 | } | 22617 | } |
| 22640 | 22618 | ||
| 22641 | /* Not found--return unchanged LIST. */ | 22619 | /* Not found--return unchanged LIST. */ |
| @@ -31569,6 +31547,14 @@ Recenter the window whenever point gets within this many lines | |||
| 31569 | of the top or bottom of the window. */); | 31547 | of the top or bottom of the window. */); |
| 31570 | scroll_margin = 0; | 31548 | scroll_margin = 0; |
| 31571 | 31549 | ||
| 31550 | DEFVAR_LISP ("maximum-scroll-margin", Vmaximum_scroll_margin, | ||
| 31551 | doc: /* Maximum effective value of `scroll-margin'. | ||
| 31552 | Given as a fraction of the current window's lines. The value should | ||
| 31553 | be a floating point number between 0.0 and 0.5. The effective maximum | ||
| 31554 | is limited to (/ (1- window-lines) 2). Non-float values for this | ||
| 31555 | variable are ignored and the default 0.25 is used instead. */); | ||
| 31556 | Vmaximum_scroll_margin = make_float (0.25); | ||
| 31557 | |||
| 31572 | DEFVAR_LISP ("display-pixels-per-inch", Vdisplay_pixels_per_inch, | 31558 | DEFVAR_LISP ("display-pixels-per-inch", Vdisplay_pixels_per_inch, |
| 31573 | doc: /* Pixels per inch value for non-window system displays. | 31559 | doc: /* Pixels per inch value for non-window system displays. |
| 31574 | Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */); | 31560 | Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */); |
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 db561c902a6..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 | ||
| @@ -12877,7 +12877,7 @@ keysyms. The default is nil, which is the same as `super'. */); | |||
| 12877 | Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900), | 12877 | Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900), |
| 12878 | make_float (DEFAULT_REHASH_SIZE), | 12878 | make_float (DEFAULT_REHASH_SIZE), |
| 12879 | make_float (DEFAULT_REHASH_THRESHOLD), | 12879 | make_float (DEFAULT_REHASH_THRESHOLD), |
| 12880 | Qnil); | 12880 | Qnil, Qnil); |
| 12881 | 12881 | ||
| 12882 | DEFVAR_BOOL ("x-frame-normalize-before-maximize", | 12882 | DEFVAR_BOOL ("x-frame-normalize-before-maximize", |
| 12883 | 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/autorevert-tests.el b/test/lisp/autorevert-tests.el index aea855ae02f..c6f103321c6 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el | |||
| @@ -24,24 +24,29 @@ | |||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | (require 'ert) | 26 | (require 'ert) |
| 27 | (require 'ert-x) | ||
| 27 | (require 'autorevert) | 28 | (require 'autorevert) |
| 28 | (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" | 29 | (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" |
| 29 | auto-revert-stop-on-user-input nil) | 30 | auto-revert-stop-on-user-input nil) |
| 30 | 31 | ||
| 31 | (defconst auto-revert--timeout 10 | 32 | (defconst auto-revert--timeout 10 |
| 32 | "Time to wait until a message appears in the *Messages* buffer.") | 33 | "Time to wait for a message.") |
| 34 | |||
| 35 | (defvar auto-revert--messages nil | ||
| 36 | "Used to collect messages issued during a section of a test.") | ||
| 33 | 37 | ||
| 34 | (defun auto-revert--wait-for-revert (buffer) | 38 | (defun auto-revert--wait-for-revert (buffer) |
| 35 | "Wait until the *Messages* buffer reports reversion of BUFFER." | 39 | "Wait until a message reports reversion of BUFFER. |
| 40 | This expects `auto-revert--messages' to be bound by | ||
| 41 | `ert-with-message-capture' before calling." | ||
| 36 | (with-timeout (auto-revert--timeout nil) | 42 | (with-timeout (auto-revert--timeout nil) |
| 37 | (with-current-buffer "*Messages*" | 43 | (while |
| 38 | (while | 44 | (null (string-match |
| 39 | (null (string-match | 45 | (format-message "Reverting buffer `%s'." (buffer-name buffer)) |
| 40 | (format-message "Reverting buffer `%s'." (buffer-name buffer)) | 46 | auto-revert--messages)) |
| 41 | (buffer-string))) | 47 | (if (with-current-buffer buffer auto-revert-use-notify) |
| 42 | (if (with-current-buffer buffer auto-revert-use-notify) | 48 | (read-event nil nil 0.1) |
| 43 | (read-event nil nil 0.1) | 49 | (sleep-for 0.1))))) |
| 44 | (sleep-for 0.1)))))) | ||
| 45 | 50 | ||
| 46 | (ert-deftest auto-revert-test00-auto-revert-mode () | 51 | (ert-deftest auto-revert-test00-auto-revert-mode () |
| 47 | "Check autorevert for a file." | 52 | "Check autorevert for a file." |
| @@ -51,41 +56,38 @@ | |||
| 51 | buf) | 56 | buf) |
| 52 | (unwind-protect | 57 | (unwind-protect |
| 53 | (progn | 58 | (progn |
| 54 | (with-current-buffer (get-buffer-create "*Messages*") | 59 | (write-region "any text" nil tmpfile nil 'no-message) |
| 55 | (narrow-to-region (point-max) (point-max))) | ||
| 56 | (write-region "any text" nil tmpfile nil 'no-message) | ||
| 57 | (setq buf (find-file-noselect tmpfile)) | 60 | (setq buf (find-file-noselect tmpfile)) |
| 58 | (with-current-buffer buf | 61 | (with-current-buffer buf |
| 59 | (should (string-equal (buffer-string) "any text")) | 62 | (ert-with-message-capture auto-revert--messages |
| 60 | ;; `buffer-stale--default-function' checks for | 63 | (should (string-equal (buffer-string) "any text")) |
| 61 | ;; `verify-visited-file-modtime'. We must ensure that it | 64 | ;; `buffer-stale--default-function' checks for |
| 62 | ;; returns nil. | 65 | ;; `verify-visited-file-modtime'. We must ensure that it |
| 63 | (sleep-for 1) | 66 | ;; returns nil. |
| 64 | (auto-revert-mode 1) | 67 | (sleep-for 1) |
| 65 | (should auto-revert-mode) | 68 | (auto-revert-mode 1) |
| 69 | (should auto-revert-mode) | ||
| 66 | 70 | ||
| 67 | ;; Modify file. We wait for a second, in order to have | 71 | ;; Modify file. We wait for a second, in order to have |
| 68 | ;; another timestamp. | 72 | ;; another timestamp. |
| 69 | (sleep-for 1) | 73 | (sleep-for 1) |
| 70 | (write-region "another text" nil tmpfile nil 'no-message) | 74 | (write-region "another text" nil tmpfile nil 'no-message) |
| 71 | 75 | ||
| 72 | ;; Check, that the buffer has been reverted. | 76 | ;; Check, that the buffer has been reverted. |
| 73 | (auto-revert--wait-for-revert buf) | 77 | (auto-revert--wait-for-revert buf)) |
| 74 | (should (string-match "another text" (buffer-string))) | 78 | (should (string-match "another text" (buffer-string))) |
| 75 | 79 | ||
| 76 | ;; When the buffer is modified, it shall not be reverted. | 80 | ;; When the buffer is modified, it shall not be reverted. |
| 77 | (with-current-buffer (get-buffer-create "*Messages*") | 81 | (ert-with-message-capture auto-revert--messages |
| 78 | (narrow-to-region (point-max) (point-max))) | 82 | (set-buffer-modified-p t) |
| 79 | (set-buffer-modified-p t) | 83 | (sleep-for 1) |
| 80 | (sleep-for 1) | 84 | (write-region "any text" nil tmpfile nil 'no-message) |
| 81 | (write-region "any text" nil tmpfile nil 'no-message) | ||
| 82 | 85 | ||
| 83 | ;; Check, that the buffer hasn't been reverted. | 86 | ;; Check, that the buffer hasn't been reverted. |
| 84 | (auto-revert--wait-for-revert buf) | 87 | (auto-revert--wait-for-revert buf)) |
| 85 | (should-not (string-match "any text" (buffer-string))))) | 88 | (should-not (string-match "any text" (buffer-string))))) |
| 86 | 89 | ||
| 87 | ;; Exit. | 90 | ;; Exit. |
| 88 | (with-current-buffer "*Messages*" (widen)) | ||
| 89 | (ignore-errors | 91 | (ignore-errors |
| 90 | (with-current-buffer buf (set-buffer-modified-p nil)) | 92 | (with-current-buffer buf (set-buffer-modified-p nil)) |
| 91 | (kill-buffer buf)) | 93 | (kill-buffer buf)) |
| @@ -106,13 +108,11 @@ | |||
| 106 | (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) | 108 | (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) |
| 107 | buf1 buf2) | 109 | buf1 buf2) |
| 108 | (unwind-protect | 110 | (unwind-protect |
| 109 | (progn | 111 | (ert-with-message-capture auto-revert--messages |
| 110 | (with-current-buffer (get-buffer-create "*Messages*") | 112 | (write-region "any text" nil tmpfile1 nil 'no-message) |
| 111 | (narrow-to-region (point-max) (point-max))) | 113 | (setq buf1 (find-file-noselect tmpfile1)) |
| 112 | (write-region "any text" nil tmpfile1 nil 'no-message) | 114 | (write-region "any text" nil tmpfile2 nil 'no-message) |
| 113 | (setq buf1 (find-file-noselect tmpfile1)) | 115 | (setq buf2 (find-file-noselect tmpfile2)) |
| 114 | (write-region "any text" nil tmpfile2 nil 'no-message) | ||
| 115 | (setq buf2 (find-file-noselect tmpfile2)) | ||
| 116 | 116 | ||
| 117 | (dolist (buf (list buf1 buf2)) | 117 | (dolist (buf (list buf1 buf2)) |
| 118 | (with-current-buffer buf | 118 | (with-current-buffer buf |
| @@ -148,7 +148,6 @@ | |||
| 148 | (should (string-match "another text" (buffer-string)))))) | 148 | (should (string-match "another text" (buffer-string)))))) |
| 149 | 149 | ||
| 150 | ;; Exit. | 150 | ;; Exit. |
| 151 | (with-current-buffer "*Messages*" (widen)) | ||
| 152 | (ignore-errors | 151 | (ignore-errors |
| 153 | (dolist (buf (list buf1 buf2)) | 152 | (dolist (buf (list buf1 buf2)) |
| 154 | (with-current-buffer buf (set-buffer-modified-p nil)) | 153 | (with-current-buffer buf (set-buffer-modified-p nil)) |
| @@ -165,8 +164,6 @@ | |||
| 165 | buf) | 164 | buf) |
| 166 | (unwind-protect | 165 | (unwind-protect |
| 167 | (progn | 166 | (progn |
| 168 | (with-current-buffer (get-buffer-create "*Messages*") | ||
| 169 | (narrow-to-region (point-max) (point-max))) | ||
| 170 | (write-region "any text" nil tmpfile nil 'no-message) | 167 | (write-region "any text" nil tmpfile nil 'no-message) |
| 171 | (setq buf (find-file-noselect tmpfile)) | 168 | (setq buf (find-file-noselect tmpfile)) |
| 172 | (with-current-buffer buf | 169 | (with-current-buffer buf |
| @@ -184,42 +181,38 @@ | |||
| 184 | 'before-revert-hook | 181 | 'before-revert-hook |
| 185 | (lambda () (delete-file buffer-file-name)) | 182 | (lambda () (delete-file buffer-file-name)) |
| 186 | nil t) | 183 | nil t) |
| 187 | (with-current-buffer (get-buffer-create "*Messages*") | ||
| 188 | (narrow-to-region (point-max) (point-max))) | ||
| 189 | (sleep-for 1) | ||
| 190 | (write-region "another text" nil tmpfile nil 'no-message) | ||
| 191 | 184 | ||
| 192 | ;; Check, that the buffer hasn't been reverted. File | 185 | (ert-with-message-capture auto-revert--messages |
| 193 | ;; notification should be disabled, falling back to | 186 | (sleep-for 1) |
| 194 | ;; polling. | 187 | (write-region "another text" nil tmpfile nil 'no-message) |
| 195 | (auto-revert--wait-for-revert buf) | 188 | (auto-revert--wait-for-revert buf)) |
| 189 | ;; Check, that the buffer hasn't been reverted. File | ||
| 190 | ;; notification should be disabled, falling back to | ||
| 191 | ;; polling. | ||
| 196 | (should (string-match "any text" (buffer-string))) | 192 | (should (string-match "any text" (buffer-string))) |
| 197 | (should-not auto-revert-use-notify) | 193 | ;; With w32notify, the 'stopped' events are not sent. |
| 194 | (or (eq file-notify--library 'w32notify) | ||
| 195 | (should-not auto-revert-use-notify)) | ||
| 198 | 196 | ||
| 199 | ;; Once the file has been recreated, the buffer shall be | 197 | ;; Once the file has been recreated, the buffer shall be |
| 200 | ;; reverted. | 198 | ;; reverted. |
| 201 | (kill-local-variable 'before-revert-hook) | 199 | (kill-local-variable 'before-revert-hook) |
| 202 | (with-current-buffer (get-buffer-create "*Messages*") | 200 | (ert-with-message-capture auto-revert--messages |
| 203 | (narrow-to-region (point-max) (point-max))) | 201 | (sleep-for 1) |
| 204 | (sleep-for 1) | 202 | (write-region "another text" nil tmpfile nil 'no-message) |
| 205 | (write-region "another text" nil tmpfile nil 'no-message) | 203 | (auto-revert--wait-for-revert buf)) |
| 206 | 204 | ;; Check, that the buffer has been reverted. | |
| 207 | ;; Check, that the buffer has been reverted. | ||
| 208 | (auto-revert--wait-for-revert buf) | ||
| 209 | (should (string-match "another text" (buffer-string))) | 205 | (should (string-match "another text" (buffer-string))) |
| 210 | 206 | ||
| 211 | ;; An empty file shall still be reverted. | 207 | ;; An empty file shall still be reverted. |
| 212 | (with-current-buffer (get-buffer-create "*Messages*") | 208 | (ert-with-message-capture auto-revert--messages |
| 213 | (narrow-to-region (point-max) (point-max))) | 209 | (sleep-for 1) |
| 214 | (sleep-for 1) | 210 | (write-region "" nil tmpfile nil 'no-message) |
| 215 | (write-region "" nil tmpfile nil 'no-message) | 211 | (auto-revert--wait-for-revert buf)) |
| 216 | 212 | ;; Check, that the buffer has been reverted. | |
| 217 | ;; Check, that the buffer has been reverted. | ||
| 218 | (auto-revert--wait-for-revert buf) | ||
| 219 | (should (string-equal "" (buffer-string))))) | 213 | (should (string-equal "" (buffer-string))))) |
| 220 | 214 | ||
| 221 | ;; Exit. | 215 | ;; Exit. |
| 222 | (with-current-buffer "*Messages*" (widen)) | ||
| 223 | (ignore-errors | 216 | (ignore-errors |
| 224 | (with-current-buffer buf (set-buffer-modified-p nil)) | 217 | (with-current-buffer buf (set-buffer-modified-p nil)) |
| 225 | (kill-buffer buf)) | 218 | (kill-buffer buf)) |
| @@ -232,9 +225,7 @@ | |||
| 232 | (let ((tmpfile (make-temp-file "auto-revert-test")) | 225 | (let ((tmpfile (make-temp-file "auto-revert-test")) |
| 233 | buf) | 226 | buf) |
| 234 | (unwind-protect | 227 | (unwind-protect |
| 235 | (progn | 228 | (ert-with-message-capture auto-revert--messages |
| 236 | (with-current-buffer (get-buffer-create "*Messages*") | ||
| 237 | (narrow-to-region (point-max) (point-max))) | ||
| 238 | (write-region "any text" nil tmpfile nil 'no-message) | 229 | (write-region "any text" nil tmpfile nil 'no-message) |
| 239 | (setq buf (find-file-noselect tmpfile)) | 230 | (setq buf (find-file-noselect tmpfile)) |
| 240 | (with-current-buffer buf | 231 | (with-current-buffer buf |
| @@ -259,7 +250,6 @@ | |||
| 259 | (string-match "modified text\nanother text" (buffer-string))))) | 250 | (string-match "modified text\nanother text" (buffer-string))))) |
| 260 | 251 | ||
| 261 | ;; Exit. | 252 | ;; Exit. |
| 262 | (with-current-buffer "*Messages*" (widen)) | ||
| 263 | (ignore-errors (kill-buffer buf)) | 253 | (ignore-errors (kill-buffer buf)) |
| 264 | (ignore-errors (delete-file tmpfile))))) | 254 | (ignore-errors (delete-file tmpfile))))) |
| 265 | 255 | ||
| @@ -283,33 +273,29 @@ | |||
| 283 | (should | 273 | (should |
| 284 | (string-match name (substring-no-properties (buffer-string)))) | 274 | (string-match name (substring-no-properties (buffer-string)))) |
| 285 | 275 | ||
| 286 | ;; Delete file. We wait for a second, in order to have | 276 | (ert-with-message-capture auto-revert--messages |
| 287 | ;; another timestamp. | 277 | ;; Delete file. We wait for a second, in order to have |
| 288 | (with-current-buffer (get-buffer-create "*Messages*") | 278 | ;; another timestamp. |
| 289 | (narrow-to-region (point-max) (point-max))) | 279 | (sleep-for 1) |
| 290 | (sleep-for 1) | 280 | (delete-file tmpfile) |
| 291 | (delete-file tmpfile) | 281 | (auto-revert--wait-for-revert buf)) |
| 292 | 282 | ;; Check, that the buffer has been reverted. | |
| 293 | ;; Check, that the buffer has been reverted. | ||
| 294 | (auto-revert--wait-for-revert buf) | ||
| 295 | (should-not | 283 | (should-not |
| 296 | (string-match name (substring-no-properties (buffer-string)))) | 284 | (string-match name (substring-no-properties (buffer-string)))) |
| 297 | 285 | ||
| 298 | ;; Make dired buffer modified. Check, that the buffer has | 286 | (ert-with-message-capture auto-revert--messages |
| 299 | ;; been still reverted. | 287 | ;; Make dired buffer modified. Check, that the buffer has |
| 300 | (with-current-buffer (get-buffer-create "*Messages*") | 288 | ;; been still reverted. |
| 301 | (narrow-to-region (point-max) (point-max))) | 289 | (set-buffer-modified-p t) |
| 302 | (set-buffer-modified-p t) | 290 | (sleep-for 1) |
| 303 | (sleep-for 1) | 291 | (write-region "any text" nil tmpfile nil 'no-message) |
| 304 | (write-region "any text" nil tmpfile nil 'no-message) | ||
| 305 | 292 | ||
| 306 | ;; Check, that the buffer has been reverted. | 293 | (auto-revert--wait-for-revert buf)) |
| 307 | (auto-revert--wait-for-revert buf) | 294 | ;; Check, that the buffer has been reverted. |
| 308 | (should | 295 | (should |
| 309 | (string-match name (substring-no-properties (buffer-string)))))) | 296 | (string-match name (substring-no-properties (buffer-string)))))) |
| 310 | 297 | ||
| 311 | ;; Exit. | 298 | ;; Exit. |
| 312 | (with-current-buffer "*Messages*" (widen)) | ||
| 313 | (ignore-errors | 299 | (ignore-errors |
| 314 | (with-current-buffer buf (set-buffer-modified-p nil)) | 300 | (with-current-buffer buf (set-buffer-modified-p nil)) |
| 315 | (kill-buffer buf)) | 301 | (kill-buffer buf)) |
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/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el new file mode 100644 index 00000000000..1eb791a993c --- /dev/null +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el | |||
| @@ -0,0 +1,493 @@ | |||
| 1 | ;;;; testcases.el -- Test cases for testcover-tests.el | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Gemini Lasswell | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; This program is free software: you can redistribute it and/or | ||
| 10 | ;; modify it under the terms of the GNU General Public License as | ||
| 11 | ;; published by the Free Software Foundation, either version 3 of the | ||
| 12 | ;; License, or (at your option) any later version. | ||
| 13 | ;; | ||
| 14 | ;; This program is distributed in the hope that it will be useful, but | ||
| 15 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | ||
| 17 | ;; General Public License for more details. | ||
| 18 | ;; | ||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with this program. If not, see `http://www.gnu.org/licenses/'. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | ;; * This file should not be loaded directly. It is meant to be read | ||
| 25 | ;; by `testcover-tests-build-test-cases'. | ||
| 26 | ;; | ||
| 27 | ;; * Test cases begin with ;; ==== name ====. The symbol name between | ||
| 28 | ;; the ===='s is used to create the name of the test. | ||
| 29 | ;; | ||
| 30 | ;; * Following the beginning comment place the test docstring and | ||
| 31 | ;; any tags or keywords for ERT. These will be spliced into the | ||
| 32 | ;; ert-deftest for the test. | ||
| 33 | ;; | ||
| 34 | ;; * To separate the above from the test case code, use another | ||
| 35 | ;; comment: ;; ==== | ||
| 36 | ;; | ||
| 37 | ;; * These special comments should start at the beginning of a line. | ||
| 38 | ;; | ||
| 39 | ;; * `testcover-tests-skeleton' will prompt you for a test name and | ||
| 40 | ;; insert the special comments. | ||
| 41 | ;; | ||
| 42 | ;; * The test case code should be annotated with %%% at the end of | ||
| 43 | ;; each form where a tan splotch is expected, and !!! at the end | ||
| 44 | ;; of each form where a red mark is expected. | ||
| 45 | ;; | ||
| 46 | ;; * If Testcover is working correctly on your code sample, using | ||
| 47 | ;; `testcover-tests-markup-region' and | ||
| 48 | ;; `testcover-tests-unmarkup-region' can make creating test cases | ||
| 49 | ;; easier. | ||
| 50 | |||
| 51 | ;;; Code: | ||
| 52 | ;;; Test Cases: | ||
| 53 | |||
| 54 | ;; ==== constants-bug-25316 ==== | ||
| 55 | "Testcover doesn't splotch constants." | ||
| 56 | :expected-result :failed | ||
| 57 | ;; ==== | ||
| 58 | (defconst testcover-testcase-const "apples") | ||
| 59 | (defun testcover-testcase-zero () 0) | ||
| 60 | (defun testcover-testcase-list-consts () | ||
| 61 | (list | ||
| 62 | emacs-version 10 | ||
| 63 | "hello" | ||
| 64 | `(a b c ,testcover-testcase-const) | ||
| 65 | '(1 2 3) | ||
| 66 | testcover-testcase-const | ||
| 67 | (testcover-testcase-zero) | ||
| 68 | nil)) | ||
| 69 | |||
| 70 | (defun testcover-testcase-add-to-const-list (arg) | ||
| 71 | (cons arg%%% (testcover-testcase-list-consts))%%%) | ||
| 72 | |||
| 73 | (should (equal (testcover-testcase-add-to-const-list 'a) | ||
| 74 | `(a ,emacs-version 10 "hello" (a b c "apples") (1 2 3) | ||
| 75 | "apples" 0 nil))) | ||
| 76 | |||
| 77 | ;; ==== customize-defcustom-bug-25326 ==== | ||
| 78 | "Testcover doesn't prevent testing of defcustom values." | ||
| 79 | :expected-result :failed | ||
| 80 | ;; ==== | ||
| 81 | (defgroup testcover-testcase nil | ||
| 82 | "Test case for testcover" | ||
| 83 | :group 'lisp | ||
| 84 | :prefix "testcover-testcase-" | ||
| 85 | :version "26.0") | ||
| 86 | (defcustom testcover-testcase-flag t | ||
| 87 | "Test value used by testcover-tests.el" | ||
| 88 | :type 'boolean | ||
| 89 | :group 'testcover-testcase) | ||
| 90 | (defun testcover-testcase-get-flag () | ||
| 91 | testcover-testcase-flag) | ||
| 92 | |||
| 93 | (testcover-testcase-get-flag) | ||
| 94 | (setq testcover-testcase-flag (not testcover-testcase-flag)) | ||
| 95 | (testcover-testcase-get-flag) | ||
| 96 | |||
| 97 | ;; ==== no-returns ==== | ||
| 98 | "Testcover doesn't splotch functions which don't return." | ||
| 99 | ;; ==== | ||
| 100 | (defun testcover-testcase-play-ball (retval) | ||
| 101 | (catch 'ball | ||
| 102 | (throw 'ball retval%%%))%%%) ; catch gets marked but not throw | ||
| 103 | |||
| 104 | (defun testcover-testcase-not-my-favorite-error-message () | ||
| 105 | (signal 'wrong-type-argument (list 'consp nil))) | ||
| 106 | |||
| 107 | (should (testcover-testcase-play-ball t)) | ||
| 108 | (condition-case nil | ||
| 109 | (testcover-testcase-not-my-favorite-error-message) | ||
| 110 | (error nil)) | ||
| 111 | |||
| 112 | ;; ==== noreturn-symbol ==== | ||
| 113 | "Wrapping a form with noreturn prevents splotching." | ||
| 114 | ;; ==== | ||
| 115 | (defun testcover-testcase-cancel (spacecraft) | ||
| 116 | (error "no destination for %s" spacecraft)) | ||
| 117 | (defun testcover-testcase-launch (spacecraft planet) | ||
| 118 | (if (null planet) | ||
| 119 | (noreturn (testcover-testcase-cancel spacecraft%%%)) | ||
| 120 | (list spacecraft%%% planet%%%)%%%)%%%) | ||
| 121 | (defun testcover-testcase-launch-2 (spacecraft planet) | ||
| 122 | (if (null planet%%%)%%% | ||
| 123 | (testcover-testcase-cancel spacecraft%%%)!!! | ||
| 124 | (list spacecraft!!! planet!!!)!!!)!!!) | ||
| 125 | (should (equal (testcover-testcase-launch "Curiosity" "Mars") '("Curiosity" "Mars"))) | ||
| 126 | (condition-case err | ||
| 127 | (testcover-testcase-launch "Voyager" nil) | ||
| 128 | (error err)) | ||
| 129 | (condition-case err | ||
| 130 | (testcover-testcase-launch-2 "Voyager II" nil) | ||
| 131 | (error err)) | ||
| 132 | |||
| 133 | (should-error (testcover-testcase-launch "Voyager" nil)) | ||
| 134 | (should-error (testcover-testcase-launch-2 "Voyager II" nil)) | ||
| 135 | |||
| 136 | ;; ==== 1-value-symbol-bug-25316 ==== | ||
| 137 | "Wrapping a form with 1value prevents splotching." | ||
| 138 | :expected-result :failed | ||
| 139 | ;; ==== | ||
| 140 | (defun testcover-testcase-always-zero (num) | ||
| 141 | (- num%%% num%%%)%%%) | ||
| 142 | (defun testcover-testcase-still-always-zero (num) | ||
| 143 | (1value (- num%%% num%%% (- num%%% num%%%)%%%))) | ||
| 144 | (defun testcover-testcase-never-called (num) | ||
| 145 | (1value (/ num!!! num!!!)!!!)!!!) | ||
| 146 | (should (eql 0 (testcover-testcase-always-zero 3))) | ||
| 147 | (should (eql 0 (testcover-testcase-still-always-zero 5))) | ||
| 148 | |||
| 149 | ;; ==== dotimes-dolist ==== | ||
| 150 | "Dolist and dotimes with a 1valued return value are 1valued." | ||
| 151 | ;; ==== | ||
| 152 | (defun testcover-testcase-do-over (things) | ||
| 153 | (dolist (thing things%%%) | ||
| 154 | (list thing)) | ||
| 155 | (dolist (thing things%%% 42) | ||
| 156 | (list thing)) | ||
| 157 | (dolist (thing things%%% things%%%) | ||
| 158 | (list thing))%%%) | ||
| 159 | (defun testcover-testcase-do-more (count) | ||
| 160 | (dotimes (num count%%%) | ||
| 161 | (+ num num)) | ||
| 162 | (dotimes (num count%%% count%%%) | ||
| 163 | (+ num num))%%% | ||
| 164 | (dotimes (num count%%% 0) | ||
| 165 | (+ num num))) | ||
| 166 | (should (equal '(a b c) (testcover-testcase-do-over '(a b c)))) | ||
| 167 | (should (eql 0 (testcover-testcase-do-more 2))) | ||
| 168 | |||
| 169 | ;; ==== let-last-form ==== | ||
| 170 | "A let form is 1valued if its last form is 1valued." | ||
| 171 | ;; ==== | ||
| 172 | (defun testcover-testcase-double (num) | ||
| 173 | (let ((double (* num%%% 2)%%%)) | ||
| 174 | double%%%)%%%) | ||
| 175 | (defun testcover-testcase-nullbody-let (num) | ||
| 176 | (let* ((square (* num%%% num%%%)%%%) | ||
| 177 | (double (* 2 num%%%)%%%)))) | ||
| 178 | (defun testcover-testcase-answer () | ||
| 179 | (let ((num 100)) | ||
| 180 | 42)) | ||
| 181 | (should-not (testcover-testcase-nullbody-let 3)) | ||
| 182 | (should (eql (testcover-testcase-answer) 42)) | ||
| 183 | (should (eql (testcover-testcase-double 10) 20)) | ||
| 184 | |||
| 185 | ;; ==== if-with-1value-clauses ==== | ||
| 186 | "An if is 1valued if both then and else are 1valued." | ||
| 187 | ;; ==== | ||
| 188 | (defun testcover-testcase-describe (val) | ||
| 189 | (if (zerop val%%%)%%% | ||
| 190 | "a number" | ||
| 191 | "a different number")) | ||
| 192 | (defun testcover-testcase-describe-2 (val) | ||
| 193 | (if (zerop val) | ||
| 194 | "zero" | ||
| 195 | "not zero")) | ||
| 196 | (defun testcover-testcase-describe-3 (val) | ||
| 197 | (if (zerop val%%%)%%% | ||
| 198 | "zero" | ||
| 199 | (format "%d" val%%%)%%%)%%%) | ||
| 200 | (should (equal (testcover-testcase-describe 0) "a number")) | ||
| 201 | (should (equal (testcover-testcase-describe-2 0) "zero")) | ||
| 202 | (should (equal (testcover-testcase-describe-2 1) "not zero")) | ||
| 203 | (should (equal (testcover-testcase-describe-3 1) "1")) | ||
| 204 | |||
| 205 | ;; ==== cond-with-1value-clauses ==== | ||
| 206 | "A cond form is marked 1valued if all clauses are 1valued." | ||
| 207 | ;; ==== | ||
| 208 | (defun testcover-testcase-cond (num) | ||
| 209 | (cond | ||
| 210 | ((eql num%%% 0)%%% 'a) | ||
| 211 | ((eql num%%% 1)%%% 'b) | ||
| 212 | ((eql num!!! 2)!!! 'c))) | ||
| 213 | (defun testcover-testcase-cond-2 (num) | ||
| 214 | (cond | ||
| 215 | ((eql num%%% 0)%%% (cons 'a 0)!!!) | ||
| 216 | ((eql num%%% 1)%%% 'b))%%%) | ||
| 217 | (should (eql (testcover-testcase-cond 1) 'b)) | ||
| 218 | (should (eql (testcover-testcase-cond-2 1) 'b)) | ||
| 219 | |||
| 220 | ;; ==== condition-case-with-1value-components ==== | ||
| 221 | "A condition-case is marked 1valued if its body and handlers are." | ||
| 222 | ;; ==== | ||
| 223 | (defun testcover-testcase-cc (arg) | ||
| 224 | (condition-case nil | ||
| 225 | (if (null arg%%%)%%% | ||
| 226 | (error "foo") | ||
| 227 | "0")!!! | ||
| 228 | (error nil))) | ||
| 229 | (should-not (testcover-testcase-cc nil)) | ||
| 230 | |||
| 231 | ;; ==== quotes-within-backquotes-bug-25316 ==== | ||
| 232 | "Forms to instrument are found within quotes within backquotes." | ||
| 233 | :expected-result :failed | ||
| 234 | ;; ==== | ||
| 235 | (defun testcover-testcase-make-list () | ||
| 236 | (list 'defun 'defvar)) | ||
| 237 | (defmacro testcover-testcase-bq-macro (arg) | ||
| 238 | (declare (debug t)) | ||
| 239 | `(memq ,arg%%% '(defconst ,@(testcover-testcase-make-list)))%%%) | ||
| 240 | (defun testcover-testcase-use-bq-macro (arg) | ||
| 241 | (testcover-testcase-bq-macro arg%%%)%%%) | ||
| 242 | (should (equal '(defun defvar) (testcover-testcase-use-bq-macro 'defun))) | ||
| 243 | |||
| 244 | ;; ==== progn-functions ==== | ||
| 245 | "Some forms are 1value if their last argument is 1value." | ||
| 246 | ;; ==== | ||
| 247 | (defun testcover-testcase-one (arg) | ||
| 248 | (progn | ||
| 249 | (setq arg (1- arg%%%)%%%)%%%)%%% | ||
| 250 | (progn | ||
| 251 | (setq arg (1+ arg%%%)%%%)%%% | ||
| 252 | 1)) | ||
| 253 | |||
| 254 | (should (eql 1 (testcover-testcase-one 0))) | ||
| 255 | ;; ==== prog1-functions ==== | ||
| 256 | "Some forms are 1value if their first argument is 1value." | ||
| 257 | ;; ==== | ||
| 258 | (defun testcover-testcase-unwinder (arg) | ||
| 259 | (unwind-protect | ||
| 260 | (if ( > arg%%% 0)%%% | ||
| 261 | 1 | ||
| 262 | 0) | ||
| 263 | (format "unwinding %s!" arg%%%)%%%)) | ||
| 264 | (defun testcover-testcase-divider (arg) | ||
| 265 | (unwind-protect | ||
| 266 | (/ 100 arg%%%)%%% | ||
| 267 | (format "unwinding! %s" arg%%%)%%%)%%%) | ||
| 268 | |||
| 269 | (should (eq 0 (testcover-testcase-unwinder 0))) | ||
| 270 | (should (eq 1 (testcover-testcase-divider 100))) | ||
| 271 | |||
| 272 | ;; ==== compose-functions ==== | ||
| 273 | "Some functions are 1value if all their arguments are 1value." | ||
| 274 | ;; ==== | ||
| 275 | (defconst testcover-testcase-count 3) | ||
| 276 | (defun testcover-testcase-number () | ||
| 277 | (+ 1 testcover-testcase-count)) | ||
| 278 | (defun testcover-testcase-more () | ||
| 279 | (+ 1 (testcover-testcase-number) testcover-testcase-count)) | ||
| 280 | |||
| 281 | (should (equal (testcover-testcase-more) 8)) | ||
| 282 | |||
| 283 | ;; ==== apply-quoted-symbol ==== | ||
| 284 | "Apply with a quoted function symbol treated as 1value if function is." | ||
| 285 | ;; ==== | ||
| 286 | (defun testcover-testcase-numlist (flag) | ||
| 287 | (if flag%%% | ||
| 288 | '(1 2 3) | ||
| 289 | '(4 5 6))) | ||
| 290 | (defun testcover-testcase-sum (flag) | ||
| 291 | (apply '+ (testcover-testcase-numlist flag%%%))) | ||
| 292 | (defun testcover-testcase-label () | ||
| 293 | (apply 'message "edebug uses: %s %s" (list 1 2)!!!)!!!) | ||
| 294 | |||
| 295 | (should (equal 6 (testcover-testcase-sum t))) | ||
| 296 | |||
| 297 | ;; ==== backquote-1value-bug-24509 ==== | ||
| 298 | "Commas within backquotes are recognized as non-1value." | ||
| 299 | :expected-result :failed | ||
| 300 | ;; ==== | ||
| 301 | (defmacro testcover-testcase-lambda (&rest body) | ||
| 302 | `(lambda () ,@body)) | ||
| 303 | |||
| 304 | (defun testcover-testcase-example () | ||
| 305 | (let ((lambda-1 (testcover-testcase-lambda (format "lambda-%d" 1))%%%) | ||
| 306 | (lambda-2 (testcover-testcase-lambda (format "lambda-%d" 2))%%%)) | ||
| 307 | (concat (funcall lambda-1%%%)%%% " " | ||
| 308 | (funcall lambda-2%%%)%%%)%%%)%%%) | ||
| 309 | |||
| 310 | (defmacro testcover-testcase-message-symbol (name) | ||
| 311 | `(message "%s" ',name)) | ||
| 312 | |||
| 313 | (defun testcover-testcase-example-2 () | ||
| 314 | (concat | ||
| 315 | (testcover-testcase-message-symbol foo)%%% | ||
| 316 | (testcover-testcase-message-symbol bar)%%%)%%%) | ||
| 317 | |||
| 318 | (should (equal "lambda-1 lambda-2" (testcover-testcase-example))) | ||
| 319 | (should (equal "foobar" (testcover-testcase-example-2))) | ||
| 320 | |||
| 321 | ;; ==== pcase-bug-24688 ==== | ||
| 322 | "Testcover copes with condition-case within backquoted list." | ||
| 323 | :expected-result :failed | ||
| 324 | ;; ==== | ||
| 325 | (defun testcover-testcase-pcase (form) | ||
| 326 | (pcase form%%% | ||
| 327 | (`(condition-case ,var ,protected-form . ,handlers) | ||
| 328 | (list var%%% protected-form%%% handlers%%%)%%%) | ||
| 329 | (_ nil))%%%) | ||
| 330 | |||
| 331 | (should (equal (testcover-testcase-pcase '(condition-case a | ||
| 332 | (/ 5 a) | ||
| 333 | (error 0))) | ||
| 334 | '(a (/ 5 a) ((error 0))))) | ||
| 335 | |||
| 336 | ;; ==== defun-in-backquote-bug-11307-and-24743 ==== | ||
| 337 | "Testcover handles defun forms within backquoted list." | ||
| 338 | :expected-result :failed | ||
| 339 | ;; ==== | ||
| 340 | (defmacro testcover-testcase-defun (name &rest body) | ||
| 341 | (declare (debug (symbolp def-body))) | ||
| 342 | `(defun ,name () ,@body)) | ||
| 343 | |||
| 344 | (testcover-testcase-defun foo (+ 1 2)) | ||
| 345 | (testcover-testcase-defun bar (+ 3 4)) | ||
| 346 | (should (eql (foo) 3)) | ||
| 347 | (should (eql (bar) 7)) | ||
| 348 | |||
| 349 | ;; ==== closure-1value-bug ==== | ||
| 350 | "Testcover does not mark closures as 1value." | ||
| 351 | :expected-result :failed | ||
| 352 | ;; ==== | ||
| 353 | ;; -*- lexical-binding:t -*- | ||
| 354 | (setq testcover-testcase-foo nil) | ||
| 355 | (setq testcover-testcase-bar 0) | ||
| 356 | |||
| 357 | (defun testcover-testcase-baz (arg) | ||
| 358 | (setq testcover-testcase-foo | ||
| 359 | (lambda () (+ arg testcover-testcase-bar%%%)))) | ||
| 360 | |||
| 361 | (testcover-testcase-baz 2) | ||
| 362 | (should (equal 2 (funcall testcover-testcase-foo))) | ||
| 363 | (testcover-testcase-baz 3) | ||
| 364 | (should (equal 3 (funcall testcover-testcase-foo))) | ||
| 365 | |||
| 366 | ;; ==== by-value-vs-by-reference-bug-25351 ==== | ||
| 367 | "An object created by a 1value expression may be modified by other code." | ||
| 368 | :expected-result :failed | ||
| 369 | ;; ==== | ||
| 370 | (defun testcover-testcase-ab () | ||
| 371 | (list 'a 'b)) | ||
| 372 | (defun testcover-testcase-change-it (arg) | ||
| 373 | (setf (cadr arg%%%)%%% 'c)%%% | ||
| 374 | arg%%%) | ||
| 375 | |||
| 376 | (should (equal (testcover-testcase-change-it (testcover-testcase-ab)) '(a c))) | ||
| 377 | (should (equal (testcover-testcase-ab) '(a b))) | ||
| 378 | |||
| 379 | ;; ==== 1value-error-test ==== | ||
| 380 | "Forms wrapped by `1value' should always return the same value." | ||
| 381 | ;; ==== | ||
| 382 | (defun testcover-testcase-thing (arg) | ||
| 383 | (1value (list 1 arg 3))) | ||
| 384 | |||
| 385 | (should (equal '(1 2 3) (testcover-testcase-thing 2))) | ||
| 386 | (should-error (testcover-testcase-thing 3)) | ||
| 387 | |||
| 388 | ;; ==== dotted-backquote ==== | ||
| 389 | "Testcover correctly instruments dotted backquoted lists." | ||
| 390 | ;; ==== | ||
| 391 | (defun testcover-testcase-dotted-bq (flag extras) | ||
| 392 | (let* ((bq | ||
| 393 | `(a b c . ,(and flag extras%%%)))) | ||
| 394 | bq)) | ||
| 395 | |||
| 396 | (should (equal '(a b c) (testcover-testcase-dotted-bq nil '(d e)))) | ||
| 397 | (should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e)))) | ||
| 398 | |||
| 399 | ;; ==== backquoted-vector-bug-25316 ==== | ||
| 400 | "Testcover reinstruments within backquoted vectors." | ||
| 401 | :expected-result :failed | ||
| 402 | ;; ==== | ||
| 403 | (defun testcover-testcase-vec (a b c) | ||
| 404 | `[,a%%% ,(list b%%% c%%%)%%%]%%%) | ||
| 405 | |||
| 406 | (defun testcover-testcase-vec-in-list (d e f) | ||
| 407 | `([[,d%%% ,e%%%] ,f%%%])%%%) | ||
| 408 | |||
| 409 | (defun testcover-testcase-vec-arg (num) | ||
| 410 | (list `[,num%%%]%%%)%%%) | ||
| 411 | |||
| 412 | (should (equal [1 (2 3)] (testcover-testcase-vec 1 2 3))) | ||
| 413 | (should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6))) | ||
| 414 | (should (equal '([100]) (testcover-testcase-vec-arg 100))) | ||
| 415 | |||
| 416 | ;; ==== vector-in-macro-spec-bug-25316 ==== | ||
| 417 | "Testcover reinstruments within vectors." | ||
| 418 | :expected-result :failed | ||
| 419 | ;; ==== | ||
| 420 | (defmacro testcover-testcase-nth-case (arg vec) | ||
| 421 | (declare (indent 1) | ||
| 422 | (debug (form (vector &rest form)))) | ||
| 423 | `(eval (aref ,vec%%% ,arg%%%))%%%) | ||
| 424 | |||
| 425 | (defun testcover-testcase-use-nth-case (choice val) | ||
| 426 | (testcover-testcase-nth-case choice | ||
| 427 | [(+ 1 val!!!)!!! | ||
| 428 | (- 1 val%%%)%%% | ||
| 429 | (* 7 val) | ||
| 430 | (/ 4 val!!!)!!!])) | ||
| 431 | |||
| 432 | (should (eql 42 (testcover-testcase-use-nth-case 2 6))) | ||
| 433 | (should (eql 49 (testcover-testcase-use-nth-case 2 7))) | ||
| 434 | (should (eql 0 (testcover-testcase-use-nth-case 1 1 ))) | ||
| 435 | |||
| 436 | ;; ==== mapcar-is-not-compose ==== | ||
| 437 | "Mapcar with 1value arguments is not 1value." | ||
| 438 | :expected-result :failed | ||
| 439 | ;; ==== | ||
| 440 | (defvar testcover-testcase-num 0) | ||
| 441 | (defun testcover-testcase-add-num (n) | ||
| 442 | (+ testcover-testcase-num n)) | ||
| 443 | (defun testcover-testcase-mapcar-sides () | ||
| 444 | (mapcar 'testcover-testcase-add-num '(1 2 3))) | ||
| 445 | |||
| 446 | (setq testcover-testcase-num 1) | ||
| 447 | (should (equal (testcover-testcase-mapcar-sides) '(2 3 4))) | ||
| 448 | (setq testcover-testcase-num 2) | ||
| 449 | (should (equal (testcover-testcase-mapcar-sides) '(3 4 5))) | ||
| 450 | |||
| 451 | ;; ==== function-with-edebug-spec-bug-25316 ==== | ||
| 452 | "Functions can have edebug specs too. | ||
| 453 | See c-make-font-lock-search-function for an example in the Emacs | ||
| 454 | sources. The other issue is that it's ok to use quote in an | ||
| 455 | edebug spec, so testcover needs to cope with that." | ||
| 456 | :expected-result :failed | ||
| 457 | ;; ==== | ||
| 458 | (defun testcover-testcase-make-function (forms) | ||
| 459 | `(lambda (flag) (if flag 0 ,@forms%%%))%%%) | ||
| 460 | |||
| 461 | (def-edebug-spec testcover-testcase-make-function | ||
| 462 | (("quote" (&rest def-form)))) | ||
| 463 | |||
| 464 | (defun testcover-testcase-thing () | ||
| 465 | (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%) | ||
| 466 | |||
| 467 | (defun testcover-testcase-use-thing () | ||
| 468 | (funcall (testcover-testcase-thing)%%% nil)%%%) | ||
| 469 | |||
| 470 | (should (equal (testcover-testcase-use-thing) 15)) | ||
| 471 | |||
| 472 | ;; ==== backquoted-dotted-alist ==== | ||
| 473 | "Testcover can instrument a dotted alist constructed with backquote." | ||
| 474 | ;; ==== | ||
| 475 | (defun testcover-testcase-make-alist (expr entries) | ||
| 476 | `((0 . ,expr%%%) . ,entries%%%)%%%) | ||
| 477 | |||
| 478 | (should (equal (testcover-testcase-make-alist "foo" '((1 . "bar") (2 . "baz"))) | ||
| 479 | '((0 . "foo") (1 . "bar") (2 . "baz")))) | ||
| 480 | |||
| 481 | ;; ==== coverage-of-the-unknown-symbol-bug-25471 ==== | ||
| 482 | "Testcover correctly records coverage of code which uses `unknown'" | ||
| 483 | :expected-result :failed | ||
| 484 | ;; ==== | ||
| 485 | (defun testcover-testcase-how-do-i-know-you (name) | ||
| 486 | (let ((val 'unknown)) | ||
| 487 | (when (equal name%%% "Bob")%%% | ||
| 488 | (setq val 'known)!!!) | ||
| 489 | val%%%)%%%) | ||
| 490 | |||
| 491 | (should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown)) | ||
| 492 | |||
| 493 | ;; testcases.el ends here. | ||
diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el new file mode 100644 index 00000000000..d31379c3aa2 --- /dev/null +++ b/test/lisp/emacs-lisp/testcover-tests.el | |||
| @@ -0,0 +1,186 @@ | |||
| 1 | ;;; testcover-tests.el --- Testcover test suite -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Gemini Lasswell | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; This program is free software: you can redistribute it and/or | ||
| 10 | ;; modify it under the terms of the GNU General Public License as | ||
| 11 | ;; published by the Free Software Foundation, either version 3 of the | ||
| 12 | ;; License, or (at your option) any later version. | ||
| 13 | ;; | ||
| 14 | ;; This program is distributed in the hope that it will be useful, but | ||
| 15 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | ||
| 17 | ;; General Public License for more details. | ||
| 18 | ;; | ||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with this program. If not, see `http://www.gnu.org/licenses/'. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | ;; Testcover test suite. | ||
| 25 | ;; * All the test cases are in testcover-resources/testcover-cases.el. | ||
| 26 | ;; See that file for an explanation of the test case format. | ||
| 27 | ;; * `testcover-tests-define-tests', which is run when this file is | ||
| 28 | ;; loaded, reads testcover-resources/testcover-cases.el and defines | ||
| 29 | ;; ERT tests for each test case. | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | (require 'ert) | ||
| 34 | (require 'testcover) | ||
| 35 | (require 'skeleton) | ||
| 36 | |||
| 37 | ;; Use `eval-and-compile' around all these definitions because they're | ||
| 38 | ;; used by the macro `testcover-tests-define-tests'. | ||
| 39 | |||
| 40 | (eval-and-compile | ||
| 41 | (defvar testcover-tests-file-dir | ||
| 42 | (expand-file-name | ||
| 43 | "testcover-resources/" | ||
| 44 | (file-name-directory (or (bound-and-true-p byte-compile-current-file) | ||
| 45 | load-file-name | ||
| 46 | buffer-file-name))) | ||
| 47 | "Directory of the \"testcover-tests.el\" file.")) | ||
| 48 | |||
| 49 | (eval-and-compile | ||
| 50 | (defvar testcover-tests-test-cases | ||
| 51 | (expand-file-name "testcases.el" testcover-tests-file-dir) | ||
| 52 | "File containing marked up code to instrument and check.")) | ||
| 53 | |||
| 54 | ;; Convert Testcover's overlays to plain text. | ||
| 55 | |||
| 56 | (eval-and-compile | ||
| 57 | (defun testcover-tests-markup-region (beg end &rest optargs) | ||
| 58 | "Mark up test code within region between BEG and END. | ||
| 59 | Convert Testcover's tan and red splotches to %%% and !!! for | ||
| 60 | testcases.el. This can be used to create test cases if Testcover | ||
| 61 | is working correctly on a code sample. OPTARGS are optional | ||
| 62 | arguments for `testcover-start'." | ||
| 63 | (interactive "r") | ||
| 64 | (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")) | ||
| 65 | (code (buffer-substring beg end)) | ||
| 66 | (marked-up-code)) | ||
| 67 | (unwind-protect | ||
| 68 | (progn | ||
| 69 | (with-temp-file tempfile | ||
| 70 | (insert code)) | ||
| 71 | (save-current-buffer | ||
| 72 | (let ((buf (find-file-noselect tempfile))) | ||
| 73 | (set-buffer buf) | ||
| 74 | (apply 'testcover-start (cons tempfile optargs)) | ||
| 75 | (testcover-mark-all buf) | ||
| 76 | (dolist (overlay (overlays-in (point-min) (point-max))) | ||
| 77 | (let ((ov-face (overlay-get overlay 'face))) | ||
| 78 | (goto-char (overlay-end overlay)) | ||
| 79 | (cond | ||
| 80 | ((eq ov-face 'testcover-nohits) (insert "!!!")) | ||
| 81 | ((eq ov-face 'testcover-1value) (insert "%%%")) | ||
| 82 | (t nil)))) | ||
| 83 | (setq marked-up-code (buffer-string))) | ||
| 84 | (set-buffer-modified-p nil))) | ||
| 85 | (ignore-errors (kill-buffer (find-file-noselect tempfile))) | ||
| 86 | (ignore-errors (delete-file tempfile))) | ||
| 87 | |||
| 88 | ;; Now replace the original code with the marked up code. | ||
| 89 | (delete-region beg end) | ||
| 90 | (insert marked-up-code)))) | ||
| 91 | |||
| 92 | (eval-and-compile | ||
| 93 | (defun testcover-tests-unmarkup-region (beg end) | ||
| 94 | "Remove the markup used in testcases.el between BEG and END." | ||
| 95 | (interactive "r") | ||
| 96 | (save-excursion | ||
| 97 | (save-restriction | ||
| 98 | (narrow-to-region beg end) | ||
| 99 | (goto-char (point-min)) | ||
| 100 | (while (re-search-forward "!!!\\|%%%" nil t) | ||
| 101 | (replace-match "")))))) | ||
| 102 | |||
| 103 | (define-skeleton testcover-tests-skeleton | ||
| 104 | "Write a testcase for testcover-tests.el." | ||
| 105 | "Enter name of test: " | ||
| 106 | ";; ==== " str " ====\n" | ||
| 107 | "\"docstring\"\n" | ||
| 108 | ";; Directives for ERT should go here, if any.\n" | ||
| 109 | ";; ====\n" | ||
| 110 | ";; Replace this line with annotated test code.\n") | ||
| 111 | |||
| 112 | ;; Check a test case. | ||
| 113 | |||
| 114 | (eval-and-compile | ||
| 115 | (defun testcover-tests-run-test-case (marked-up-code) | ||
| 116 | "Test the operation of Testcover on the string MARKED-UP-CODE." | ||
| 117 | (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))) | ||
| 118 | (unwind-protect | ||
| 119 | (progn | ||
| 120 | (with-temp-file tempfile | ||
| 121 | (insert marked-up-code)) | ||
| 122 | ;; Remove the marks and mark the code up again. The original | ||
| 123 | ;; and recreated versions should match. | ||
| 124 | (save-current-buffer | ||
| 125 | (set-buffer (find-file-noselect tempfile)) | ||
| 126 | ;; Fail the test if the debugger tries to become active, | ||
| 127 | ;; which will happen if Testcover's reinstrumentation | ||
| 128 | ;; leaves an edebug-enter in the code. This will also | ||
| 129 | ;; prevent debugging these tests using Edebug. | ||
| 130 | (cl-letf (((symbol-function #'edebug-enter) | ||
| 131 | (lambda (&rest _args) | ||
| 132 | (ert-fail | ||
| 133 | (concat "Debugger invoked during test run " | ||
| 134 | "(possible edebug-enter not replaced)"))))) | ||
| 135 | (dolist (byte-compile '(t nil)) | ||
| 136 | (testcover-tests-unmarkup-region (point-min) (point-max)) | ||
| 137 | (unwind-protect | ||
| 138 | (testcover-tests-markup-region (point-min) (point-max) byte-compile) | ||
| 139 | (set-buffer-modified-p nil)) | ||
| 140 | (should (string= marked-up-code | ||
| 141 | (buffer-string))))))) | ||
| 142 | (ignore-errors (kill-buffer (find-file-noselect tempfile))) | ||
| 143 | (ignore-errors (delete-file tempfile)))))) | ||
| 144 | |||
| 145 | ;; Convert test case file to ert-defmethod. | ||
| 146 | |||
| 147 | (eval-and-compile | ||
| 148 | (defun testcover-tests-build-test-cases () | ||
| 149 | "Parse the test case file and return a list of ERT test definitions. | ||
| 150 | Construct and return a list of `ert-deftest' forms. See testcases.el | ||
| 151 | for documentation of the test definition format." | ||
| 152 | (let (results) | ||
| 153 | (with-temp-buffer | ||
| 154 | (insert-file-contents testcover-tests-test-cases) | ||
| 155 | (goto-char (point-min)) | ||
| 156 | (while (re-search-forward | ||
| 157 | (concat "^;; ==== \\([^ ]+?\\) ====\n" | ||
| 158 | "\\(\\(?:.*\n\\)*?\\)" | ||
| 159 | ";; ====\n" | ||
| 160 | "\\(\\(?:.*\n\\)*?\\)" | ||
| 161 | "\\(\\'\\|;; ====\\)") | ||
| 162 | nil t) | ||
| 163 | (let ((name (match-string 1)) | ||
| 164 | (splice (car (read-from-string | ||
| 165 | (format "(%s)" (match-string 2))))) | ||
| 166 | (code (match-string 3))) | ||
| 167 | (push | ||
| 168 | `(ert-deftest ,(intern (concat "testcover-tests-" name)) () | ||
| 169 | ,@splice | ||
| 170 | (testcover-tests-run-test-case ,code)) | ||
| 171 | results)) | ||
| 172 | (beginning-of-line))) | ||
| 173 | results))) | ||
| 174 | |||
| 175 | ;; Define all the tests. | ||
| 176 | |||
| 177 | (defmacro testcover-tests-define-tests () | ||
| 178 | "Construct and define ERT test methods using the test case file." | ||
| 179 | (let* ((test-cases (testcover-tests-build-test-cases))) | ||
| 180 | `(progn ,@test-cases))) | ||
| 181 | |||
| 182 | (testcover-tests-define-tests) | ||
| 183 | |||
| 184 | (provide 'testcover-tests) | ||
| 185 | |||
| 186 | ;;; testcover-tests.el ends here | ||
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..27434bcef20 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el | |||
| @@ -36,6 +36,7 @@ | |||
| 36 | ;;; Code: | 36 | ;;; Code: |
| 37 | 37 | ||
| 38 | (require 'ert) | 38 | (require 'ert) |
| 39 | (require 'ert-x) | ||
| 39 | (require 'filenotify) | 40 | (require 'filenotify) |
| 40 | (require 'tramp) | 41 | (require 'tramp) |
| 41 | 42 | ||
| @@ -703,21 +704,19 @@ delivered." | |||
| 703 | (should auto-revert-notify-watch-descriptor) | 704 | (should auto-revert-notify-watch-descriptor) |
| 704 | 705 | ||
| 705 | ;; Modify file. We wait for a second, in order to have | 706 | ;; Modify file. We wait for a second, in order to have |
| 706 | ;; another timestamp. | 707 | ;; another timestamp. |
| 707 | (with-current-buffer (get-buffer-create "*Messages*") | 708 | (ert-with-message-capture captured-messages |
| 708 | (narrow-to-region (point-max) (point-max))) | 709 | (sleep-for 1) |
| 709 | (sleep-for 1) | 710 | (write-region |
| 710 | (write-region | 711 | "another text" nil file-notify--test-tmpfile nil 'no-message) |
| 711 | "another text" nil file-notify--test-tmpfile nil 'no-message) | 712 | |
| 712 | 713 | ;; Check, that the buffer has been reverted. | |
| 713 | ;; Check, that the buffer has been reverted. | 714 | (file-notify--wait-for-events |
| 714 | (with-current-buffer (get-buffer-create "*Messages*") | 715 | timeout |
| 715 | (file-notify--wait-for-events | 716 | (string-match |
| 716 | timeout | ||
| 717 | (string-match | ||
| 718 | (format-message "Reverting buffer `%s'." (buffer-name buf)) | 717 | (format-message "Reverting buffer `%s'." (buffer-name buf)) |
| 719 | (buffer-string)))) | 718 | captured-messages)) |
| 720 | (should (string-match "another text" (buffer-string))) | 719 | (should (string-match "another text" (buffer-string)))) |
| 721 | 720 | ||
| 722 | ;; Stop file notification. Autorevert shall still work via polling. | 721 | ;; Stop file notification. Autorevert shall still work via polling. |
| 723 | (file-notify-rm-watch auto-revert-notify-watch-descriptor) | 722 | (file-notify-rm-watch auto-revert-notify-watch-descriptor) |
| @@ -728,27 +727,24 @@ delivered." | |||
| 728 | 727 | ||
| 729 | ;; Modify file. We wait for two seconds, in order to | 728 | ;; Modify file. We wait for two seconds, in order to |
| 730 | ;; have another timestamp. One second seems to be too | 729 | ;; have another timestamp. One second seems to be too |
| 731 | ;; short. | 730 | ;; short. |
| 732 | (with-current-buffer (get-buffer-create "*Messages*") | 731 | (ert-with-message-capture captured-messages |
| 733 | (narrow-to-region (point-max) (point-max))) | 732 | (sleep-for 2) |
| 734 | (sleep-for 2) | 733 | (write-region |
| 735 | (write-region | 734 | "foo bla" nil file-notify--test-tmpfile nil 'no-message) |
| 736 | "foo bla" nil file-notify--test-tmpfile nil 'no-message) | 735 | |
| 737 | 736 | ;; Check, that the buffer has been reverted. | |
| 738 | ;; Check, that the buffer has been reverted. | 737 | (file-notify--wait-for-events |
| 739 | (with-current-buffer (get-buffer-create "*Messages*") | 738 | timeout |
| 740 | (file-notify--wait-for-events | 739 | (string-match |
| 741 | timeout | 740 | (format-message "Reverting buffer `%s'." (buffer-name buf)) |
| 742 | (string-match | 741 | captured-messages)) |
| 743 | (format-message "Reverting buffer `%s'." (buffer-name buf)) | 742 | (should (string-match "foo bla" (buffer-string))))) |
| 744 | (buffer-string)))) | ||
| 745 | (should (string-match "foo bla" (buffer-string)))) | ||
| 746 | 743 | ||
| 747 | ;; The environment shall be cleaned up. | 744 | ;; The environment shall be cleaned up. |
| 748 | (file-notify--test-cleanup-p)) | 745 | (file-notify--test-cleanup-p)) |
| 749 | 746 | ||
| 750 | ;; Cleanup. | 747 | ;; Cleanup. |
| 751 | (with-current-buffer "*Messages*" (widen)) | ||
| 752 | (ignore-errors (kill-buffer buf)) | 748 | (ignore-errors (kill-buffer buf)) |
| 753 | (file-notify--test-cleanup)))) | 749 | (file-notify--test-cleanup)))) |
| 754 | 750 | ||
| @@ -850,6 +846,13 @@ delivered." | |||
| 850 | ;; After deleting the parent directory, the descriptor must | 846 | ;; After deleting the parent directory, the descriptor must |
| 851 | ;; not be valid anymore. | 847 | ;; not be valid anymore. |
| 852 | (should-not (file-notify-valid-p file-notify--test-desc)) | 848 | (should-not (file-notify-valid-p file-notify--test-desc)) |
| 849 | ;; w32notify doesn't generate 'stopped' events when the parent | ||
| 850 | ;; directory is deleted, which doesn't provide a chance for | ||
| 851 | ;; filenotify.el to remove the descriptor from the internal | ||
| 852 | ;; hash table it maintains. So we must remove the descriptor | ||
| 853 | ;; manually. | ||
| 854 | (if (string-equal (file-notify--test-library) "w32notify") | ||
| 855 | (file-notify--rm-descriptor file-notify--test-desc)) | ||
| 853 | 856 | ||
| 854 | ;; The environment shall be cleaned up. | 857 | ;; The environment shall be cleaned up. |
| 855 | (file-notify--test-cleanup-p)) | 858 | (file-notify--test-cleanup-p)) |
| @@ -906,6 +909,8 @@ delivered." | |||
| 906 | (file-notify--test-timeout) | 909 | (file-notify--test-timeout) |
| 907 | (not (file-notify-valid-p file-notify--test-desc))) | 910 | (not (file-notify-valid-p file-notify--test-desc))) |
| 908 | (should-not (file-notify-valid-p file-notify--test-desc)) | 911 | (should-not (file-notify-valid-p file-notify--test-desc)) |
| 912 | (if (string-equal (file-notify--test-library) "w32notify") | ||
| 913 | (file-notify--rm-descriptor file-notify--test-desc)) | ||
| 909 | 914 | ||
| 910 | ;; The environment shall be cleaned up. | 915 | ;; The environment shall be cleaned up. |
| 911 | (file-notify--test-cleanup-p)) | 916 | (file-notify--test-cleanup-p)) |
| @@ -975,6 +980,8 @@ delivered." | |||
| 975 | (file-notify--test-read-event) | 980 | (file-notify--test-read-event) |
| 976 | (delete-file file))) | 981 | (delete-file file))) |
| 977 | (delete-directory file-notify--test-tmpfile) | 982 | (delete-directory file-notify--test-tmpfile) |
| 983 | (if (string-equal (file-notify--test-library) "w32notify") | ||
| 984 | (file-notify--rm-descriptor file-notify--test-desc)) | ||
| 978 | 985 | ||
| 979 | ;; The environment shall be cleaned up. | 986 | ;; The environment shall be cleaned up. |
| 980 | (file-notify--test-cleanup-p)) | 987 | (file-notify--test-cleanup-p)) |
| @@ -1184,6 +1191,9 @@ the file watch." | |||
| 1184 | (delete-directory file-notify--test-tmpfile 'recursive)) | 1191 | (delete-directory file-notify--test-tmpfile 'recursive)) |
| 1185 | (should-not (file-notify-valid-p file-notify--test-desc1)) | 1192 | (should-not (file-notify-valid-p file-notify--test-desc1)) |
| 1186 | (should-not (file-notify-valid-p file-notify--test-desc2)) | 1193 | (should-not (file-notify-valid-p file-notify--test-desc2)) |
| 1194 | (when (string-equal (file-notify--test-library) "w32notify") | ||
| 1195 | (file-notify--rm-descriptor file-notify--test-desc1) | ||
| 1196 | (file-notify--rm-descriptor file-notify--test-desc2)) | ||
| 1187 | 1197 | ||
| 1188 | ;; The environment shall be cleaned up. | 1198 | ;; The environment shall be cleaned up. |
| 1189 | (file-notify--test-cleanup-p)) | 1199 | (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/kmacro-tests.el b/test/lisp/kmacro-tests.el new file mode 100644 index 00000000000..5124cbbf962 --- /dev/null +++ b/test/lisp/kmacro-tests.el | |||
| @@ -0,0 +1,890 @@ | |||
| 1 | ;;; kmacro-tests.el --- Tests for kmacro.el -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Gemini Lasswell <gazally@runbox.com> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'kmacro) | ||
| 27 | (require 'ert) | ||
| 28 | (require 'ert-x) | ||
| 29 | |||
| 30 | ;;; Test fixtures: | ||
| 31 | |||
| 32 | (defmacro kmacro-tests-with-kmacro-clean-slate (&rest body) | ||
| 33 | "Create a clean environment for a kmacro test BODY to run in." | ||
| 34 | (declare (debug (body))) | ||
| 35 | `(cl-letf* ((kmacro-execute-before-append t) | ||
| 36 | (kmacro-ring-max 8) | ||
| 37 | (kmacro-repeat-no-prefix t) | ||
| 38 | (kmacro-call-repeat-key nil) | ||
| 39 | (kmacro-call-repeat-with-arg nil) | ||
| 40 | |||
| 41 | (kbd-macro-termination-hook nil) | ||
| 42 | (defining-kbd-macro nil) | ||
| 43 | (executing-kbd-macro nil) | ||
| 44 | (executing-kbd-macro-index 0) | ||
| 45 | (last-kbd-macro nil) | ||
| 46 | |||
| 47 | (kmacro-ring nil) | ||
| 48 | |||
| 49 | (kmacro-counter 0) | ||
| 50 | (kmacro-default-counter-format "%d") | ||
| 51 | (kmacro-counter-format "%d") | ||
| 52 | (kmacro-counter-format-start "%d") | ||
| 53 | (kmacro-counter-value-start 0) | ||
| 54 | (kmacro-last-counter 0) | ||
| 55 | (kmacro-initial-counter-value nil) | ||
| 56 | |||
| 57 | (kmacro-tests-macros nil) | ||
| 58 | (kmacro-tests-events nil) | ||
| 59 | (kmacro-tests-sequences nil)) | ||
| 60 | (advice-add 'end-kbd-macro :after #'kmacro-tests-end-macro-advice) | ||
| 61 | (advice-add 'read-event :around #'kmacro-tests-read-event-advice ) | ||
| 62 | (advice-add 'read-key-sequence :around #'kmacro-tests-read-key-sequence-advice) | ||
| 63 | (unwind-protect | ||
| 64 | (ert-with-test-buffer (:name "") | ||
| 65 | (switch-to-buffer (current-buffer)) | ||
| 66 | ,@body) | ||
| 67 | (advice-remove 'read-key-sequence #'kmacro-tests-read-key-sequence-advice) | ||
| 68 | (advice-remove 'read-event #'kmacro-tests-read-event-advice) | ||
| 69 | (advice-remove 'end-kbd-macro #'kmacro-tests-end-macro-advice)))) | ||
| 70 | |||
| 71 | (defmacro kmacro-tests-deftest (name _args docstring &rest keys-and-body) | ||
| 72 | "Define a kmacro unit test. | ||
| 73 | NAME is the name of the test, _ARGS should be nil, and DOCSTRING | ||
| 74 | is required. To avoid having to duplicate ert's keyword parsing | ||
| 75 | here, its keywords and values (if any) must be inside a list | ||
| 76 | after the docstring, preceding the body, here combined with the | ||
| 77 | body in KEYS-AND-BODY." | ||
| 78 | (declare (debug (&define name sexp stringp | ||
| 79 | [&optional (&rest &or [keywordp sexp])] | ||
| 80 | def-body)) | ||
| 81 | (doc-string 3) | ||
| 82 | (indent 2)) | ||
| 83 | |||
| 84 | (let* ((keys (when (and (listp (car keys-and-body)) | ||
| 85 | (keywordp (caar keys-and-body))) | ||
| 86 | (car keys-and-body))) | ||
| 87 | (body (if keys (cdr keys-and-body) | ||
| 88 | keys-and-body))) | ||
| 89 | `(ert-deftest ,name () | ||
| 90 | ,docstring ,@keys | ||
| 91 | (kmacro-tests-with-kmacro-clean-slate ,@body)))) | ||
| 92 | |||
| 93 | (defvar kmacro-tests-keymap | ||
| 94 | (let ((map (make-sparse-keymap))) | ||
| 95 | (dotimes (i 26) | ||
| 96 | (define-key map (string (+ ?a i)) 'self-insert-command)) | ||
| 97 | (dotimes (i 10) | ||
| 98 | (define-key map (string (+ ?0 i)) 'self-insert-command)) | ||
| 99 | ;; Define a few key sequences of different lengths. | ||
| 100 | (dolist (item '(("\C-a" . beginning-of-line) | ||
| 101 | ("\C-b" . backward-char) | ||
| 102 | ("\C-e" . end-of-line) | ||
| 103 | ("\C-f" . forward-char) | ||
| 104 | ("\C-r" . isearch-backward) | ||
| 105 | ("\C-u" . universal-argument) | ||
| 106 | ("\C-w" . kill-region) | ||
| 107 | ("\C-SPC" . set-mark-command) | ||
| 108 | ("\M-w" . kill-ring-save) | ||
| 109 | ("\M-x" . execute-extended-command) | ||
| 110 | ("\C-cd" . downcase-word) | ||
| 111 | ("\C-cxu" . upcase-word) | ||
| 112 | ("\C-cxq" . quoted-insert) | ||
| 113 | ("\C-cxi" . kmacro-insert-counter) | ||
| 114 | ("\C-x\C-k" . kmacro-keymap))) | ||
| 115 | (define-key map (car item) (cdr item))) | ||
| 116 | map) | ||
| 117 | "Keymap to use for testing keyboard macros. | ||
| 118 | This is used to obtain consistent results even if tests are run | ||
| 119 | in an environment with rebound keys.") | ||
| 120 | |||
| 121 | (defvar kmacro-tests-events nil | ||
| 122 | "Input events used by the kmacro test in progress.") | ||
| 123 | |||
| 124 | (defun kmacro-tests-read-event-advice (orig-func &rest args) | ||
| 125 | "Pop and return an event from `kmacro-tests-events'. | ||
| 126 | Return the result of calling ORIG-FUNC with ARGS if | ||
| 127 | `kmacro-tests-events' is empty, or if a keyboard macro is | ||
| 128 | running." | ||
| 129 | (if (or executing-kbd-macro (null kmacro-tests-events)) | ||
| 130 | (apply orig-func args) | ||
| 131 | (pop kmacro-tests-events))) | ||
| 132 | |||
| 133 | (defvar kmacro-tests-sequences nil | ||
| 134 | "Input sequences used by the kmacro test in progress.") | ||
| 135 | |||
| 136 | (defun kmacro-tests-read-key-sequence-advice (orig-func &rest args) | ||
| 137 | "Pop and return a string from `kmacro-tests-sequences'. | ||
| 138 | Return the result of calling ORIG-FUNC with ARGS if | ||
| 139 | `kmacro-tests-sequences' is empty, or if a keyboard macro is | ||
| 140 | running." | ||
| 141 | (if (or executing-kbd-macro (null kmacro-tests-sequences)) | ||
| 142 | (apply orig-func args) | ||
| 143 | (pop kmacro-tests-sequences))) | ||
| 144 | |||
| 145 | (defvar kmacro-tests-macros nil | ||
| 146 | "Keyboard macros (in vector form) used by the kmacro test in progress.") | ||
| 147 | |||
| 148 | (defun kmacro-tests-end-macro-advice (&rest _args) | ||
| 149 | "Pop a macro from `kmacro-tests-macros' and assign it to `last-kbd-macro'. | ||
| 150 | If `kmacro-tests-macros' is empty, do nothing." | ||
| 151 | (when kmacro-tests-macros | ||
| 152 | (setq last-kbd-macro (pop kmacro-tests-macros)))) | ||
| 153 | |||
| 154 | ;;; Some more powerful expectations: | ||
| 155 | |||
| 156 | (defmacro kmacro-tests-should-insert (value &rest body) | ||
| 157 | "Verify that VALUE is inserted by the execution of BODY. | ||
| 158 | Execute BODY, then check that the string VALUE was inserted | ||
| 159 | into the current buffer at point." | ||
| 160 | (declare (debug (stringp body)) | ||
| 161 | (indent 1)) | ||
| 162 | (let ((g-p (cl-gensym)) | ||
| 163 | (g-bsize (cl-gensym))) | ||
| 164 | `(let ((,g-p (point)) | ||
| 165 | (,g-bsize (buffer-size))) | ||
| 166 | ,@body | ||
| 167 | (should (equal (buffer-substring ,g-p (point)) ,value)) | ||
| 168 | (should (equal (- (buffer-size) ,g-bsize) (length ,value)))))) | ||
| 169 | |||
| 170 | (defmacro kmacro-tests-should-match-message (value &rest body) | ||
| 171 | "Verify that a message matching VALUE is issued while executing BODY. | ||
| 172 | Execute BODY, and then if there is not a regexp match between | ||
| 173 | VALUE and any text written to *Messages* during the execution, | ||
| 174 | cause the current test to fail." | ||
| 175 | (declare (debug (form body)) | ||
| 176 | (indent 1)) | ||
| 177 | (let ((g-captured-messages (cl-gensym))) | ||
| 178 | `(ert-with-message-capture ,g-captured-messages | ||
| 179 | ,@body | ||
| 180 | (should (string-match-p ,value ,g-captured-messages))))) | ||
| 181 | |||
| 182 | ;;; Tests: | ||
| 183 | |||
| 184 | (kmacro-tests-deftest kmacro-tests-test-insert-counter-01-nil () | ||
| 185 | "`kmacro-insert-counter' adds one to macro counter with nil arg." | ||
| 186 | (kmacro-tests-should-insert "0" | ||
| 187 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) | ||
| 188 | (kmacro-tests-should-insert "1" | ||
| 189 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) | ||
| 190 | |||
| 191 | (kmacro-tests-deftest kmacro-tests-test-insert-counter-02-int () | ||
| 192 | "`kmacro-insert-counter' increments by value of list argument." | ||
| 193 | (kmacro-tests-should-insert "0" | ||
| 194 | (kmacro-tests-simulate-command '(kmacro-insert-counter 2))) | ||
| 195 | (kmacro-tests-should-insert "2" | ||
| 196 | (kmacro-tests-simulate-command '(kmacro-insert-counter 3))) | ||
| 197 | (kmacro-tests-should-insert "5" | ||
| 198 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) | ||
| 199 | |||
| 200 | (kmacro-tests-deftest kmacro-tests-test-insert-counter-03-list () | ||
| 201 | "`kmacro-insert-counter' doesn't increment when given universal argument." | ||
| 202 | (kmacro-tests-should-insert "0" | ||
| 203 | (kmacro-tests-simulate-command '(kmacro-insert-counter (16)))) | ||
| 204 | (kmacro-tests-should-insert "0" | ||
| 205 | (kmacro-tests-simulate-command '(kmacro-insert-counter (4))))) | ||
| 206 | |||
| 207 | (kmacro-tests-deftest kmacro-tests-test-insert-counter-04-neg () | ||
| 208 | "`kmacro-insert-counter' decrements with '- prefix argument" | ||
| 209 | (kmacro-tests-should-insert "0" | ||
| 210 | (kmacro-tests-simulate-command '(kmacro-insert-counter -))) | ||
| 211 | (kmacro-tests-should-insert "-1" | ||
| 212 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) | ||
| 213 | |||
| 214 | (kmacro-tests-deftest kmacro-tests-test-start-format-counter () | ||
| 215 | "`kmacro-insert-counter' uses start value and format." | ||
| 216 | (kmacro-tests-simulate-command '(kmacro-set-counter 10)) | ||
| 217 | (kmacro-tests-should-insert "10" | ||
| 218 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) | ||
| 219 | (kmacro-tests-should-insert "11" | ||
| 220 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) | ||
| 221 | (kmacro-set-format "c=%s") | ||
| 222 | (kmacro-tests-simulate-command '(kmacro-set-counter 50)) | ||
| 223 | (kmacro-tests-should-insert "c=50" | ||
| 224 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) | ||
| 225 | |||
| 226 | (kmacro-tests-deftest kmacro-tests-test-start-macro-when-defining-macro () | ||
| 227 | "Starting a macro while defining a macro does not start a second macro." | ||
| 228 | (kmacro-tests-simulate-command '(kmacro-start-macro nil)) | ||
| 229 | ;; We should now be in the macro-recording state. | ||
| 230 | (should defining-kbd-macro) | ||
| 231 | (should-not last-kbd-macro) | ||
| 232 | ;; Calling it again should leave us in the same state. | ||
| 233 | (kmacro-tests-simulate-command '(kmacro-start-macro nil)) | ||
| 234 | (should defining-kbd-macro) | ||
| 235 | (should-not last-kbd-macro)) | ||
| 236 | |||
| 237 | |||
| 238 | (kmacro-tests-deftest kmacro-tests-set-macro-counter-while-defining () | ||
| 239 | "Use of the prefix arg with kmacro-start sets kmacro-counter." | ||
| 240 | ;; Give kmacro-start-macro an argument. | ||
| 241 | (kmacro-tests-simulate-command '(kmacro-start-macro 5)) | ||
| 242 | (should defining-kbd-macro) | ||
| 243 | ;; Verify that the counter is set to that value. | ||
| 244 | (kmacro-tests-should-insert "5" | ||
| 245 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) | ||
| 246 | ;; Change it while defining a macro. | ||
| 247 | (kmacro-tests-simulate-command '(kmacro-set-counter 1)) | ||
| 248 | (kmacro-tests-should-insert "1" | ||
| 249 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) | ||
| 250 | ;; Using universal arg to to set counter should reset to starting value. | ||
| 251 | (kmacro-tests-simulate-command '(kmacro-set-counter (4)) '(4)) | ||
| 252 | (kmacro-tests-should-insert "5" | ||
| 253 | (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) | ||
| 254 | |||
| 255 | |||
| 256 | (kmacro-tests-deftest kmacro-tests-start-insert-counter-appends-to-macro () | ||
| 257 | "Use of the universal arg appends to the previous macro." | ||
| 258 | (let ((kmacro-tests-macros (list (string-to-vector "hello")))) | ||
| 259 | ;; Start recording a macro. | ||
| 260 | (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil)) | ||
| 261 | ;; Make sure we are recording. | ||
| 262 | (should defining-kbd-macro) | ||
| 263 | ;; Call it again and it should insert the counter. | ||
| 264 | (kmacro-tests-should-insert "0" | ||
| 265 | (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil))) | ||
| 266 | ;; We should still be in the recording state. | ||
| 267 | (should defining-kbd-macro) | ||
| 268 | ;; End recording with repeat count. | ||
| 269 | (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 3)) | ||
| 270 | ;; Recording should be finished. | ||
| 271 | (should-not defining-kbd-macro) | ||
| 272 | ;; Now use prefix arg to append to the previous macro. | ||
| 273 | ;; This should run the previous macro first. | ||
| 274 | (kmacro-tests-should-insert "hello" | ||
| 275 | (kmacro-tests-simulate-command | ||
| 276 | '(kmacro-start-macro-or-insert-counter (4)))) | ||
| 277 | ;; Verify that the recording state has changed. | ||
| 278 | (should (equal defining-kbd-macro 'append)))) | ||
| 279 | |||
| 280 | (kmacro-tests-deftest kmacro-tests-end-call-macro-prefix-args () | ||
| 281 | "kmacro-end-call-macro changes behavior based on prefix arg." | ||
| 282 | ;; "Record" two macros. | ||
| 283 | (dotimes (i 2) | ||
| 284 | (kmacro-tests-define-macro (vconcat (format "macro #%d" (1+ i))))) | ||
| 285 | ;; With no prefix arg, it should call the second macro. | ||
| 286 | (kmacro-tests-should-insert "macro #2" | ||
| 287 | (kmacro-tests-simulate-command '(kmacro-end-or-call-macro nil))) | ||
| 288 | ;; With universal arg, it should call the first one. | ||
| 289 | (kmacro-tests-should-insert "macro #1" | ||
| 290 | (kmacro-tests-simulate-command '(kmacro-end-or-call-macro (4))))) | ||
| 291 | |||
| 292 | (kmacro-tests-deftest kmacro-tests-end-and-call-macro () | ||
| 293 | "Keyboard command to end and call macro works under various conditions." | ||
| 294 | ;; First, try it with no macro to record. | ||
| 295 | (setq kmacro-tests-macros '("")) | ||
| 296 | (kmacro-tests-simulate-command '(kmacro-start-macro nil)) | ||
| 297 | (condition-case err | ||
| 298 | (kmacro-tests-simulate-command '(kmacro-end-and-call-macro 2) 2) | ||
| 299 | (error (should (string= (cadr err) | ||
| 300 | "No kbd macro has been defined")))) | ||
| 301 | |||
| 302 | ;; Check that it stopped defining and that no macro was recorded. | ||
| 303 | (should-not defining-kbd-macro) | ||
| 304 | (should-not last-kbd-macro) | ||
| 305 | |||
| 306 | ;; Now try it while not recording, but first record a non-nil macro. | ||
| 307 | (kmacro-tests-define-macro "macro") | ||
| 308 | (kmacro-tests-should-insert "macro" | ||
| 309 | (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil)))) | ||
| 310 | |||
| 311 | (kmacro-tests-deftest kmacro-tests-end-and-call-macro-mouse () | ||
| 312 | "Commands to end and call macro work under various conditions. | ||
| 313 | This is a regression test for Bug#24992." | ||
| 314 | (:expected-result :failed) | ||
| 315 | (cl-letf (((symbol-function #'mouse-set-point) #'ignore)) | ||
| 316 | ;; First, try it with no macro to record. | ||
| 317 | (setq kmacro-tests-macros '("")) | ||
| 318 | (kmacro-tests-simulate-command '(kmacro-start-macro nil)) | ||
| 319 | (condition-case err | ||
| 320 | (kmacro-tests-simulate-command '(kmacro-end-call-mouse 2) 2) | ||
| 321 | (error (should (string= (cadr err) | ||
| 322 | "No kbd macro has been defined")))) | ||
| 323 | |||
| 324 | ;; Check that it stopped defining and that no macro was recorded. | ||
| 325 | (should-not defining-kbd-macro) | ||
| 326 | (should-not last-kbd-macro) | ||
| 327 | |||
| 328 | ;; Now try it while not recording, but first record a non-nil macro. | ||
| 329 | (kmacro-tests-define-macro "macro") | ||
| 330 | (kmacro-tests-should-insert "macro" | ||
| 331 | (kmacro-tests-simulate-command '(kmacro-end-call-mouse nil))))) | ||
| 332 | |||
| 333 | (kmacro-tests-deftest kmacro-tests-call-macro-hint-and-repeat () | ||
| 334 | "`kmacro-call-macro' gives hint in Messages and sets up repeat keymap. | ||
| 335 | This is a regression test for: Bug#3412, Bug#11817." | ||
| 336 | (kmacro-tests-define-macro [?m]) | ||
| 337 | (let ((kmacro-call-repeat-key t) | ||
| 338 | (kmacro-call-repeat-with-arg t) | ||
| 339 | (overriding-terminal-local-map overriding-terminal-local-map) | ||
| 340 | (last-input-event ?e)) | ||
| 341 | (message "") ; Clear the echo area. (Bug#3412) | ||
| 342 | (kmacro-tests-should-match-message "Type e to repeat macro" | ||
| 343 | (kmacro-tests-should-insert "mmmmmm" | ||
| 344 | (cl-letf (((symbol-function #'this-single-command-keys) (lambda () | ||
| 345 | [?\C-x ?e]))) | ||
| 346 | (kmacro-call-macro 3)) | ||
| 347 | ;; Check that it set up for repeat, and run the repeat. | ||
| 348 | (funcall (lookup-key overriding-terminal-local-map "e")))))) | ||
| 349 | |||
| 350 | (kmacro-tests-deftest | ||
| 351 | kmacro-tests-run-macro-command-recorded-in-macro () | ||
| 352 | "No infinite loop if `kmacro-end-and-call-macro' is recorded in the macro. | ||
| 353 | \(Bug#15126)" | ||
| 354 | (:expected-result :failed) | ||
| 355 | (ert-skip "Skipping due to Bug#24921 (an ERT bug)") | ||
| 356 | (kmacro-tests-define-macro (vconcat "foo" [return] "\M-x" | ||
| 357 | "kmacro-end-and-call-macro")) | ||
| 358 | (use-local-map kmacro-tests-keymap) | ||
| 359 | (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil))) | ||
| 360 | |||
| 361 | |||
| 362 | (kmacro-tests-deftest kmacro-tests-test-ring-2nd-commands () | ||
| 363 | "2nd macro in ring is displayed and executed normally and on repeat." | ||
| 364 | (use-local-map kmacro-tests-keymap) | ||
| 365 | ;; Record one macro, with count. | ||
| 366 | (push (vconcat "\C-cxi" "\C-u\C-cxi") kmacro-tests-macros) | ||
| 367 | (kmacro-tests-simulate-command '(kmacro-start-macro 1)) | ||
| 368 | (kmacro-tests-simulate-command '(kmacro-end-macro nil)) | ||
| 369 | ;; Check that execute and display do nothing with no 2nd macro. | ||
| 370 | (kmacro-tests-should-insert "" | ||
| 371 | (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil))) | ||
| 372 | (kmacro-tests-should-match-message "Only one keyboard macro defined" | ||
| 373 | (kmacro-tests-simulate-command '(kmacro-view-ring-2nd))) | ||
| 374 | ;; Record another one, with format. | ||
| 375 | (kmacro-set-format "=%d=") | ||
| 376 | (kmacro-tests-define-macro (vconcat "bar")) | ||
| 377 | ;; Execute the first one, mocked up to insert counter. | ||
| 378 | ;; Should get default format. | ||
| 379 | (kmacro-tests-should-insert "11" | ||
| 380 | (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil))) | ||
| 381 | ;; Now display the 2nd ring macro and check result. | ||
| 382 | (kmacro-tests-should-match-message "C-c x i C-u C-c x i" | ||
| 383 | (kmacro-view-ring-2nd))) | ||
| 384 | |||
| 385 | (kmacro-tests-deftest kmacro-tests-fill-ring-and-rotate () | ||
| 386 | "Macro ring can shift one way, shift the other way, swap and pop." | ||
| 387 | (cl-letf ((kmacro-ring-max 4)) | ||
| 388 | ;; Record enough macros that the first one drops off the history. | ||
| 389 | (dotimes (n (1+ kmacro-ring-max)) | ||
| 390 | (kmacro-tests-define-macro (make-vector (1+ n) (+ ?a n)))) | ||
| 391 | ;; Cycle the ring and check that #2 comes up. | ||
| 392 | (kmacro-tests-should-match-message "2*b" | ||
| 393 | (kmacro-tests-simulate-command '(kmacro-cycle-ring-next nil))) | ||
| 394 | ;; Execute the current macro and check arguments. | ||
| 395 | (kmacro-tests-should-insert "bbbb" | ||
| 396 | (kmacro-call-macro 2 t)) | ||
| 397 | ;; Cycle the ring the other way; #5 expected. | ||
| 398 | (kmacro-tests-should-match-message "5*e" (kmacro-cycle-ring-previous nil)) | ||
| 399 | ;; Swapping the top two should give #4. | ||
| 400 | (kmacro-tests-should-match-message "4*d" (kmacro-swap-ring)) | ||
| 401 | ;; Delete the top and expect #5. | ||
| 402 | (kmacro-tests-should-match-message "5*e" (kmacro-delete-ring-head)))) | ||
| 403 | |||
| 404 | |||
| 405 | (kmacro-tests-deftest kmacro-tests-test-ring-commands-when-no-macros () | ||
| 406 | "Ring commands give appropriate message when no macros exist." | ||
| 407 | (dolist (cmd '((kmacro-cycle-ring-next nil) | ||
| 408 | (kmacro-cycle-ring-previous nil) | ||
| 409 | (kmacro-swap-ring) | ||
| 410 | (kmacro-delete-ring-head) | ||
| 411 | (kmacro-view-ring-2nd) | ||
| 412 | (kmacro-call-ring-2nd nil) | ||
| 413 | (kmacro-view-macro))) | ||
| 414 | (kmacro-tests-should-match-message "No keyboard macro defined" | ||
| 415 | (kmacro-tests-simulate-command cmd)))) | ||
| 416 | |||
| 417 | (kmacro-tests-deftest kmacro-tests-repeat-on-last-key () | ||
| 418 | "Kmacro commands can be run in sequence without prefix keys." | ||
| 419 | (let* ((prefix (where-is-internal 'kmacro-keymap nil t)) | ||
| 420 | ;; Make a sequence of events to run. | ||
| 421 | ;; Comments are expected output of mock macros | ||
| 422 | ;; on the first and second run of the sequence (see below). | ||
| 423 | (events (mapcar #'kmacro-tests-get-kmacro-key | ||
| 424 | '(kmacro-end-or-call-macro-repeat ;c / b | ||
| 425 | kmacro-end-or-call-macro-repeat ;c / b | ||
| 426 | kmacro-call-ring-2nd-repeat ;b / a | ||
| 427 | kmacro-cycle-ring-next | ||
| 428 | kmacro-end-or-call-macro-repeat ;a / a | ||
| 429 | kmacro-cycle-ring-previous | ||
| 430 | kmacro-end-or-call-macro-repeat ;c / b | ||
| 431 | kmacro-delete-ring-head | ||
| 432 | kmacro-end-or-call-macro-repeat ;b / a | ||
| 433 | ))) | ||
| 434 | (kmacro-tests-macros (list [?a] [?b] [?c])) | ||
| 435 | ;; What we want kmacro to see as keyboard command sequence | ||
| 436 | (first-event (seq-concatenate | ||
| 437 | 'vector | ||
| 438 | prefix | ||
| 439 | (vector (kmacro-tests-get-kmacro-key | ||
| 440 | 'kmacro-end-or-call-macro-repeat))))) | ||
| 441 | (cl-letf | ||
| 442 | ;; standardize repeat options | ||
| 443 | ((kmacro-repeat-no-prefix t) | ||
| 444 | (kmacro-call-repeat-key t) | ||
| 445 | (kmacro-call-repeat-with-arg nil)) | ||
| 446 | ;; "Record" two macros | ||
| 447 | (dotimes (_n 2) | ||
| 448 | (kmacro-tests-simulate-command '(kmacro-start-macro nil)) | ||
| 449 | (kmacro-tests-simulate-command '(kmacro-end-macro nil))) | ||
| 450 | ;; Start recording #3 | ||
| 451 | (kmacro-tests-simulate-command '(kmacro-start-macro nil)) | ||
| 452 | |||
| 453 | ;; Set up pending keyboard events and a fresh buffer | ||
| 454 | ;; kmacro-set-counter is not one of the repeating kmacro | ||
| 455 | ;; commands so it should end the sequence. | ||
| 456 | (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-set-counter)) | ||
| 457 | (kmacro-tests-events (append events (list end-key)))) | ||
| 458 | (cl-letf (((symbol-function #'this-single-command-keys) | ||
| 459 | (lambda () first-event))) | ||
| 460 | (use-local-map kmacro-tests-keymap) | ||
| 461 | (kmacro-tests-should-insert "ccbacb" | ||
| 462 | ;; End #3 and launch loop to read events. | ||
| 463 | (kmacro-end-or-call-macro-repeat nil)))) | ||
| 464 | |||
| 465 | ;; `kmacro-edit-macro-repeat' should also stop the sequence, | ||
| 466 | ;; so run it again with that at the end. | ||
| 467 | (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-edit-macro-repeat)) | ||
| 468 | (kmacro-tests-events (append events (list end-key)))) | ||
| 469 | (cl-letf (((symbol-function #'edit-kbd-macro) #'ignore) | ||
| 470 | ((symbol-function #'this-single-command-keys) | ||
| 471 | (lambda () first-event))) | ||
| 472 | (use-local-map kmacro-tests-keymap) | ||
| 473 | (kmacro-tests-should-insert "bbbbbaaba" | ||
| 474 | (kmacro-end-or-call-macro-repeat 3))))))) | ||
| 475 | |||
| 476 | (kmacro-tests-deftest kmacro-tests-repeat-view-and-run () | ||
| 477 | "Kmacro view cycles through ring and executes macro just viewed." | ||
| 478 | (let* ((prefix (where-is-internal 'kmacro-keymap nil t)) | ||
| 479 | (kmacro-tests-events | ||
| 480 | (mapcar #'kmacro-tests-get-kmacro-key | ||
| 481 | (append (make-list 5 'kmacro-view-macro-repeat) | ||
| 482 | '(kmacro-end-or-call-macro-repeat | ||
| 483 | kmacro-set-counter)))) | ||
| 484 | ;; Make kmacro see this as keyboard command sequence. | ||
| 485 | (first-event (seq-concatenate | ||
| 486 | 'vector | ||
| 487 | prefix | ||
| 488 | (vector (kmacro-tests-get-kmacro-key | ||
| 489 | 'kmacro-view-macro-repeat)))) | ||
| 490 | ;; Construct a regexp to match the messages which should be | ||
| 491 | ;; produced by repeated view-repeats. | ||
| 492 | (macros-regexp (apply #'concat | ||
| 493 | (mapcar (lambda (c) (format ".+%s\n" c)) | ||
| 494 | '("d" "c" "b" "a" "d" "c"))))) | ||
| 495 | (cl-letf ((kmacro-repeat-no-prefix t) | ||
| 496 | (kmacro-call-repeat-key t) | ||
| 497 | (kmacro-call-repeat-with-arg nil) | ||
| 498 | ((symbol-function #'this-single-command-keys) (lambda () | ||
| 499 | first-event))) | ||
| 500 | ;; "Record" some macros. | ||
| 501 | (dotimes (n 4) | ||
| 502 | (kmacro-tests-define-macro (make-vector 1 (+ ?a n)))) | ||
| 503 | |||
| 504 | (use-local-map kmacro-tests-keymap) | ||
| 505 | ;; 6 views (the direct call plus the 5 in events) should | ||
| 506 | ;; cycle through the ring and get to the second-to-last | ||
| 507 | ;; macro defined. | ||
| 508 | (kmacro-tests-should-insert "c" | ||
| 509 | (kmacro-tests-should-match-message macros-regexp | ||
| 510 | (kmacro-tests-simulate-command '(kmacro-view-macro-repeat nil))))))) | ||
| 511 | |||
| 512 | (kmacro-tests-deftest kmacro-tests-bind-to-key-when-recording () | ||
| 513 | "Bind to key doesn't bind a key during macro recording." | ||
| 514 | (cl-letf ((global-map global-map) | ||
| 515 | (saved-binding (key-binding "\C-a")) | ||
| 516 | (kmacro-tests-sequences (list "\C-a"))) | ||
| 517 | (kmacro-tests-simulate-command '(kmacro-start-macro 1)) | ||
| 518 | (kmacro-bind-to-key nil) | ||
| 519 | (should (eq saved-binding (key-binding "\C-a"))))) | ||
| 520 | |||
| 521 | (kmacro-tests-deftest kmacro-tests-name-or-bind-to-key-when-no-macro () | ||
| 522 | "Bind to key, symbol or register fails when when no macro exists." | ||
| 523 | (should-error (kmacro-bind-to-key nil)) | ||
| 524 | (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test)) | ||
| 525 | (should-error (kmacro-to-register))) | ||
| 526 | |||
| 527 | (kmacro-tests-deftest kmacro-tests-bind-to-key-bad-key-sequence () | ||
| 528 | "Bind to key fails to bind to ^G." | ||
| 529 | (let ((global-map global-map) | ||
| 530 | (saved-binding (key-binding "\C-g")) | ||
| 531 | (kmacro-tests-sequences (list "\C-g"))) | ||
| 532 | (kmacro-tests-define-macro [1]) | ||
| 533 | (kmacro-bind-to-key nil) | ||
| 534 | (should (eq saved-binding (key-binding "\C-g"))))) | ||
| 535 | |||
| 536 | (kmacro-tests-deftest kmacro-tests-bind-to-key-with-key-sequence-in-use () | ||
| 537 | "Bind to key respects yes-or-no-p when given already bound key sequence." | ||
| 538 | (kmacro-tests-define-macro (vconcat "abaab")) | ||
| 539 | (let ((global-map global-map) | ||
| 540 | (map (make-sparse-keymap)) | ||
| 541 | (kmacro-tests-sequences (make-list 2 "\C-hi"))) | ||
| 542 | (define-key map "\C-hi" 'info) | ||
| 543 | (use-local-map map) | ||
| 544 | ;; Try the command with yes-or-no-p set up to say no. | ||
| 545 | (cl-letf (((symbol-function #'yes-or-no-p) | ||
| 546 | (lambda (prompt) | ||
| 547 | (should (string-match-p "info" prompt)) | ||
| 548 | (should (string-match-p "C-h i" prompt)) | ||
| 549 | nil))) | ||
| 550 | (kmacro-bind-to-key nil)) | ||
| 551 | |||
| 552 | (should (equal (where-is-internal 'info nil t) | ||
| 553 | (vconcat "\C-hi"))) | ||
| 554 | ;; Try it again with yes. | ||
| 555 | (cl-letf (((symbol-function #' yes-or-no-p) | ||
| 556 | (lambda (_prompt) t))) | ||
| 557 | (kmacro-bind-to-key nil)) | ||
| 558 | |||
| 559 | (should-not (equal (where-is-internal 'info global-map t) | ||
| 560 | (vconcat "\C-hi"))) | ||
| 561 | (use-local-map nil) | ||
| 562 | (kmacro-tests-should-insert "abaab" | ||
| 563 | (funcall (key-binding "\C-hi"))))) | ||
| 564 | |||
| 565 | (kmacro-tests-deftest kmacro-tests-kmacro-bind-to-single-key () | ||
| 566 | "Bind to key uses C-x C-k A when asked to bind to A." | ||
| 567 | (let ((global-map global-map) | ||
| 568 | (kmacro-tests-macros (list (string-to-vector "\C-cxi")))) | ||
| 569 | (use-local-map kmacro-tests-keymap) | ||
| 570 | |||
| 571 | ;; Record a macro with counter and format set. | ||
| 572 | (kmacro-set-format "<%d>") | ||
| 573 | (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter 5)) | ||
| 574 | (kmacro-tests-simulate-command '(kmacro-end-macro nil)) | ||
| 575 | |||
| 576 | (let ((kmacro-tests-sequences (list "A"))) | ||
| 577 | (kmacro-bind-to-key nil)) | ||
| 578 | |||
| 579 | ;; Record a second macro with different counter and format. | ||
| 580 | (kmacro-set-format "%d") | ||
| 581 | (kmacro-tests-define-macro [2]) | ||
| 582 | |||
| 583 | ;; Check the bound key and run it and verify correct counter | ||
| 584 | ;; and format. | ||
| 585 | (should (equal (string-to-vector "\C-cxi") | ||
| 586 | (car (kmacro-extract-lambda | ||
| 587 | (key-binding "\C-x\C-kA"))))) | ||
| 588 | (kmacro-tests-should-insert "<5>" | ||
| 589 | (funcall (key-binding "\C-x\C-kA"))))) | ||
| 590 | |||
| 591 | (kmacro-tests-deftest kmacro-tests-name-last-macro-unable-to-bind () | ||
| 592 | "Name last macro won't bind to symbol which is already bound." | ||
| 593 | (kmacro-tests-define-macro [1]) | ||
| 594 | ;; Set up a test symbol which looks like a function. | ||
| 595 | (setplist 'kmacro-tests-symbol-for-test nil) | ||
| 596 | (fset 'kmacro-tests-symbol-for-test #'ignore) | ||
| 597 | (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test)) | ||
| 598 | ;; The empty string symbol also can't be bound. | ||
| 599 | (should-error (kmacro-name-last-macro (make-symbol "")))) | ||
| 600 | |||
| 601 | (kmacro-tests-deftest kmacro-tests-name-last-macro-bind-and-rebind () | ||
| 602 | "Name last macro can rebind a symbol it binds." | ||
| 603 | ;; Make sure our symbol is unbound. | ||
| 604 | (when (fboundp 'kmacro-tests-symbol-for-test) | ||
| 605 | (fmakunbound 'kmacro-tests-symbol-for-test)) | ||
| 606 | (setplist 'kmacro-tests-symbol-for-test nil) | ||
| 607 | ;; Make two macros and bind them to the same symbol. | ||
| 608 | (dotimes (i 2) | ||
| 609 | (kmacro-tests-define-macro (make-vector (1+ i) (+ ?a i))) | ||
| 610 | (kmacro-name-last-macro 'kmacro-tests-symbol-for-test) | ||
| 611 | (should (fboundp 'kmacro-tests-symbol-for-test))) | ||
| 612 | |||
| 613 | ;; Now run the function bound to the symbol. Result should be the | ||
| 614 | ;; second macro. | ||
| 615 | (kmacro-tests-should-insert "bb" | ||
| 616 | (kmacro-tests-simulate-command '(kmacro-tests-symbol-for-test)))) | ||
| 617 | |||
| 618 | (kmacro-tests-deftest kmacro-tests-store-in-register () | ||
| 619 | "Macro can be stored in and retrieved from a register." | ||
| 620 | (use-local-map kmacro-tests-keymap) | ||
| 621 | ;; Save and restore register 200 so we can use it for the test. | ||
| 622 | (let ((saved-reg-contents (get-register 200))) | ||
| 623 | (unwind-protect | ||
| 624 | (progn | ||
| 625 | ;; Define a macro, and save it to a register. | ||
| 626 | (kmacro-tests-define-macro (vconcat "a\C-a\C-cxu")) | ||
| 627 | (kmacro-to-register 200) | ||
| 628 | ;; Then make a new different macro. | ||
| 629 | (kmacro-tests-define-macro (vconcat "bb\C-a\C-cxu")) | ||
| 630 | ;; When called from the register, result should be first macro. | ||
| 631 | (kmacro-tests-should-insert "AAA" | ||
| 632 | (kmacro-tests-simulate-command '(jump-to-register 200 3) 3)) | ||
| 633 | (kmacro-tests-should-insert "a C-a C-c x u" | ||
| 634 | (kmacro-tests-simulate-command '(insert-register 200 t) '(4)))) | ||
| 635 | (set-register 200 saved-reg-contents)))) | ||
| 636 | |||
| 637 | (kmacro-tests-deftest kmacro-tests-step-edit-act () | ||
| 638 | "Step-edit steps-through a macro with act and act-repeat." | ||
| 639 | (kmacro-tests-run-step-edit "he\C-u2lo" | ||
| 640 | :events (make-list 6 'act) | ||
| 641 | :result "hello" | ||
| 642 | :macro-result "he\C-u2lo") | ||
| 643 | |||
| 644 | (kmacro-tests-run-step-edit "f\C-aoo\C-abar" | ||
| 645 | :events (make-list 5 'act-repeat) | ||
| 646 | :result "baroof" | ||
| 647 | :macro-result "f\C-aoo\C-abar")) | ||
| 648 | |||
| 649 | (kmacro-tests-deftest kmacro-tests-step-edit-skip () | ||
| 650 | "Step-editing can skip parts of macro." | ||
| 651 | (kmacro-tests-run-step-edit "ofoofff" | ||
| 652 | :events '(skip skip-keep skip-keep skip-keep | ||
| 653 | skip-rest) | ||
| 654 | :result "" | ||
| 655 | :macro-result "foo")) | ||
| 656 | |||
| 657 | (kmacro-tests-deftest kmacro-tests-step-edit-quit () | ||
| 658 | "Quit while step-editing leaves macro unchanged." | ||
| 659 | (kmacro-tests-run-step-edit "bar" | ||
| 660 | :events '(help insert skip help quit) | ||
| 661 | :sequences '("f" "o" "o" "\C-j") | ||
| 662 | :result "foo" | ||
| 663 | :macro-result "bar")) | ||
| 664 | |||
| 665 | (kmacro-tests-deftest kmacro-tests-step-insert () | ||
| 666 | "Step edit can insert in macro." | ||
| 667 | (kmacro-tests-run-step-edit "fbazbop" | ||
| 668 | :events '(insert act insert-1 act-repeat) | ||
| 669 | :sequences '("o" "o" "\C-a" "\C-j" "\C-e") | ||
| 670 | :result "foobazbop" | ||
| 671 | :macro-result "oo\C-af\C-ebazbop")) | ||
| 672 | |||
| 673 | (kmacro-tests-deftest kmacro-tests-step-edit-replace-digit-argument () | ||
| 674 | "Step-edit replace can replace a numeric argument in a macro. | ||
| 675 | This is a regression for item 1 in Bug#24991." | ||
| 676 | (:expected-result :failed) | ||
| 677 | (kmacro-tests-run-step-edit "\C-u3b\C-a\C-cxu" | ||
| 678 | :events '(act replace automatic) | ||
| 679 | :sequences '("8" "x" "\C-j") | ||
| 680 | :result "XXXXXXXX" | ||
| 681 | :macro-result "\C-u8x\C-a\C-cxu")) | ||
| 682 | |||
| 683 | (kmacro-tests-deftest kmacro-tests-step-edit-replace () | ||
| 684 | "Step-edit replace and replace-1 can replace parts of a macro." | ||
| 685 | (kmacro-tests-run-step-edit "a\C-a\C-cxu" | ||
| 686 | :events '(act act replace) | ||
| 687 | :sequences '("b" "c" "\C-j") | ||
| 688 | :result "bca" | ||
| 689 | :macro-result "a\C-abc") | ||
| 690 | (kmacro-tests-run-step-edit "a\C-a\C-cxucd" | ||
| 691 | :events '(act replace-1 automatic) | ||
| 692 | :sequences '("b") | ||
| 693 | :result "abcd" | ||
| 694 | :macro-result "ab\C-cxucd") | ||
| 695 | (kmacro-tests-run-step-edit "by" | ||
| 696 | :events '(act replace) | ||
| 697 | :sequences '("a" "r" "\C-j") | ||
| 698 | :result "bar" | ||
| 699 | :macro-result "bar")) | ||
| 700 | |||
| 701 | (kmacro-tests-deftest kmacro-tests-step-edit-append () | ||
| 702 | "Step edit append inserts after point, and append-end inserts at end." | ||
| 703 | (kmacro-tests-run-step-edit "f-b" | ||
| 704 | :events '(append append-end) | ||
| 705 | :sequences '("o" "o" "\C-j" "a" "r" "\C-j") | ||
| 706 | :result "foo-bar" | ||
| 707 | :macro-result "foo-bar") | ||
| 708 | (kmacro-tests-run-step-edit "x" | ||
| 709 | :events '(append) | ||
| 710 | :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j") | ||
| 711 | :result "Xy" | ||
| 712 | :macro-result "x\C-a\C-cxu\C-ey")) | ||
| 713 | |||
| 714 | (kmacro-tests-deftest kmacro-tests-append-end-at-end-appends () | ||
| 715 | "Append-end when already at end of macro appends to end of macro. | ||
| 716 | This is a regression for item 2 in Bug#24991." | ||
| 717 | (:expected-result :failed) | ||
| 718 | (kmacro-tests-run-step-edit "x" | ||
| 719 | :events '(append-end) | ||
| 720 | :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j") | ||
| 721 | :result "Xy" | ||
| 722 | :macro-result "x\C-a\C-cxu\C-ey")) | ||
| 723 | |||
| 724 | |||
| 725 | (kmacro-tests-deftest kmacro-tests-step-edit-skip-entire () | ||
| 726 | "Skipping a whole macro in step-edit leaves macro unchanged. | ||
| 727 | This is a regression for item 3 in Bug#24991." | ||
| 728 | (:expected-result :failed) | ||
| 729 | (kmacro-tests-run-step-edit "xyzzy" | ||
| 730 | :events '(skip-rest) | ||
| 731 | :result "" | ||
| 732 | :macro-result "xyzzy")) | ||
| 733 | |||
| 734 | (kmacro-tests-deftest kmacro-tests-step-edit-step-through-negative-argument () | ||
| 735 | "Step edit works on macros using negative universal argument. | ||
| 736 | This is a regression for item 4 in Bug#24991." | ||
| 737 | (:expected-result :failed) | ||
| 738 | (kmacro-tests-run-step-edit "boo\C-u-\C-cu" | ||
| 739 | :events '(act-repeat automatic) | ||
| 740 | :result "BOO" | ||
| 741 | :macro-result "boo\C-u-\C-cd")) | ||
| 742 | |||
| 743 | (kmacro-tests-deftest kmacro-tests-step-edit-with-quoted-insert () | ||
| 744 | "Stepping through a macro that uses quoted insert leaves macro unchanged. | ||
| 745 | This is a regression for item 5 in Bug#24991." | ||
| 746 | (:expected-result :failed) | ||
| 747 | (let ((read-quoted-char-radix 8)) | ||
| 748 | (kmacro-tests-run-step-edit "\C-cxq17051i there" | ||
| 749 | :events '(act automatic) | ||
| 750 | :result "ḩi there" | ||
| 751 | :macro-result "\C-cxq17051i there") | ||
| 752 | (kmacro-tests-run-step-edit "g\C-cxq17051i" | ||
| 753 | :events '(act insert-1 automatic) | ||
| 754 | :sequences '("-") | ||
| 755 | :result "g-ḩi" | ||
| 756 | :macro-result "g-\C-cxq17051i"))) | ||
| 757 | |||
| 758 | (kmacro-tests-deftest kmacro-tests-step-edit-can-replace-meta-keys () | ||
| 759 | "Replacing C-w with M-w produces the expected result. | ||
| 760 | This is a regression for item 7 in Bug#24991." | ||
| 761 | (:expected-result :failed) | ||
| 762 | (kmacro-tests-run-step-edit "abc\C-b\C-b\C-SPC\C-f\C-w\C-e\C-y" | ||
| 763 | :events '(act-repeat act-repeat | ||
| 764 | act-repeat act-repeat | ||
| 765 | replace automatic) | ||
| 766 | :sequences '("\M-w" "\C-j") | ||
| 767 | :result "abcb" | ||
| 768 | :macro-result "abc\C-b\C-b\C-SPC\C-f\M-w\C-e\C-y") | ||
| 769 | (kmacro-tests-should-insert "abcb" (kmacro-call-macro nil))) | ||
| 770 | |||
| 771 | (kmacro-tests-deftest kmacro-tests-step-edit-ignores-qr-map-commands () | ||
| 772 | "Unimplemented commands from `query-replace-map' are ignored." | ||
| 773 | (kmacro-tests-run-step-edit "yep" | ||
| 774 | :events '(edit-replacement | ||
| 775 | act-and-show act-and-exit | ||
| 776 | delete-and-edit | ||
| 777 | recenter backup | ||
| 778 | scroll-up scroll-down | ||
| 779 | scroll-other-window | ||
| 780 | scroll-other-window-down | ||
| 781 | exit-prefix | ||
| 782 | act act act) | ||
| 783 | :result "yep" | ||
| 784 | :macro-result "yep")) | ||
| 785 | |||
| 786 | (kmacro-tests-deftest | ||
| 787 | kmacro-tests-step-edit-edits-macro-with-extended-command () | ||
| 788 | "Step-editing a macro which uses the minibuffer can change the macro." | ||
| 789 | (let ((mac (vconcat [?\M-x] "eval-expression" '[return] | ||
| 790 | "(insert-char (+ ?a \C-e" [?1] "))" '[return])) | ||
| 791 | (mac-after (vconcat [?\M-x] "eval-expression" '[return] | ||
| 792 | "(insert-char (+ ?a \C-e" [?2] "))" '[return]))) | ||
| 793 | |||
| 794 | (kmacro-tests-run-step-edit mac | ||
| 795 | :events '(act act-repeat | ||
| 796 | act act-repeat act | ||
| 797 | replace-1 act-repeat act) | ||
| 798 | :sequences '("2") | ||
| 799 | :result "c" | ||
| 800 | :macro-result mac-after))) | ||
| 801 | |||
| 802 | (kmacro-tests-deftest kmacro-tests-step-edit-step-through-isearch () | ||
| 803 | "Step-editing can edit a macro which uses `isearch-backward' (Bug#22488)." | ||
| 804 | (:expected-result :failed) | ||
| 805 | (let ((mac (vconcat "test Input" '[return] | ||
| 806 | [?\C-r] "inp" '[return] "\C-cxu")) | ||
| 807 | (mac-after (vconcat "test input" '[return] | ||
| 808 | [?\C-r] "inp" '[return] "\C-cd"))) | ||
| 809 | |||
| 810 | (kmacro-tests-run-step-edit mac | ||
| 811 | :events '(act-repeat act act | ||
| 812 | act-repeat act | ||
| 813 | replace-1) | ||
| 814 | :sequences '("\C-cd") | ||
| 815 | :result "test input\n" | ||
| 816 | :macro-result mac-after))) | ||
| 817 | |||
| 818 | (kmacro-tests-deftest kmacro-tests-step-edit-cleans-up-hook () | ||
| 819 | "Step-editing properly cleans up `post-command-hook.' (Bug #18708)" | ||
| 820 | (:expected-result :failed) | ||
| 821 | (let (post-command-hook) | ||
| 822 | (setq-local post-command-hook '(t)) | ||
| 823 | (kmacro-tests-run-step-edit "x" | ||
| 824 | :events '(act) | ||
| 825 | :result "x" | ||
| 826 | :macro-result "x") | ||
| 827 | (kmacro-tests-simulate-command '(beginning-of-line)))) | ||
| 828 | |||
| 829 | (cl-defun kmacro-tests-run-step-edit | ||
| 830 | (macro &key events sequences result macro-result) | ||
| 831 | "Set up and run a test of `kmacro-step-edit-macro'. | ||
| 832 | |||
| 833 | Run `kmacro-step-edit-macro' with MACRO defined as a keyboard macro | ||
| 834 | and `read-event' and `read-key-sequence' set up to return items from | ||
| 835 | EVENTS and SEQUENCES respectively. SEQUENCES may be nil, but | ||
| 836 | EVENTS should not be. EVENTS should be a list of symbols bound | ||
| 837 | in `kmacro-step-edit-map' or `query-replace' map, and this function | ||
| 838 | will do the keymap lookup for you. SEQUENCES should contain | ||
| 839 | return values for `read-key-sequence'. | ||
| 840 | |||
| 841 | Before running the macro, the current buffer will be erased. | ||
| 842 | RESULT is the string that should be inserted during the | ||
| 843 | step-editing process, and MACRO-RESULT is the expected value of | ||
| 844 | `last-kbd-macro' after the editing is complete." | ||
| 845 | |||
| 846 | (let* ((kmacro-tests-events (mapcar #'kmacro-tests-get-kmacro-step-edit-key events)) | ||
| 847 | (kmacro-tests-sequences sequences)) | ||
| 848 | |||
| 849 | (kmacro-tests-define-macro (string-to-vector macro)) | ||
| 850 | (use-local-map kmacro-tests-keymap) | ||
| 851 | (erase-buffer) | ||
| 852 | (kmacro-step-edit-macro) | ||
| 853 | (when result | ||
| 854 | (should (equal result (buffer-string)))) | ||
| 855 | (when macro-result | ||
| 856 | (should (equal last-kbd-macro (string-to-vector macro-result)))))) | ||
| 857 | |||
| 858 | ;;; Utilities: | ||
| 859 | |||
| 860 | (defun kmacro-tests-simulate-command (command &optional arg) | ||
| 861 | "Call `ert-simulate-command' after setting `current-prefix-arg'. | ||
| 862 | Sets `current-prefix-arg' to ARG if it is non-nil, otherwise to | ||
| 863 | the second element of COMMAND, before executing COMMAND using | ||
| 864 | `ert-simulate-command'." | ||
| 865 | (let ((current-prefix-arg (or arg (cadr command)))) | ||
| 866 | (ert-simulate-command command))) | ||
| 867 | |||
| 868 | (defun kmacro-tests-define-macro (mac) | ||
| 869 | "Define MAC as a keyboard macro using kmacro commands." | ||
| 870 | (push mac kmacro-tests-macros) | ||
| 871 | (kmacro-tests-simulate-command '(kmacro-start-macro nil)) | ||
| 872 | (should defining-kbd-macro) | ||
| 873 | (kmacro-tests-simulate-command '(kmacro-end-macro nil)) | ||
| 874 | (should (equal mac last-kbd-macro))) | ||
| 875 | |||
| 876 | (defun kmacro-tests-get-kmacro-key (sym) | ||
| 877 | "Look up kmacro command SYM in kmacro's keymap. | ||
| 878 | Return the integer key value found." | ||
| 879 | (aref (where-is-internal sym kmacro-keymap t) 0)) | ||
| 880 | |||
| 881 | (defun kmacro-tests-get-kmacro-step-edit-key (sym) | ||
| 882 | "Return the first key bound to SYM in `kmacro-step-edit-map'." | ||
| 883 | (let ((where (aref (where-is-internal sym kmacro-step-edit-map t) 0))) | ||
| 884 | (if (consp where) | ||
| 885 | (car where) | ||
| 886 | where))) | ||
| 887 | |||
| 888 | (provide 'kmacro-tests) | ||
| 889 | |||
| 890 | ;;; kmacro-tests.el ends here | ||
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/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el index 84749efa45b..7cb737c30e2 100644 --- a/test/lisp/progmodes/js-tests.el +++ b/test/lisp/progmodes/js-tests.el | |||
| @@ -85,6 +85,20 @@ if (!/[ (:,='\"]/.test(value)) { | |||
| 85 | (should (= (current-column) x)) | 85 | (should (= (current-column) x)) |
| 86 | (forward-line)))) | 86 | (forward-line)))) |
| 87 | 87 | ||
| 88 | (ert-deftest js-mode-auto-fill () | ||
| 89 | (with-temp-buffer | ||
| 90 | (js-mode) | ||
| 91 | (setq fill-column 70) | ||
| 92 | (insert "/* ") | ||
| 93 | (dotimes (_ 16) | ||
| 94 | (insert "test ")) | ||
| 95 | (do-auto-fill) | ||
| 96 | ;; The bug is that, after auto-fill, the second line starts with | ||
| 97 | ;; "/*", whereas it should start with " * ". | ||
| 98 | (goto-char (point-min)) | ||
| 99 | (forward-line) | ||
| 100 | (should (looking-at " \\* test")))) | ||
| 101 | |||
| 88 | (provide 'js-tests) | 102 | (provide 'js-tests) |
| 89 | 103 | ||
| 90 | ;;; js-tests.el ends here | 104 | ;;; 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/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index 6eb32ea7fc4..5372c37a179 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el | |||
| @@ -218,5 +218,20 @@ | |||
| 218 | (should (member "body" completions)) | 218 | (should (member "body" completions)) |
| 219 | (should-not (member "article" completions))))) | 219 | (should-not (member "article" completions))))) |
| 220 | 220 | ||
| 221 | (ert-deftest css-mdn-symbol-guessing () | ||
| 222 | (dolist (item '(("@med" "ia" "@media") | ||
| 223 | ("@keyframes " "{" "@keyframes") | ||
| 224 | ("p::after" "" "::after") | ||
| 225 | ("p:before" "" ":before") | ||
| 226 | ("a:v" "isited" ":visited") | ||
| 227 | ("border-" "color: red" "border-color") | ||
| 228 | ("border-color: red" ";" "border-color") | ||
| 229 | ("border-color: red; color: green" ";" "color"))) | ||
| 230 | (with-temp-buffer | ||
| 231 | (css-mode) | ||
| 232 | (insert (nth 0 item)) | ||
| 233 | (save-excursion (insert (nth 1 item))) | ||
| 234 | (should (equal (nth 2 item) (css--mdn-find-symbol)))))) | ||
| 235 | |||
| 221 | (provide 'css-mode-tests) | 236 | (provide 'css-mode-tests) |
| 222 | ;;; css-mode-tests.el ends here | 237 | ;;; css-mode-tests.el ends here |
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/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el new file mode 100644 index 00000000000..807a411fa5d --- /dev/null +++ b/test/lisp/vc/diff-mode-tests.el | |||
| @@ -0,0 +1,203 @@ | |||
| 1 | ;; Copyright (C) 2017 Free Software Foundation, Inc | ||
| 2 | |||
| 3 | ;; Author: Dima Kogan <dima@secretsauce.net> | ||
| 4 | ;; Maintainer: emacs-devel@gnu.org | ||
| 5 | |||
| 6 | ;; This file is part of GNU Emacs. | ||
| 7 | |||
| 8 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Code: | ||
| 22 | |||
| 23 | (require 'diff-mode) | ||
| 24 | |||
| 25 | |||
| 26 | (ert-deftest diff-mode-test-ignore-trailing-dashes () | ||
| 27 | "Check to make sure we successfully ignore trailing -- made by | ||
| 28 | 'git format-patch'. This is bug #9597" | ||
| 29 | |||
| 30 | ;; I made a test repo, put some files in it, made arbitrary changes | ||
| 31 | ;; and invoked 'git format-patch' to get a patch out of it. The | ||
| 32 | ;; patch and the before and after versions of the files appear here. | ||
| 33 | ;; The test simply tries to apply the patch. The patch contains | ||
| 34 | ;; trailing --, which confused diff-mode previously | ||
| 35 | (let ((patch "From 18ed35640be496647e0a02fc155b4ee4a0490eca Mon Sep 17 00:00:00 2001 | ||
| 36 | From: Dima Kogan <dima@secretsauce.net> | ||
| 37 | Date: Mon, 30 Jan 2017 22:24:13 -0800 | ||
| 38 | Subject: [PATCH] test commit | ||
| 39 | |||
| 40 | --- | ||
| 41 | fil | 3 --- | ||
| 42 | fil2 | 4 ---- | ||
| 43 | 2 files changed, 7 deletions(-) | ||
| 44 | |||
| 45 | diff --git a/fil b/fil | ||
| 46 | index 10344f1..2a56245 100644 | ||
| 47 | --- a/fil | ||
| 48 | +++ b/fil | ||
| 49 | @@ -2,10 +2,8 @@ Afrocentrism | ||
| 50 | Americanisms | ||
| 51 | Americanization | ||
| 52 | Americanizations | ||
| 53 | -Americanized | ||
| 54 | Americanizes | ||
| 55 | Americanizing | ||
| 56 | -Andrianampoinimerina | ||
| 57 | Anglicanisms | ||
| 58 | Antananarivo | ||
| 59 | Apalachicola | ||
| 60 | @@ -15,6 +13,5 @@ Aristophanes | ||
| 61 | Aristotelian | ||
| 62 | Ashurbanipal | ||
| 63 | Australopithecus | ||
| 64 | -Austronesian | ||
| 65 | Bangladeshis | ||
| 66 | Barquisimeto | ||
| 67 | diff --git a/fil2 b/fil2 | ||
| 68 | index 8858f0d..86e8ea5 100644 | ||
| 69 | --- a/fil2 | ||
| 70 | +++ b/fil2 | ||
| 71 | @@ -1,20 +1,16 @@ | ||
| 72 | whippoorwills | ||
| 73 | whitewashing | ||
| 74 | wholehearted | ||
| 75 | -wholeheartedly | ||
| 76 | wholesomeness | ||
| 77 | wildernesses | ||
| 78 | windbreakers | ||
| 79 | wisecracking | ||
| 80 | withstanding | ||
| 81 | -woodcarvings | ||
| 82 | woolgathering | ||
| 83 | workstations | ||
| 84 | worthlessness | ||
| 85 | wretchedness | ||
| 86 | wristwatches | ||
| 87 | -wrongfulness | ||
| 88 | wrongheadedly | ||
| 89 | wrongheadedness | ||
| 90 | -xylophonists | ||
| 91 | youthfulness | ||
| 92 | -- | ||
| 93 | 2.11.0 | ||
| 94 | |||
| 95 | ") | ||
| 96 | (fil_before "Afrocentrism | ||
| 97 | Americanisms | ||
| 98 | Americanization | ||
| 99 | Americanizations | ||
| 100 | Americanized | ||
| 101 | Americanizes | ||
| 102 | Americanizing | ||
| 103 | Andrianampoinimerina | ||
| 104 | Anglicanisms | ||
| 105 | Antananarivo | ||
| 106 | Apalachicola | ||
| 107 | Appalachians | ||
| 108 | Argentinians | ||
| 109 | Aristophanes | ||
| 110 | Aristotelian | ||
| 111 | Ashurbanipal | ||
| 112 | Australopithecus | ||
| 113 | Austronesian | ||
| 114 | Bangladeshis | ||
| 115 | Barquisimeto | ||
| 116 | ") | ||
| 117 | (fil_after "Afrocentrism | ||
| 118 | Americanisms | ||
| 119 | Americanization | ||
| 120 | Americanizations | ||
| 121 | Americanizes | ||
| 122 | Americanizing | ||
| 123 | Anglicanisms | ||
| 124 | Antananarivo | ||
| 125 | Apalachicola | ||
| 126 | Appalachians | ||
| 127 | Argentinians | ||
| 128 | Aristophanes | ||
| 129 | Aristotelian | ||
| 130 | Ashurbanipal | ||
| 131 | Australopithecus | ||
| 132 | Bangladeshis | ||
| 133 | Barquisimeto | ||
| 134 | ") | ||
| 135 | (fil2_before "whippoorwills | ||
| 136 | whitewashing | ||
| 137 | wholehearted | ||
| 138 | wholeheartedly | ||
| 139 | wholesomeness | ||
| 140 | wildernesses | ||
| 141 | windbreakers | ||
| 142 | wisecracking | ||
| 143 | withstanding | ||
| 144 | woodcarvings | ||
| 145 | woolgathering | ||
| 146 | workstations | ||
| 147 | worthlessness | ||
| 148 | wretchedness | ||
| 149 | wristwatches | ||
| 150 | wrongfulness | ||
| 151 | wrongheadedly | ||
| 152 | wrongheadedness | ||
| 153 | xylophonists | ||
| 154 | youthfulness | ||
| 155 | ") | ||
| 156 | (fil2_after "whippoorwills | ||
| 157 | whitewashing | ||
| 158 | wholehearted | ||
| 159 | wholesomeness | ||
| 160 | wildernesses | ||
| 161 | windbreakers | ||
| 162 | wisecracking | ||
| 163 | withstanding | ||
| 164 | woolgathering | ||
| 165 | workstations | ||
| 166 | worthlessness | ||
| 167 | wretchedness | ||
| 168 | wristwatches | ||
| 169 | wrongheadedly | ||
| 170 | wrongheadedness | ||
| 171 | youthfulness | ||
| 172 | ") | ||
| 173 | (temp-dir (make-temp-file "diff-mode-test" 'dir))) | ||
| 174 | |||
| 175 | (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" ))) | ||
| 176 | (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2")))) | ||
| 177 | (unwind-protect | ||
| 178 | (progn | ||
| 179 | (with-current-buffer buf (insert fil_before) (save-buffer)) | ||
| 180 | (with-current-buffer buf2 (insert fil2_before) (save-buffer)) | ||
| 181 | |||
| 182 | (with-temp-buffer | ||
| 183 | (cd temp-dir) | ||
| 184 | (insert patch) | ||
| 185 | (beginning-of-buffer) | ||
| 186 | (diff-apply-hunk) | ||
| 187 | (diff-apply-hunk) | ||
| 188 | (diff-apply-hunk)) | ||
| 189 | |||
| 190 | (should (equal (with-current-buffer buf (buffer-string)) | ||
| 191 | fil_after)) | ||
| 192 | (should (equal (with-current-buffer buf2 (buffer-string)) | ||
| 193 | fil2_after))) | ||
| 194 | |||
| 195 | (ignore-errors | ||
| 196 | (with-current-buffer buf (set-buffer-modified-p nil)) | ||
| 197 | (kill-buffer buf) | ||
| 198 | (with-current-buffer buf2 (set-buffer-modified-p nil)) | ||
| 199 | (kill-buffer buf2) | ||
| 200 | (delete-directory temp-dir 'recursive)))))) | ||
| 201 | |||
| 202 | |||
| 203 | (provide 'diff-mode-tests) | ||
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/manual/indent/css-mode.css b/test/manual/indent/css-mode.css index 3a00739bfc4..0845c02c299 100644 --- a/test/manual/indent/css-mode.css +++ b/test/manual/indent/css-mode.css | |||
| @@ -43,3 +43,30 @@ article:hover | |||
| 43 | { | 43 | { |
| 44 | color: black; | 44 | color: black; |
| 45 | } | 45 | } |
| 46 | |||
| 47 | /* bug:13425 */ | ||
| 48 | div:first-child, | ||
| 49 | div:last-child, | ||
| 50 | div[disabled], | ||
| 51 | div::before { | ||
| 52 | font: 15px "Helvetica Neue", | ||
| 53 | Helvetica, | ||
| 54 | Arial, | ||
| 55 | "Nimbus Sans L", | ||
| 56 | sans-serif; | ||
| 57 | font: 15px "Helvetica Neue", Helvetica, Arial, | ||
| 58 | "Nimbus Sans L", sans-serif; | ||
| 59 | transform: matrix(1.0, 2.0, | ||
| 60 | 3.0, 4.0, | ||
| 61 | 5.0, 6.0); | ||
| 62 | transform: matrix( | ||
| 63 | 1.0, 2.0, | ||
| 64 | 3.0, 4.0, | ||
| 65 | 5.0, 6.0 | ||
| 66 | ); | ||
| 67 | } | ||
| 68 | @font-face { | ||
| 69 | src: url("Sans-Regular.eot") format("eot"), | ||
| 70 | url("Sans-Regular.woff") format("woff"), | ||
| 71 | url("Sans-Regular.ttf") format("truetype"); | ||
| 72 | } | ||
diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss index e1ec90a5299..f9911ad11b7 100644 --- a/test/manual/indent/scss-mode.scss +++ b/test/manual/indent/scss-mode.scss | |||
| @@ -16,20 +16,20 @@ nav { | |||
| 16 | } | 16 | } |
| 17 | } | 17 | } |
| 18 | nav ul { | 18 | nav ul { |
| 19 | margin: 0; | 19 | margin: 0; |
| 20 | padding: 0; | 20 | padding: 0; |
| 21 | list-style: none; | 21 | list-style: none; |
| 22 | } | 22 | } |
| 23 | 23 | ||
| 24 | nav li { | 24 | nav li { |
| 25 | display: inline-block; | 25 | display: inline-block; |
| 26 | } | 26 | } |
| 27 | 27 | ||
| 28 | nav a var | 28 | nav a var |
| 29 | { | 29 | { |
| 30 | display: block; | 30 | display: block; |
| 31 | padding: 6px 12px; | 31 | padding: 6px 12px; |
| 32 | text-decoration: none; | 32 | text-decoration: none; |
| 33 | } | 33 | } |
| 34 | 34 | ||
| 35 | $name: foo; | 35 | $name: foo; |
| @@ -67,10 +67,28 @@ button { | |||
| 67 | 67 | ||
| 68 | // bug:21230 | 68 | // bug:21230 |
| 69 | $list: ( | 69 | $list: ( |
| 70 | ('a', #000000, #fff) | 70 | ('a', #000000, #fff) |
| 71 | ('b', #000000, #fff) | 71 | ('b', #000000, #fff) |
| 72 | ('c', #000000, #fff) | 72 | ('c', #000000, #fff) |
| 73 | ('d', #000000, #fff) | 73 | ('d', #000000, #fff) |
| 74 | ('e', #000000, #fff) | 74 | ('e', #000000, #fff) |
| 75 | ('f', #000000, #fff) | 75 | ('f', #000000, #fff) |
| 76 | ); | 76 | ); |
| 77 | |||
| 78 | // bug:13425 | ||
| 79 | div:first-child, | ||
| 80 | div:last-child { | ||
| 81 | @include foo-mixin( | ||
| 82 | $foo: 'foo', | ||
| 83 | $bar: 'bar', | ||
| 84 | ); | ||
| 85 | |||
| 86 | font: 15px "Helvetica Neue", Helvetica, Arial, | ||
| 87 | "Nimbus Sans L", sans-serif; | ||
| 88 | |||
| 89 | div:first-child, | ||
| 90 | div:last-child { | ||
| 91 | font: 15px "Helvetica Neue", Helvetica, Arial, | ||
| 92 | "Nimbus Sans L", sans-serif; | ||
| 93 | } | ||
| 94 | } | ||
diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el new file mode 100644 index 00000000000..1167efd6a66 --- /dev/null +++ b/test/manual/scroll-tests.el | |||
| @@ -0,0 +1,130 @@ | |||
| 1 | ;;; scroll-tests.el -- tests for scrolling -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; This program 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 | ;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;; These are mostly automated ert tests, but they don't work in batch | ||
| 23 | ;; mode which is why they are under test/manual. | ||
| 24 | |||
| 25 | ;;; Code: | ||
| 26 | |||
| 27 | (require 'ert) | ||
| 28 | (eval-when-compile (require 'cl-lib)) | ||
| 29 | |||
| 30 | (defun scroll-tests-up-and-down (margin &optional effective-margin) | ||
| 31 | (unless effective-margin | ||
| 32 | (setq effective-margin margin)) | ||
| 33 | (erase-buffer) | ||
| 34 | (insert (mapconcat #'number-to-string | ||
| 35 | (number-sequence 1 200) "\n")) | ||
| 36 | (goto-char 1) | ||
| 37 | (sit-for 0) | ||
| 38 | (let ((scroll-margin margin) | ||
| 39 | (wstart (window-start))) | ||
| 40 | ;; Stopping before `scroll-margin' so we shouldn't have | ||
| 41 | ;; scrolled. | ||
| 42 | (let ((current-prefix-arg (- (window-text-height) 1 effective-margin))) | ||
| 43 | (call-interactively 'next-line)) | ||
| 44 | (sit-for 0) | ||
| 45 | (should (= wstart (window-start))) | ||
| 46 | ;; Passing `scroll-margin' should trigger scrolling. | ||
| 47 | (call-interactively 'next-line) | ||
| 48 | (sit-for 0) | ||
| 49 | (should (/= wstart (window-start))) | ||
| 50 | ;; Scroll back to top. | ||
| 51 | (let ((current-prefix-arg (window-start))) | ||
| 52 | (call-interactively 'scroll-down-command)) | ||
| 53 | (sit-for 0) | ||
| 54 | (should (= 1 (window-start))))) | ||
| 55 | |||
| 56 | (defmacro scroll-tests-with-buffer-window (&rest body) | ||
| 57 | (declare (debug t)) | ||
| 58 | `(with-temp-buffer | ||
| 59 | (with-selected-window (display-buffer (current-buffer)) | ||
| 60 | ,@body))) | ||
| 61 | |||
| 62 | (ert-deftest scroll-tests-scroll-margin-0 () | ||
| 63 | (skip-unless (not noninteractive)) | ||
| 64 | (scroll-tests-with-buffer-window | ||
| 65 | (scroll-tests-up-and-down 0))) | ||
| 66 | |||
| 67 | (ert-deftest scroll-tests-scroll-margin-negative () | ||
| 68 | "A negative `scroll-margin' should be the same as 0." | ||
| 69 | (skip-unless (not noninteractive)) | ||
| 70 | (scroll-tests-with-buffer-window | ||
| 71 | (scroll-tests-up-and-down -10 0))) | ||
| 72 | |||
| 73 | (ert-deftest scroll-tests-scroll-margin-max () | ||
| 74 | (skip-unless (not noninteractive)) | ||
| 75 | (scroll-tests-with-buffer-window | ||
| 76 | (let ((max-margin (/ (window-text-height) 4))) | ||
| 77 | (scroll-tests-up-and-down max-margin)))) | ||
| 78 | |||
| 79 | (ert-deftest scroll-tests-scroll-margin-over-max () | ||
| 80 | "A `scroll-margin' more than max should be the same as max." | ||
| 81 | (skip-unless (not noninteractive)) | ||
| 82 | (scroll-tests-with-buffer-window | ||
| 83 | (set-window-text-height nil 7) | ||
| 84 | (let ((max-margin (/ (window-text-height) 4))) | ||
| 85 | (scroll-tests-up-and-down (+ max-margin 1) max-margin) | ||
| 86 | (scroll-tests-up-and-down (+ max-margin 2) max-margin)))) | ||
| 87 | |||
| 88 | (defun scroll-tests--point-in-middle-of-window-p () | ||
| 89 | (= (count-lines (window-start) (window-point)) | ||
| 90 | (/ (1- (window-text-height)) 2))) | ||
| 91 | |||
| 92 | (cl-defun scroll-tests--scroll-margin-whole-window (&key with-line-spacing) | ||
| 93 | "Test `maximum-scroll-margin' at 0.5. | ||
| 94 | With a high `scroll-margin', this should keep cursor in the | ||
| 95 | middle of the window." | ||
| 96 | (let ((maximum-scroll-margin 0.5) | ||
| 97 | (scroll-margin 100)) | ||
| 98 | (scroll-tests-with-buffer-window | ||
| 99 | (setq-local line-spacing with-line-spacing) | ||
| 100 | ;; Choose an odd number, so there is one line in the middle. | ||
| 101 | (set-window-text-height nil 7) | ||
| 102 | ;; `set-window-text-height' doesn't count `line-spacing'. | ||
| 103 | (when with-line-spacing | ||
| 104 | (window-resize nil (* line-spacing 7) nil nil 'pixels)) | ||
| 105 | (erase-buffer) | ||
| 106 | (insert (mapconcat #'number-to-string | ||
| 107 | (number-sequence 1 200) "\n")) | ||
| 108 | (goto-char 1) | ||
| 109 | (sit-for 0) | ||
| 110 | (call-interactively 'scroll-up-command) | ||
| 111 | (sit-for 0) | ||
| 112 | (should (scroll-tests--point-in-middle-of-window-p)) | ||
| 113 | (call-interactively 'scroll-up-command) | ||
| 114 | (sit-for 0) | ||
| 115 | (should (scroll-tests--point-in-middle-of-window-p)) | ||
| 116 | (call-interactively 'scroll-down-command) | ||
| 117 | (sit-for 0) | ||
| 118 | (should (scroll-tests--point-in-middle-of-window-p))))) | ||
| 119 | |||
| 120 | (ert-deftest scroll-tests-scroll-margin-whole-window () | ||
| 121 | (skip-unless (not noninteractive)) | ||
| 122 | (scroll-tests--scroll-margin-whole-window)) | ||
| 123 | |||
| 124 | (ert-deftest scroll-tests-scroll-margin-whole-window-line-spacing () | ||
| 125 | ;; `line-spacing' has no effect on tty displays. | ||
| 126 | (skip-unless (display-graphic-p)) | ||
| 127 | (scroll-tests--scroll-margin-whole-window :with-line-spacing 3)) | ||
| 128 | |||
| 129 | |||
| 130 | ;;; scroll-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 | ||