diff options
| author | Vibhav Pant | 2017-02-05 23:08:53 +0530 |
|---|---|---|
| committer | Vibhav Pant | 2017-02-05 23:08:53 +0530 |
| commit | ad70ca1dad26da79f0a95cc0ec687902ef20fa9b (patch) | |
| tree | 732e8e9ace1fdd7aaf982f0fa5ac6c8e4eb5f7c7 | |
| parent | 2db473bda8be72cf3c1e4694d70ce48f60492b0e (diff) | |
| parent | 148100d98319499f0ac6f57b8be08cbd14884a5c (diff) | |
| download | emacs-ad70ca1dad26da79f0a95cc0ec687902ef20fa9b.tar.gz emacs-ad70ca1dad26da79f0a95cc0ec687902ef20fa9b.zip | |
Merge remote-tracking branch 'origin/master' into feature/byte-switch
82 files changed, 3655 insertions, 1371 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/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/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{% |
| @@ -307,10 +307,23 @@ local part of a remote file name. Thus, if you have a directory named | |||
| 307 | "/~" on the remote host "foo", you can prevent it from being | 307 | "/~" on the remote host "foo", you can prevent it from being |
| 308 | substituted by a home directory by writing it as "/foo:/:/~/file". | 308 | substituted by a home directory by writing it as "/foo:/:/~/file". |
| 309 | 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 | |||
| 310 | 315 | ||
| 311 | * Editing Changes in Emacs 26.1 | 316 | * Editing Changes in Emacs 26.1 |
| 312 | 317 | ||
| 313 | +++ | 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 | +++ | ||
| 314 | ** New bindings for 'query-replace-map'. | 327 | ** New bindings for 'query-replace-map'. |
| 315 | 'undo', undo the last replacement; bound to 'u'. | 328 | 'undo', undo the last replacement; bound to 'u'. |
| 316 | 'undo-all', undo all replacements; bound to 'U'. | 329 | 'undo-all', undo all replacements; bound to 'U'. |
| @@ -451,6 +464,11 @@ viewing HTML files and the like. | |||
| 451 | 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 |
| 452 | 'edebug-sit-on-break'. | 465 | 'edebug-sit-on-break'. |
| 453 | 466 | ||
| 467 | +++ | ||
| 468 | *** New customizable option 'edebug-max-depth' | ||
| 469 | This allows to enlarge the maximum recursion depth when instrumenting | ||
| 470 | code. | ||
| 471 | |||
| 454 | ** Eshell | 472 | ** Eshell |
| 455 | 473 | ||
| 456 | *** 'eshell-input-filter's value is now a named function | 474 | *** 'eshell-input-filter's value is now a named function |
| @@ -613,6 +631,13 @@ HTML tags, classes and IDs using the 'completion-at-point' command. | |||
| 613 | Completion candidates for HTML classes and IDs are retrieved from open | 631 | Completion candidates for HTML classes and IDs are retrieved from open |
| 614 | HTML mode buffers. | 632 | HTML mode buffers. |
| 615 | 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 | |||
| 616 | +++ | 641 | +++ |
| 617 | ** Emacs now supports character name escape sequences in character and | 642 | ** Emacs now supports character name escape sequences in character and |
| 618 | string literals. The syntax variants \N{character name} and | 643 | string literals. The syntax variants \N{character name} and |
| @@ -738,6 +763,13 @@ instead. | |||
| 738 | 763 | ||
| 739 | * Lisp Changes in Emacs 26.1 | 764 | * Lisp Changes in Emacs 26.1 |
| 740 | 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. | ||
| 741 | ** New variable 'while-no-input-ignore-events' which allow | 773 | ** New variable 'while-no-input-ignore-events' which allow |
| 742 | setting which special events 'while-no-input' should ignore. | 774 | setting which special events 'while-no-input' should ignore. |
| 743 | It is a list of symbols. | 775 | It is a list of symbols. |
| @@ -864,6 +896,10 @@ collection). | |||
| 864 | +++ | 896 | +++ |
| 865 | ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. | 897 | ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. |
| 866 | 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 | |||
| 867 | +++ | 903 | +++ |
| 868 | ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' | 904 | ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' |
| 869 | 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. |
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/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/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.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/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/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 25392fdcc71..b7d104853c3 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -5134,6 +5134,14 @@ Before and after saving the buffer, this function runs | |||
| 5134 | "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.") |
| 5135 | (make-variable-buffer-local 'buffer-save-without-query) | 5135 | (make-variable-buffer-local 'buffer-save-without-query) |
| 5136 | 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 | |||
| 5137 | (defun save-some-buffers (&optional arg pred) | 5145 | (defun save-some-buffers (&optional arg pred) |
| 5138 | "Save some modified file-visiting buffers. Asks user about each one. | 5146 | "Save some modified file-visiting buffers. Asks user about each one. |
| 5139 | 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 |
| @@ -5149,10 +5157,13 @@ If PRED is nil, all the file-visiting buffers are considered. | |||
| 5149 | 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. |
| 5150 | 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 |
| 5151 | 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'. | ||
| 5152 | 5161 | ||
| 5153 | See `save-some-buffers-action-alist' if you want to | 5162 | See `save-some-buffers-action-alist' if you want to |
| 5154 | change the additional actions you can take on files." | 5163 | change the additional actions you can take on files." |
| 5155 | (interactive "P") | 5164 | (interactive "P") |
| 5165 | (unless pred | ||
| 5166 | (setq pred save-some-buffers-default-predicate)) | ||
| 5156 | (save-window-excursion | 5167 | (save-window-excursion |
| 5157 | (let* (queried autosaved-buffers | 5168 | (let* (queried autosaved-buffers |
| 5158 | files-done abbrevs-done) | 5169 | files-done abbrevs-done) |
| @@ -6572,7 +6583,7 @@ normally equivalent short `-D' option is just passed on to | |||
| 6572 | (unless (equal switches "") | 6583 | (unless (equal switches "") |
| 6573 | ;; Split the switches at any spaces so we can | 6584 | ;; Split the switches at any spaces so we can |
| 6574 | ;; pass separate options as separate args. | 6585 | ;; pass separate options as separate args. |
| 6575 | (split-string switches))) | 6586 | (split-string-and-unquote switches))) |
| 6576 | ;; Avoid lossage if FILE starts with `-'. | 6587 | ;; Avoid lossage if FILE starts with `-'. |
| 6577 | '("--") | 6588 | '("--") |
| 6578 | (progn | 6589 | (progn |
| @@ -6812,6 +6823,8 @@ asks whether processes should be killed. | |||
| 6812 | 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 |
| 6813 | 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." |
| 6814 | (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. | ||
| 6815 | (save-some-buffers arg t) | 6828 | (save-some-buffers arg t) |
| 6816 | (let ((confirm confirm-kill-emacs)) | 6829 | (let ((confirm confirm-kill-emacs)) |
| 6817 | (and | 6830 | (and |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 43e1231914c..a4ff840f755 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -1713,9 +1713,10 @@ regexp." | |||
| 1713 | ;; (modify-syntax-entry ?- "w" table) | 1713 | ;; (modify-syntax-entry ?- "w" table) |
| 1714 | (modify-syntax-entry ?> ")<" table) | 1714 | (modify-syntax-entry ?> ")<" table) |
| 1715 | (modify-syntax-entry ?< "(>" table) | 1715 | (modify-syntax-entry ?< "(>" table) |
| 1716 | ;; make M-. in article buffers work for `foo' strings | 1716 | ;; make M-. in article buffers work for `foo' strings, |
| 1717 | (modify-syntax-entry ?' " " table) | 1717 | ;; and still allow C-s C-w to yank ' to the search ring |
| 1718 | (modify-syntax-entry ?` " " table) | 1718 | (modify-syntax-entry ?' "'" table) |
| 1719 | (modify-syntax-entry ?` "'" table) | ||
| 1719 | table) | 1720 | table) |
| 1720 | "Syntax table used in article mode buffers. | 1721 | "Syntax table used in article mode buffers. |
| 1721 | Initialized from `text-mode-syntax-table'.") | 1722 | Initialized from `text-mode-syntax-table'.") |
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/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/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/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 fd7aa50840f..dfd7aebd569 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 | 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)) | ||
| 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/js.el b/lisp/progmodes/js.el index 74dd4add9e2..e42e01481b6 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el | |||
| @@ -3849,6 +3849,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." | |||
| 3849 | comment-start-skip "\\(//+\\|/\\*+\\)\\s *") | 3849 | comment-start-skip "\\(//+\\|/\\*+\\)\\s *") |
| 3850 | (setq-local comment-line-break-function #'c-indent-new-comment-line) | 3850 | (setq-local comment-line-break-function #'c-indent-new-comment-line) |
| 3851 | (setq-local c-block-comment-start-regexp "/\\*") | 3851 | (setq-local c-block-comment-start-regexp "/\\*") |
| 3852 | (setq-local comment-multi-line t) | ||
| 3852 | 3853 | ||
| 3853 | (setq-local electric-indent-chars | 3854 | (setq-local electric-indent-chars |
| 3854 | (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". | 3855 | (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". |
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index a507755d42e..a8933b0103e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -918,11 +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 | ;; 'grep -E -foo' results in 'grep: oo: No such file or directory'. | 921 | (let* ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E" |
| 922 | ;; while 'grep -e -foo' inexplicably doesn't. | ||
| 923 | (when (eq (aref regexp 0) ?-) | ||
| 924 | (setq regexp (concat "\\" regexp))) | ||
| 925 | (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " | ||
| 926 | grep-find-template t t)) | 922 | grep-find-template t t)) |
| 927 | (grep-highlight-matches nil) | 923 | (grep-highlight-matches nil) |
| 928 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) | 924 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) |
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/subr.el b/lisp/subr.el index a6ba05c2021..a204577ddf9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1417,8 +1417,10 @@ be a list of the form returned by `event-start' and `event-end'." | |||
| 1417 | ;; bug#23850 | 1417 | ;; bug#23850 |
| 1418 | (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") | 1418 | (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") |
| 1419 | (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") | ||
| 1420 | (make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1") | 1421 | (make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1") |
| 1421 | (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") | ||
| 1422 | 1424 | ||
| 1423 | (defun log10 (x) | 1425 | (defun log10 (x) |
| 1424 | "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/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/vc/diff-mode.el b/lisp/vc/diff-mode.el index e609ca9f943..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) |
| @@ -647,28 +650,36 @@ If the prefix ARG is given, restrict the view to the current file instead." | |||
| 647 | (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) | 650 | (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) |
| 648 | (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) | 651 | (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) |
| 649 | 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 | |||
| 650 | (defun diff-hunk-kill () | 658 | (defun diff-hunk-kill () |
| 651 | "Kill the hunk at point." | 659 | "Kill the hunk at point." |
| 652 | (interactive) | 660 | (interactive) |
| 653 | (let* ((hunk-bounds (diff-bounds-of-hunk)) | 661 | (if (not (diff--some-hunks-p)) |
| 654 | (file-bounds (ignore-errors (diff-bounds-of-file))) | 662 | (error "No hunks") |
| 655 | ;; If the current hunk is the only one for its file, kill the | 663 | (diff-beginning-of-hunk t) |
| 656 | ;; file header too. | 664 | (let* ((hunk-bounds (diff-bounds-of-hunk)) |
| 657 | (bounds (if (and file-bounds | 665 | (file-bounds (ignore-errors (diff-bounds-of-file))) |
| 658 | (progn (goto-char (car file-bounds)) | 666 | ;; If the current hunk is the only one for its file, kill the |
| 659 | (= (progn (diff-hunk-next) (point)) | 667 | ;; file header too. |
| 660 | (car hunk-bounds))) | 668 | (bounds (if (and file-bounds |
| 661 | (progn (goto-char (cadr hunk-bounds)) | 669 | (progn (goto-char (car file-bounds)) |
| 662 | ;; bzr puts a newline after the last hunk. | 670 | (= (progn (diff-hunk-next) (point)) |
| 663 | (while (looking-at "^\n") | 671 | (car hunk-bounds))) |
| 664 | (forward-char 1)) | 672 | (progn (goto-char (cadr hunk-bounds)) |
| 665 | (= (point) (cadr file-bounds)))) | 673 | ;; bzr puts a newline after the last hunk. |
| 666 | file-bounds | 674 | (while (looking-at "^\n") |
| 667 | hunk-bounds)) | 675 | (forward-char 1)) |
| 668 | (inhibit-read-only t)) | 676 | (= (point) (cadr file-bounds)))) |
| 669 | (apply 'kill-region bounds) | 677 | file-bounds |
| 670 | (goto-char (car bounds)) | 678 | hunk-bounds)) |
| 671 | (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))))) | ||
| 672 | 683 | ||
| 673 | (defun diff-beginning-of-file-and-junk () | 684 | (defun diff-beginning-of-file-and-junk () |
| 674 | "Go to the beginning of file-related diff-info. | 685 | "Go to the beginning of file-related diff-info. |
| @@ -720,9 +731,12 @@ data such as \"Index: ...\" and such." | |||
| 720 | (defun diff-file-kill () | 731 | (defun diff-file-kill () |
| 721 | "Kill current file's hunks." | 732 | "Kill current file's hunks." |
| 722 | (interactive) | 733 | (interactive) |
| 723 | (let ((inhibit-read-only t)) | 734 | (if (not (diff--some-hunks-p)) |
| 724 | (apply 'kill-region (diff-bounds-of-file))) | 735 | (error "No hunks") |
| 725 | (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)))) | ||
| 726 | 740 | ||
| 727 | (defun diff-kill-junk () | 741 | (defun diff-kill-junk () |
| 728 | "Kill spurious empty diffs." | 742 | "Kill spurious empty diffs." |
| @@ -1537,15 +1551,20 @@ Only works for unified diffs." | |||
| 1537 | (pcase (char-after) | 1551 | (pcase (char-after) |
| 1538 | (?\s (cl-decf before) (cl-decf after) t) | 1552 | (?\s (cl-decf before) (cl-decf after) t) |
| 1539 | (?- | 1553 | (?- |
| 1540 | (if (and (looking-at diff-file-header-re) | 1554 | (cond |
| 1541 | (zerop before) (zerop after)) | 1555 | ((and (looking-at diff-separator-re) |
| 1542 | ;; No need to query: this is a case where two patches | 1556 | (zerop before) (zerop after)) |
| 1543 | ;; are concatenated and only counting the lines will | 1557 | nil) |
| 1544 | ;; give the right result. Let's just add an empty | 1558 | ((and (looking-at diff-file-header-re) |
| 1545 | ;; line so that our code which doesn't count lines | 1559 | (zerop before) (zerop after)) |
| 1546 | ;; will not get confused. | 1560 | ;; No need to query: this is a case where two patches |
| 1547 | (progn (save-excursion (insert "\n")) nil) | 1561 | ;; are concatenated and only counting the lines will |
| 1548 | (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))) | ||
| 1549 | (?+ (cl-decf after) t) | 1568 | (?+ (cl-decf after) t) |
| 1550 | (_ | 1569 | (_ |
| 1551 | (cond | 1570 | (cond |
| @@ -2000,57 +2019,58 @@ Return new point, if it was moved." | |||
| 2000 | "Highlight changes of hunk at point at a finer granularity." | 2019 | "Highlight changes of hunk at point at a finer granularity." |
| 2001 | (interactive) | 2020 | (interactive) |
| 2002 | (require 'smerge-mode) | 2021 | (require 'smerge-mode) |
| 2003 | (save-excursion | 2022 | (when (diff--some-hunks-p) |
| 2004 | (diff-beginning-of-hunk t) | 2023 | (save-excursion |
| 2005 | (let* ((start (point)) | 2024 | (diff-beginning-of-hunk t) |
| 2006 | (style (diff-hunk-style)) ;Skips the hunk header as well. | 2025 | (let* ((start (point)) |
| 2007 | (beg (point)) | 2026 | (style (diff-hunk-style)) ;Skips the hunk header as well. |
| 2008 | (props-c '((diff-mode . fine) (face diff-refine-changed))) | 2027 | (beg (point)) |
| 2009 | (props-r '((diff-mode . fine) (face diff-refine-removed))) | 2028 | (props-c '((diff-mode . fine) (face diff-refine-changed))) |
| 2010 | (props-a '((diff-mode . fine) (face diff-refine-added))) | 2029 | (props-r '((diff-mode . fine) (face diff-refine-removed))) |
| 2011 | ;; Be careful to go back to `start' so diff-end-of-hunk gets | 2030 | (props-a '((diff-mode . fine) (face diff-refine-added))) |
| 2012 | ;; to read the hunk header's line info. | 2031 | ;; Be careful to go back to `start' so diff-end-of-hunk gets |
| 2013 | (end (progn (goto-char start) (diff-end-of-hunk) (point)))) | 2032 | ;; to read the hunk header's line info. |
| 2014 | 2033 | (end (progn (goto-char start) (diff-end-of-hunk) (point)))) | |
| 2015 | (remove-overlays beg end 'diff-mode 'fine) | 2034 | |
| 2016 | 2035 | (remove-overlays beg end 'diff-mode 'fine) | |
| 2017 | (goto-char beg) | 2036 | |
| 2018 | (pcase style | 2037 | (goto-char beg) |
| 2019 | (`unified | 2038 | (pcase style |
| 2020 | (while (re-search-forward "^-" end t) | 2039 | (`unified |
| 2021 | (let ((beg-del (progn (beginning-of-line) (point))) | 2040 | (while (re-search-forward "^-" end t) |
| 2022 | beg-add end-add) | 2041 | (let ((beg-del (progn (beginning-of-line) (point))) |
| 2023 | (when (and (diff--forward-while-leading-char ?- end) | 2042 | beg-add end-add) |
| 2024 | ;; Allow for "\ No newline at end of file". | 2043 | (when (and (diff--forward-while-leading-char ?- end) |
| 2025 | (progn (diff--forward-while-leading-char ?\\ end) | 2044 | ;; Allow for "\ No newline at end of file". |
| 2026 | (setq beg-add (point))) | 2045 | (progn (diff--forward-while-leading-char ?\\ end) |
| 2027 | (diff--forward-while-leading-char ?+ end) | 2046 | (setq beg-add (point))) |
| 2028 | (progn (diff--forward-while-leading-char ?\\ end) | 2047 | (diff--forward-while-leading-char ?+ end) |
| 2029 | (setq end-add (point)))) | 2048 | (progn (diff--forward-while-leading-char ?\\ end) |
| 2030 | (smerge-refine-subst beg-del beg-add beg-add end-add | 2049 | (setq end-add (point)))) |
| 2031 | nil 'diff-refine-preproc props-r props-a))))) | 2050 | (smerge-refine-subst beg-del beg-add beg-add end-add |
| 2032 | (`context | 2051 | nil 'diff-refine-preproc props-r props-a))))) |
| 2033 | (let* ((middle (save-excursion (re-search-forward "^---"))) | 2052 | (`context |
| 2034 | (other middle)) | 2053 | (let* ((middle (save-excursion (re-search-forward "^---"))) |
| 2035 | (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) | 2054 | (other middle)) |
| 2036 | (smerge-refine-subst (match-beginning 0) (match-end 0) | 2055 | (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) |
| 2037 | (save-excursion | 2056 | (smerge-refine-subst (match-beginning 0) (match-end 0) |
| 2038 | (goto-char other) | 2057 | (save-excursion |
| 2039 | (re-search-forward "^\\(?:!.*\n\\)+" end) | 2058 | (goto-char other) |
| 2040 | (setq other (match-end 0)) | 2059 | (re-search-forward "^\\(?:!.*\n\\)+" end) |
| 2041 | (match-beginning 0)) | 2060 | (setq other (match-end 0)) |
| 2042 | other | 2061 | (match-beginning 0)) |
| 2043 | (if diff-use-changed-face props-c) | 2062 | other |
| 2044 | 'diff-refine-preproc | 2063 | (if diff-use-changed-face props-c) |
| 2045 | (unless diff-use-changed-face props-r) | 2064 | 'diff-refine-preproc |
| 2046 | (unless diff-use-changed-face props-a))))) | 2065 | (unless diff-use-changed-face props-r) |
| 2047 | (_ ;; Normal diffs. | 2066 | (unless diff-use-changed-face props-a))))) |
| 2048 | (let ((beg1 (1+ (point)))) | 2067 | (_ ;; Normal diffs. |
| 2049 | (when (re-search-forward "^---.*\n" end t) | 2068 | (let ((beg1 (1+ (point)))) |
| 2050 | ;; It's a combined add&remove, so there's something to do. | 2069 | (when (re-search-forward "^---.*\n" end t) |
| 2051 | (smerge-refine-subst beg1 (match-beginning 0) | 2070 | ;; It's a combined add&remove, so there's something to do. |
| 2052 | (match-end 0) end | 2071 | (smerge-refine-subst beg1 (match-beginning 0) |
| 2053 | nil 'diff-refine-preproc props-r props-a)))))))) | 2072 | (match-end 0) end |
| 2073 | nil 'diff-refine-preproc props-r props-a))))))))) | ||
| 2054 | 2074 | ||
| 2055 | (defun diff-undo (&optional arg) | 2075 | (defun diff-undo (&optional arg) |
| 2056 | "Perform `undo', ignoring the buffer's read-only status." | 2076 | "Perform `undo', ignoring the buffer's read-only status." |
diff --git a/src/alloc.c b/src/alloc.c index dd2b688f91e..62f43669f2a 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -2880,7 +2880,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, | |||
| 2880 | for (EMACS_INT size = XFASTINT (length); 0 < size; size--) | 2880 | for (EMACS_INT size = XFASTINT (length); 0 < size; size--) |
| 2881 | { | 2881 | { |
| 2882 | val = Fcons (init, val); | 2882 | val = Fcons (init, val); |
| 2883 | maybe_quit (); | 2883 | rarely_quit (size); |
| 2884 | } | 2884 | } |
| 2885 | 2885 | ||
| 2886 | return val; | 2886 | return val; |
| @@ -4887,12 +4887,19 @@ mark_memory (void *start, void *end) | |||
| 4887 | } | 4887 | } |
| 4888 | } | 4888 | } |
| 4889 | 4889 | ||
| 4890 | #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 | ||
| 4891 | 4898 | ||
| 4892 | static bool setjmp_tested_p; | 4899 | static bool setjmp_tested_p; |
| 4893 | static int longjmps_done; | 4900 | static int longjmps_done; |
| 4894 | 4901 | ||
| 4895 | #define SETJMP_WILL_LIKELY_WORK "\ | 4902 | # define SETJMP_WILL_LIKELY_WORK "\ |
| 4896 | \n\ | 4903 | \n\ |
| 4897 | Emacs garbage collector has been changed to use conservative stack\n\ | 4904 | Emacs garbage collector has been changed to use conservative stack\n\ |
| 4898 | 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\ |
| @@ -4905,7 +4912,7 @@ verify that the methods used are appropriate for your system.\n\ | |||
| 4905 | Please mail the result to <emacs-devel@gnu.org>.\n\ | 4912 | Please mail the result to <emacs-devel@gnu.org>.\n\ |
| 4906 | " | 4913 | " |
| 4907 | 4914 | ||
| 4908 | #define SETJMP_WILL_NOT_WORK "\ | 4915 | # define SETJMP_WILL_NOT_WORK "\ |
| 4909 | \n\ | 4916 | \n\ |
| 4910 | Emacs garbage collector has been changed to use conservative stack\n\ | 4917 | Emacs garbage collector has been changed to use conservative stack\n\ |
| 4911 | 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\ |
| @@ -4931,6 +4938,9 @@ Please mail the result to <emacs-devel@gnu.org>.\n\ | |||
| 4931 | static void | 4938 | static void |
| 4932 | test_setjmp (void) | 4939 | test_setjmp (void) |
| 4933 | { | 4940 | { |
| 4941 | if (setjmp_tested_p) | ||
| 4942 | return; | ||
| 4943 | setjmp_tested_p = true; | ||
| 4934 | char buf[10]; | 4944 | char buf[10]; |
| 4935 | register int x; | 4945 | register int x; |
| 4936 | sys_jmp_buf jbuf; | 4946 | sys_jmp_buf jbuf; |
| @@ -4967,9 +4977,60 @@ test_setjmp (void) | |||
| 4967 | if (longjmps_done == 1) | 4977 | if (longjmps_done == 1) |
| 4968 | sys_longjmp (jbuf, 1); | 4978 | sys_longjmp (jbuf, 1); |
| 4969 | } | 4979 | } |
| 4980 | # endif /* ! GC_SETJMP_WORKS */ | ||
| 4981 | #endif /* ! HAVE___BUILTIN_UNWIND_INIT */ | ||
| 4970 | 4982 | ||
| 4971 | #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 | ||
| 4972 | 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 | ||
| 4973 | 5034 | ||
| 4974 | /* Mark live Lisp objects on the C stack. | 5035 | /* Mark live Lisp objects on the C stack. |
| 4975 | 5036 | ||
| @@ -4981,12 +5042,7 @@ test_setjmp (void) | |||
| 4981 | 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 |
| 4982 | variables or are used to pass parameters. | 5043 | variables or are used to pass parameters. |
| 4983 | 5044 | ||
| 4984 | If GC_SAVE_REGISTERS_ON_STACK is defined, it should expand to | 5045 | This code assumes that calling setjmp saves registers we need |
| 4985 | something that either saves relevant registers on the stack, or | ||
| 4986 | calls mark_maybe_object passing it each register's contents. | ||
| 4987 | |||
| 4988 | If GC_SAVE_REGISTERS_ON_STACK is not defined, the current | ||
| 4989 | implementation assumes that calling setjmp saves registers we need | ||
| 4990 | 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 |
| 4991 | 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 |
| 4992 | by taking a look at the source code of setjmp. | 5048 | by taking a look at the source code of setjmp. |
| @@ -5050,62 +5106,9 @@ flush_stack_call_func (void (*func) (void *arg), void *arg) | |||
| 5050 | { | 5106 | { |
| 5051 | void *end; | 5107 | void *end; |
| 5052 | struct thread_state *self = current_thread; | 5108 | struct thread_state *self = current_thread; |
| 5053 | 5109 | SET_STACK_TOP_ADDRESS (&end); | |
| 5054 | #ifdef HAVE___BUILTIN_UNWIND_INIT | ||
| 5055 | /* Force callee-saved registers and register windows onto the stack. | ||
| 5056 | This is the preferred method if available, obviating the need for | ||
| 5057 | machine dependent methods. */ | ||
| 5058 | __builtin_unwind_init (); | ||
| 5059 | end = &end; | ||
| 5060 | #else /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 5061 | #ifndef GC_SAVE_REGISTERS_ON_STACK | ||
| 5062 | /* jmp_buf may not be aligned enough on darwin-ppc64 */ | ||
| 5063 | union aligned_jmpbuf { | ||
| 5064 | Lisp_Object o; | ||
| 5065 | sys_jmp_buf j; | ||
| 5066 | } j; | ||
| 5067 | volatile bool stack_grows_down_p = (char *) &j > (char *) stack_bottom; | ||
| 5068 | #endif | ||
| 5069 | /* This trick flushes the register windows so that all the state of | ||
| 5070 | the process is contained in the stack. */ | ||
| 5071 | /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is | ||
| 5072 | needed on ia64 too. See mach_dep.c, where it also says inline | ||
| 5073 | assembler doesn't work with relevant proprietary compilers. */ | ||
| 5074 | #ifdef __sparc__ | ||
| 5075 | #if defined (__sparc64__) && defined (__FreeBSD__) | ||
| 5076 | /* FreeBSD does not have a ta 3 handler. */ | ||
| 5077 | asm ("flushw"); | ||
| 5078 | #else | ||
| 5079 | asm ("ta 3"); | ||
| 5080 | #endif | ||
| 5081 | #endif | ||
| 5082 | |||
| 5083 | /* Save registers that we need to see on the stack. We need to see | ||
| 5084 | registers used to hold register variables and registers used to | ||
| 5085 | pass parameters. */ | ||
| 5086 | #ifdef GC_SAVE_REGISTERS_ON_STACK | ||
| 5087 | GC_SAVE_REGISTERS_ON_STACK (end); | ||
| 5088 | #else /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 5089 | |||
| 5090 | #ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that | ||
| 5091 | setjmp will definitely work, test it | ||
| 5092 | and print a message with the result | ||
| 5093 | of the test. */ | ||
| 5094 | if (!setjmp_tested_p) | ||
| 5095 | { | ||
| 5096 | setjmp_tested_p = 1; | ||
| 5097 | test_setjmp (); | ||
| 5098 | } | ||
| 5099 | #endif /* GC_SETJMP_WORKS */ | ||
| 5100 | |||
| 5101 | sys_setjmp (j.j); | ||
| 5102 | end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; | ||
| 5103 | #endif /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 5104 | #endif /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 5105 | |||
| 5106 | self->stack_top = end; | 5110 | self->stack_top = end; |
| 5107 | (*func) (arg); | 5111 | func (arg); |
| 5108 | |||
| 5109 | eassert (current_thread == self); | 5112 | eassert (current_thread == self); |
| 5110 | } | 5113 | } |
| 5111 | 5114 | ||
| @@ -5437,7 +5440,8 @@ make_pure_vector (ptrdiff_t len) | |||
| 5437 | /* Copy all contents and parameters of TABLE to a new table allocated | 5440 | /* Copy all contents and parameters of TABLE to a new table allocated |
| 5438 | from pure space, return the purified table. */ | 5441 | from pure space, return the purified table. */ |
| 5439 | static struct Lisp_Hash_Table * | 5442 | static struct Lisp_Hash_Table * |
| 5440 | purecopy_hash_table (struct Lisp_Hash_Table *table) { | 5443 | purecopy_hash_table (struct Lisp_Hash_Table *table) |
| 5444 | { | ||
| 5441 | eassert (NILP (table->weak)); | 5445 | eassert (NILP (table->weak)); |
| 5442 | eassert (!NILP (table->pure)); | 5446 | eassert (!NILP (table->pure)); |
| 5443 | 5447 | ||
| @@ -5480,14 +5484,12 @@ Does not copy symbols. Copies strings without text properties. */) | |||
| 5480 | return purecopy (obj); | 5484 | return purecopy (obj); |
| 5481 | } | 5485 | } |
| 5482 | 5486 | ||
| 5483 | struct pinned_object | 5487 | /* Pinned objects are marked before every GC cycle. */ |
| 5488 | static struct pinned_object | ||
| 5484 | { | 5489 | { |
| 5485 | Lisp_Object object; | 5490 | Lisp_Object object; |
| 5486 | struct pinned_object *next; | 5491 | struct pinned_object *next; |
| 5487 | }; | 5492 | } *pinned_objects; |
| 5488 | |||
| 5489 | /* Pinned objects are marked before every GC cycle. */ | ||
| 5490 | static struct pinned_object *pinned_objects; | ||
| 5491 | 5493 | ||
| 5492 | static Lisp_Object | 5494 | static Lisp_Object |
| 5493 | purecopy (Lisp_Object obj) | 5495 | purecopy (Lisp_Object obj) |
| @@ -5519,13 +5521,13 @@ purecopy (Lisp_Object obj) | |||
| 5519 | else if (HASH_TABLE_P (obj)) | 5521 | else if (HASH_TABLE_P (obj)) |
| 5520 | { | 5522 | { |
| 5521 | struct Lisp_Hash_Table *table = XHASH_TABLE (obj); | 5523 | struct Lisp_Hash_Table *table = XHASH_TABLE (obj); |
| 5522 | /* We cannot purify hash tables which haven't been defined with | 5524 | /* Do not purify hash tables which haven't been defined with |
| 5523 | :purecopy as non-nil or are weak - they aren't guaranteed to | 5525 | :purecopy as non-nil or are weak - they aren't guaranteed to |
| 5524 | not change. */ | 5526 | not change. */ |
| 5525 | if (!NILP (table->weak) || NILP (table->pure)) | 5527 | if (!NILP (table->weak) || NILP (table->pure)) |
| 5526 | { | 5528 | { |
| 5527 | /* Instead, the hash table is added to the list of pinned objects, | 5529 | /* Instead, add the hash table to the list of pinned objects, |
| 5528 | and is marked before GC. */ | 5530 | so that it will be marked during GC. */ |
| 5529 | struct pinned_object *o = xmalloc (sizeof *o); | 5531 | struct pinned_object *o = xmalloc (sizeof *o); |
| 5530 | o->object = obj; | 5532 | o->object = obj; |
| 5531 | o->next = pinned_objects; | 5533 | o->next = pinned_objects; |
| @@ -5755,11 +5757,8 @@ compact_undo_list (Lisp_Object list) | |||
| 5755 | static void | 5757 | static void |
| 5756 | mark_pinned_objects (void) | 5758 | mark_pinned_objects (void) |
| 5757 | { | 5759 | { |
| 5758 | struct pinned_object *pobj; | 5760 | for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next) |
| 5759 | for (pobj = pinned_objects; pobj; pobj = pobj->next) | 5761 | mark_object (pobj->object); |
| 5760 | { | ||
| 5761 | mark_object (pobj->object); | ||
| 5762 | } | ||
| 5763 | } | 5762 | } |
| 5764 | 5763 | ||
| 5765 | static void | 5764 | static void |
| @@ -6051,58 +6050,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 6051 | (void) | 6050 | (void) |
| 6052 | { | 6051 | { |
| 6053 | void *end; | 6052 | void *end; |
| 6054 | 6053 | SET_STACK_TOP_ADDRESS (&end); | |
| 6055 | #ifdef HAVE___BUILTIN_UNWIND_INIT | ||
| 6056 | /* Force callee-saved registers and register windows onto the stack. | ||
| 6057 | This is the preferred method if available, obviating the need for | ||
| 6058 | machine dependent methods. */ | ||
| 6059 | __builtin_unwind_init (); | ||
| 6060 | end = &end; | ||
| 6061 | #else /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 6062 | #ifndef GC_SAVE_REGISTERS_ON_STACK | ||
| 6063 | /* jmp_buf may not be aligned enough on darwin-ppc64 */ | ||
| 6064 | union aligned_jmpbuf { | ||
| 6065 | Lisp_Object o; | ||
| 6066 | sys_jmp_buf j; | ||
| 6067 | } j; | ||
| 6068 | volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base; | ||
| 6069 | #endif | ||
| 6070 | /* This trick flushes the register windows so that all the state of | ||
| 6071 | the process is contained in the stack. */ | ||
| 6072 | /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is | ||
| 6073 | needed on ia64 too. See mach_dep.c, where it also says inline | ||
| 6074 | assembler doesn't work with relevant proprietary compilers. */ | ||
| 6075 | #ifdef __sparc__ | ||
| 6076 | #if defined (__sparc64__) && defined (__FreeBSD__) | ||
| 6077 | /* FreeBSD does not have a ta 3 handler. */ | ||
| 6078 | asm ("flushw"); | ||
| 6079 | #else | ||
| 6080 | asm ("ta 3"); | ||
| 6081 | #endif | ||
| 6082 | #endif | ||
| 6083 | |||
| 6084 | /* Save registers that we need to see on the stack. We need to see | ||
| 6085 | registers used to hold register variables and registers used to | ||
| 6086 | pass parameters. */ | ||
| 6087 | #ifdef GC_SAVE_REGISTERS_ON_STACK | ||
| 6088 | GC_SAVE_REGISTERS_ON_STACK (end); | ||
| 6089 | #else /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 6090 | |||
| 6091 | #ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that | ||
| 6092 | setjmp will definitely work, test it | ||
| 6093 | and print a message with the result | ||
| 6094 | of the test. */ | ||
| 6095 | if (!setjmp_tested_p) | ||
| 6096 | { | ||
| 6097 | setjmp_tested_p = 1; | ||
| 6098 | test_setjmp (); | ||
| 6099 | } | ||
| 6100 | #endif /* GC_SETJMP_WORKS */ | ||
| 6101 | |||
| 6102 | sys_setjmp (j.j); | ||
| 6103 | end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; | ||
| 6104 | #endif /* not GC_SAVE_REGISTERS_ON_STACK */ | ||
| 6105 | #endif /* not HAVE___BUILTIN_UNWIND_INIT */ | ||
| 6106 | return garbage_collect_1 (end); | 6054 | return garbage_collect_1 (end); |
| 6107 | } | 6055 | } |
| 6108 | 6056 | ||
| @@ -7412,9 +7360,6 @@ init_alloc_once (void) | |||
| 7412 | void | 7360 | void |
| 7413 | init_alloc (void) | 7361 | init_alloc (void) |
| 7414 | { | 7362 | { |
| 7415 | #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS | ||
| 7416 | setjmp_tested_p = longjmps_done = 0; | ||
| 7417 | #endif | ||
| 7418 | Vgc_elapsed = make_float (0.0); | 7363 | Vgc_elapsed = make_float (0.0); |
| 7419 | gcs_done = 0; | 7364 | gcs_done = 0; |
| 7420 | 7365 | ||
diff --git a/src/bytecode.c b/src/bytecode.c index 288d78efe41..f9531761b3c 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -843,11 +843,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 843 | { | 843 | { |
| 844 | Lisp_Object v2 = POP, v1 = TOP; | 844 | Lisp_Object v2 = POP, v1 = TOP; |
| 845 | CHECK_NUMBER (v1); | 845 | CHECK_NUMBER (v1); |
| 846 | EMACS_INT n = XINT (v1); | 846 | for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) |
| 847 | immediate_quit = true; | 847 | { |
| 848 | while (--n >= 0 && CONSP (v2)) | 848 | v2 = XCDR (v2); |
| 849 | v2 = XCDR (v2); | 849 | rarely_quit (n); |
| 850 | immediate_quit = false; | 850 | } |
| 851 | TOP = CAR (v2); | 851 | TOP = CAR (v2); |
| 852 | NEXT; | 852 | NEXT; |
| 853 | } | 853 | } |
| @@ -1277,11 +1277,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1277 | /* Exchange args and then do nth. */ | 1277 | /* Exchange args and then do nth. */ |
| 1278 | Lisp_Object v2 = POP, v1 = TOP; | 1278 | Lisp_Object v2 = POP, v1 = TOP; |
| 1279 | CHECK_NUMBER (v2); | 1279 | CHECK_NUMBER (v2); |
| 1280 | EMACS_INT n = XINT (v2); | 1280 | for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) |
| 1281 | immediate_quit = true; | 1281 | { |
| 1282 | while (--n >= 0 && CONSP (v1)) | 1282 | v1 = XCDR (v1); |
| 1283 | v1 = XCDR (v1); | 1283 | rarely_quit (n); |
| 1284 | immediate_quit = false; | 1284 | } |
| 1285 | TOP = CAR (v1); | 1285 | TOP = CAR (v1); |
| 1286 | } | 1286 | } |
| 1287 | else | 1287 | else |
diff --git a/src/callproc.c b/src/callproc.c index 301ccf383b5..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 = true; | 201 | |
| 202 | maybe_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 = false; | ||
| 206 | message1 ("Waiting for process to die...done"); | 206 | message1 ("Waiting for process to die...done"); |
| 207 | } | 207 | } |
| 208 | #endif /* !MSDOS */ | 208 | #endif /* !MSDOS */ |
| @@ -726,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 = true; | ||
| 730 | maybe_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 = false; | ||
| 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 | maybe_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 = false; | ||
| 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/dired.c b/src/dired.c index 52e81fb380b..5ea00fb8db4 100644 --- a/src/dired.c +++ b/src/dired.c | |||
| @@ -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 = true; | ||
| 252 | maybe_quit (); | 251 | maybe_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 = false; | ||
| 258 | |||
| 259 | if (wanted) | 256 | if (wanted) |
| 260 | { | 257 | { |
| 261 | if (!NILP (full)) | 258 | if (!NILP (full)) |
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 82c6abb9987..4618164d008 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -3053,7 +3053,6 @@ determines whether case is significant or ignored. */) | |||
| 3053 | i2 = begp2; | 3053 | i2 = begp2; |
| 3054 | i1_byte = buf_charpos_to_bytepos (bp1, i1); | 3054 | i1_byte = buf_charpos_to_bytepos (bp1, i1); |
| 3055 | i2_byte = buf_charpos_to_bytepos (bp2, i2); | 3055 | i2_byte = buf_charpos_to_bytepos (bp2, i2); |
| 3056 | immediate_quit = true; | ||
| 3057 | 3056 | ||
| 3058 | while (i1 < endp1 && i2 < endp2) | 3057 | while (i1 < endp1 && i2 < endp2) |
| 3059 | { | 3058 | { |
| @@ -3092,17 +3091,14 @@ determines whether case is significant or ignored. */) | |||
| 3092 | c1 = char_table_translate (trt, c1); | 3091 | c1 = char_table_translate (trt, c1); |
| 3093 | c2 = char_table_translate (trt, c2); | 3092 | c2 = char_table_translate (trt, c2); |
| 3094 | } | 3093 | } |
| 3094 | |||
| 3095 | if (c1 != c2) | 3095 | if (c1 != c2) |
| 3096 | { | 3096 | return make_number (c1 < c2 ? -1 - chars : chars + 1); |
| 3097 | immediate_quit = false; | ||
| 3098 | return make_number (c1 < c2 ? -1 - chars : chars + 1); | ||
| 3099 | } | ||
| 3100 | 3097 | ||
| 3101 | chars++; | 3098 | chars++; |
| 3099 | rarely_quit (chars); | ||
| 3102 | } | 3100 | } |
| 3103 | 3101 | ||
| 3104 | immediate_quit = false; | ||
| 3105 | |||
| 3106 | /* The strings match as far as they go. | 3102 | /* The strings match as far as they go. |
| 3107 | If one is shorter, that one is less. */ | 3103 | If one is shorter, that one is less. */ |
| 3108 | if (chars < endp1 - begp1) | 3104 | if (chars < endp1 - begp1) |
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 62d4af15e27..22b02b49521 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -1131,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value) | |||
| 1131 | /* Restore certain special C variables. */ | 1131 | /* Restore certain special C variables. */ |
| 1132 | set_poll_suppress_count (catch->poll_suppress_count); | 1132 | set_poll_suppress_count (catch->poll_suppress_count); |
| 1133 | unblock_input_to (catch->interrupt_input_blocked); | 1133 | unblock_input_to (catch->interrupt_input_blocked); |
| 1134 | immediate_quit = false; | ||
| 1135 | 1134 | ||
| 1136 | do | 1135 | do |
| 1137 | { | 1136 | { |
| @@ -1462,6 +1461,19 @@ process_quit_flag (void) | |||
| 1462 | quit (); | 1461 | quit (); |
| 1463 | } | 1462 | } |
| 1464 | 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 | |||
| 1465 | void | 1477 | void |
| 1466 | maybe_quit (void) | 1478 | maybe_quit (void) |
| 1467 | { | 1479 | { |
| @@ -1517,7 +1529,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) | |||
| 1517 | Lisp_Object clause = Qnil; | 1529 | Lisp_Object clause = Qnil; |
| 1518 | struct handler *h; | 1530 | struct handler *h; |
| 1519 | 1531 | ||
| 1520 | immediate_quit = false; | ||
| 1521 | if (gc_in_progress || waiting_for_input) | 1532 | if (gc_in_progress || waiting_for_input) |
| 1522 | emacs_abort (); | 1533 | emacs_abort (); |
| 1523 | 1534 | ||
diff --git a/src/fileio.c b/src/fileio.c index a46cfc7ac69..38400623793 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -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 = true; | ||
| 1964 | ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); | 1963 | ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); |
| 1965 | immediate_quit = false; | ||
| 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,7 +2022,6 @@ permissions. */) | |||
| 2024 | oldsize = out_st.st_size; | 2022 | oldsize = out_st.st_size; |
| 2025 | } | 2023 | } |
| 2026 | 2024 | ||
| 2027 | immediate_quit = true; | ||
| 2028 | maybe_quit (); | 2025 | maybe_quit (); |
| 2029 | 2026 | ||
| 2030 | if (clone_file (ofd, ifd)) | 2027 | if (clone_file (ofd, ifd)) |
| @@ -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 = false; | ||
| 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. */ |
| @@ -3401,15 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data) | |||
| 3401 | static Lisp_Object | 3396 | static Lisp_Object |
| 3402 | read_non_regular (Lisp_Object state) | 3397 | read_non_regular (Lisp_Object state) |
| 3403 | { | 3398 | { |
| 3404 | int nbytes; | 3399 | int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0), |
| 3405 | 3400 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE | |
| 3406 | immediate_quit = true; | 3401 | + XSAVE_INTEGER (state, 1)), |
| 3407 | maybe_quit (); | 3402 | XSAVE_INTEGER (state, 2)); |
| 3408 | nbytes = emacs_read (XSAVE_INTEGER (state, 0), | ||
| 3409 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE | ||
| 3410 | + XSAVE_INTEGER (state, 1)), | ||
| 3411 | XSAVE_INTEGER (state, 2)); | ||
| 3412 | immediate_quit = false; | ||
| 3413 | /* Fast recycle this object for the likely next call. */ | 3403 | /* Fast recycle this object for the likely next call. */ |
| 3414 | free_misc (state); | 3404 | free_misc (state); |
| 3415 | return make_number (nbytes); | 3405 | return make_number (nbytes); |
| @@ -3753,17 +3743,17 @@ by calling `format-decode', which see. */) | |||
| 3753 | int nread; | 3743 | int nread; |
| 3754 | 3744 | ||
| 3755 | if (st.st_size <= (1024 * 4)) | 3745 | if (st.st_size <= (1024 * 4)) |
| 3756 | nread = emacs_read (fd, read_buf, 1024 * 4); | 3746 | nread = emacs_read_quit (fd, read_buf, 1024 * 4); |
| 3757 | else | 3747 | else |
| 3758 | { | 3748 | { |
| 3759 | nread = emacs_read (fd, read_buf, 1024); | 3749 | nread = emacs_read_quit (fd, read_buf, 1024); |
| 3760 | if (nread == 1024) | 3750 | if (nread == 1024) |
| 3761 | { | 3751 | { |
| 3762 | int ntail; | 3752 | int ntail; |
| 3763 | if (lseek (fd, - (1024 * 3), SEEK_END) < 0) | 3753 | if (lseek (fd, - (1024 * 3), SEEK_END) < 0) |
| 3764 | report_file_error ("Setting file position", | 3754 | report_file_error ("Setting file position", |
| 3765 | orig_filename); | 3755 | orig_filename); |
| 3766 | ntail = emacs_read (fd, read_buf + nread, 1024 * 3); | 3756 | ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3); |
| 3767 | nread = ntail < 0 ? ntail : nread + ntail; | 3757 | nread = ntail < 0 ? ntail : nread + ntail; |
| 3768 | } | 3758 | } |
| 3769 | } | 3759 | } |
| @@ -3868,15 +3858,11 @@ by calling `format-decode', which see. */) | |||
| 3868 | report_file_error ("Setting file position", orig_filename); | 3858 | report_file_error ("Setting file position", orig_filename); |
| 3869 | } | 3859 | } |
| 3870 | 3860 | ||
| 3871 | immediate_quit = true; | ||
| 3872 | maybe_quit (); | ||
| 3873 | /* Count how many chars at the start of the file | 3861 | /* Count how many chars at the start of the file |
| 3874 | match the text at the beginning of the buffer. */ | 3862 | match the text at the beginning of the buffer. */ |
| 3875 | while (1) | 3863 | while (true) |
| 3876 | { | 3864 | { |
| 3877 | int nread, bufpos; | 3865 | int nread = emacs_read_quit (fd, read_buf, sizeof read_buf); |
| 3878 | |||
| 3879 | nread = emacs_read (fd, read_buf, sizeof read_buf); | ||
| 3880 | if (nread < 0) | 3866 | if (nread < 0) |
| 3881 | report_file_error ("Read error", orig_filename); | 3867 | report_file_error ("Read error", orig_filename); |
| 3882 | else if (nread == 0) | 3868 | else if (nread == 0) |
| @@ -3898,7 +3884,7 @@ by calling `format-decode', which see. */) | |||
| 3898 | break; | 3884 | break; |
| 3899 | } | 3885 | } |
| 3900 | 3886 | ||
| 3901 | bufpos = 0; | 3887 | int bufpos = 0; |
| 3902 | while (bufpos < nread && same_at_start < ZV_BYTE | 3888 | while (bufpos < nread && same_at_start < ZV_BYTE |
| 3903 | && FETCH_BYTE (same_at_start) == read_buf[bufpos]) | 3889 | && FETCH_BYTE (same_at_start) == read_buf[bufpos]) |
| 3904 | same_at_start++, bufpos++; | 3890 | same_at_start++, bufpos++; |
| @@ -3907,7 +3893,6 @@ by calling `format-decode', which see. */) | |||
| 3907 | if (bufpos != nread) | 3893 | if (bufpos != nread) |
| 3908 | break; | 3894 | break; |
| 3909 | } | 3895 | } |
| 3910 | immediate_quit = false; | ||
| 3911 | /* If the file matches the buffer completely, | 3896 | /* If the file matches the buffer completely, |
| 3912 | there's no need to replace anything. */ | 3897 | there's no need to replace anything. */ |
| 3913 | if (same_at_start - BEGV_BYTE == end_offset - beg_offset) | 3898 | if (same_at_start - BEGV_BYTE == end_offset - beg_offset) |
| @@ -3919,8 +3904,7 @@ by calling `format-decode', which see. */) | |||
| 3919 | del_range_1 (same_at_start, same_at_end, 0, 0); | 3904 | del_range_1 (same_at_start, same_at_end, 0, 0); |
| 3920 | goto handled; | 3905 | goto handled; |
| 3921 | } | 3906 | } |
| 3922 | immediate_quit = true; | 3907 | |
| 3923 | maybe_quit (); | ||
| 3924 | /* Count how many chars at the end of the file | 3908 | /* Count how many chars at the end of the file |
| 3925 | 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 |
| 3926 | already found that decoding is necessary, don't waste time. */ | 3910 | already found that decoding is necessary, don't waste time. */ |
| @@ -3942,7 +3926,8 @@ by calling `format-decode', which see. */) | |||
| 3942 | total_read = nread = 0; | 3926 | total_read = nread = 0; |
| 3943 | while (total_read < trial) | 3927 | while (total_read < trial) |
| 3944 | { | 3928 | { |
| 3945 | 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); | ||
| 3946 | if (nread < 0) | 3931 | if (nread < 0) |
| 3947 | report_file_error ("Read error", orig_filename); | 3932 | report_file_error ("Read error", orig_filename); |
| 3948 | else if (nread == 0) | 3933 | else if (nread == 0) |
| @@ -3977,7 +3962,6 @@ by calling `format-decode', which see. */) | |||
| 3977 | if (nread == 0) | 3962 | if (nread == 0) |
| 3978 | break; | 3963 | break; |
| 3979 | } | 3964 | } |
| 3980 | immediate_quit = false; | ||
| 3981 | 3965 | ||
| 3982 | if (! giveup_match_end) | 3966 | if (! giveup_match_end) |
| 3983 | { | 3967 | { |
| @@ -4069,18 +4053,13 @@ by calling `format-decode', which see. */) | |||
| 4069 | inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ | 4053 | inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ |
| 4070 | unprocessed = 0; /* Bytes not processed in previous loop. */ | 4054 | unprocessed = 0; /* Bytes not processed in previous loop. */ |
| 4071 | 4055 | ||
| 4072 | while (1) | 4056 | while (true) |
| 4073 | { | 4057 | { |
| 4074 | /* 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 |
| 4075 | quitting while reading a huge file. */ | 4059 | quitting while reading a huge file. */ |
| 4076 | 4060 | ||
| 4077 | /* Allow quitting out of the actual I/O. */ | 4061 | this = emacs_read_quit (fd, read_buf + unprocessed, |
| 4078 | immediate_quit = true; | 4062 | READ_BUF_SIZE - unprocessed); |
| 4079 | maybe_quit (); | ||
| 4080 | this = emacs_read (fd, read_buf + unprocessed, | ||
| 4081 | READ_BUF_SIZE - unprocessed); | ||
| 4082 | immediate_quit = false; | ||
| 4083 | |||
| 4084 | if (this <= 0) | 4063 | if (this <= 0) |
| 4085 | break; | 4064 | break; |
| 4086 | 4065 | ||
| @@ -4294,13 +4273,10 @@ by calling `format-decode', which see. */) | |||
| 4294 | /* 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 |
| 4295 | 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 |
| 4296 | here doesn't do any harm. */ | 4275 | here doesn't do any harm. */ |
| 4297 | immediate_quit = true; | 4276 | this = emacs_read_quit (fd, |
| 4298 | maybe_quit (); | 4277 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE |
| 4299 | this = emacs_read (fd, | 4278 | + inserted), |
| 4300 | ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE | 4279 | trytry); |
| 4301 | + inserted), | ||
| 4302 | trytry); | ||
| 4303 | immediate_quit = false; | ||
| 4304 | } | 4280 | } |
| 4305 | 4281 | ||
| 4306 | if (this <= 0) | 4282 | if (this <= 0) |
| @@ -5002,8 +4978,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, | |||
| 5002 | } | 4978 | } |
| 5003 | } | 4979 | } |
| 5004 | 4980 | ||
| 5005 | immediate_quit = true; | ||
| 5006 | |||
| 5007 | if (STRINGP (start)) | 4981 | if (STRINGP (start)) |
| 5008 | ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); | 4982 | ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); |
| 5009 | else if (XINT (start) != XINT (end)) | 4983 | else if (XINT (start) != XINT (end)) |
| @@ -5026,8 +5000,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, | |||
| 5026 | save_errno = errno; | 5000 | save_errno = errno; |
| 5027 | } | 5001 | } |
| 5028 | 5002 | ||
| 5029 | immediate_quit = false; | ||
| 5030 | |||
| 5031 | /* fsync is not crucial for temporary files. Nor for auto-save | 5003 | /* fsync is not crucial for temporary files. Nor for auto-save |
| 5032 | files, since they might lose some work anyway. */ | 5004 | files, since they might lose some work anyway. */ |
| 5033 | if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) | 5005 | if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) |
| @@ -5417,7 +5389,7 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end, | |||
| 5417 | : (STRINGP (coding->dst_object) | 5389 | : (STRINGP (coding->dst_object) |
| 5418 | ? SSDATA (coding->dst_object) | 5390 | ? SSDATA (coding->dst_object) |
| 5419 | : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); | 5391 | : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); |
| 5420 | coding->produced -= emacs_write_sig (desc, buf, coding->produced); | 5392 | coding->produced -= emacs_write_quit (desc, buf, coding->produced); |
| 5421 | 5393 | ||
| 5422 | if (coding->raw_destination) | 5394 | if (coding->raw_destination) |
| 5423 | { | 5395 | { |
diff --git a/src/filelock.c b/src/filelock.c index de65c52efa1..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; |
| @@ -84,22 +84,6 @@ See Info node `(elisp)Random Numbers' for more details. */) | |||
| 84 | return make_number (val); | 84 | return make_number (val); |
| 85 | } | 85 | } |
| 86 | 86 | ||
| 87 | /* Heuristic on how many iterations of a tight loop can be safely done | ||
| 88 | before it's time to do a quit. This must be a power of 2. It | ||
| 89 | is nice but not necessary for it to equal USHRT_MAX + 1. */ | ||
| 90 | enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; | ||
| 91 | |||
| 92 | /* Process a quit, but do it only rarely, for efficiency. "Rarely" | ||
| 93 | means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times, | ||
| 94 | whichever is smaller. Use *QUIT_COUNT to count this. */ | ||
| 95 | |||
| 96 | static void | ||
| 97 | rarely_quit (unsigned short int *quit_count) | ||
| 98 | { | ||
| 99 | if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1))) | ||
| 100 | maybe_quit (); | ||
| 101 | } | ||
| 102 | |||
| 103 | /* Random data-structure functions. */ | 87 | /* Random data-structure functions. */ |
| 104 | 88 | ||
| 105 | DEFUN ("length", Flength, Slength, 1, 1, 0, | 89 | DEFUN ("length", Flength, Slength, 1, 1, 0, |
| @@ -1359,20 +1343,17 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, | |||
| 1359 | (Lisp_Object n, Lisp_Object list) | 1343 | (Lisp_Object n, Lisp_Object list) |
| 1360 | { | 1344 | { |
| 1361 | CHECK_NUMBER (n); | 1345 | CHECK_NUMBER (n); |
| 1362 | EMACS_INT num = XINT (n); | ||
| 1363 | Lisp_Object tail = list; | 1346 | Lisp_Object tail = list; |
| 1364 | immediate_quit = true; | 1347 | for (EMACS_INT num = XINT (n); 0 < num; num--) |
| 1365 | for (EMACS_INT i = 0; i < num; i++) | ||
| 1366 | { | 1348 | { |
| 1367 | if (! CONSP (tail)) | 1349 | if (! CONSP (tail)) |
| 1368 | { | 1350 | { |
| 1369 | immediate_quit = false; | ||
| 1370 | CHECK_LIST_END (tail, list); | 1351 | CHECK_LIST_END (tail, list); |
| 1371 | return Qnil; | 1352 | return Qnil; |
| 1372 | } | 1353 | } |
| 1373 | tail = XCDR (tail); | 1354 | tail = XCDR (tail); |
| 1355 | rarely_quit (num); | ||
| 1374 | } | 1356 | } |
| 1375 | immediate_quit = false; | ||
| 1376 | return tail; | 1357 | return tail; |
| 1377 | } | 1358 | } |
| 1378 | 1359 | ||
| @@ -1408,7 +1389,7 @@ The value is actually the tail of LIST whose car is ELT. */) | |||
| 1408 | { | 1389 | { |
| 1409 | if (! NILP (Fequal (elt, XCAR (tail)))) | 1390 | if (! NILP (Fequal (elt, XCAR (tail)))) |
| 1410 | return tail; | 1391 | return tail; |
| 1411 | rarely_quit (&quit_count); | 1392 | rarely_quit (++quit_count); |
| 1412 | } | 1393 | } |
| 1413 | CHECK_LIST_END (tail, list); | 1394 | CHECK_LIST_END (tail, list); |
| 1414 | return Qnil; | 1395 | return Qnil; |
| @@ -1419,17 +1400,14 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | |||
| 1419 | 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. */) |
| 1420 | (Lisp_Object elt, Lisp_Object list) | 1401 | (Lisp_Object elt, Lisp_Object list) |
| 1421 | { | 1402 | { |
| 1422 | immediate_quit = true; | 1403 | unsigned short int quit_count = 0; |
| 1423 | Lisp_Object tail; | 1404 | Lisp_Object tail; |
| 1424 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | 1405 | for (tail = list; CONSP (tail); tail = XCDR (tail)) |
| 1425 | { | 1406 | { |
| 1426 | if (EQ (XCAR (tail), elt)) | 1407 | if (EQ (XCAR (tail), elt)) |
| 1427 | { | 1408 | return tail; |
| 1428 | immediate_quit = false; | 1409 | rarely_quit (++quit_count); |
| 1429 | return tail; | ||
| 1430 | } | ||
| 1431 | } | 1410 | } |
| 1432 | immediate_quit = false; | ||
| 1433 | CHECK_LIST_END (tail, list); | 1411 | CHECK_LIST_END (tail, list); |
| 1434 | return Qnil; | 1412 | return Qnil; |
| 1435 | } | 1413 | } |
| @@ -1442,18 +1420,15 @@ The value is actually the tail of LIST whose car is ELT. */) | |||
| 1442 | if (!FLOATP (elt)) | 1420 | if (!FLOATP (elt)) |
| 1443 | return Fmemq (elt, list); | 1421 | return Fmemq (elt, list); |
| 1444 | 1422 | ||
| 1445 | immediate_quit = true; | 1423 | unsigned short int quit_count = 0; |
| 1446 | Lisp_Object tail; | 1424 | Lisp_Object tail; |
| 1447 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | 1425 | for (tail = list; CONSP (tail); tail = XCDR (tail)) |
| 1448 | { | 1426 | { |
| 1449 | Lisp_Object tem = XCAR (tail); | 1427 | Lisp_Object tem = XCAR (tail); |
| 1450 | if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) | 1428 | if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) |
| 1451 | { | 1429 | return tail; |
| 1452 | immediate_quit = false; | 1430 | rarely_quit (++quit_count); |
| 1453 | return tail; | ||
| 1454 | } | ||
| 1455 | } | 1431 | } |
| 1456 | immediate_quit = false; | ||
| 1457 | CHECK_LIST_END (tail, list); | 1432 | CHECK_LIST_END (tail, list); |
| 1458 | return Qnil; | 1433 | return Qnil; |
| 1459 | } | 1434 | } |
| @@ -1464,15 +1439,14 @@ The value is actually the first element of LIST whose car is KEY. | |||
| 1464 | Elements of LIST that are not conses are ignored. */) | 1439 | Elements of LIST that are not conses are ignored. */) |
| 1465 | (Lisp_Object key, Lisp_Object list) | 1440 | (Lisp_Object key, Lisp_Object list) |
| 1466 | { | 1441 | { |
| 1467 | immediate_quit = true; | 1442 | unsigned short int quit_count = 0; |
| 1468 | Lisp_Object tail; | 1443 | Lisp_Object tail; |
| 1469 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | 1444 | for (tail = list; CONSP (tail); tail = XCDR (tail)) |
| 1470 | if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) | 1445 | { |
| 1471 | { | 1446 | if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) |
| 1472 | immediate_quit = false; | ||
| 1473 | return XCAR (tail); | 1447 | return XCAR (tail); |
| 1474 | } | 1448 | rarely_quit (++quit_count); |
| 1475 | immediate_quit = true; | 1449 | } |
| 1476 | CHECK_LIST_END (tail, list); | 1450 | CHECK_LIST_END (tail, list); |
| 1477 | return Qnil; | 1451 | return Qnil; |
| 1478 | } | 1452 | } |
| @@ -1502,7 +1476,7 @@ The value is actually the first element of LIST whose car equals KEY. */) | |||
| 1502 | if (CONSP (car) | 1476 | if (CONSP (car) |
| 1503 | && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) | 1477 | && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) |
| 1504 | return car; | 1478 | return car; |
| 1505 | rarely_quit (&quit_count); | 1479 | rarely_quit (++quit_count); |
| 1506 | } | 1480 | } |
| 1507 | CHECK_LIST_END (tail, list); | 1481 | CHECK_LIST_END (tail, list); |
| 1508 | return Qnil; | 1482 | return Qnil; |
| @@ -1529,15 +1503,14 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, | |||
| 1529 | 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. */) |
| 1530 | (Lisp_Object key, Lisp_Object list) | 1504 | (Lisp_Object key, Lisp_Object list) |
| 1531 | { | 1505 | { |
| 1532 | immediate_quit = true; | 1506 | unsigned short int quit_count = 0; |
| 1533 | Lisp_Object tail; | 1507 | Lisp_Object tail; |
| 1534 | for (tail = list; CONSP (tail); tail = XCDR (tail)) | 1508 | for (tail = list; CONSP (tail); tail = XCDR (tail)) |
| 1535 | if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) | 1509 | { |
| 1536 | { | 1510 | if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) |
| 1537 | immediate_quit = false; | ||
| 1538 | return XCAR (tail); | 1511 | return XCAR (tail); |
| 1539 | } | 1512 | rarely_quit (++quit_count); |
| 1540 | immediate_quit = true; | 1513 | } |
| 1541 | CHECK_LIST_END (tail, list); | 1514 | CHECK_LIST_END (tail, list); |
| 1542 | return Qnil; | 1515 | return Qnil; |
| 1543 | } | 1516 | } |
| @@ -1555,7 +1528,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) | |||
| 1555 | if (CONSP (car) | 1528 | if (CONSP (car) |
| 1556 | && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) | 1529 | && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) |
| 1557 | return car; | 1530 | return car; |
| 1558 | rarely_quit (&quit_count); | 1531 | rarely_quit (++quit_count); |
| 1559 | } | 1532 | } |
| 1560 | CHECK_LIST_END (tail, list); | 1533 | CHECK_LIST_END (tail, list); |
| 1561 | return Qnil; | 1534 | return Qnil; |
| @@ -1589,6 +1562,7 @@ argument. */) | |||
| 1589 | else | 1562 | else |
| 1590 | prev = tail; | 1563 | prev = tail; |
| 1591 | } | 1564 | } |
| 1565 | CHECK_LIST_END (tail, list); | ||
| 1592 | return list; | 1566 | return list; |
| 1593 | } | 1567 | } |
| 1594 | 1568 | ||
| @@ -1710,7 +1684,7 @@ changing the value of a sequence `foo'. */) | |||
| 1710 | } | 1684 | } |
| 1711 | else | 1685 | else |
| 1712 | prev = tail; | 1686 | prev = tail; |
| 1713 | rarely_quit (&quit_count); | 1687 | rarely_quit (++quit_count); |
| 1714 | } | 1688 | } |
| 1715 | CHECK_LIST_END (tail, seq); | 1689 | CHECK_LIST_END (tail, seq); |
| 1716 | } | 1690 | } |
| @@ -1735,10 +1709,10 @@ This function may destructively modify SEQ to produce the value. */) | |||
| 1735 | 1709 | ||
| 1736 | for (prev = Qnil, tail = seq; CONSP (tail); tail = next) | 1710 | for (prev = Qnil, tail = seq; CONSP (tail); tail = next) |
| 1737 | { | 1711 | { |
| 1738 | rarely_quit (&quit_count); | ||
| 1739 | next = XCDR (tail); | 1712 | next = XCDR (tail); |
| 1740 | Fsetcdr (tail, prev); | 1713 | Fsetcdr (tail, prev); |
| 1741 | prev = tail; | 1714 | prev = tail; |
| 1715 | rarely_quit (++quit_count); | ||
| 1742 | } | 1716 | } |
| 1743 | CHECK_LIST_END (tail, seq); | 1717 | CHECK_LIST_END (tail, seq); |
| 1744 | seq = prev; | 1718 | seq = prev; |
| @@ -1784,8 +1758,8 @@ See also the function `nreverse', which is used more often. */) | |||
| 1784 | unsigned short int quit_count = 0; | 1758 | unsigned short int quit_count = 0; |
| 1785 | for (new = Qnil; CONSP (seq); seq = XCDR (seq)) | 1759 | for (new = Qnil; CONSP (seq); seq = XCDR (seq)) |
| 1786 | { | 1760 | { |
| 1787 | rarely_quit (&quit_count); | ||
| 1788 | new = Fcons (XCAR (seq), new); | 1761 | new = Fcons (XCAR (seq), new); |
| 1762 | rarely_quit (++quit_count); | ||
| 1789 | } | 1763 | } |
| 1790 | CHECK_LIST_END (seq, seq); | 1764 | CHECK_LIST_END (seq, seq); |
| 1791 | } | 1765 | } |
| @@ -2076,21 +2050,20 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value. | |||
| 2076 | The PLIST is modified by side effects. */) | 2050 | The PLIST is modified by side effects. */) |
| 2077 | (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) | 2051 | (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) |
| 2078 | { | 2052 | { |
| 2079 | immediate_quit = true; | 2053 | unsigned short int quit_count = 0; |
| 2080 | Lisp_Object prev = Qnil; | 2054 | Lisp_Object prev = Qnil; |
| 2081 | for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); | 2055 | for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
| 2082 | tail = XCDR (XCDR (tail))) | 2056 | tail = XCDR (XCDR (tail))) |
| 2083 | { | 2057 | { |
| 2084 | if (EQ (prop, XCAR (tail))) | 2058 | if (EQ (prop, XCAR (tail))) |
| 2085 | { | 2059 | { |
| 2086 | immediate_quit = false; | ||
| 2087 | Fsetcar (XCDR (tail), val); | 2060 | Fsetcar (XCDR (tail), val); |
| 2088 | return plist; | 2061 | return plist; |
| 2089 | } | 2062 | } |
| 2090 | 2063 | ||
| 2091 | prev = tail; | 2064 | prev = tail; |
| 2065 | rarely_quit (++quit_count); | ||
| 2092 | } | 2066 | } |
| 2093 | immediate_quit = true; | ||
| 2094 | Lisp_Object newcell | 2067 | Lisp_Object newcell |
| 2095 | = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); | 2068 | = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); |
| 2096 | if (NILP (prev)) | 2069 | if (NILP (prev)) |
| @@ -2127,7 +2100,7 @@ one of the properties on the list. */) | |||
| 2127 | { | 2100 | { |
| 2128 | if (! NILP (Fequal (prop, XCAR (tail)))) | 2101 | if (! NILP (Fequal (prop, XCAR (tail)))) |
| 2129 | return XCAR (XCDR (tail)); | 2102 | return XCAR (XCDR (tail)); |
| 2130 | rarely_quit (&quit_count); | 2103 | rarely_quit (++quit_count); |
| 2131 | } | 2104 | } |
| 2132 | 2105 | ||
| 2133 | CHECK_LIST_END (tail, prop); | 2106 | CHECK_LIST_END (tail, prop); |
| @@ -2157,7 +2130,7 @@ The PLIST is modified by side effects. */) | |||
| 2157 | } | 2130 | } |
| 2158 | 2131 | ||
| 2159 | prev = tail; | 2132 | prev = tail; |
| 2160 | rarely_quit (&quit_count); | 2133 | rarely_quit (++quit_count); |
| 2161 | } | 2134 | } |
| 2162 | Lisp_Object newcell = list2 (prop, val); | 2135 | Lisp_Object newcell = list2 (prop, val); |
| 2163 | if (NILP (prev)) | 2136 | if (NILP (prev)) |
| @@ -2237,7 +2210,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, | |||
| 2237 | 2210 | ||
| 2238 | unsigned short int quit_count = 0; | 2211 | unsigned short int quit_count = 0; |
| 2239 | tail_recurse: | 2212 | tail_recurse: |
| 2240 | rarely_quit (&quit_count); | 2213 | rarely_quit (++quit_count); |
| 2241 | if (EQ (o1, o2)) | 2214 | if (EQ (o1, o2)) |
| 2242 | return 1; | 2215 | return 1; |
| 2243 | if (XTYPE (o1) != XTYPE (o2)) | 2216 | if (XTYPE (o1) != XTYPE (o2)) |
| @@ -2441,18 +2414,15 @@ usage: (nconc &rest LISTS) */) | |||
| 2441 | 2414 | ||
| 2442 | CHECK_CONS (tem); | 2415 | CHECK_CONS (tem); |
| 2443 | 2416 | ||
| 2444 | immediate_quit = true; | ||
| 2445 | Lisp_Object tail; | 2417 | Lisp_Object tail; |
| 2446 | do | 2418 | do |
| 2447 | { | 2419 | { |
| 2448 | tail = tem; | 2420 | tail = tem; |
| 2449 | tem = XCDR (tail); | 2421 | tem = XCDR (tail); |
| 2422 | rarely_quit (++quit_count); | ||
| 2450 | } | 2423 | } |
| 2451 | while (CONSP (tem)); | 2424 | while (CONSP (tem)); |
| 2452 | 2425 | ||
| 2453 | immediate_quit = false; | ||
| 2454 | rarely_quit (&quit_count); | ||
| 2455 | |||
| 2456 | tem = args[argnum + 1]; | 2426 | tem = args[argnum + 1]; |
| 2457 | Fsetcdr (tail, tem); | 2427 | Fsetcdr (tail, tem); |
| 2458 | if (NILP (tem)) | 2428 | if (NILP (tem)) |
| @@ -2873,13 +2843,13 @@ property and a property with the value nil. | |||
| 2873 | 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. */) |
| 2874 | (Lisp_Object plist, Lisp_Object prop) | 2844 | (Lisp_Object plist, Lisp_Object prop) |
| 2875 | { | 2845 | { |
| 2876 | immediate_quit = true; | 2846 | unsigned short int quit_count = 0; |
| 2877 | while (CONSP (plist) && !EQ (XCAR (plist), prop)) | 2847 | while (CONSP (plist) && !EQ (XCAR (plist), prop)) |
| 2878 | { | 2848 | { |
| 2879 | plist = XCDR (plist); | 2849 | plist = XCDR (plist); |
| 2880 | plist = CDR (plist); | 2850 | plist = CDR (plist); |
| 2851 | rarely_quit (++quit_count); | ||
| 2881 | } | 2852 | } |
| 2882 | immediate_quit = false; | ||
| 2883 | return plist; | 2853 | return plist; |
| 2884 | } | 2854 | } |
| 2885 | 2855 | ||
diff --git a/src/indent.c b/src/indent.c index 23951a16eb6..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 = true; | ||
| 1204 | maybe_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 = false; | ||
| 1698 | return &val_compute_motion; | 1701 | return &val_compute_motion; |
| 1699 | } | 1702 | } |
| 1700 | 1703 | ||
diff --git a/src/keyboard.c b/src/keyboard.c index d41603b2e50..a86e7c5f8e4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -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 |
| @@ -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 | maybe_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) |
| @@ -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/lisp.h b/src/lisp.h index 91c430fe98d..a9011b4a8be 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1995,8 +1995,8 @@ struct Lisp_Hash_Table | |||
| 1995 | hash table size to reduce collisions. */ | 1995 | hash table size to reduce collisions. */ |
| 1996 | Lisp_Object index; | 1996 | Lisp_Object index; |
| 1997 | 1997 | ||
| 1998 | /* Non-nil if the table can be purecopied. Any changes the table after | 1998 | /* Non-nil if the table can be purecopied. The table cannot be |
| 1999 | purecopy will result in an error. */ | 1999 | changed afterwards. */ |
| 2000 | Lisp_Object pure; | 2000 | Lisp_Object pure; |
| 2001 | 2001 | ||
| 2002 | /* 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 |
| @@ -3123,29 +3123,28 @@ struct handler | |||
| 3123 | 3123 | ||
| 3124 | extern Lisp_Object memory_signal_data; | 3124 | extern Lisp_Object memory_signal_data; |
| 3125 | 3125 | ||
| 3126 | /* Check quit-flag and quit if it is non-nil. Typing C-g does not | 3126 | extern void maybe_quit (void); |
| 3127 | directly cause a quit; it only sets Vquit_flag. So the program | ||
| 3128 | needs to call maybe_quit at times when it is safe to quit. Every | ||
| 3129 | loop that might run for a long time or might not exit ought to call | ||
| 3130 | maybe_quit at least once, at a safe place. Unless that is | ||
| 3131 | impossible, of course. But it is very desirable to avoid creating | ||
| 3132 | loops where maybe_quit is impossible. | ||
| 3133 | 3127 | ||
| 3134 | Exception: if you set immediate_quit, the handler that responds to | 3128 | /* True if ought to quit now. */ |
| 3135 | the C-g does the quit itself. This is a good thing to do around a | ||
| 3136 | loop that has no side effects and (in particular) cannot call | ||
| 3137 | arbitrary Lisp code. | ||
| 3138 | 3129 | ||
| 3139 | If quit-flag is set to `kill-emacs' the SIGINT handler has received | 3130 | #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) |
| 3140 | a request to exit Emacs when it is safe to do. | ||
| 3141 | 3131 | ||
| 3142 | When not quitting, process any pending signals. */ | 3132 | /* Heuristic on how many iterations of a tight loop can be safely done |
| 3133 | before it's time to do a quit. This must be a power of 2. It | ||
| 3134 | is nice but not necessary for it to equal USHRT_MAX + 1. */ | ||
| 3143 | 3135 | ||
| 3144 | extern void maybe_quit (void); | 3136 | enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; |
| 3145 | 3137 | ||
| 3146 | /* 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). */ | ||
| 3147 | 3141 | ||
| 3148 | #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 | } | ||
| 3149 | 3148 | ||
| 3150 | extern Lisp_Object Vascii_downcase_table; | 3149 | extern Lisp_Object Vascii_downcase_table; |
| 3151 | extern Lisp_Object Vascii_canon_table; | 3150 | extern Lisp_Object Vascii_canon_table; |
| @@ -4221,8 +4220,10 @@ extern int emacs_open (const char *, int, int); | |||
| 4221 | extern int emacs_pipe (int[2]); | 4220 | extern int emacs_pipe (int[2]); |
| 4222 | extern int emacs_close (int); | 4221 | extern int emacs_close (int); |
| 4223 | extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); | 4222 | extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); |
| 4223 | extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t); | ||
| 4224 | extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); | 4224 | extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); |
| 4225 | extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); | 4225 | extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); |
| 4226 | extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t); | ||
| 4226 | extern void emacs_perror (char const *); | 4227 | extern void emacs_perror (char const *); |
| 4227 | 4228 | ||
| 4228 | extern void unlock_all_files (void); | 4229 | extern void unlock_all_files (void); |
| @@ -4348,9 +4349,6 @@ extern char my_edata[]; | |||
| 4348 | extern char my_endbss[]; | 4349 | extern char my_endbss[]; |
| 4349 | extern char *my_endbss_static; | 4350 | extern char *my_endbss_static; |
| 4350 | 4351 | ||
| 4351 | /* True means ^G can quit instantly. */ | ||
| 4352 | extern bool immediate_quit; | ||
| 4353 | |||
| 4354 | extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); | 4352 | extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); |
| 4355 | extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); | 4353 | extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); |
| 4356 | extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); | 4354 | extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); |
| @@ -4537,7 +4535,7 @@ enum | |||
| 4537 | use these only in macros like AUTO_CONS that declare a local | 4535 | use these only in macros like AUTO_CONS that declare a local |
| 4538 | variable whose lifetime will be clear to the programmer. */ | 4536 | variable whose lifetime will be clear to the programmer. */ |
| 4539 | #define STACK_CONS(a, b) \ | 4537 | #define STACK_CONS(a, b) \ |
| 4540 | make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons) | 4538 | make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons) |
| 4541 | #define AUTO_CONS_EXPR(a, b) \ | 4539 | #define AUTO_CONS_EXPR(a, b) \ |
| 4542 | (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) | 4540 | (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) |
| 4543 | 4541 | ||
| @@ -4583,8 +4581,7 @@ enum | |||
| 4583 | Lisp_Object name = \ | 4581 | Lisp_Object name = \ |
| 4584 | (USE_STACK_STRING \ | 4582 | (USE_STACK_STRING \ |
| 4585 | ? (make_lisp_ptr \ | 4583 | ? (make_lisp_ptr \ |
| 4586 | ((&(union Aligned_String) \ | 4584 | ((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \ |
| 4587 | {{len, -1, 0, (unsigned char *) (str)}}.s), \ | ||
| 4588 | Lisp_String)) \ | 4585 | Lisp_String)) \ |
| 4589 | : make_unibyte_string (str, len)) | 4586 | : make_unibyte_string (str, len)) |
| 4590 | 4587 | ||
diff --git a/src/lread.c b/src/lread.c index 17806922a8c..094aa628eec 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -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' |
diff --git a/src/process.c b/src/process.c index dbd4358dd1a..434a3955b2c 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -3431,7 +3431,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, | |||
| 3431 | break; | 3431 | break; |
| 3432 | } | 3432 | } |
| 3433 | 3433 | ||
| 3434 | immediate_quit = true; | ||
| 3435 | maybe_quit (); | 3434 | maybe_quit (); |
| 3436 | 3435 | ||
| 3437 | ret = connect (s, sa, addrlen); | 3436 | ret = connect (s, sa, addrlen); |
| @@ -3439,8 +3438,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, | |||
| 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 | ||
| @@ -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 = false; | ||
| 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 = false; | ||
| 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,7 +4006,6 @@ 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 = true; | ||
| 4016 | maybe_quit (); | 4009 | maybe_quit (); |
| 4017 | 4010 | ||
| 4018 | struct addrinfo hints; | 4011 | struct addrinfo 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 = false; | ||
| 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); |
diff --git a/src/regex.c b/src/regex.c index f6e67afef4c..796f868d1c2 100644 --- a/src/regex.c +++ b/src/regex.c | |||
| @@ -1728,10 +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 (immediate_quit ? maybe_quit () : (void) 0) | 1732 | static void maybe_quit (void) {} |
| 1733 | #else | ||
| 1734 | # define IMMEDIATE_QUIT_CHECK ((void) 0) | ||
| 1735 | #endif | 1733 | #endif |
| 1736 | 1734 | ||
| 1737 | /* Structure to manage work area for range table. */ | 1735 | /* Structure to manage work area for range table. */ |
| @@ -5820,7 +5818,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, | |||
| 5820 | /* Unconditionally jump (without popping any failure points). */ | 5818 | /* Unconditionally jump (without popping any failure points). */ |
| 5821 | case jump: | 5819 | case jump: |
| 5822 | unconditional_jump: | 5820 | unconditional_jump: |
| 5823 | IMMEDIATE_QUIT_CHECK; | 5821 | maybe_quit (); |
| 5824 | EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ | 5822 | EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ |
| 5825 | DEBUG_PRINT ("EXECUTING jump %d ", mcnt); | 5823 | DEBUG_PRINT ("EXECUTING jump %d ", mcnt); |
| 5826 | p += mcnt; /* Do the jump. */ | 5824 | p += mcnt; /* Do the jump. */ |
| @@ -6168,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, | |||
| 6168 | 6166 | ||
| 6169 | /* We goto here if a matching operation fails. */ | 6167 | /* We goto here if a matching operation fails. */ |
| 6170 | fail: | 6168 | fail: |
| 6171 | IMMEDIATE_QUIT_CHECK; | 6169 | maybe_quit (); |
| 6172 | if (!FAIL_STACK_EMPTY ()) | 6170 | if (!FAIL_STACK_EMPTY ()) |
| 6173 | { | 6171 | { |
| 6174 | re_char *str, *pat; | 6172 | re_char *str, *pat; |
diff --git a/src/search.c b/src/search.c index f54f44c8818..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. |
| @@ -277,7 +296,6 @@ looking_at_1 (Lisp_Object string, bool posix) | |||
| 277 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); | 296 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 278 | 297 | ||
| 279 | /* Do a pending quit right away, to avoid paradoxical behavior */ | 298 | /* Do a pending quit right away, to avoid paradoxical behavior */ |
| 280 | immediate_quit = true; | ||
| 281 | maybe_quit (); | 299 | maybe_quit (); |
| 282 | 300 | ||
| 283 | /* Get pointers and sizes of the two strings | 301 | /* Get pointers and sizes of the two strings |
| @@ -301,20 +319,13 @@ looking_at_1 (Lisp_Object string, bool posix) | |||
| 301 | 319 | ||
| 302 | re_match_object = Qnil; | 320 | re_match_object = Qnil; |
| 303 | 321 | ||
| 304 | #ifdef REL_ALLOC | 322 | freeze_buffer_relocation (); |
| 305 | /* Prevent ralloc.c from relocating the current buffer while | ||
| 306 | searching it. */ | ||
| 307 | r_alloc_inhibit_buffer_relocation (1); | ||
| 308 | #endif | ||
| 309 | i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, | 323 | i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, |
| 310 | PT_BYTE - BEGV_BYTE, | 324 | PT_BYTE - BEGV_BYTE, |
| 311 | (NILP (Vinhibit_changing_match_data) | 325 | (NILP (Vinhibit_changing_match_data) |
| 312 | ? &search_regs : NULL), | 326 | ? &search_regs : NULL), |
| 313 | ZV_BYTE - BEGV_BYTE); | 327 | ZV_BYTE - BEGV_BYTE); |
| 314 | immediate_quit = false; | 328 | thaw_buffer_relocation (); |
| 315 | #ifdef REL_ALLOC | ||
| 316 | r_alloc_inhibit_buffer_relocation (0); | ||
| 317 | #endif | ||
| 318 | 329 | ||
| 319 | if (i == -2) | 330 | if (i == -2) |
| 320 | matcher_overflow (); | 331 | matcher_overflow (); |
| @@ -399,7 +410,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, | |||
| 399 | ? BVAR (current_buffer, case_canon_table) : Qnil), | 410 | ? BVAR (current_buffer, case_canon_table) : Qnil), |
| 400 | posix, | 411 | posix, |
| 401 | STRING_MULTIBYTE (string)); | 412 | STRING_MULTIBYTE (string)); |
| 402 | immediate_quit = true; | ||
| 403 | re_match_object = string; | 413 | re_match_object = string; |
| 404 | 414 | ||
| 405 | val = re_search (bufp, SSDATA (string), | 415 | val = re_search (bufp, SSDATA (string), |
| @@ -407,7 +417,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, | |||
| 407 | SBYTES (string) - pos_byte, | 417 | SBYTES (string) - pos_byte, |
| 408 | (NILP (Vinhibit_changing_match_data) | 418 | (NILP (Vinhibit_changing_match_data) |
| 409 | ? &search_regs : NULL)); | 419 | ? &search_regs : NULL)); |
| 410 | immediate_quit = false; | ||
| 411 | 420 | ||
| 412 | /* Set last_thing_searched only when match data is changed. */ | 421 | /* Set last_thing_searched only when match data is changed. */ |
| 413 | if (NILP (Vinhibit_changing_match_data)) | 422 | if (NILP (Vinhibit_changing_match_data)) |
| @@ -471,13 +480,11 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, | |||
| 471 | 480 | ||
| 472 | bufp = compile_pattern (regexp, 0, table, | 481 | bufp = compile_pattern (regexp, 0, table, |
| 473 | 0, STRING_MULTIBYTE (string)); | 482 | 0, STRING_MULTIBYTE (string)); |
| 474 | immediate_quit = true; | ||
| 475 | re_match_object = string; | 483 | re_match_object = string; |
| 476 | 484 | ||
| 477 | val = re_search (bufp, SSDATA (string), | 485 | val = re_search (bufp, SSDATA (string), |
| 478 | SBYTES (string), 0, | 486 | SBYTES (string), 0, |
| 479 | SBYTES (string), 0); | 487 | SBYTES (string), 0); |
| 480 | immediate_quit = false; | ||
| 481 | return val; | 488 | return val; |
| 482 | } | 489 | } |
| 483 | 490 | ||
| @@ -498,9 +505,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, | |||
| 498 | bufp = compile_pattern (regexp, 0, | 505 | bufp = compile_pattern (regexp, 0, |
| 499 | Vascii_canon_table, 0, | 506 | Vascii_canon_table, 0, |
| 500 | 0); | 507 | 0); |
| 501 | immediate_quit = true; | ||
| 502 | val = re_search (bufp, string, len, 0, len, 0); | 508 | val = re_search (bufp, string, len, 0, len, 0); |
| 503 | immediate_quit = false; | ||
| 504 | return val; | 509 | return val; |
| 505 | } | 510 | } |
| 506 | 511 | ||
| @@ -561,18 +566,10 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 561 | } | 566 | } |
| 562 | 567 | ||
| 563 | buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); | 568 | buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); |
| 564 | immediate_quit = true; | 569 | freeze_buffer_relocation (); |
| 565 | #ifdef REL_ALLOC | ||
| 566 | /* Prevent ralloc.c from relocating the current buffer while | ||
| 567 | searching it. */ | ||
| 568 | r_alloc_inhibit_buffer_relocation (1); | ||
| 569 | #endif | ||
| 570 | len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, | 570 | len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, |
| 571 | pos_byte, NULL, limit_byte); | 571 | pos_byte, NULL, limit_byte); |
| 572 | #ifdef REL_ALLOC | 572 | thaw_buffer_relocation (); |
| 573 | r_alloc_inhibit_buffer_relocation (0); | ||
| 574 | #endif | ||
| 575 | immediate_quit = false; | ||
| 576 | 573 | ||
| 577 | return len; | 574 | return len; |
| 578 | } | 575 | } |
| @@ -649,7 +646,7 @@ newline_cache_on_off (struct buffer *buf) | |||
| 649 | 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 |
| 650 | to the returned character position. | 647 | to the returned character position. |
| 651 | 648 | ||
| 652 | If ALLOW_QUIT, set immediate_quit. That's good to do | 649 | If ALLOW_QUIT, check for quitting. That's good to do |
| 653 | except when inside redisplay. */ | 650 | except when inside redisplay. */ |
| 654 | 651 | ||
| 655 | ptrdiff_t | 652 | ptrdiff_t |
| @@ -685,8 +682,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 685 | if (shortage != 0) | 682 | if (shortage != 0) |
| 686 | *shortage = 0; | 683 | *shortage = 0; |
| 687 | 684 | ||
| 688 | immediate_quit = allow_quit; | ||
| 689 | |||
| 690 | if (count > 0) | 685 | if (count > 0) |
| 691 | while (start != end) | 686 | while (start != end) |
| 692 | { | 687 | { |
| @@ -704,7 +699,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 704 | ptrdiff_t next_change; | 699 | ptrdiff_t next_change; |
| 705 | int result = 1; | 700 | int result = 1; |
| 706 | 701 | ||
| 707 | immediate_quit = false; | ||
| 708 | while (start < end && result) | 702 | while (start < end && result) |
| 709 | { | 703 | { |
| 710 | ptrdiff_t lim1; | 704 | ptrdiff_t lim1; |
| @@ -757,7 +751,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 757 | start_byte = end_byte; | 751 | start_byte = end_byte; |
| 758 | break; | 752 | break; |
| 759 | } | 753 | } |
| 760 | immediate_quit = allow_quit; | ||
| 761 | 754 | ||
| 762 | /* START should never be after END. */ | 755 | /* START should never be after END. */ |
| 763 | if (start_byte > ceiling_byte) | 756 | if (start_byte > ceiling_byte) |
| @@ -810,11 +803,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 810 | 803 | ||
| 811 | if (--count == 0) | 804 | if (--count == 0) |
| 812 | { | 805 | { |
| 813 | immediate_quit = false; | ||
| 814 | if (bytepos) | 806 | if (bytepos) |
| 815 | *bytepos = lim_byte + next; | 807 | *bytepos = lim_byte + next; |
| 816 | return BYTE_TO_CHAR (lim_byte + next); | 808 | return BYTE_TO_CHAR (lim_byte + next); |
| 817 | } | 809 | } |
| 810 | if (allow_quit) | ||
| 811 | maybe_quit (); | ||
| 818 | } | 812 | } |
| 819 | 813 | ||
| 820 | start_byte = lim_byte; | 814 | start_byte = lim_byte; |
| @@ -833,7 +827,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 833 | ptrdiff_t next_change; | 827 | ptrdiff_t next_change; |
| 834 | int result = 1; | 828 | int result = 1; |
| 835 | 829 | ||
| 836 | immediate_quit = false; | ||
| 837 | while (start > end && result) | 830 | while (start > end && result) |
| 838 | { | 831 | { |
| 839 | ptrdiff_t lim1; | 832 | ptrdiff_t lim1; |
| @@ -870,7 +863,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 870 | start_byte = end_byte; | 863 | start_byte = end_byte; |
| 871 | break; | 864 | break; |
| 872 | } | 865 | } |
| 873 | immediate_quit = allow_quit; | ||
| 874 | 866 | ||
| 875 | /* Start should never be at or before end. */ | 867 | /* Start should never be at or before end. */ |
| 876 | if (start_byte <= ceiling_byte) | 868 | if (start_byte <= ceiling_byte) |
| @@ -918,11 +910,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 918 | 910 | ||
| 919 | if (++count >= 0) | 911 | if (++count >= 0) |
| 920 | { | 912 | { |
| 921 | immediate_quit = false; | ||
| 922 | if (bytepos) | 913 | if (bytepos) |
| 923 | *bytepos = ceiling_byte + prev + 1; | 914 | *bytepos = ceiling_byte + prev + 1; |
| 924 | return BYTE_TO_CHAR (ceiling_byte + prev + 1); | 915 | return BYTE_TO_CHAR (ceiling_byte + prev + 1); |
| 925 | } | 916 | } |
| 917 | if (allow_quit) | ||
| 918 | maybe_quit (); | ||
| 926 | } | 919 | } |
| 927 | 920 | ||
| 928 | start_byte = ceiling_byte; | 921 | start_byte = ceiling_byte; |
| @@ -930,7 +923,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 930 | } | 923 | } |
| 931 | } | 924 | } |
| 932 | 925 | ||
| 933 | immediate_quit = false; | ||
| 934 | if (shortage) | 926 | if (shortage) |
| 935 | *shortage = count * direction; | 927 | *shortage = count * direction; |
| 936 | if (bytepos) | 928 | if (bytepos) |
| @@ -954,7 +946,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 954 | the number of line boundaries left unfound, and position at | 946 | the number of line boundaries left unfound, and position at |
| 955 | the limit we bumped up against. | 947 | the limit we bumped up against. |
| 956 | 948 | ||
| 957 | If ALLOW_QUIT, set immediate_quit. That's good to do | 949 | If ALLOW_QUIT, check for quitting. That's good to do |
| 958 | except in special cases. */ | 950 | except in special cases. */ |
| 959 | 951 | ||
| 960 | ptrdiff_t | 952 | ptrdiff_t |
| @@ -1197,9 +1189,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1197 | trt, posix, | 1189 | trt, posix, |
| 1198 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); | 1190 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 1199 | 1191 | ||
| 1200 | immediate_quit = true; /* Quit immediately if user types ^G, | ||
| 1201 | because letting this function finish | ||
| 1202 | can take too long. */ | ||
| 1203 | maybe_quit (); /* Do a pending quit right away, | 1192 | maybe_quit (); /* Do a pending quit right away, |
| 1204 | to avoid paradoxical behavior */ | 1193 | to avoid paradoxical behavior */ |
| 1205 | /* Get pointers and sizes of the two strings | 1194 | /* Get pointers and sizes of the two strings |
| @@ -1222,11 +1211,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1222 | } | 1211 | } |
| 1223 | re_match_object = Qnil; | 1212 | re_match_object = Qnil; |
| 1224 | 1213 | ||
| 1225 | #ifdef REL_ALLOC | 1214 | freeze_buffer_relocation (); |
| 1226 | /* Prevent ralloc.c from relocating the current buffer while | ||
| 1227 | searching it. */ | ||
| 1228 | r_alloc_inhibit_buffer_relocation (1); | ||
| 1229 | #endif | ||
| 1230 | 1215 | ||
| 1231 | while (n < 0) | 1216 | while (n < 0) |
| 1232 | { | 1217 | { |
| @@ -1268,13 +1253,11 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1268 | } | 1253 | } |
| 1269 | else | 1254 | else |
| 1270 | { | 1255 | { |
| 1271 | immediate_quit = false; | 1256 | thaw_buffer_relocation (); |
| 1272 | #ifdef REL_ALLOC | ||
| 1273 | r_alloc_inhibit_buffer_relocation (0); | ||
| 1274 | #endif | ||
| 1275 | return (n); | 1257 | return (n); |
| 1276 | } | 1258 | } |
| 1277 | n++; | 1259 | n++; |
| 1260 | maybe_quit (); | ||
| 1278 | } | 1261 | } |
| 1279 | while (n > 0) | 1262 | while (n > 0) |
| 1280 | { | 1263 | { |
| @@ -1313,18 +1296,13 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, | |||
| 1313 | } | 1296 | } |
| 1314 | else | 1297 | else |
| 1315 | { | 1298 | { |
| 1316 | immediate_quit = false; | 1299 | thaw_buffer_relocation (); |
| 1317 | #ifdef REL_ALLOC | ||
| 1318 | r_alloc_inhibit_buffer_relocation (0); | ||
| 1319 | #endif | ||
| 1320 | return (0 - n); | 1300 | return (0 - n); |
| 1321 | } | 1301 | } |
| 1322 | n--; | 1302 | n--; |
| 1303 | maybe_quit (); | ||
| 1323 | } | 1304 | } |
| 1324 | immediate_quit = false; | 1305 | thaw_buffer_relocation (); |
| 1325 | #ifdef REL_ALLOC | ||
| 1326 | r_alloc_inhibit_buffer_relocation (0); | ||
| 1327 | #endif | ||
| 1328 | return (pos); | 1306 | return (pos); |
| 1329 | } | 1307 | } |
| 1330 | else /* non-RE case */ | 1308 | else /* non-RE case */ |
| @@ -3231,8 +3209,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 3231 | if (shortage != 0) | 3209 | if (shortage != 0) |
| 3232 | *shortage = 0; | 3210 | *shortage = 0; |
| 3233 | 3211 | ||
| 3234 | immediate_quit = allow_quit; | ||
| 3235 | |||
| 3236 | if (count > 0) | 3212 | if (count > 0) |
| 3237 | while (start != end) | 3213 | while (start != end) |
| 3238 | { | 3214 | { |
| @@ -3275,11 +3251,12 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 3275 | 3251 | ||
| 3276 | if (--count == 0) | 3252 | if (--count == 0) |
| 3277 | { | 3253 | { |
| 3278 | immediate_quit = false; | ||
| 3279 | if (bytepos) | 3254 | if (bytepos) |
| 3280 | *bytepos = lim_byte + next; | 3255 | *bytepos = lim_byte + next; |
| 3281 | return BYTE_TO_CHAR (lim_byte + next); | 3256 | return BYTE_TO_CHAR (lim_byte + next); |
| 3282 | } | 3257 | } |
| 3258 | if (allow_quit) | ||
| 3259 | maybe_quit (); | ||
| 3283 | } | 3260 | } |
| 3284 | 3261 | ||
| 3285 | start_byte = lim_byte; | 3262 | start_byte = lim_byte; |
| @@ -3287,7 +3264,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, | |||
| 3287 | } | 3264 | } |
| 3288 | } | 3265 | } |
| 3289 | 3266 | ||
| 3290 | immediate_quit = false; | ||
| 3291 | if (shortage) | 3267 | if (shortage) |
| 3292 | *shortage = count; | 3268 | *shortage = count; |
| 3293 | if (bytepos) | 3269 | if (bytepos) |
diff --git a/src/syntax.c b/src/syntax.c index f9e4093765c..7aa43e6e5c7 100644 --- a/src/syntax.c +++ b/src/syntax.c | |||
| @@ -621,11 +621,9 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) | |||
| 621 | SETUP_BUFFER_SYNTAX_TABLE (); | 621 | SETUP_BUFFER_SYNTAX_TABLE (); |
| 622 | while (PT > BEGV) | 622 | while (PT > BEGV) |
| 623 | { | 623 | { |
| 624 | int c; | ||
| 625 | |||
| 626 | /* Open-paren at start of line means we may have found our | 624 | /* Open-paren at start of line means we may have found our |
| 627 | defun-start. */ | 625 | defun-start. */ |
| 628 | c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); | 626 | int c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); |
| 629 | if (SYNTAX (c) == Sopen) | 627 | if (SYNTAX (c) == Sopen) |
| 630 | { | 628 | { |
| 631 | SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ | 629 | SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ |
| @@ -715,6 +713,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, | |||
| 715 | ptrdiff_t nesting = 1; /* Current comment nesting. */ | 713 | ptrdiff_t nesting = 1; /* Current comment nesting. */ |
| 716 | int c; | 714 | int c; |
| 717 | int syntax = 0; | 715 | int syntax = 0; |
| 716 | unsigned short int quit_count = 0; | ||
| 718 | 717 | ||
| 719 | /* FIXME: A }} comment-ender style leads to incorrect behavior | 718 | /* FIXME: A }} comment-ender style leads to incorrect behavior |
| 720 | in the case of {{ c }}} because we ignore the last two chars which are | 719 | in the case of {{ c }}} because we ignore the last two chars which are |
| @@ -724,6 +723,8 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, | |||
| 724 | that determines quote parity to the comment-end. */ | 723 | that determines quote parity to the comment-end. */ |
| 725 | while (from != stop) | 724 | while (from != stop) |
| 726 | { | 725 | { |
| 726 | rarely_quit (++quit_count); | ||
| 727 | |||
| 727 | ptrdiff_t temp_byte; | 728 | ptrdiff_t temp_byte; |
| 728 | int prev_syntax; | 729 | int prev_syntax; |
| 729 | bool com2start, com2end, comstart; | 730 | bool com2start, com2end, comstart; |
| @@ -951,7 +952,9 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, | |||
| 951 | defun_start_byte = CHAR_TO_BYTE (defun_start); | 952 | defun_start_byte = CHAR_TO_BYTE (defun_start); |
| 952 | } | 953 | } |
| 953 | } | 954 | } |
| 954 | } while (defun_start < comment_end); | 955 | rarely_quit (++quit_count); |
| 956 | } | ||
| 957 | while (defun_start < comment_end); | ||
| 955 | 958 | ||
| 956 | from_byte = CHAR_TO_BYTE (from); | 959 | from_byte = CHAR_TO_BYTE (from); |
| 957 | UPDATE_SYNTAX_TABLE_FORWARD (from - 1); | 960 | UPDATE_SYNTAX_TABLE_FORWARD (from - 1); |
| @@ -1417,29 +1420,23 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, | |||
| 1417 | COUNT negative means scan backward and stop at word beginning. */ | 1420 | COUNT negative means scan backward and stop at word beginning. */ |
| 1418 | 1421 | ||
| 1419 | ptrdiff_t | 1422 | ptrdiff_t |
| 1420 | scan_words (register ptrdiff_t from, register EMACS_INT count) | 1423 | scan_words (ptrdiff_t from, EMACS_INT count) |
| 1421 | { | 1424 | { |
| 1422 | register ptrdiff_t beg = BEGV; | 1425 | ptrdiff_t beg = BEGV; |
| 1423 | register ptrdiff_t end = ZV; | 1426 | ptrdiff_t end = ZV; |
| 1424 | register ptrdiff_t from_byte = CHAR_TO_BYTE (from); | 1427 | ptrdiff_t from_byte = CHAR_TO_BYTE (from); |
| 1425 | register enum syntaxcode code; | 1428 | enum syntaxcode code; |
| 1426 | int ch0, ch1; | 1429 | int ch0, ch1; |
| 1427 | Lisp_Object func, pos; | 1430 | Lisp_Object func, pos; |
| 1428 | 1431 | ||
| 1429 | immediate_quit = true; | ||
| 1430 | maybe_quit (); | ||
| 1431 | |||
| 1432 | SETUP_SYNTAX_TABLE (from, count); | 1432 | SETUP_SYNTAX_TABLE (from, count); |
| 1433 | 1433 | ||
| 1434 | while (count > 0) | 1434 | while (count > 0) |
| 1435 | { | 1435 | { |
| 1436 | while (1) | 1436 | while (true) |
| 1437 | { | 1437 | { |
| 1438 | if (from == end) | 1438 | if (from == end) |
| 1439 | { | 1439 | return 0; |
| 1440 | immediate_quit = false; | ||
| 1441 | return 0; | ||
| 1442 | } | ||
| 1443 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 1440 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| 1444 | ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 1441 | ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 1445 | code = SYNTAX (ch0); | 1442 | code = SYNTAX (ch0); |
| @@ -1449,6 +1446,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1449 | break; | 1446 | break; |
| 1450 | if (code == Sword) | 1447 | if (code == Sword) |
| 1451 | break; | 1448 | break; |
| 1449 | rarely_quit (from); | ||
| 1452 | } | 1450 | } |
| 1453 | /* Now CH0 is a character which begins a word and FROM is the | 1451 | /* Now CH0 is a character which begins a word and FROM is the |
| 1454 | position of the next character. */ | 1452 | position of the next character. */ |
| @@ -1477,19 +1475,17 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1477 | break; | 1475 | break; |
| 1478 | INC_BOTH (from, from_byte); | 1476 | INC_BOTH (from, from_byte); |
| 1479 | ch0 = ch1; | 1477 | ch0 = ch1; |
| 1478 | rarely_quit (from); | ||
| 1480 | } | 1479 | } |
| 1481 | } | 1480 | } |
| 1482 | count--; | 1481 | count--; |
| 1483 | } | 1482 | } |
| 1484 | while (count < 0) | 1483 | while (count < 0) |
| 1485 | { | 1484 | { |
| 1486 | while (1) | 1485 | while (true) |
| 1487 | { | 1486 | { |
| 1488 | if (from == beg) | 1487 | if (from == beg) |
| 1489 | { | 1488 | return 0; |
| 1490 | immediate_quit = false; | ||
| 1491 | return 0; | ||
| 1492 | } | ||
| 1493 | DEC_BOTH (from, from_byte); | 1489 | DEC_BOTH (from, from_byte); |
| 1494 | UPDATE_SYNTAX_TABLE_BACKWARD (from); | 1490 | UPDATE_SYNTAX_TABLE_BACKWARD (from); |
| 1495 | ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 1491 | ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| @@ -1499,6 +1495,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1499 | break; | 1495 | break; |
| 1500 | if (code == Sword) | 1496 | if (code == Sword) |
| 1501 | break; | 1497 | break; |
| 1498 | rarely_quit (from); | ||
| 1502 | } | 1499 | } |
| 1503 | /* Now CH1 is a character which ends a word and FROM is the | 1500 | /* Now CH1 is a character which ends a word and FROM is the |
| 1504 | position of it. */ | 1501 | position of it. */ |
| @@ -1531,13 +1528,12 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) | |||
| 1531 | break; | 1528 | break; |
| 1532 | } | 1529 | } |
| 1533 | ch1 = ch0; | 1530 | ch1 = ch0; |
| 1531 | rarely_quit (from); | ||
| 1534 | } | 1532 | } |
| 1535 | } | 1533 | } |
| 1536 | count++; | 1534 | count++; |
| 1537 | } | 1535 | } |
| 1538 | 1536 | ||
| 1539 | immediate_quit = false; | ||
| 1540 | |||
| 1541 | return from; | 1537 | return from; |
| 1542 | } | 1538 | } |
| 1543 | 1539 | ||
| @@ -1921,7 +1917,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 1921 | stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; | 1917 | stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; |
| 1922 | } | 1918 | } |
| 1923 | 1919 | ||
| 1924 | immediate_quit = true; | ||
| 1925 | /* This code may look up syntax tables using functions that rely on the | 1920 | /* This code may look up syntax tables using functions that rely on the |
| 1926 | gl_state object. To make sure this object is not out of date, | 1921 | gl_state object. To make sure this object is not out of date, |
| 1927 | let's initialize it manually. | 1922 | let's initialize it manually. |
| @@ -1971,9 +1966,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 1971 | } | 1966 | } |
| 1972 | fwd_ok: | 1967 | fwd_ok: |
| 1973 | p += nbytes, pos++, pos_byte += nbytes; | 1968 | p += nbytes, pos++, pos_byte += nbytes; |
| 1969 | rarely_quit (pos); | ||
| 1974 | } | 1970 | } |
| 1975 | else | 1971 | else |
| 1976 | while (1) | 1972 | while (true) |
| 1977 | { | 1973 | { |
| 1978 | if (p >= stop) | 1974 | if (p >= stop) |
| 1979 | { | 1975 | { |
| @@ -1995,15 +1991,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 1995 | break; | 1991 | break; |
| 1996 | fwd_unibyte_ok: | 1992 | fwd_unibyte_ok: |
| 1997 | p++, pos++, pos_byte++; | 1993 | p++, pos++, pos_byte++; |
| 1994 | rarely_quit (pos); | ||
| 1998 | } | 1995 | } |
| 1999 | } | 1996 | } |
| 2000 | else | 1997 | else |
| 2001 | { | 1998 | { |
| 2002 | if (multibyte) | 1999 | if (multibyte) |
| 2003 | while (1) | 2000 | while (true) |
| 2004 | { | 2001 | { |
| 2005 | unsigned char *prev_p; | ||
| 2006 | |||
| 2007 | if (p <= stop) | 2002 | if (p <= stop) |
| 2008 | { | 2003 | { |
| 2009 | if (p <= endp) | 2004 | if (p <= endp) |
| @@ -2011,8 +2006,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2011 | p = GPT_ADDR; | 2006 | p = GPT_ADDR; |
| 2012 | stop = endp; | 2007 | stop = endp; |
| 2013 | } | 2008 | } |
| 2014 | prev_p = p; | 2009 | unsigned char *prev_p = p; |
| 2015 | while (--p >= stop && ! CHAR_HEAD_P (*p)); | 2010 | do |
| 2011 | p--; | ||
| 2012 | while (stop <= p && ! CHAR_HEAD_P (*p)); | ||
| 2013 | |||
| 2016 | c = STRING_CHAR (p); | 2014 | c = STRING_CHAR (p); |
| 2017 | 2015 | ||
| 2018 | if (! NILP (iso_classes) && in_classes (c, iso_classes)) | 2016 | if (! NILP (iso_classes) && in_classes (c, iso_classes)) |
| @@ -2036,9 +2034,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2036 | } | 2034 | } |
| 2037 | back_ok: | 2035 | back_ok: |
| 2038 | pos--, pos_byte -= prev_p - p; | 2036 | pos--, pos_byte -= prev_p - p; |
| 2037 | rarely_quit (pos); | ||
| 2039 | } | 2038 | } |
| 2040 | else | 2039 | else |
| 2041 | while (1) | 2040 | while (true) |
| 2042 | { | 2041 | { |
| 2043 | if (p <= stop) | 2042 | if (p <= stop) |
| 2044 | { | 2043 | { |
| @@ -2060,11 +2059,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, | |||
| 2060 | break; | 2059 | break; |
| 2061 | back_unibyte_ok: | 2060 | back_unibyte_ok: |
| 2062 | p--, pos--, pos_byte--; | 2061 | p--, pos--, pos_byte--; |
| 2062 | rarely_quit (pos); | ||
| 2063 | } | 2063 | } |
| 2064 | } | 2064 | } |
| 2065 | 2065 | ||
| 2066 | SET_PT_BOTH (pos, pos_byte); | 2066 | SET_PT_BOTH (pos, pos_byte); |
| 2067 | immediate_quit = false; | ||
| 2068 | 2067 | ||
| 2069 | SAFE_FREE (); | 2068 | SAFE_FREE (); |
| 2070 | return make_number (PT - start_point); | 2069 | return make_number (PT - start_point); |
| @@ -2138,7 +2137,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2138 | ptrdiff_t pos_byte = PT_BYTE; | 2137 | ptrdiff_t pos_byte = PT_BYTE; |
| 2139 | unsigned char *p, *endp, *stop; | 2138 | unsigned char *p, *endp, *stop; |
| 2140 | 2139 | ||
| 2141 | immediate_quit = true; | ||
| 2142 | SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); | 2140 | SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); |
| 2143 | 2141 | ||
| 2144 | if (forwardp) | 2142 | if (forwardp) |
| @@ -2167,6 +2165,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2167 | if (! fastmap[SYNTAX (c)]) | 2165 | if (! fastmap[SYNTAX (c)]) |
| 2168 | goto done; | 2166 | goto done; |
| 2169 | p += nbytes, pos++, pos_byte += nbytes; | 2167 | p += nbytes, pos++, pos_byte += nbytes; |
| 2168 | rarely_quit (pos); | ||
| 2170 | } | 2169 | } |
| 2171 | while (!parse_sexp_lookup_properties | 2170 | while (!parse_sexp_lookup_properties |
| 2172 | || pos < gl_state.e_property); | 2171 | || pos < gl_state.e_property); |
| @@ -2183,10 +2182,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2183 | 2182 | ||
| 2184 | if (multibyte) | 2183 | if (multibyte) |
| 2185 | { | 2184 | { |
| 2186 | while (1) | 2185 | while (true) |
| 2187 | { | 2186 | { |
| 2188 | unsigned char *prev_p; | ||
| 2189 | |||
| 2190 | if (p <= stop) | 2187 | if (p <= stop) |
| 2191 | { | 2188 | { |
| 2192 | if (p <= endp) | 2189 | if (p <= endp) |
| @@ -2195,17 +2192,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2195 | stop = endp; | 2192 | stop = endp; |
| 2196 | } | 2193 | } |
| 2197 | UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); | 2194 | UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); |
| 2198 | prev_p = p; | 2195 | |
| 2199 | while (--p >= stop && ! CHAR_HEAD_P (*p)); | 2196 | unsigned char *prev_p = p; |
| 2197 | do | ||
| 2198 | p--; | ||
| 2199 | while (stop <= p && ! CHAR_HEAD_P (*p)); | ||
| 2200 | |||
| 2200 | c = STRING_CHAR (p); | 2201 | c = STRING_CHAR (p); |
| 2201 | if (! fastmap[SYNTAX (c)]) | 2202 | if (! fastmap[SYNTAX (c)]) |
| 2202 | break; | 2203 | break; |
| 2203 | pos--, pos_byte -= prev_p - p; | 2204 | pos--, pos_byte -= prev_p - p; |
| 2205 | rarely_quit (pos); | ||
| 2204 | } | 2206 | } |
| 2205 | } | 2207 | } |
| 2206 | else | 2208 | else |
| 2207 | { | 2209 | { |
| 2208 | while (1) | 2210 | while (true) |
| 2209 | { | 2211 | { |
| 2210 | if (p <= stop) | 2212 | if (p <= stop) |
| 2211 | { | 2213 | { |
| @@ -2218,13 +2220,13 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 2218 | if (! fastmap[SYNTAX (p[-1])]) | 2220 | if (! fastmap[SYNTAX (p[-1])]) |
| 2219 | break; | 2221 | break; |
| 2220 | p--, pos--, pos_byte--; | 2222 | p--, pos--, pos_byte--; |
| 2223 | rarely_quit (pos); | ||
| 2221 | } | 2224 | } |
| 2222 | } | 2225 | } |
| 2223 | } | 2226 | } |
| 2224 | 2227 | ||
| 2225 | done: | 2228 | done: |
| 2226 | SET_PT_BOTH (pos, pos_byte); | 2229 | SET_PT_BOTH (pos, pos_byte); |
| 2227 | immediate_quit = false; | ||
| 2228 | 2230 | ||
| 2229 | return make_number (PT - start_point); | 2231 | return make_number (PT - start_point); |
| 2230 | } | 2232 | } |
| @@ -2286,9 +2288,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, | |||
| 2286 | ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, | 2288 | ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, |
| 2287 | EMACS_INT *incomment_ptr, int *last_syntax_ptr) | 2289 | EMACS_INT *incomment_ptr, int *last_syntax_ptr) |
| 2288 | { | 2290 | { |
| 2289 | register int c, c1; | 2291 | unsigned short int quit_count = 0; |
| 2290 | register enum syntaxcode code; | 2292 | int c, c1; |
| 2291 | register int syntax, other_syntax; | 2293 | enum syntaxcode code; |
| 2294 | int syntax, other_syntax; | ||
| 2292 | 2295 | ||
| 2293 | if (nesting <= 0) nesting = -1; | 2296 | if (nesting <= 0) nesting = -1; |
| 2294 | 2297 | ||
| @@ -2380,6 +2383,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, | |||
| 2380 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 2383 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| 2381 | nesting++; | 2384 | nesting++; |
| 2382 | } | 2385 | } |
| 2386 | |||
| 2387 | rarely_quit (++quit_count); | ||
| 2383 | } | 2388 | } |
| 2384 | *charpos_ptr = from; | 2389 | *charpos_ptr = from; |
| 2385 | *bytepos_ptr = from_byte; | 2390 | *bytepos_ptr = from_byte; |
| @@ -2407,14 +2412,12 @@ between them, return t; otherwise return nil. */) | |||
| 2407 | ptrdiff_t out_charpos, out_bytepos; | 2412 | ptrdiff_t out_charpos, out_bytepos; |
| 2408 | EMACS_INT dummy; | 2413 | EMACS_INT dummy; |
| 2409 | int dummy2; | 2414 | int dummy2; |
| 2415 | unsigned short int quit_count = 0; | ||
| 2410 | 2416 | ||
| 2411 | CHECK_NUMBER (count); | 2417 | CHECK_NUMBER (count); |
| 2412 | count1 = XINT (count); | 2418 | count1 = XINT (count); |
| 2413 | stop = count1 > 0 ? ZV : BEGV; | 2419 | stop = count1 > 0 ? ZV : BEGV; |
| 2414 | 2420 | ||
| 2415 | immediate_quit = true; | ||
| 2416 | maybe_quit (); | ||
| 2417 | |||
| 2418 | from = PT; | 2421 | from = PT; |
| 2419 | from_byte = PT_BYTE; | 2422 | from_byte = PT_BYTE; |
| 2420 | 2423 | ||
| @@ -2429,7 +2432,6 @@ between them, return t; otherwise return nil. */) | |||
| 2429 | if (from == stop) | 2432 | if (from == stop) |
| 2430 | { | 2433 | { |
| 2431 | SET_PT_BOTH (from, from_byte); | 2434 | SET_PT_BOTH (from, from_byte); |
| 2432 | immediate_quit = false; | ||
| 2433 | return Qnil; | 2435 | return Qnil; |
| 2434 | } | 2436 | } |
| 2435 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 2437 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| @@ -2456,6 +2458,7 @@ between them, return t; otherwise return nil. */) | |||
| 2456 | INC_BOTH (from, from_byte); | 2458 | INC_BOTH (from, from_byte); |
| 2457 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 2459 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| 2458 | } | 2460 | } |
| 2461 | rarely_quit (++quit_count); | ||
| 2459 | } | 2462 | } |
| 2460 | while (code == Swhitespace || (code == Sendcomment && c == '\n')); | 2463 | while (code == Swhitespace || (code == Sendcomment && c == '\n')); |
| 2461 | 2464 | ||
| @@ -2463,7 +2466,6 @@ between them, return t; otherwise return nil. */) | |||
| 2463 | comstyle = ST_COMMENT_STYLE; | 2466 | comstyle = ST_COMMENT_STYLE; |
| 2464 | else if (code != Scomment) | 2467 | else if (code != Scomment) |
| 2465 | { | 2468 | { |
| 2466 | immediate_quit = false; | ||
| 2467 | DEC_BOTH (from, from_byte); | 2469 | DEC_BOTH (from, from_byte); |
| 2468 | SET_PT_BOTH (from, from_byte); | 2470 | SET_PT_BOTH (from, from_byte); |
| 2469 | return Qnil; | 2471 | return Qnil; |
| @@ -2474,7 +2476,6 @@ between them, return t; otherwise return nil. */) | |||
| 2474 | from = out_charpos; from_byte = out_bytepos; | 2476 | from = out_charpos; from_byte = out_bytepos; |
| 2475 | if (!found) | 2477 | if (!found) |
| 2476 | { | 2478 | { |
| 2477 | immediate_quit = false; | ||
| 2478 | SET_PT_BOTH (from, from_byte); | 2479 | SET_PT_BOTH (from, from_byte); |
| 2479 | return Qnil; | 2480 | return Qnil; |
| 2480 | } | 2481 | } |
| @@ -2486,23 +2487,19 @@ between them, return t; otherwise return nil. */) | |||
| 2486 | 2487 | ||
| 2487 | while (count1 < 0) | 2488 | while (count1 < 0) |
| 2488 | { | 2489 | { |
| 2489 | while (1) | 2490 | while (true) |
| 2490 | { | 2491 | { |
| 2491 | bool quoted; | ||
| 2492 | int syntax; | ||
| 2493 | |||
| 2494 | if (from <= stop) | 2492 | if (from <= stop) |
| 2495 | { | 2493 | { |
| 2496 | SET_PT_BOTH (BEGV, BEGV_BYTE); | 2494 | SET_PT_BOTH (BEGV, BEGV_BYTE); |
| 2497 | immediate_quit = false; | ||
| 2498 | return Qnil; | 2495 | return Qnil; |
| 2499 | } | 2496 | } |
| 2500 | 2497 | ||
| 2501 | DEC_BOTH (from, from_byte); | 2498 | DEC_BOTH (from, from_byte); |
| 2502 | /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ | 2499 | /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ |
| 2503 | quoted = char_quoted (from, from_byte); | 2500 | bool quoted = char_quoted (from, from_byte); |
| 2504 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 2501 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 2505 | syntax = SYNTAX_WITH_FLAGS (c); | 2502 | int syntax = SYNTAX_WITH_FLAGS (c); |
| 2506 | code = SYNTAX (c); | 2503 | code = SYNTAX (c); |
| 2507 | comstyle = 0; | 2504 | comstyle = 0; |
| 2508 | comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); | 2505 | comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); |
| @@ -2545,6 +2542,7 @@ between them, return t; otherwise return nil. */) | |||
| 2545 | } | 2542 | } |
| 2546 | else if (from == stop) | 2543 | else if (from == stop) |
| 2547 | break; | 2544 | break; |
| 2545 | rarely_quit (++quit_count); | ||
| 2548 | } | 2546 | } |
| 2549 | if (fence_found == 0) | 2547 | if (fence_found == 0) |
| 2550 | { | 2548 | { |
| @@ -2587,18 +2585,18 @@ between them, return t; otherwise return nil. */) | |||
| 2587 | else if (code != Swhitespace || quoted) | 2585 | else if (code != Swhitespace || quoted) |
| 2588 | { | 2586 | { |
| 2589 | leave: | 2587 | leave: |
| 2590 | immediate_quit = false; | ||
| 2591 | INC_BOTH (from, from_byte); | 2588 | INC_BOTH (from, from_byte); |
| 2592 | SET_PT_BOTH (from, from_byte); | 2589 | SET_PT_BOTH (from, from_byte); |
| 2593 | return Qnil; | 2590 | return Qnil; |
| 2594 | } | 2591 | } |
| 2592 | |||
| 2593 | rarely_quit (++quit_count); | ||
| 2595 | } | 2594 | } |
| 2596 | 2595 | ||
| 2597 | count1++; | 2596 | count1++; |
| 2598 | } | 2597 | } |
| 2599 | 2598 | ||
| 2600 | SET_PT_BOTH (from, from_byte); | 2599 | SET_PT_BOTH (from, from_byte); |
| 2601 | immediate_quit = false; | ||
| 2602 | return Qt; | 2600 | return Qt; |
| 2603 | } | 2601 | } |
| 2604 | 2602 | ||
| @@ -2632,6 +2630,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2632 | EMACS_INT dummy; | 2630 | EMACS_INT dummy; |
| 2633 | int dummy2; | 2631 | int dummy2; |
| 2634 | bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; | 2632 | bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; |
| 2633 | unsigned short int quit_count = 0; | ||
| 2635 | 2634 | ||
| 2636 | if (depth > 0) min_depth = 0; | 2635 | if (depth > 0) min_depth = 0; |
| 2637 | 2636 | ||
| @@ -2640,7 +2639,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2640 | 2639 | ||
| 2641 | from_byte = CHAR_TO_BYTE (from); | 2640 | from_byte = CHAR_TO_BYTE (from); |
| 2642 | 2641 | ||
| 2643 | immediate_quit = true; | ||
| 2644 | maybe_quit (); | 2642 | maybe_quit (); |
| 2645 | 2643 | ||
| 2646 | SETUP_SYNTAX_TABLE (from, count); | 2644 | SETUP_SYNTAX_TABLE (from, count); |
| @@ -2648,6 +2646,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2648 | { | 2646 | { |
| 2649 | while (from < stop) | 2647 | while (from < stop) |
| 2650 | { | 2648 | { |
| 2649 | rarely_quit (++quit_count); | ||
| 2651 | bool comstart_first, prefix; | 2650 | bool comstart_first, prefix; |
| 2652 | int syntax, other_syntax; | 2651 | int syntax, other_syntax; |
| 2653 | UPDATE_SYNTAX_TABLE_FORWARD (from); | 2652 | UPDATE_SYNTAX_TABLE_FORWARD (from); |
| @@ -2716,6 +2715,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2716 | goto done; | 2715 | goto done; |
| 2717 | } | 2716 | } |
| 2718 | INC_BOTH (from, from_byte); | 2717 | INC_BOTH (from, from_byte); |
| 2718 | rarely_quit (++quit_count); | ||
| 2719 | } | 2719 | } |
| 2720 | goto done; | 2720 | goto done; |
| 2721 | 2721 | ||
| @@ -2787,6 +2787,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2787 | if (c_code == Scharquote || c_code == Sescape) | 2787 | if (c_code == Scharquote || c_code == Sescape) |
| 2788 | INC_BOTH (from, from_byte); | 2788 | INC_BOTH (from, from_byte); |
| 2789 | INC_BOTH (from, from_byte); | 2789 | INC_BOTH (from, from_byte); |
| 2790 | rarely_quit (++quit_count); | ||
| 2790 | } | 2791 | } |
| 2791 | INC_BOTH (from, from_byte); | 2792 | INC_BOTH (from, from_byte); |
| 2792 | if (!depth && sexpflag) goto done; | 2793 | if (!depth && sexpflag) goto done; |
| @@ -2801,7 +2802,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2801 | if (depth) | 2802 | if (depth) |
| 2802 | goto lose; | 2803 | goto lose; |
| 2803 | 2804 | ||
| 2804 | immediate_quit = false; | ||
| 2805 | return Qnil; | 2805 | return Qnil; |
| 2806 | 2806 | ||
| 2807 | /* End of object reached */ | 2807 | /* End of object reached */ |
| @@ -2813,11 +2813,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2813 | { | 2813 | { |
| 2814 | while (from > stop) | 2814 | while (from > stop) |
| 2815 | { | 2815 | { |
| 2816 | int syntax; | 2816 | rarely_quit (++quit_count); |
| 2817 | DEC_BOTH (from, from_byte); | 2817 | DEC_BOTH (from, from_byte); |
| 2818 | UPDATE_SYNTAX_TABLE_BACKWARD (from); | 2818 | UPDATE_SYNTAX_TABLE_BACKWARD (from); |
| 2819 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 2819 | c = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 2820 | syntax= SYNTAX_WITH_FLAGS (c); | 2820 | int syntax = SYNTAX_WITH_FLAGS (c); |
| 2821 | code = syntax_multibyte (c, multibyte_symbol_p); | 2821 | code = syntax_multibyte (c, multibyte_symbol_p); |
| 2822 | if (depth == min_depth) | 2822 | if (depth == min_depth) |
| 2823 | last_good = from; | 2823 | last_good = from; |
| @@ -2889,6 +2889,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2889 | default: goto done2; | 2889 | default: goto done2; |
| 2890 | } | 2890 | } |
| 2891 | DEC_BOTH (from, from_byte); | 2891 | DEC_BOTH (from, from_byte); |
| 2892 | rarely_quit (++quit_count); | ||
| 2892 | } | 2893 | } |
| 2893 | goto done2; | 2894 | goto done2; |
| 2894 | 2895 | ||
| @@ -2951,13 +2952,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2951 | if (syntax_multibyte (c, multibyte_symbol_p) == code) | 2952 | if (syntax_multibyte (c, multibyte_symbol_p) == code) |
| 2952 | break; | 2953 | break; |
| 2953 | } | 2954 | } |
| 2955 | rarely_quit (++quit_count); | ||
| 2954 | } | 2956 | } |
| 2955 | if (code == Sstring_fence && !depth && sexpflag) goto done2; | 2957 | if (code == Sstring_fence && !depth && sexpflag) goto done2; |
| 2956 | break; | 2958 | break; |
| 2957 | 2959 | ||
| 2958 | case Sstring: | 2960 | case Sstring: |
| 2959 | stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); | 2961 | stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); |
| 2960 | while (1) | 2962 | while (true) |
| 2961 | { | 2963 | { |
| 2962 | if (from == stop) | 2964 | if (from == stop) |
| 2963 | goto lose; | 2965 | goto lose; |
| @@ -2971,6 +2973,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2971 | == Sstring)) | 2973 | == Sstring)) |
| 2972 | break; | 2974 | break; |
| 2973 | } | 2975 | } |
| 2976 | rarely_quit (++quit_count); | ||
| 2974 | } | 2977 | } |
| 2975 | if (!depth && sexpflag) goto done2; | 2978 | if (!depth && sexpflag) goto done2; |
| 2976 | break; | 2979 | break; |
| @@ -2984,7 +2987,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2984 | if (depth) | 2987 | if (depth) |
| 2985 | goto lose; | 2988 | goto lose; |
| 2986 | 2989 | ||
| 2987 | immediate_quit = false; | ||
| 2988 | return Qnil; | 2990 | return Qnil; |
| 2989 | 2991 | ||
| 2990 | done2: | 2992 | done2: |
| @@ -2992,7 +2994,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) | |||
| 2992 | } | 2994 | } |
| 2993 | 2995 | ||
| 2994 | 2996 | ||
| 2995 | immediate_quit = false; | ||
| 2996 | XSETFASTINT (val, from); | 2997 | XSETFASTINT (val, from); |
| 2997 | return val; | 2998 | return val; |
| 2998 | 2999 | ||
| @@ -3085,6 +3086,7 @@ the prefix syntax flag (p). */) | |||
| 3085 | if (pos <= beg) | 3086 | if (pos <= beg) |
| 3086 | break; | 3087 | break; |
| 3087 | DEC_BOTH (pos, pos_byte); | 3088 | DEC_BOTH (pos, pos_byte); |
| 3089 | rarely_quit (pos); | ||
| 3088 | } | 3090 | } |
| 3089 | 3091 | ||
| 3090 | SET_PT_BOTH (opoint, opoint_byte); | 3092 | SET_PT_BOTH (opoint, opoint_byte); |
| @@ -3155,6 +3157,7 @@ scan_sexps_forward (struct lisp_parse_state *state, | |||
| 3155 | bool found; | 3157 | bool found; |
| 3156 | ptrdiff_t out_bytepos, out_charpos; | 3158 | ptrdiff_t out_bytepos, out_charpos; |
| 3157 | int temp; | 3159 | int temp; |
| 3160 | unsigned short int quit_count = 0; | ||
| 3158 | 3161 | ||
| 3159 | prev_from = from; | 3162 | prev_from = from; |
| 3160 | prev_from_byte = from_byte; | 3163 | prev_from_byte = from_byte; |
| @@ -3173,7 +3176,6 @@ do { prev_from = from; \ | |||
| 3173 | UPDATE_SYNTAX_TABLE_FORWARD (from); \ | 3176 | UPDATE_SYNTAX_TABLE_FORWARD (from); \ |
| 3174 | } while (0) | 3177 | } while (0) |
| 3175 | 3178 | ||
| 3176 | immediate_quit = true; | ||
| 3177 | maybe_quit (); | 3179 | maybe_quit (); |
| 3178 | 3180 | ||
| 3179 | depth = state->depth; | 3181 | depth = state->depth; |
| @@ -3225,6 +3227,7 @@ do { prev_from = from; \ | |||
| 3225 | 3227 | ||
| 3226 | while (from < end) | 3228 | while (from < end) |
| 3227 | { | 3229 | { |
| 3230 | rarely_quit (++quit_count); | ||
| 3228 | INC_FROM; | 3231 | INC_FROM; |
| 3229 | 3232 | ||
| 3230 | if ((from < end) | 3233 | if ((from < end) |
| @@ -3281,6 +3284,7 @@ do { prev_from = from; \ | |||
| 3281 | goto symdone; | 3284 | goto symdone; |
| 3282 | } | 3285 | } |
| 3283 | INC_FROM; | 3286 | INC_FROM; |
| 3287 | rarely_quit (++quit_count); | ||
| 3284 | } | 3288 | } |
| 3285 | symdone: | 3289 | symdone: |
| 3286 | curlevel->prev = curlevel->last; | 3290 | curlevel->prev = curlevel->last; |
| @@ -3391,6 +3395,7 @@ do { prev_from = from; \ | |||
| 3391 | break; | 3395 | break; |
| 3392 | } | 3396 | } |
| 3393 | INC_FROM; | 3397 | INC_FROM; |
| 3398 | rarely_quit (++quit_count); | ||
| 3394 | } | 3399 | } |
| 3395 | } | 3400 | } |
| 3396 | string_end: | 3401 | string_end: |
| @@ -3432,7 +3437,6 @@ do { prev_from = from; \ | |||
| 3432 | state->levelstarts); | 3437 | state->levelstarts); |
| 3433 | state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) | 3438 | state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) |
| 3434 | || state->quoted) ? prev_from_syntax : Smax; | 3439 | || state->quoted) ? prev_from_syntax : Smax; |
| 3435 | immediate_quit = false; | ||
| 3436 | } | 3440 | } |
| 3437 | 3441 | ||
| 3438 | /* Convert a (lisp) parse state to the internal form used in | 3442 | /* Convert a (lisp) parse state to the internal form used in |
diff --git a/src/sysdep.c b/src/sysdep.c index e172dc0aed4..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 maybe_quit | ||
| 395 | internally. */ | ||
| 396 | if (interruptible) | ||
| 397 | maybe_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 |
| @@ -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 | maybe_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 maybe_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/w32fns.c b/src/w32fns.c index 6a576fcec27..1b628b0b42e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c | |||
| @@ -3168,16 +3168,7 @@ signal_user_input (void) | |||
| 3168 | Vquit_flag = Vthrow_on_input; | 3168 | Vquit_flag = Vthrow_on_input; |
| 3169 | /* Calling maybe_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 = false; | ||
| 3178 | maybe_quit (); | ||
| 3179 | } | ||
| 3180 | #endif | ||
| 3181 | } | 3172 | } |
| 3182 | } | 3173 | } |
| 3183 | 3174 | ||
diff --git a/src/window.c b/src/window.c index 71a82b522c4..95690443f8e 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -4770,7 +4770,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) | |||
| 4770 | { | 4770 | { |
| 4771 | ptrdiff_t count = SPECPDL_INDEX (); | 4771 | ptrdiff_t count = SPECPDL_INDEX (); |
| 4772 | 4772 | ||
| 4773 | immediate_quit = true; | ||
| 4774 | n = clip_to_bounds (INT_MIN, n, INT_MAX); | 4773 | n = clip_to_bounds (INT_MIN, n, INT_MAX); |
| 4775 | 4774 | ||
| 4776 | wset_redisplay (XWINDOW (window)); | 4775 | wset_redisplay (XWINDOW (window)); |
| @@ -4789,7 +4788,36 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) | |||
| 4789 | 4788 | ||
| 4790 | /* Bug#15957. */ | 4789 | /* Bug#15957. */ |
| 4791 | XWINDOW (window)->window_end_valid = false; | 4790 | XWINDOW (window)->window_end_valid = false; |
| 4792 | 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; | ||
| 4793 | } | 4821 | } |
| 4794 | 4822 | ||
| 4795 | 4823 | ||
| @@ -4808,7 +4836,6 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 4808 | bool vscrolled = false; | 4836 | bool vscrolled = false; |
| 4809 | int x, y, rtop, rbot, rowh, vpos; | 4837 | int x, y, rtop, rbot, rowh, vpos; |
| 4810 | void *itdata = NULL; | 4838 | void *itdata = NULL; |
| 4811 | int window_total_lines; | ||
| 4812 | int frame_line_height = default_line_pixel_height (w); | 4839 | int frame_line_height = default_line_pixel_height (w); |
| 4813 | bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window), | 4840 | bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window), |
| 4814 | Fwindow_old_point (window))); | 4841 | Fwindow_old_point (window))); |
| @@ -5064,12 +5091,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 5064 | /* Move PT out of scroll margins. | 5091 | /* Move PT out of scroll margins. |
| 5065 | 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 |
| 5066 | even if there is a header line. */ | 5093 | even if there is a header line. */ |
| 5067 | window_total_lines | 5094 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 5068 | = w->total_lines * WINDOW_FRAME_LINE_HEIGHT (w) / frame_line_height; | ||
| 5069 | this_scroll_margin = max (0, scroll_margin); | ||
| 5070 | this_scroll_margin | ||
| 5071 | = min (this_scroll_margin, window_total_lines / 4); | ||
| 5072 | this_scroll_margin *= frame_line_height; | ||
| 5073 | 5095 | ||
| 5074 | if (n > 0) | 5096 | if (n > 0) |
| 5075 | { | 5097 | { |
| @@ -5125,7 +5147,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 5125 | in the scroll margin at the bottom. */ | 5147 | in the scroll margin at the bottom. */ |
| 5126 | move_it_to (&it, PT, -1, | 5148 | move_it_to (&it, PT, -1, |
| 5127 | (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w) | 5149 | (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w) |
| 5128 | - this_scroll_margin - 1), | 5150 | - partial_line_height (&it) - this_scroll_margin - 1), |
| 5129 | -1, | 5151 | -1, |
| 5130 | MOVE_TO_POS | MOVE_TO_Y); | 5152 | MOVE_TO_POS | MOVE_TO_Y); |
| 5131 | 5153 | ||
| @@ -5292,9 +5314,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) | |||
| 5292 | 5314 | ||
| 5293 | if (pos < ZV) | 5315 | if (pos < ZV) |
| 5294 | { | 5316 | { |
| 5295 | /* Don't use a scroll margin that is negative or too large. */ | 5317 | int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); |
| 5296 | int this_scroll_margin = | ||
| 5297 | max (0, min (scroll_margin, w->total_lines / 4)); | ||
| 5298 | 5318 | ||
| 5299 | set_marker_restricted_both (w->start, w->contents, pos, pos_byte); | 5319 | set_marker_restricted_both (w->start, w->contents, pos, pos_byte); |
| 5300 | w->start_at_line_beg = !NILP (bolp); | 5320 | w->start_at_line_beg = !NILP (bolp); |
| @@ -5724,8 +5744,7 @@ and redisplay normally--don't erase and redraw the frame. */) | |||
| 5724 | 5744 | ||
| 5725 | /* Do this after making BUF current | 5745 | /* Do this after making BUF current |
| 5726 | in case scroll_margin is buffer-local. */ | 5746 | in case scroll_margin is buffer-local. */ |
| 5727 | this_scroll_margin | 5747 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); |
| 5728 | = max (0, min (scroll_margin, w->total_lines / 4)); | ||
| 5729 | 5748 | ||
| 5730 | /* Don't use redisplay code for initial frames, as the necessary | 5749 | /* Don't use redisplay code for initial frames, as the necessary |
| 5731 | data structures might not be set up yet then. */ | 5750 | data structures might not be set up yet then. */ |
| @@ -5964,10 +5983,6 @@ from the top of the window. */) | |||
| 5964 | 5983 | ||
| 5965 | lines = displayed_window_lines (w); | 5984 | lines = displayed_window_lines (w); |
| 5966 | 5985 | ||
| 5967 | #if false | ||
| 5968 | this_scroll_margin = max (0, min (scroll_margin, lines / 4)); | ||
| 5969 | #endif | ||
| 5970 | |||
| 5971 | if (NILP (arg)) | 5986 | if (NILP (arg)) |
| 5972 | XSETFASTINT (arg, lines / 2); | 5987 | XSETFASTINT (arg, lines / 2); |
| 5973 | else | 5988 | else |
| @@ -5983,6 +5998,8 @@ from the top of the window. */) | |||
| 5983 | 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 |
| 5984 | inside #if false so as not to lose it. -- rms. */ | 5999 | inside #if false so as not to lose it. -- rms. */ |
| 5985 | 6000 | ||
| 6001 | this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); | ||
| 6002 | |||
| 5986 | /* 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. */ |
| 5987 | iarg = max (iarg, this_scroll_margin); | 6004 | iarg = max (iarg, this_scroll_margin); |
| 5988 | 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 33661c882cd..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) |
| @@ -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/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/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/filenotify-tests.el b/test/lisp/filenotify-tests.el index db7f55e8fc5..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 | ||
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/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/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/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/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 | ||