diff options
| author | Yuuki Harano | 2021-06-13 17:34:06 +0900 |
|---|---|---|
| committer | Yuuki Harano | 2021-06-13 17:34:06 +0900 |
| commit | 7d5e94bada09e642a8bfc4f66804f7948bad40bc (patch) | |
| tree | 38629672102b31bb38a855f24d4dd009e212c10d | |
| parent | 7673b6b9eb0af3add73e1614a466f142092b00aa (diff) | |
| parent | dc471feee3bcac872cc52cdc73282955cd2d219d (diff) | |
| download | emacs-7d5e94bada09e642a8bfc4f66804f7948bad40bc.tar.gz emacs-7d5e94bada09e642a8bfc4f66804f7948bad40bc.zip | |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
148 files changed, 7254 insertions, 1693 deletions
diff --git a/configure.ac b/configure.ac index 39f9adad0ef..88d5cc160b2 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -3847,27 +3847,28 @@ AC_DEFUN([libgccjit_smoke_test], [ | |||
| 3847 | }]])]) | 3847 | }]])]) |
| 3848 | 3848 | ||
| 3849 | AC_DEFUN([libgccjit_not_found], [ | 3849 | AC_DEFUN([libgccjit_not_found], [ |
| 3850 | AC_MSG_ERROR([elisp native compiler requested but libgccjit not found. | 3850 | AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit was not found. |
| 3851 | Please try installing libgccjit or similar package. | 3851 | Please try installing libgccjit or a similar package. |
| 3852 | If you are sure you want Emacs compiled without elisp native compiler, pass | 3852 | If you are sure you want Emacs be compiled without ELisp native compiler, |
| 3853 | --without-native-compilation | 3853 | pass the --without-native-compilation option to configure.])]) |
| 3854 | to configure.])]) | ||
| 3855 | 3854 | ||
| 3856 | AC_DEFUN([libgccjit_dev_not_found], [ | 3855 | AC_DEFUN([libgccjit_dev_not_found], [ |
| 3857 | AC_MSG_ERROR([elisp native compiler requested but libgccjit header files were | 3856 | AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit header files were |
| 3858 | not found. | 3857 | not found. |
| 3859 | Please try installing libgccjit-dev or similar package. | 3858 | Please try installing libgccjit-dev or a similar package. |
| 3860 | If you are sure you want Emacs compiled without elisp native compiler, pass | 3859 | If you are sure you want Emacs be compiled without ELisp native compiler, |
| 3861 | --without-nativecomp | 3860 | pass the --without-nativecomp option to configure.])]) |
| 3862 | to configure.])]) | ||
| 3863 | 3861 | ||
| 3864 | AC_DEFUN([libgccjit_broken], [ | 3862 | AC_DEFUN([libgccjit_broken], [ |
| 3865 | AC_MSG_ERROR([Installed libgccjit has failed passing the smoke test. | 3863 | AC_MSG_ERROR([The installed libgccjit failed to compile and run a test program using |
| 3866 | You can verify it yourself compiling: | 3864 | the libgccjit library; see config.log for the details of the failure. |
| 3865 | The test program can be found here: | ||
| 3867 | <https://gcc.gnu.org/onlinedocs/jit/intro/tutorial01.html>. | 3866 | <https://gcc.gnu.org/onlinedocs/jit/intro/tutorial01.html>. |
| 3868 | Please report the issue to your distribution if libgccjit was installed through | 3867 | You can try compiling it yourself to investigate the issues. |
| 3869 | that. | 3868 | Please report the issue to your distribution if libgccjit was installed |
| 3870 | Here instructions on how to compile and install libgccjit from source: | 3869 | through that. |
| 3870 | You can find the instructions on how to compile and install libgccjit from | ||
| 3871 | source on this site: | ||
| 3871 | <https://gcc.gnu.org/wiki/JIT>.])]) | 3872 | <https://gcc.gnu.org/wiki/JIT>.])]) |
| 3872 | 3873 | ||
| 3873 | HAVE_NATIVE_COMP=no | 3874 | HAVE_NATIVE_COMP=no |
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 5fccdaa8343..f6c422aa906 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi | |||
| @@ -1189,8 +1189,8 @@ that has some special meaning for formatting the source code of a | |||
| 1189 | program. | 1189 | program. |
| 1190 | 1190 | ||
| 1191 | To activate the fill-column indication display, use the minor modes | 1191 | To activate the fill-column indication display, use the minor modes |
| 1192 | @w{@kbd{M-x display-fill-column-indicator-mode}} and | 1192 | @kbd{M-x display-fill-@-column-indicator-mode} and |
| 1193 | @w{@kbd{M-x global-display-fill-column-indicator-mode}}, which enable | 1193 | @kbd{M-x global-display-fill-column-indicator-mode}, which enable |
| 1194 | the indicator locally or globally, respectively. | 1194 | the indicator locally or globally, respectively. |
| 1195 | 1195 | ||
| 1196 | Alternatively, you can set the two buffer-local variables | 1196 | Alternatively, you can set the two buffer-local variables |
| @@ -1220,8 +1220,8 @@ The value @code{nil} disables the indicator. When the mode is enabled | |||
| 1220 | through the functions @code{display-fill-column-indicator-mode} or | 1220 | through the functions @code{display-fill-column-indicator-mode} or |
| 1221 | @code{global-display-fill-column-indicator-mode}, they will use the | 1221 | @code{global-display-fill-column-indicator-mode}, they will use the |
| 1222 | character specified by this variable, if it is non-@code{nil}; | 1222 | character specified by this variable, if it is non-@code{nil}; |
| 1223 | otherwise Emacs will use the character @samp{U+2502 VERTICAL LINE}, | 1223 | otherwise Emacs will use the character U+2502 @sc{box drawings light vertical}, |
| 1224 | falling back to @samp{|} if @code{U+2502} cannot be displayed. | 1224 | falling back to @samp{|} if U+2502 cannot be displayed. |
| 1225 | 1225 | ||
| 1226 | @item fill-column-indicator | 1226 | @item fill-column-indicator |
| 1227 | @vindex fill-column-indicator | 1227 | @vindex fill-column-indicator |
| @@ -1577,8 +1577,8 @@ characters, as well as many non-@acronym{ASCII} characters. | |||
| 1577 | @cindex control characters on display | 1577 | @cindex control characters on display |
| 1578 | The @acronym{ASCII} character set contains non-printing @dfn{control | 1578 | The @acronym{ASCII} character set contains non-printing @dfn{control |
| 1579 | characters}. Two of these are displayed specially: the newline | 1579 | characters}. Two of these are displayed specially: the newline |
| 1580 | character (Unicode code point @code{U+000A}) is displayed by starting | 1580 | character (Unicode code point U+000A) is displayed by starting |
| 1581 | a new line, while the tab character (@code{U+0009}) is displayed as a | 1581 | a new line, while the tab character (U+0009) is displayed as a |
| 1582 | space that extends to the next tab stop column (normally every 8 | 1582 | space that extends to the next tab stop column (normally every 8 |
| 1583 | columns). The number of spaces per tab is controlled by the | 1583 | columns). The number of spaces per tab is controlled by the |
| 1584 | buffer-local variable @code{tab-width}, which must have an integer | 1584 | buffer-local variable @code{tab-width}, which must have an integer |
| @@ -1587,17 +1587,17 @@ character in the buffer is displayed has nothing to do with the | |||
| 1587 | definition of @key{TAB} as a command. | 1587 | definition of @key{TAB} as a command. |
| 1588 | 1588 | ||
| 1589 | Other @acronym{ASCII} control characters, whose codes are below | 1589 | Other @acronym{ASCII} control characters, whose codes are below |
| 1590 | @code{U+0020} (octal 40, decimal 32), are displayed as a caret | 1590 | U+0020 (octal 40, decimal 32), are displayed as a caret |
| 1591 | (@samp{^}) followed by the non-control version of the character, with | 1591 | (@samp{^}) followed by the non-control version of the character, with |
| 1592 | the @code{escape-glyph} face. For instance, the @samp{control-A} | 1592 | the @code{escape-glyph} face. For instance, the @samp{control-A} |
| 1593 | character, @code{U+0001}, is displayed as @samp{^A}. | 1593 | character, U+0001, is displayed as @samp{^A}. |
| 1594 | 1594 | ||
| 1595 | @cindex octal escapes | 1595 | @cindex octal escapes |
| 1596 | @vindex ctl-arrow | 1596 | @vindex ctl-arrow |
| 1597 | The raw bytes with codes @code{U+0080} (octal 200) through | 1597 | The raw bytes with codes U+0080 (octal 200) through |
| 1598 | @code{U+009F} (octal 237) are displayed as @dfn{octal escape | 1598 | U+009F (octal 237) are displayed as @dfn{octal escape |
| 1599 | sequences}, with the @code{escape-glyph} face. For instance, | 1599 | sequences}, with the @code{escape-glyph} face. For instance, |
| 1600 | character code @code{U+0098} (octal 230) is displayed as @samp{\230}. | 1600 | character code U+0098 (octal 230) is displayed as @samp{\230}. |
| 1601 | If you change the buffer-local variable @code{ctl-arrow} to | 1601 | If you change the buffer-local variable @code{ctl-arrow} to |
| 1602 | @code{nil}, the @acronym{ASCII} control characters are also displayed | 1602 | @code{nil}, the @acronym{ASCII} control characters are also displayed |
| 1603 | as octal escape sequences instead of caret escape sequences. (You can | 1603 | as octal escape sequences instead of caret escape sequences. (You can |
| @@ -1616,11 +1616,11 @@ can cause problems if they are entered into a buffer without your | |||
| 1616 | realization, e.g., by yanking; for instance, source code compilers | 1616 | realization, e.g., by yanking; for instance, source code compilers |
| 1617 | typically do not treat non-@acronym{ASCII} spaces as whitespace | 1617 | typically do not treat non-@acronym{ASCII} spaces as whitespace |
| 1618 | characters. To deal with this problem, Emacs displays such characters | 1618 | characters. To deal with this problem, Emacs displays such characters |
| 1619 | specially: it displays @code{U+00A0} (no-break space) and other | 1619 | specially: it displays U+00A0 @sc{no-break space} and other |
| 1620 | characters from the Unicode horizontal space class with the | 1620 | characters from the Unicode horizontal space class with the |
| 1621 | @code{nobreak-space} face, and it displays @code{U+00AD} (soft | 1621 | @code{nobreak-space} face, and it displays U+00AD @sc{soft |
| 1622 | hyphen), @code{U+2010} (hyphen), and @code{U+2011} (non-breaking | 1622 | hyphen}, U+2010 @sc{hyphen}, and U+2011 @sc{non-breaking |
| 1623 | hyphen) with the @code{nobreak-hyphen} face. To disable this, change | 1623 | hyphen} with the @code{nobreak-hyphen} face. To disable this, change |
| 1624 | the variable @code{nobreak-char-display} to @code{nil}. If you give | 1624 | the variable @code{nobreak-char-display} to @code{nil}. If you give |
| 1625 | this variable a non-@code{nil} and non-@code{t} value, Emacs instead | 1625 | this variable a non-@code{nil} and non-@code{t} value, Emacs instead |
| 1626 | displays such characters as a highlighted backslash followed by a | 1626 | displays such characters as a highlighted backslash followed by a |
| @@ -1829,15 +1829,15 @@ variable @code{visual-line-fringe-indicators}. | |||
| 1829 | That produces incorrect results when CJK and Latin text are mixed | 1829 | That produces incorrect results when CJK and Latin text are mixed |
| 1830 | together (because CJK characters don't use whitespace to separate | 1830 | together (because CJK characters don't use whitespace to separate |
| 1831 | words). You can customize the option @code{word-wrap-by-category} to | 1831 | words). You can customize the option @code{word-wrap-by-category} to |
| 1832 | allow Emacs to break lines after any character with ``|'' category | 1832 | allow Emacs to break lines after any character with @samp{|} category |
| 1833 | (@pxref{Categories,,, elisp, the Emacs Lisp Reference Manual}), which | 1833 | (@pxref{Categories,,, elisp, the Emacs Lisp Reference Manual}), which |
| 1834 | provides better support for CJK characters. Also, if this variable is | 1834 | provides better support for CJK characters. Also, if this variable is |
| 1835 | set using Customize, Emacs automatically loads @file{kinsoku.el}. | 1835 | set using Customize, Emacs automatically loads @file{kinsoku.el}. |
| 1836 | When @file{kinsoku.el} is loaded, Emacs respects kinsoku rules when | 1836 | When @file{kinsoku.el} is loaded, Emacs respects kinsoku rules when |
| 1837 | breaking lines. That means characters with the ``>'' category don't | 1837 | breaking lines. That means characters with the @samp{>} category don't |
| 1838 | appear at the beginning of a line (e.g., U+FF0C FULLWIDTH COMMA), and | 1838 | appear at the beginning of a line (e.g., U+FF0C @sc{fullwidth comma}), and |
| 1839 | characters with the ``<'' category don't appear at the end of a line | 1839 | characters with the @samp{<} category don't appear at the end of a line |
| 1840 | (e.g., U+300A LEFT DOUBLE ANGLE BRACKET). You can view the category | 1840 | (e.g., U+300A @sc{left double angle bracket}). You can view the category |
| 1841 | set of a character using the commands @code{char-category-set} and | 1841 | set of a character using the commands @code{char-category-set} and |
| 1842 | @code{category-set-mnemonics}, or by typing @kbd{C-u C-x =} with point | 1842 | @code{category-set-mnemonics}, or by typing @kbd{C-u C-x =} with point |
| 1843 | on the character and looking at the ``category'' section in the | 1843 | on the character and looking at the ``category'' section in the |
diff --git a/doc/emacs/docstyle.texi b/doc/emacs/docstyle.texi index 5bdcd079d91..e7404398d24 100644 --- a/doc/emacs/docstyle.texi +++ b/doc/emacs/docstyle.texi | |||
| @@ -15,4 +15,5 @@ | |||
| 15 | @hyphenation{work-a-round} | 15 | @hyphenation{work-a-round} |
| 16 | @hyphenation{work-a-rounds} | 16 | @hyphenation{work-a-rounds} |
| 17 | @hyphenation{un-marked} | 17 | @hyphenation{un-marked} |
| 18 | @hyphenation{dic-tion-ary} | ||
| 18 | @end iftex | 19 | @end iftex |
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 6b41849ccc8..acc0381ec30 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi | |||
| @@ -365,7 +365,7 @@ Like @kbd{i}, but you can also specify dictionary completion | |||
| 365 | information. | 365 | information. |
| 366 | 366 | ||
| 367 | @item u | 367 | @item u |
| 368 | Insert the lower-case version of this word in your private dic@-tion@-ary | 368 | Insert the lower-case version of this word in your private dictionary |
| 369 | file. | 369 | file. |
| 370 | 370 | ||
| 371 | @item l @var{word} @key{RET} | 371 | @item l @var{word} @key{RET} |
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 89de9af13e5..56763b2967a 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi | |||
| @@ -311,13 +311,13 @@ the end. Using any other prefix argument specifies an earlier kill; | |||
| 311 | e.g., @kbd{C-u 4 C-y} reinserts the fourth most recent kill. | 311 | e.g., @kbd{C-u 4 C-y} reinserts the fourth most recent kill. |
| 312 | @xref{Earlier Kills}. | 312 | @xref{Earlier Kills}. |
| 313 | 313 | ||
| 314 | On graphical displays, @kbd{C-y} first checks if another application | 314 | On graphical displays and on capable text-mode displays, @kbd{C-y} |
| 315 | has placed any text in the system clipboard more recently than the | 315 | first checks if another application has placed any text in the system |
| 316 | last Emacs kill. If so, it inserts the clipboard's text instead. | 316 | clipboard more recently than the last Emacs kill. If so, it inserts |
| 317 | Thus, Emacs effectively treats ``cut'' or ``copy'' clipboard | 317 | the clipboard's text instead. Thus, Emacs effectively treats ``cut'' |
| 318 | operations performed in other applications like Emacs kills, except | 318 | or ``copy'' clipboard operations performed in other applications like |
| 319 | that they are not recorded in the kill ring. @xref{Cut and Paste}, | 319 | Emacs kills, except that they are not recorded in the kill ring. |
| 320 | for details. | 320 | @xref{Cut and Paste}, for details. |
| 321 | 321 | ||
| 322 | @menu | 322 | @menu |
| 323 | * Kill Ring:: Where killed text is stored. | 323 | * Kill Ring:: Where killed text is stored. |
| @@ -371,12 +371,12 @@ command, it works differently, see below.) | |||
| 371 | last-yank pointer which points at an entry in the kill ring. Each | 371 | last-yank pointer which points at an entry in the kill ring. Each |
| 372 | time you kill, the last-yank pointer moves to the newly made entry at | 372 | time you kill, the last-yank pointer moves to the newly made entry at |
| 373 | the front of the ring. @kbd{C-y} yanks the entry which the last-yank | 373 | the front of the ring. @kbd{C-y} yanks the entry which the last-yank |
| 374 | pointer points to. @kbd{M-y} moves the last-yank pointer to a | 374 | pointer points to. @kbd{M-y} after a @kbd{C-y} or another @kbd{M-y} |
| 375 | different entry, and the text in the buffer changes to match. Enough | 375 | moves the last-yank pointer to the previous entry, and the text in the |
| 376 | @kbd{M-y} commands can move the pointer to any entry in the ring, so | 376 | buffer changes to match. Enough @kbd{M-y} commands one after another |
| 377 | you can get any entry into the buffer. Eventually the pointer reaches | 377 | can move the pointer to any entry in the ring, so you can get any |
| 378 | the end of the ring; the next @kbd{M-y} loops back around to the first | 378 | entry into the buffer. Eventually the pointer reaches the end of the |
| 379 | entry again. | 379 | ring; the next @kbd{M-y} loops back around to the first entry again. |
| 380 | 380 | ||
| 381 | @kbd{M-y} moves the last-yank pointer around the ring, but it does | 381 | @kbd{M-y} moves the last-yank pointer around the ring, but it does |
| 382 | not change the order of the entries in the ring, which always runs from | 382 | not change the order of the entries in the ring, which always runs from |
| @@ -388,12 +388,13 @@ pointer by. A negative argument moves the pointer toward the front of | |||
| 388 | the ring; from the front of the ring, it moves around to the last | 388 | the ring; from the front of the ring, it moves around to the last |
| 389 | entry and continues forward from there. | 389 | entry and continues forward from there. |
| 390 | 390 | ||
| 391 | Once the text you are looking for is brought into the buffer, you can | 391 | Once the text you are looking for is brought into the buffer, you |
| 392 | stop doing @kbd{M-y} commands and it will stay there. It's just a copy | 392 | can stop doing @kbd{M-y} commands and the last yanked text will stay |
| 393 | of the kill ring entry, so editing it in the buffer does not change | 393 | there. It's just a copy of the kill ring entry, so editing it in the |
| 394 | what's in the ring. As long as no new killing is done, the last-yank | 394 | buffer does not change what's in the ring. As long as no new killing |
| 395 | pointer remains at the same place in the kill ring, so repeating | 395 | is done, the last-yank pointer remains at the same place in the kill |
| 396 | @kbd{C-y} will yank another copy of the same previous kill. | 396 | ring, so repeating @kbd{C-y} will yank another copy of the same |
| 397 | previous kill. | ||
| 397 | 398 | ||
| 398 | When you call @kbd{C-y} with a numeric argument, that also sets the | 399 | When you call @kbd{C-y} with a numeric argument, that also sets the |
| 399 | last-yank pointer to the entry that it yanks. | 400 | last-yank pointer to the entry that it yanks. |
| @@ -404,11 +405,18 @@ one of the previous kills. You can use the minibuffer history | |||
| 404 | commands (@pxref{Minibuffer History}) to navigate or search through | 405 | commands (@pxref{Minibuffer History}) to navigate or search through |
| 405 | the entries in the kill ring until you find the one you want to | 406 | the entries in the kill ring until you find the one you want to |
| 406 | reinsert. Or you can use completion commands (@pxref{Completion | 407 | reinsert. Or you can use completion commands (@pxref{Completion |
| 407 | Commands}) to complete on the list of entries in the kill ring or pop | 408 | Commands}) to complete on an entry from the list of entries in the |
| 408 | up the @file{*Completions*} buffer with the candidate entries from | 409 | kill ring or pop up the @file{*Completions*} buffer with the candidate |
| 409 | which you can choose. After selecting the kill-ring entry, you can | 410 | entries from which you can choose. After selecting the kill-ring |
| 410 | optionally edit it in the minibuffer. Finally, type @kbd{RET} to exit | 411 | entry, you can optionally edit it in the minibuffer. Finally, type |
| 411 | the minibuffer and insert the selected text. | 412 | @kbd{RET} to exit the minibuffer and insert the text of the selected |
| 413 | kill-ring entry. Like in case of @kbd{M-y} after another yank | ||
| 414 | command, the last-yank pointer is left pointing at the text you just | ||
| 415 | yanked, whether it is one of the previous kills or an entry from the | ||
| 416 | kill-ring that you edited before inserting it. (In the latter case, | ||
| 417 | the edited entry is added to the front of the kill-ring.) So here, | ||
| 418 | too, typing @kbd{C-y} will yank another copy of the text just | ||
| 419 | inserted. | ||
| 412 | 420 | ||
| 413 | When invoked with a plain prefix argument (@kbd{C-u M-y}) after a | 421 | When invoked with a plain prefix argument (@kbd{C-u M-y}) after a |
| 414 | command that is not a yank command, @kbd{M-y} leaves the cursor in | 422 | command that is not a yank command, @kbd{M-y} leaves the cursor in |
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index c8027792505..027133cc3a3 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi | |||
| @@ -1864,6 +1864,12 @@ it to exit. Programs that use @env{EDITOR} usually wait for the | |||
| 1864 | editor---in this case @command{emacsclient}---to exit before doing | 1864 | editor---in this case @command{emacsclient}---to exit before doing |
| 1865 | something else. | 1865 | something else. |
| 1866 | 1866 | ||
| 1867 | @findex server-edit-abort | ||
| 1868 | If you want to abandon the edit instead, use the @w{@kbd{M-x | ||
| 1869 | server-edit-abort}} command. This sends a message back to the | ||
| 1870 | @command{emacsclient} program, telling it to exit with abnormal exit | ||
| 1871 | status, and doesn't save any buffers. | ||
| 1872 | |||
| 1867 | You can also call @command{emacsclient} with multiple file name | 1873 | You can also call @command{emacsclient} with multiple file name |
| 1868 | arguments: @samp{emacsclient @var{file1} @var{file2} ...} tells the | 1874 | arguments: @samp{emacsclient @var{file1} @var{file2} ...} tells the |
| 1869 | Emacs server to visit @var{file1}, @var{file2}, and so forth. Emacs | 1875 | Emacs server to visit @var{file1}, @var{file2}, and so forth. Emacs |
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index c66deb77487..facbc7f3ed8 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi | |||
| @@ -310,6 +310,9 @@ the space that it occupied is given to an adjacent window (but not the | |||
| 310 | minibuffer window, even if that is active at the time). Deleting the | 310 | minibuffer window, even if that is active at the time). Deleting the |
| 311 | window has no effect on the buffer it used to display; the buffer | 311 | window has no effect on the buffer it used to display; the buffer |
| 312 | continues to exist, and you can still switch to it with @kbd{C-x b}. | 312 | continues to exist, and you can still switch to it with @kbd{C-x b}. |
| 313 | The option @code{delete-window-choose-selected} allows to choose which | ||
| 314 | window becomes the new selected window instead (@pxref{Deleting | ||
| 315 | Windows,,, elisp, The Emacs Lisp Reference Manual}). | ||
| 313 | 316 | ||
| 314 | @findex kill-buffer-and-window | 317 | @findex kill-buffer-and-window |
| 315 | @kindex C-x 4 0 | 318 | @kindex C-x 4 0 |
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 298bec5230c..dbbc34fb3a5 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi | |||
| @@ -839,7 +839,7 @@ evaluated, and the result used. For instance: | |||
| 839 | @end example | 839 | @end example |
| 840 | 840 | ||
| 841 | @noindent | 841 | @noindent |
| 842 | will be printed as | 842 | will result in: |
| 843 | 843 | ||
| 844 | @example | 844 | @example |
| 845 | (concat "foo" "bar" "zot") | 845 | (concat "foo" "bar" "zot") |
| @@ -866,13 +866,14 @@ should be included. | |||
| 866 | @end example | 866 | @end example |
| 867 | 867 | ||
| 868 | @item :no-eval* | 868 | @item :no-eval* |
| 869 | Like @code{:no-eval}, but alaways inserts @samp{[it depends]} as the | 869 | Like @code{:no-eval}, but always inserts @samp{[it depends]} as the |
| 870 | result. | 870 | result. For instance: |
| 871 | 871 | ||
| 872 | @example | 872 | @example |
| 873 | :no-eval* (buffer-string) | 873 | :no-eval* (buffer-string) |
| 874 | @end example | 874 | @end example |
| 875 | 875 | ||
| 876 | @noindent | ||
| 876 | will result in: | 877 | will result in: |
| 877 | 878 | ||
| 878 | @example | 879 | @example |
| @@ -894,12 +895,21 @@ Used to output the result from non-evaluating example forms. | |||
| 894 | 895 | ||
| 895 | @item :eg-result | 896 | @item :eg-result |
| 896 | Used to output an example result from non-evaluating example forms. | 897 | Used to output an example result from non-evaluating example forms. |
| 898 | For instance: | ||
| 897 | 899 | ||
| 898 | @example | 900 | @example |
| 899 | :no-eval (looking-at "f[0-9]") | 901 | :no-eval (looking-at "f[0-9]") |
| 900 | :eg-result t | 902 | :eg-result t |
| 901 | @end example | 903 | @end example |
| 902 | 904 | ||
| 905 | @noindent | ||
| 906 | will result in: | ||
| 907 | |||
| 908 | @example | ||
| 909 | (looking-at "f[0-9]") | ||
| 910 | eg. @click{} t | ||
| 911 | @end example | ||
| 912 | |||
| 903 | @item :result-string | 913 | @item :result-string |
| 904 | @itemx :eg-result-string | 914 | @itemx :eg-result-string |
| 905 | These two are the same as @code{:result} and @code{:eg-result}, | 915 | These two are the same as @code{:result} and @code{:eg-result}, |
| @@ -951,7 +961,7 @@ sections. | |||
| 951 | 961 | ||
| 952 | @defun shortdoc-add-function shortdoc-add-function group section elem | 962 | @defun shortdoc-add-function shortdoc-add-function group section elem |
| 953 | Lisp packages can add functions to groups with this command. Each | 963 | Lisp packages can add functions to groups with this command. Each |
| 954 | @var{elem} should be a function descriptions, as described above. | 964 | @var{elem} should be a function description, as described above. |
| 955 | @var{group} is the function group, and @var{section} is what section | 965 | @var{group} is the function group, and @var{section} is what section |
| 956 | in the function group to insert the function into. | 966 | in the function group to insert the function into. |
| 957 | 967 | ||
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 4150a2b21b8..0e250d0f59b 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi | |||
| @@ -1429,7 +1429,7 @@ other words, if a module function wants to call Lisp functions or | |||
| 1429 | Emacs primitives, convert @code{emacs_value} objects to and from C | 1429 | Emacs primitives, convert @code{emacs_value} objects to and from C |
| 1430 | datatypes (@pxref{Module Values}), or interact with Emacs in any other | 1430 | datatypes (@pxref{Module Values}), or interact with Emacs in any other |
| 1431 | way, some call from Emacs to @code{emacs_module_init} or to a module | 1431 | way, some call from Emacs to @code{emacs_module_init} or to a module |
| 1432 | function must be in the call stack. Module function may not interact | 1432 | function must be in the call stack. Module functions may not interact |
| 1433 | with Emacs while garbage collection is running; @pxref{Garbage | 1433 | with Emacs while garbage collection is running; @pxref{Garbage |
| 1434 | Collection}. They may only interact with Emacs from Lisp interpreter | 1434 | Collection}. They may only interact with Emacs from Lisp interpreter |
| 1435 | threads (including the main thread) created by Emacs; @pxref{Threads}. | 1435 | threads (including the main thread) created by Emacs; @pxref{Threads}. |
diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi index b8df363614d..cf23ecb9d4e 100644 --- a/doc/lispref/macros.texi +++ b/doc/lispref/macros.texi | |||
| @@ -241,7 +241,6 @@ of constants and nonconstant parts. To make this easier, use the | |||
| 241 | @samp{`} syntax (@pxref{Backquote}). For example: | 241 | @samp{`} syntax (@pxref{Backquote}). For example: |
| 242 | 242 | ||
| 243 | @example | 243 | @example |
| 244 | @example | ||
| 245 | @group | 244 | @group |
| 246 | (defmacro t-becomes-nil (variable) | 245 | (defmacro t-becomes-nil (variable) |
| 247 | `(if (eq ,variable t) | 246 | `(if (eq ,variable t) |
| @@ -253,7 +252,6 @@ of constants and nonconstant parts. To make this easier, use the | |||
| 253 | @equiv{} (if (eq foo t) (setq foo nil)) | 252 | @equiv{} (if (eq foo t) (setq foo nil)) |
| 254 | @end group | 253 | @end group |
| 255 | @end example | 254 | @end example |
| 256 | @end example | ||
| 257 | 255 | ||
| 258 | @node Problems with Macros | 256 | @node Problems with Macros |
| 259 | @section Common Problems Using Macros | 257 | @section Common Problems Using Macros |
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 88f2f14c092..02064e7a374 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi | |||
| @@ -3004,7 +3004,8 @@ name. | |||
| 3004 | However, @var{facespec} can also evaluate to a list of this form: | 3004 | However, @var{facespec} can also evaluate to a list of this form: |
| 3005 | 3005 | ||
| 3006 | @example | 3006 | @example |
| 3007 | (face @var{face} @var{prop1} @var{val1} @var{prop2} @var{val2}@dots{}) | 3007 | (@var{subexp} |
| 3008 | (face @var{face} @var{prop1} @var{val1} @var{prop2} @var{val2}@dots{})) | ||
| 3008 | @end example | 3009 | @end example |
| 3009 | 3010 | ||
| 3010 | @noindent | 3011 | @noindent |
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 37fde0a953d..242c5ed1522 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi | |||
| @@ -2369,11 +2369,17 @@ has no effect except in @sc{cbreak} mode. | |||
| 2369 | 2369 | ||
| 2370 | The argument @var{meta} controls support for input character codes | 2370 | The argument @var{meta} controls support for input character codes |
| 2371 | above 127. If @var{meta} is @code{t}, Emacs converts characters with | 2371 | above 127. If @var{meta} is @code{t}, Emacs converts characters with |
| 2372 | the 8th bit set into Meta characters. If @var{meta} is @code{nil}, | 2372 | the 8th bit set into Meta characters, before it decodes them as needed |
| 2373 | (@pxref{Terminal I/O Encoding}). If @var{meta} is @code{nil}, | ||
| 2373 | Emacs disregards the 8th bit; this is necessary when the terminal uses | 2374 | Emacs disregards the 8th bit; this is necessary when the terminal uses |
| 2374 | it as a parity bit. If @var{meta} is neither @code{t} nor @code{nil}, | 2375 | it as a parity bit. If @var{meta} is the symbol @code{encoded}, Emacs |
| 2375 | Emacs uses all 8 bits of input unchanged. This is good for terminals | 2376 | first decodes the characters using all the 8 bits of each byte, and |
| 2376 | that use 8-bit character sets. | 2377 | then converts the decoded single-byte characters into Meta characters |
| 2378 | if they have their eighth bit set. Finally, if @var{meta} is neither | ||
| 2379 | @code{t} nor @code{nil} nor @code{encoded}, Emacs uses all 8 bits of | ||
| 2380 | input unchanged, both before and after decoding them. This is good | ||
| 2381 | for terminals that use 8-bit character sets and don't encode the Meta | ||
| 2382 | modifier as the eighth bit. | ||
| 2377 | 2383 | ||
| 2378 | If @var{quit-char} is non-@code{nil}, it specifies the character to | 2384 | If @var{quit-char} is non-@code{nil}, it specifies the character to |
| 2379 | use for quitting. Normally this character is @kbd{C-g}. | 2385 | use for quitting. Normally this character is @kbd{C-g}. |
| @@ -2398,9 +2404,11 @@ flow control for output to the terminal. This value is meaningful only | |||
| 2398 | when @var{interrupt} is @code{nil}. | 2404 | when @var{interrupt} is @code{nil}. |
| 2399 | @item meta | 2405 | @item meta |
| 2400 | is @code{t} if Emacs treats the eighth bit of input characters as | 2406 | is @code{t} if Emacs treats the eighth bit of input characters as |
| 2401 | the meta bit; @code{nil} means Emacs clears the eighth bit of every | 2407 | the Meta bit before decoding input; @code{encoded} if Emacs treats the |
| 2402 | input character; any other value means Emacs uses all eight bits as the | 2408 | eighth bit of the decoded single-byte characters as the Meta bit; |
| 2403 | basic character code. | 2409 | @code{nil} if Emacs clears the eighth bit of every input character; |
| 2410 | any other value means Emacs uses all eight bits as the basic character | ||
| 2411 | code. | ||
| 2404 | @item quit | 2412 | @item quit |
| 2405 | is the character Emacs currently uses for quitting, usually @kbd{C-g}. | 2413 | is the character Emacs currently uses for quitting, usually @kbd{C-g}. |
| 2406 | @end table | 2414 | @end table |
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index b38ee995abe..1d3e2d986c5 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi | |||
| @@ -368,7 +368,7 @@ preceding expression either once or not at all. For example, | |||
| 368 | @anchor{Non-greedy repetition} | 368 | @anchor{Non-greedy repetition} |
| 369 | @item @samp{*?}, @samp{+?}, @samp{??} | 369 | @item @samp{*?}, @samp{+?}, @samp{??} |
| 370 | @cindex non-greedy repetition characters in regexp | 370 | @cindex non-greedy repetition characters in regexp |
| 371 | These are @dfn{non-greedy} variants of the operators @samp{*}, @samp{+} | 371 | are @dfn{non-greedy} variants of the operators @samp{*}, @samp{+} |
| 372 | and @samp{?}. Where those operators match the largest possible | 372 | and @samp{?}. Where those operators match the largest possible |
| 373 | substring (consistent with matching the entire containing expression), | 373 | substring (consistent with matching the entire containing expression), |
| 374 | the non-greedy variants match the smallest possible substring | 374 | the non-greedy variants match the smallest possible substring |
| @@ -443,6 +443,13 @@ including newline. However, a reversed range should always be from | |||
| 443 | the letter @samp{z} to the letter @samp{a} to make it clear that it is | 443 | the letter @samp{z} to the letter @samp{a} to make it clear that it is |
| 444 | not a typo; for example, @samp{[+-*/]} should be avoided, because it | 444 | not a typo; for example, @samp{[+-*/]} should be avoided, because it |
| 445 | matches only @samp{/} rather than the likely-intended four characters. | 445 | matches only @samp{/} rather than the likely-intended four characters. |
| 446 | |||
| 447 | @item | ||
| 448 | If the end points of a range are raw 8-bit bytes (@pxref{Text | ||
| 449 | Representations}), or if the range start is ASCII and the end is a raw | ||
| 450 | byte (as in @samp{[a-\377]}), the range will match only ASCII | ||
| 451 | characters and raw 8-bit bytes, but not non-ASCII characters. This | ||
| 452 | feature is intended for searching text in unibyte buffers and strings. | ||
| 446 | @end enumerate | 453 | @end enumerate |
| 447 | 454 | ||
| 448 | Some kinds of character alternatives are not the best style even | 455 | Some kinds of character alternatives are not the best style even |
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 2df6c15c4ca..bde7075b0df 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi | |||
| @@ -572,12 +572,14 @@ The function is called by @code{syntax-ppss} (@pxref{Position Parse}), | |||
| 572 | and by Font Lock mode during syntactic fontification (@pxref{Syntactic | 572 | and by Font Lock mode during syntactic fontification (@pxref{Syntactic |
| 573 | Font Lock}). It is called with two arguments, @var{start} and | 573 | Font Lock}). It is called with two arguments, @var{start} and |
| 574 | @var{end}, which are the starting and ending positions of the text on | 574 | @var{end}, which are the starting and ending positions of the text on |
| 575 | which it should act. It is allowed to call @code{syntax-ppss} on any | 575 | which it should act. It is allowed to arbitrarily move point within |
| 576 | position before @var{end}, but if a Lisp program calls | 576 | the region delimited by @var{start} and @var{end}; such motions don't |
| 577 | @code{syntax-ppss} on some position and later modifies the buffer at | 577 | need to use @code{save-excursion} (@pxref{Excursions}). It is also |
| 578 | some earlier position, then it is that program's responsibility to | 578 | allowed to call @code{syntax-ppss} on any position before @var{end}, |
| 579 | call @code{syntax-ppss-flush-cache} to flush the now obsolete info | 579 | but if a Lisp program calls @code{syntax-ppss} on some position and |
| 580 | from the cache. | 580 | later modifies the buffer at some earlier position, then it is that |
| 581 | program's responsibility to call @code{syntax-ppss-flush-cache} to | ||
| 582 | flush the now obsolete info from the cache. | ||
| 581 | 583 | ||
| 582 | @strong{Caution:} When this variable is non-@code{nil}, Emacs removes | 584 | @strong{Caution:} When this variable is non-@code{nil}, Emacs removes |
| 583 | @code{syntax-table} text properties arbitrarily and relies on | 585 | @code{syntax-table} text properties arbitrarily and relies on |
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 36abc316cbb..62c76f09c0d 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi | |||
| @@ -1582,6 +1582,12 @@ buffer-local binding in buffer @var{buffer}, it returns the default | |||
| 1582 | value (@pxref{Default Value}) of @var{variable} instead. | 1582 | value (@pxref{Default Value}) of @var{variable} instead. |
| 1583 | @end defun | 1583 | @end defun |
| 1584 | 1584 | ||
| 1585 | @defun buffer-local-boundp variable buffer | ||
| 1586 | This returns non-@code{nil} if there's either a buffer-local binding | ||
| 1587 | of @var{variable} (a symbol) in buffer @var{buffer}, or @var{variable} | ||
| 1588 | has a global binding. | ||
| 1589 | @end defun | ||
| 1590 | |||
| 1585 | @defun buffer-local-variables &optional buffer | 1591 | @defun buffer-local-variables &optional buffer |
| 1586 | This function returns a list describing the buffer-local variables in | 1592 | This function returns a list describing the buffer-local variables in |
| 1587 | buffer @var{buffer}. (If @var{buffer} is omitted, the current buffer | 1593 | buffer @var{buffer}. (If @var{buffer} is omitted, the current buffer |
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 82d2ce4757b..3b6f74b89cf 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi | |||
| @@ -1318,6 +1318,33 @@ lieu of the usual action of @code{delete-window}. @xref{Window | |||
| 1318 | Parameters}. | 1318 | Parameters}. |
| 1319 | @end deffn | 1319 | @end deffn |
| 1320 | 1320 | ||
| 1321 | When @code{delete-window} deletes the selected window of its frame, it | ||
| 1322 | has to make another window the new selected window of that frame. The | ||
| 1323 | following option allows configuring which window is chosen. | ||
| 1324 | |||
| 1325 | @defopt delete-window-choose-selected | ||
| 1326 | This option allows specifying which window should become a frame's | ||
| 1327 | selected window after @code{delete-window} has deleted the previously | ||
| 1328 | selected one. Possible choices are | ||
| 1329 | |||
| 1330 | @itemize | ||
| 1331 | @item @code{mru} | ||
| 1332 | (the default) choose the most recently used window on that frame. | ||
| 1333 | |||
| 1334 | @item @code{pos} | ||
| 1335 | choose the window comprising the frame coordinates of point of the | ||
| 1336 | previously selected window on that frame. | ||
| 1337 | |||
| 1338 | @item @code{nil} | ||
| 1339 | choose the first window (the window returned by | ||
| 1340 | @code{frame-first-window}) on that frame. | ||
| 1341 | @end itemize | ||
| 1342 | |||
| 1343 | A window with a non-@code{nil} @code{no-other-window} parameter is | ||
| 1344 | chosen only if all other windows on that frame have that parameter set | ||
| 1345 | to a non-@code{nil} value too. | ||
| 1346 | @end defopt | ||
| 1347 | |||
| 1321 | @deffn Command delete-other-windows &optional window | 1348 | @deffn Command delete-other-windows &optional window |
| 1322 | This function makes @var{window} fill its frame, deleting other | 1349 | This function makes @var{window} fill its frame, deleting other |
| 1323 | windows as necessary. If @var{window} is omitted or @code{nil}, it | 1350 | windows as necessary. If @var{window} is omitted or @code{nil}, it |
| @@ -1838,6 +1865,14 @@ with @var{window} as the selected window without needlessly running | |||
| 1838 | @code{buffer-list-update-hook}. | 1865 | @code{buffer-list-update-hook}. |
| 1839 | @end defmac | 1866 | @end defmac |
| 1840 | 1867 | ||
| 1868 | @defmac with-selected-frame frame forms@dots{} | ||
| 1869 | This macro executes @var{forms} with @var{frame} as the selected | ||
| 1870 | frame. The value returned is the value of the last form in | ||
| 1871 | @var{forms}. This macro saves and restores the selected frame, and | ||
| 1872 | changes the order of neither the recently selected windows nor the | ||
| 1873 | buffers in the buffer list. | ||
| 1874 | @end defmac | ||
| 1875 | |||
| 1841 | @defun frame-selected-window &optional frame | 1876 | @defun frame-selected-window &optional frame |
| 1842 | This function returns the window on @var{frame} that is selected | 1877 | This function returns the window on @var{frame} that is selected |
| 1843 | within that frame. @var{frame} should be a live frame; if omitted or | 1878 | within that frame. @var{frame} should be a live frame; if omitted or |
| @@ -1999,7 +2034,7 @@ meaning as for @code{next-window}. | |||
| 1999 | criterion, without selecting it: | 2034 | criterion, without selecting it: |
| 2000 | 2035 | ||
| 2001 | @cindex least recently used window | 2036 | @cindex least recently used window |
| 2002 | @defun get-lru-window &optional all-frames dedicated not-selected | 2037 | @defun get-lru-window &optional all-frames dedicated not-selected no-other |
| 2003 | This function returns a live window which is heuristically the least | 2038 | This function returns a live window which is heuristically the least |
| 2004 | recently used. The optional argument @var{all-frames} has | 2039 | recently used. The optional argument @var{all-frames} has |
| 2005 | the same meaning as in @code{next-window}. | 2040 | the same meaning as in @code{next-window}. |
| @@ -2010,33 +2045,25 @@ window (@pxref{Dedicated Windows}) is never a candidate unless the | |||
| 2010 | optional argument @var{dedicated} is non-@code{nil}. The selected | 2045 | optional argument @var{dedicated} is non-@code{nil}. The selected |
| 2011 | window is never returned, unless it is the only candidate. However, if | 2046 | window is never returned, unless it is the only candidate. However, if |
| 2012 | the optional argument @var{not-selected} is non-@code{nil}, this | 2047 | the optional argument @var{not-selected} is non-@code{nil}, this |
| 2013 | function returns @code{nil} in that case. | 2048 | function returns @code{nil} in that case. The optional argument |
| 2049 | @var{no-other}, if non-@code{nil}, means to never return a window whose | ||
| 2050 | @code{no-other-window} parameter is non-@code{nil}. | ||
| 2014 | @end defun | 2051 | @end defun |
| 2015 | 2052 | ||
| 2016 | @cindex most recently used window | 2053 | @cindex most recently used window |
| 2017 | @defun get-mru-window &optional all-frames dedicated not-selected | 2054 | @defun get-mru-window &optional all-frames dedicated not-selected no-other |
| 2018 | This function is like @code{get-lru-window}, but it returns the most | 2055 | This function is like @code{get-lru-window}, but it returns the most |
| 2019 | recently used window instead. The meaning of the arguments is the | 2056 | recently used window instead. The meaning of the arguments is the |
| 2020 | same as described for @code{get-lru-window}. | 2057 | same as for @code{get-lru-window}. |
| 2021 | @end defun | 2058 | @end defun |
| 2022 | 2059 | ||
| 2023 | @cindex largest window | 2060 | @cindex largest window |
| 2024 | @defun get-largest-window &optional all-frames dedicated not-selected | 2061 | @defun get-largest-window &optional all-frames dedicated not-selected no-other |
| 2025 | This function returns the window with the largest area (height times | 2062 | This function returns the window with the largest area (height times |
| 2026 | width). The optional argument @var{all-frames} specifies the windows to | 2063 | width). If there are two candidate windows of the same size, it prefers |
| 2027 | search, and has the same meaning as in @code{next-window}. | 2064 | the one that comes first in the cyclic ordering of windows, starting |
| 2028 | 2065 | from the selected window. The meaning of the arguments is the same as | |
| 2029 | A minibuffer window is never a candidate. A dedicated window | 2066 | for @code{get-lru-window}. |
| 2030 | (@pxref{Dedicated Windows}) is never a candidate unless the optional | ||
| 2031 | argument @var{dedicated} is non-@code{nil}. The selected window is not | ||
| 2032 | a candidate if the optional argument @var{not-selected} is | ||
| 2033 | non-@code{nil}. If the optional argument @var{not-selected} is | ||
| 2034 | non-@code{nil} and the selected window is the only candidate, this | ||
| 2035 | function returns @code{nil}. | ||
| 2036 | |||
| 2037 | If there are two candidate windows of the same size, this function | ||
| 2038 | prefers the one that comes first in the cyclic ordering of windows, | ||
| 2039 | starting from the selected window. | ||
| 2040 | @end defun | 2067 | @end defun |
| 2041 | 2068 | ||
| 2042 | @cindex window that satisfies a predicate | 2069 | @cindex window that satisfies a predicate |
diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in index da912bd5112..290be604e3b 100644 --- a/doc/man/emacs.1.in +++ b/doc/man/emacs.1.in | |||
| @@ -197,7 +197,7 @@ searches for Lisp files. | |||
| 197 | .\" START DELETING HERE IF YOU'RE NOT USING X | 197 | .\" START DELETING HERE IF YOU'RE NOT USING X |
| 198 | .SS Using Emacs with X | 198 | .SS Using Emacs with X |
| 199 | .I Emacs | 199 | .I Emacs |
| 200 | has been tailored to work well with the X window system. | 200 | has been tailored to work well with the X Window System. |
| 201 | If you run | 201 | If you run |
| 202 | .I Emacs | 202 | .I Emacs |
| 203 | from under X windows, it will create its own X window to | 203 | from under X windows, it will create its own X window to |
| @@ -566,7 +566,7 @@ distribution. | |||
| 566 | /usr/local/share/info \(em files for the Info documentation browser. | 566 | /usr/local/share/info \(em files for the Info documentation browser. |
| 567 | The complete text of the Emacs reference manual is included in a | 567 | The complete text of the Emacs reference manual is included in a |
| 568 | convenient tree structured form. | 568 | convenient tree structured form. |
| 569 | Also includes the Emacs Lisp Reference Manual, useful to anyone | 569 | This includes the Emacs Lisp Reference Manual, useful to anyone |
| 570 | wishing to write programs in the Emacs Lisp extension language, | 570 | wishing to write programs in the Emacs Lisp extension language, |
| 571 | and the Introduction to Programming in Emacs Lisp. | 571 | and the Introduction to Programming in Emacs Lisp. |
| 572 | 572 | ||
diff --git a/doc/man/etags.1 b/doc/man/etags.1 index 354f6ca88b4..cbd3c1a646e 100644 --- a/doc/man/etags.1 +++ b/doc/man/etags.1 | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | .\" See section COPYING for copyright and redistribution information. | 1 | .\" See section COPYING for copyright and redistribution information. |
| 2 | .TH ETAGS 1 "2019-06-24" "GNU Tools" "GNU" | 2 | .TH ETAGS 1 "2021-03-30" "GNU Tools" "GNU" |
| 3 | .de BP | 3 | .de BP |
| 4 | .sp | 4 | .sp |
| 5 | .ti -.2i | 5 | .ti -.2i |
| @@ -50,9 +50,9 @@ format understood by | |||
| 50 | .BR vi ( 1 )\c | 50 | .BR vi ( 1 )\c |
| 51 | \&. Both forms of the program understand | 51 | \&. Both forms of the program understand |
| 52 | the syntax of C, Objective C, C++, Java, Fortran, Ada, Cobol, Erlang, | 52 | the syntax of C, Objective C, C++, Java, Fortran, Ada, Cobol, Erlang, |
| 53 | Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Pascal, Perl, | 53 | Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Mercury, Pascal, |
| 54 | Ruby, Rust, PHP, PostScript, Python, Prolog, Scheme and | 54 | Perl, Ruby, Rust, PHP, PostScript, Python, Prolog, Scheme and most |
| 55 | most assembler\-like syntaxes. | 55 | assembler\-like syntaxes. |
| 56 | Both forms read the files specified on the command line, and write a tag | 56 | Both forms read the files specified on the command line, and write a tag |
| 57 | table (defaults: \fBTAGS\fP for \fBetags\fP, \fBtags\fP for | 57 | table (defaults: \fBTAGS\fP for \fBetags\fP, \fBtags\fP for |
| 58 | \fBctags\fP) in the current working directory. | 58 | \fBctags\fP) in the current working directory. |
| @@ -91,6 +91,9 @@ Only \fBctags\fP accepts this option. | |||
| 91 | In C and derived languages, create tags for function declarations, | 91 | In C and derived languages, create tags for function declarations, |
| 92 | and create tags for extern variables unless \-\-no\-globals is used. | 92 | and create tags for extern variables unless \-\-no\-globals is used. |
| 93 | In Lisp, create tags for (defvar foo) declarations. | 93 | In Lisp, create tags for (defvar foo) declarations. |
| 94 | In Mercury, declarations start a line with "\|\fB:-\fP\|" and are always | ||
| 95 | tagged. In addition, this option tags predicates or functions in first | ||
| 96 | rules of clauses, as in Prolog. | ||
| 94 | .TP | 97 | .TP |
| 95 | .B \-D, \-\-no\-defines | 98 | .B \-D, \-\-no\-defines |
| 96 | Do not create tag entries for C preprocessor constant definitions | 99 | Do not create tag entries for C preprocessor constant definitions |
| @@ -125,10 +128,14 @@ final brace of a function or structure definition in C and C++. | |||
| 125 | Parse the following files according to the given language. More than | 128 | Parse the following files according to the given language. More than |
| 126 | one such options may be intermixed with filenames. Use \fB\-\-help\fP | 129 | one such options may be intermixed with filenames. Use \fB\-\-help\fP |
| 127 | to get a list of the available languages and their default filename | 130 | to get a list of the available languages and their default filename |
| 128 | extensions. The "auto" language can be used to restore automatic | 131 | extensions. For example, as Mercury and Objective-C have same |
| 129 | detection of language based on the file name. The "none" | 132 | filename extension \fI.m\fP, a test based on contents tries to detect |
| 130 | language may be used to disable language parsing altogether; only | 133 | the language. If this test fails, \fB\-\-language=\fP\fImercury\fP or |
| 131 | regexp matching is done in this case (see the \fB\-\-regex\fP option). | 134 | \fB\-\-language=\fP\fIobjc\fP should be used. |
| 135 | The "auto" language can be used to restore automatic detection of language | ||
| 136 | based on the file name. The "none" language may be used to disable language | ||
| 137 | parsing altogether; only regexp matching is done in this case (see the | ||
| 138 | \fB\-\-regex\fP option). | ||
| 132 | .TP | 139 | .TP |
| 133 | .B \-\-members | 140 | .B \-\-members |
| 134 | Create tag entries for variables that are members of structure-like | 141 | Create tag entries for variables that are members of structure-like |
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 4952e909902..63b42827311 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi | |||
| @@ -115,10 +115,10 @@ Each class can have methods, which are defined like this: | |||
| 115 | (cl-defmethod call-person ((pers person) &optional scriptname) | 115 | (cl-defmethod call-person ((pers person) &optional scriptname) |
| 116 | "Dial the phone for the person PERS. | 116 | "Dial the phone for the person PERS. |
| 117 | Execute the program SCRIPTNAME to dial the phone." | 117 | Execute the program SCRIPTNAME to dial the phone." |
| 118 | (message "Dialing the phone for %s" (oref pers name)) | 118 | (message "Dialing the phone for %s" (slot-value pers 'name)) |
| 119 | (shell-command (concat (or scriptname "dialphone.sh") | 119 | (shell-command (concat (or scriptname "dialphone.sh") |
| 120 | " " | 120 | " " |
| 121 | (oref pers phone)))) | 121 | (slot-value pers 'phone)))) |
| 122 | @end example | 122 | @end example |
| 123 | 123 | ||
| 124 | @noindent | 124 | @noindent |
| @@ -693,16 +693,43 @@ for each slot. For example: | |||
| 693 | @node Accessing Slots | 693 | @node Accessing Slots |
| 694 | @chapter Accessing Slots | 694 | @chapter Accessing Slots |
| 695 | 695 | ||
| 696 | There are several ways to access slot values in an object. The naming | 696 | There are several ways to access slot values in an object. |
| 697 | and argument-order conventions are similar to those used for | 697 | The following accessors are defined by CLOS to reference or modify |
| 698 | referencing vectors (@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference | 698 | slot values, and use the previously mentioned set/ref routines. |
| 699 | Manual}). | 699 | |
| 700 | @defun slot-value object slot | ||
| 701 | @anchor{slot-value} | ||
| 702 | This function retrieves the value of @var{slot} from @var{object}. | ||
| 703 | |||
| 704 | This is a generalized variable that can be used with @code{setf} to | ||
| 705 | modify the value stored in @var{slot}. @xref{Generalized | ||
| 706 | Variables,,,elisp,GNU Emacs Lisp Reference Manual}. | ||
| 707 | @end defun | ||
| 708 | |||
| 709 | @defun set-slot-value object slot value | ||
| 710 | @anchor{set-slot-value} | ||
| 711 | This function sets the value of @var{slot} from @var{object}. | ||
| 712 | |||
| 713 | This is not a CLOS function, but is the obsolete setter for | ||
| 714 | @code{slot-value} used by the @code{setf} macro. It is therefore | ||
| 715 | recommended to use @w{@code{(setf (slot-value @var{object} @var{slot}) | ||
| 716 | @var{value})}} instead. | ||
| 717 | @end defun | ||
| 718 | |||
| 719 | @defun slot-makeunbound object slot | ||
| 720 | This function unbinds @var{slot} in @var{object}. Referencing an | ||
| 721 | unbound slot can signal an error. | ||
| 722 | @end defun | ||
| 723 | |||
| 724 | The following accessors follow a naming and argument-order conventions | ||
| 725 | are similar to those used for referencing vectors | ||
| 726 | (@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference Manual}). | ||
| 700 | 727 | ||
| 701 | @defmac oref obj slot | 728 | @defmac oref obj slot |
| 702 | @anchor{oref} | 729 | @anchor{oref} |
| 703 | This macro retrieves the value stored in @var{obj} in the named | 730 | This macro retrieves the value stored in @var{obj} in the named |
| 704 | @var{slot}. Slot names are determined by @code{defclass} which | 731 | @var{slot}. Unlike @code{slot-value}, the symbol for @var{slot} must |
| 705 | creates the slot. | 732 | not be quoted. |
| 706 | 733 | ||
| 707 | This is a generalized variable that can be used with @code{setf} to | 734 | This is a generalized variable that can be used with @code{setf} to |
| 708 | modify the value stored in @var{slot}. @xref{Generalized | 735 | modify the value stored in @var{slot}. @xref{Generalized |
| @@ -737,35 +764,6 @@ changed, this can be arranged by simply executing this bit of code: | |||
| 737 | @end example | 764 | @end example |
| 738 | @end defmac | 765 | @end defmac |
| 739 | 766 | ||
| 740 | The following accessors are defined by CLOS to reference or modify | ||
| 741 | slot values, and use the previously mentioned set/ref routines. | ||
| 742 | |||
| 743 | @defun slot-value object slot | ||
| 744 | @anchor{slot-value} | ||
| 745 | This function retrieves the value of @var{slot} from @var{object}. | ||
| 746 | Unlike @code{oref}, the symbol for @var{slot} must be quoted. | ||
| 747 | |||
| 748 | This is a generalized variable that can be used with @code{setf} to | ||
| 749 | modify the value stored in @var{slot}. @xref{Generalized | ||
| 750 | Variables,,,elisp,GNU Emacs Lisp Reference Manual}. | ||
| 751 | @end defun | ||
| 752 | |||
| 753 | @defun set-slot-value object slot value | ||
| 754 | @anchor{set-slot-value} | ||
| 755 | This function sets the value of @var{slot} from @var{object}. Unlike | ||
| 756 | @code{oset}, the symbol for @var{slot} must be quoted. | ||
| 757 | |||
| 758 | This is not a CLOS function, but is the obsolete setter for | ||
| 759 | @code{slot-value} used by the @code{setf} macro. It is therefore | ||
| 760 | recommended to use @w{@code{(setf (slot-value @var{object} @var{slot}) | ||
| 761 | @var{value})}} instead. | ||
| 762 | @end defun | ||
| 763 | |||
| 764 | @defun slot-makeunbound object slot | ||
| 765 | This function unbinds @var{slot} in @var{object}. Referencing an | ||
| 766 | unbound slot can signal an error. | ||
| 767 | @end defun | ||
| 768 | |||
| 769 | @defun object-add-to-list object slot item &optional append | 767 | @defun object-add-to-list object slot item &optional append |
| 770 | @anchor{object-add-to-list} | 768 | @anchor{object-add-to-list} |
| 771 | In OBJECT's @var{slot}, add @var{item} to the list of elements. | 769 | In OBJECT's @var{slot}, add @var{item} to the list of elements. |
| @@ -807,7 +805,7 @@ Where each @var{var} is the local variable given to the associated | |||
| 807 | variable name of the same name as the slot. | 805 | variable name of the same name as the slot. |
| 808 | 806 | ||
| 809 | @example | 807 | @example |
| 810 | (defclass myclass () (x :initform 1)) | 808 | (defclass myclass () ((x :initform 1))) |
| 811 | (setq mc (make-instance 'myclass)) | 809 | (setq mc (make-instance 'myclass)) |
| 812 | (with-slots (x) mc x) => 1 | 810 | (with-slots (x) mc x) => 1 |
| 813 | (with-slots ((something x)) mc something) => 1 | 811 | (with-slots ((something x)) mc something) => 1 |
| @@ -981,8 +979,8 @@ the @code{subclass} specializer with @code{cl-defmethod}: | |||
| 981 | new)) | 979 | new)) |
| 982 | @end example | 980 | @end example |
| 983 | 981 | ||
| 984 | The first argument of a static method will be a class rather than an | 982 | The argument of a static method will be a class rather than an object. |
| 985 | object. Use the functions @code{oref-default} or @code{oset-default} which | 983 | Use the functions @code{oref-default} or @code{oset-default} which |
| 986 | will work on a class. | 984 | will work on a class. |
| 987 | 985 | ||
| 988 | A class's @code{make-instance} method is defined as a static | 986 | A class's @code{make-instance} method is defined as a static |
| @@ -1238,12 +1236,6 @@ of CLOS. | |||
| 1238 | Return the list of public slots for @var{obj}. | 1236 | Return the list of public slots for @var{obj}. |
| 1239 | @end defun | 1237 | @end defun |
| 1240 | 1238 | ||
| 1241 | @defun class-slot-initarg class slot | ||
| 1242 | For the given @var{class} return an :initarg associated with | ||
| 1243 | @var{slot}. Not all slots have initargs, so the return value can be | ||
| 1244 | @code{nil}. | ||
| 1245 | @end defun | ||
| 1246 | |||
| 1247 | @node Base Classes | 1239 | @node Base Classes |
| 1248 | @chapter Base Classes | 1240 | @chapter Base Classes |
| 1249 | 1241 | ||
| @@ -1656,8 +1648,8 @@ Method invoked when an attempt to access a slot in @var{object} fails. | |||
| 1656 | that was requested, and optional @var{new-value} is the value that was desired | 1648 | that was requested, and optional @var{new-value} is the value that was desired |
| 1657 | to be set. | 1649 | to be set. |
| 1658 | 1650 | ||
| 1659 | This method is called from @code{oref}, @code{oset}, and other functions which | 1651 | This method is called from @code{slot-value}, @code{set-slot-value}, |
| 1660 | directly reference slots in EIEIO objects. | 1652 | and other functions which directly reference slots in EIEIO objects. |
| 1661 | 1653 | ||
| 1662 | The default method signals an error of type @code{invalid-slot-name}. | 1654 | The default method signals an error of type @code{invalid-slot-name}. |
| 1663 | @xref{Signals}. | 1655 | @xref{Signals}. |
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 0cf5ba96506..7cd3e5f5828 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi | |||
| @@ -1870,6 +1870,11 @@ A customizable list of viewers that take preference over | |||
| 1870 | Interface functions: | 1870 | Interface functions: |
| 1871 | 1871 | ||
| 1872 | @table @code | 1872 | @table @code |
| 1873 | @item mailcap-view-file | ||
| 1874 | @findex mailcap-view-file | ||
| 1875 | Prompt for a file name, and start a viewer applicable for the file | ||
| 1876 | type in question. | ||
| 1877 | |||
| 1873 | @item mailcap-parse-mailcaps | 1878 | @item mailcap-parse-mailcaps |
| 1874 | @findex mailcap-parse-mailcaps | 1879 | @findex mailcap-parse-mailcaps |
| 1875 | @vindex mailcap-prefer-mailcap-viewers | 1880 | @vindex mailcap-prefer-mailcap-viewers |
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 213b69e1ef2..77a19a4a593 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi | |||
| @@ -518,7 +518,7 @@ That is, if called with the following arguments, @var{server} and | |||
| 518 | for the values of the other parameters. | 518 | for the values of the other parameters. |
| 519 | 519 | ||
| 520 | @example | 520 | @example |
| 521 | (erc :server "chat.freenode.net" :full-name "Harry S Truman") | 521 | (erc :server "chat.freenode.net" :full-name "J. Random Hacker") |
| 522 | @end example | 522 | @end example |
| 523 | @end defun | 523 | @end defun |
| 524 | 524 | ||
| @@ -545,7 +545,7 @@ for the values of the other parameters, and @code{client-certificate} | |||
| 545 | will be @code{nil}. | 545 | will be @code{nil}. |
| 546 | 546 | ||
| 547 | @example | 547 | @example |
| 548 | (erc-tls :server "chat.freenode.net" :full-name "Harry S Truman") | 548 | (erc-tls :server "chat.freenode.net" :full-name "J. Random Hacker") |
| 549 | @end example | 549 | @end example |
| 550 | 550 | ||
| 551 | To use a certificate with @code{erc-tls}, specify the optional | 551 | To use a certificate with @code{erc-tls}, specify the optional |
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 7d6fa4cb5ca..b63947c044f 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi | |||
| @@ -2583,25 +2583,28 @@ with the process mark and then execute the command. | |||
| 2583 | @itemx M m | 2583 | @itemx M m |
| 2584 | @kindex M m @r{(Group)} | 2584 | @kindex M m @r{(Group)} |
| 2585 | @findex gnus-group-mark-group | 2585 | @findex gnus-group-mark-group |
| 2586 | Set the mark on the current group (@code{gnus-group-mark-group}). | 2586 | Toggle the process mark for the current group |
| 2587 | (@code{gnus-group-mark-group}).@* | ||
| 2588 | If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark | ||
| 2589 | for the current group. | ||
| 2587 | 2590 | ||
| 2588 | @item M-# | 2591 | @item M-# |
| 2589 | @kindex M-# @r{(Group)} | 2592 | @kindex M-# @r{(Group)} |
| 2590 | @itemx M u | 2593 | @itemx M u |
| 2591 | @kindex M u @r{(Group)} | 2594 | @kindex M u @r{(Group)} |
| 2592 | @findex gnus-group-unmark-group | 2595 | @findex gnus-group-unmark-group |
| 2593 | Remove the mark from the current group | 2596 | Remove the process mark, if any, from the current group |
| 2594 | (@code{gnus-group-unmark-group}). | 2597 | (@code{gnus-group-unmark-group}). |
| 2595 | 2598 | ||
| 2596 | @item M U | 2599 | @item M U |
| 2597 | @kindex M U @r{(Group)} | 2600 | @kindex M U @r{(Group)} |
| 2598 | @findex gnus-group-unmark-all-groups | 2601 | @findex gnus-group-unmark-all-groups |
| 2599 | Remove the mark from all groups (@code{gnus-group-unmark-all-groups}). | 2602 | Remove the process mark from all groups (@code{gnus-group-unmark-all-groups}). |
| 2600 | 2603 | ||
| 2601 | @item M w | 2604 | @item M w |
| 2602 | @kindex M w @r{(Group)} | 2605 | @kindex M w @r{(Group)} |
| 2603 | @findex gnus-group-mark-region | 2606 | @findex gnus-group-mark-region |
| 2604 | Mark all groups between point and mark (@code{gnus-group-mark-region}). | 2607 | Mark groups in region (@code{gnus-group-mark-region}). |
| 2605 | 2608 | ||
| 2606 | @item M b | 2609 | @item M b |
| 2607 | @kindex M b @r{(Group)} | 2610 | @kindex M b @r{(Group)} |
| @@ -4041,9 +4044,11 @@ Toggle hiding empty topics | |||
| 4041 | @item T # | 4044 | @item T # |
| 4042 | @kindex T # @r{(Topic)} | 4045 | @kindex T # @r{(Topic)} |
| 4043 | @findex gnus-topic-mark-topic | 4046 | @findex gnus-topic-mark-topic |
| 4044 | Mark all groups in the current topic with the process mark | 4047 | Toggle the process mark for all groups in the current topic |
| 4045 | (@code{gnus-topic-mark-topic}). This command works recursively on | 4048 | (@code{gnus-topic-mark-topic}). This command works recursively on |
| 4046 | sub-topics unless given a prefix. | 4049 | sub-topics unless given a prefix.@* |
| 4050 | If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark | ||
| 4051 | for the current topic. | ||
| 4047 | 4052 | ||
| 4048 | @item T M-# | 4053 | @item T M-# |
| 4049 | @kindex T M-# @r{(Topic)} | 4054 | @kindex T M-# @r{(Topic)} |
| @@ -5241,6 +5246,12 @@ have to disable fetching headers with @samp{XOVER}: | |||
| 5241 | Be aware, though, that this will make entering an @acronym{NNTP} group | 5246 | Be aware, though, that this will make entering an @acronym{NNTP} group |
| 5242 | much, much slower, so this is not recommended. | 5247 | much, much slower, so this is not recommended. |
| 5243 | 5248 | ||
| 5249 | One particular scenario in which it can be desirable to not use | ||
| 5250 | @samp{XOVER} is for @code{nnvirtual} groups in order to support | ||
| 5251 | limiting by extra headers (e.g., by the newsgroup of its component | ||
| 5252 | groups). Because group parameters are not inherited, a separate | ||
| 5253 | select method for the component groups with the appropriate | ||
| 5254 | @code{nov-is-evil} set as a method variable is required. | ||
| 5244 | 5255 | ||
| 5245 | @node Summary Buffer Mode Line | 5256 | @node Summary Buffer Mode Line |
| 5246 | @subsection Summary Buffer Mode Line | 5257 | @subsection Summary Buffer Mode Line |
| @@ -6617,14 +6628,16 @@ articles into the cache. For more information, | |||
| 6617 | @kindex # @r{(Summary)} | 6628 | @kindex # @r{(Summary)} |
| 6618 | @kindex M P p @r{(Summary)} | 6629 | @kindex M P p @r{(Summary)} |
| 6619 | @findex gnus-summary-mark-as-processable | 6630 | @findex gnus-summary-mark-as-processable |
| 6620 | Mark the current article with the process mark | 6631 | Toggle the process mark for the current article |
| 6621 | (@code{gnus-summary-mark-as-processable}). | 6632 | (@code{gnus-summary-mark-as-processable}).@* |
| 6622 | @findex gnus-summary-unmark-as-processable | 6633 | If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark |
| 6634 | for the current article. | ||
| 6623 | 6635 | ||
| 6624 | @item M P u | 6636 | @item M P u |
| 6625 | @itemx M-# | 6637 | @itemx M-# |
| 6626 | @kindex M P u @r{(Summary)} | 6638 | @kindex M P u @r{(Summary)} |
| 6627 | @kindex M-# @r{(Summary)} | 6639 | @kindex M-# @r{(Summary)} |
| 6640 | @findex gnus-summary-unmark-as-processable | ||
| 6628 | Remove the process mark, if any, from the current article | 6641 | Remove the process mark, if any, from the current article |
| 6629 | (@code{gnus-summary-unmark-as-processable}). | 6642 | (@code{gnus-summary-unmark-as-processable}). |
| 6630 | 6643 | ||
| @@ -10562,13 +10575,15 @@ Here are the available keystrokes when using pick mode: | |||
| 10562 | @item . | 10575 | @item . |
| 10563 | @kindex . @r{(Pick)} | 10576 | @kindex . @r{(Pick)} |
| 10564 | @findex gnus-pick-article-or-thread | 10577 | @findex gnus-pick-article-or-thread |
| 10565 | Pick the article or thread on the current line | 10578 | Pick the article or thread on the current line or unpick it if is |
| 10566 | (@code{gnus-pick-article-or-thread}). If the variable | 10579 | already picked (@code{gnus-pick-article-or-thread}). If the variable |
| 10567 | @code{gnus-thread-hide-subtree} is true, then this key selects the | 10580 | @code{gnus-thread-hide-subtree} is true, then this key selects the |
| 10568 | entire thread when used at the first article of the thread. Otherwise, | 10581 | entire thread when used at the first article of the thread. Otherwise, |
| 10569 | it selects just the article. If given a numerical prefix, go to that | 10582 | it selects just the article. If given a numerical prefix, go to that |
| 10570 | thread or article and pick it. (The line number is normally displayed | 10583 | thread or article and pick it. (The line number is normally displayed |
| 10571 | at the beginning of the summary pick lines.) | 10584 | at the beginning of the summary pick lines.) If |
| 10585 | @code{gnus-process-mark-toggle} is @code{nil}, this key will pick an | ||
| 10586 | article or thread. | ||
| 10572 | 10587 | ||
| 10573 | @item @key{SPC} | 10588 | @item @key{SPC} |
| 10574 | @kindex SPC @r{(Pick)} | 10589 | @kindex SPC @r{(Pick)} |
| @@ -112,6 +112,17 @@ filters. | |||
| 112 | * Changes in Emacs 28.1 | 112 | * Changes in Emacs 28.1 |
| 113 | 113 | ||
| 114 | +++ | 114 | +++ |
| 115 | ** Etags now supports the Mercury programming language. | ||
| 116 | See https://mercurylang.org. | ||
| 117 | |||
| 118 | +++ | ||
| 119 | ** Etags command line option '--declarations' now has Mercury-specific behavior. | ||
| 120 | All Mercury declarations are tagged by default. However, for | ||
| 121 | compatibility with 'etags' support for Prolog, predicates and | ||
| 122 | functions appearing first in clauses will also be tagged if 'etags' is | ||
| 123 | invoked with the '--declarations' command-line option. | ||
| 124 | |||
| 125 | +++ | ||
| 115 | ** New command 'font-lock-update', bound to 'C-x x f'. | 126 | ** New command 'font-lock-update', bound to 'C-x x f'. |
| 116 | This command updates the syntax highlighting in this buffer. | 127 | This command updates the syntax highlighting in this buffer. |
| 117 | 128 | ||
| @@ -295,6 +306,17 @@ default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more | |||
| 295 | about the different options to visit a file, how you can disable the | 306 | about the different options to visit a file, how you can disable the |
| 296 | prompt, and how you can tweak the file size threshold. | 307 | prompt, and how you can tweak the file size threshold. |
| 297 | 308 | ||
| 309 | +++ | ||
| 310 | ** Improved support for terminal emulators that encode the Meta flag. | ||
| 311 | Some terminal emulators set the 8th bit of Meta characters, and then | ||
| 312 | encode the resulting character code as if it were non-ASCII character | ||
| 313 | above codepoint 127. Previously, the only way of using these in Emacs | ||
| 314 | was to set up the terminal emulator to use the 'ESC' characters to send | ||
| 315 | Meta characters to Emacs, e.g., send "ESC x" when the user types | ||
| 316 | 'M-x'. You can now avoid the need for this setup of such terminal | ||
| 317 | emulators by using the new input-meta-mode with the special value | ||
| 318 | 'encoded' with these terminal emulators. | ||
| 319 | |||
| 298 | 320 | ||
| 299 | * Editing Changes in Emacs 28.1 | 321 | * Editing Changes in Emacs 28.1 |
| 300 | 322 | ||
| @@ -510,6 +532,13 @@ When emacsclient connects, Emacs will (by default) output a message | |||
| 510 | about how to exit the client frame. If 'server-client-instructions' | 532 | about how to exit the client frame. If 'server-client-instructions' |
| 511 | is set to nil, this message is inhibited. | 533 | is set to nil, this message is inhibited. |
| 512 | 534 | ||
| 535 | +++ | ||
| 536 | *** New command 'server-edit-abort'. | ||
| 537 | This command (not bound to any key by default) can be used to abort | ||
| 538 | an edit instead of marking it as "Done" (which the 'C-x #' command | ||
| 539 | does). The 'emacsclient' program exits with an abnormal status as | ||
| 540 | result of this command. | ||
| 541 | |||
| 513 | ** Perl mode | 542 | ** Perl mode |
| 514 | 543 | ||
| 515 | --- | 544 | --- |
| @@ -534,9 +563,23 @@ indentation is done using SMIE or with the old ad-hoc code. | |||
| 534 | ** Icomplete | 563 | ** Icomplete |
| 535 | 564 | ||
| 536 | +++ | 565 | +++ |
| 537 | *** New minor mode 'icomplete-vertical-mode'. | 566 | *** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode'. |
| 538 | This mode is intended to be used with Icomplete or Fido, to display the | 567 | This mode is intended to be used with Icomplete ('M-x icomplete-mode') |
| 539 | list of completions candidates vertically instead of horizontally. | 568 | or Fido ('M-x fido-mode'), to display the list of completions |
| 569 | candidates vertically instead of horizontally. When used with | ||
| 570 | Icomplete, completions are rotated and selection kept at the top. | ||
| 571 | When used with Fido, completions scroll like a typical dropdown | ||
| 572 | widget. | ||
| 573 | |||
| 574 | *** Default value of 'icomplete-compute-delay' has been changed to 0.15 s. | ||
| 575 | |||
| 576 | *** Default value of 'icomplete-max-delay-chars' has been changed to 2. | ||
| 577 | |||
| 578 | *** Reduced blinking while completing the next completions set. | ||
| 579 | Icomplete doesn't hide the hint with the previously computed | ||
| 580 | completions anymore when compute delay is in effect, or the previous | ||
| 581 | computation has been aborted by input. Instead it shows the previous | ||
| 582 | completions until the new ones are ready. | ||
| 540 | 583 | ||
| 541 | --- | 584 | --- |
| 542 | ** Specific warnings can now be disabled from the warning buffer. | 585 | ** Specific warnings can now be disabled from the warning buffer. |
| @@ -551,9 +594,28 @@ disabled entirely. | |||
| 551 | --- | 594 | --- |
| 552 | *** Autoload the main entry point 'mspool-show'. | 595 | *** Autoload the main entry point 'mspool-show'. |
| 553 | 596 | ||
| 597 | ** Windmove | ||
| 598 | |||
| 599 | *** New user options to customize windmove keybindings. | ||
| 600 | These options include 'windmove-default-keybindings', | ||
| 601 | 'windmove-display-default-keybindings', | ||
| 602 | 'windmove-delete-default-keybindings', | ||
| 603 | 'windmove-swap-states-default-keybindings'. | ||
| 604 | |||
| 554 | ** Windows | 605 | ** Windows |
| 555 | 606 | ||
| 556 | +++ | 607 | +++ |
| 608 | *** New option 'delete-window-choose-selected'. | ||
| 609 | This allows to choose a frame's selected window after deleting the | ||
| 610 | previously selected one. | ||
| 611 | |||
| 612 | +++ | ||
| 613 | *** New argument NO-OTHER for some window functions. | ||
| 614 | 'get-lru-window', ‘get-mru-window’ and 'get-largest-window' now accept a | ||
| 615 | new optional argument NO-OTHER which, if non-nil, avoids returning a | ||
| 616 | window whose 'no-other-window' parameter is non-nil. | ||
| 617 | |||
| 618 | +++ | ||
| 557 | *** New 'display-buffer' function 'display-buffer-use-least-recent-window'. | 619 | *** New 'display-buffer' function 'display-buffer-use-least-recent-window'. |
| 558 | This is like 'display-buffer-use-some-window', but won't reuse the | 620 | This is like 'display-buffer-use-some-window', but won't reuse the |
| 559 | current window, and when called repeatedly will try not to reuse a | 621 | current window, and when called repeatedly will try not to reuse a |
| @@ -829,9 +891,23 @@ If non-nil, only branches and remotes are considered when doing | |||
| 829 | completion over Git branch names. The default is nil, which causes | 891 | completion over Git branch names. The default is nil, which causes |
| 830 | tags to be considered as well. | 892 | tags to be considered as well. |
| 831 | 893 | ||
| 894 | --- | ||
| 895 | *** New user option 'vc-git-log-switches'. | ||
| 896 | String or list of strings specifying switches for Git log under VC. | ||
| 897 | |||
| 832 | ** Gnus | 898 | ** Gnus |
| 833 | 899 | ||
| 834 | +++ | 900 | +++ |
| 901 | *** The '#' command in the Group and Summary buffer now toggles, | ||
| 902 | instead of sets, the process mark. | ||
| 903 | |||
| 904 | +++ | ||
| 905 | *** New user option 'gnus-process-mark-toggle'. | ||
| 906 | If non-nil (the default), the '#' command in the Group and Summary | ||
| 907 | buffers will toggle, instead of set, the process mark. | ||
| 908 | |||
| 909 | |||
| 910 | +++ | ||
| 835 | *** New user option 'gnus-registry-register-all'. | 911 | *** New user option 'gnus-registry-register-all'. |
| 836 | If non-nil (the default), create registry entries for all messages. | 912 | If non-nil (the default), create registry entries for all messages. |
| 837 | If nil, don't automatically create entries, they must be created | 913 | If nil, don't automatically create entries, they must be created |
| @@ -1037,6 +1113,15 @@ grep-like tools. | |||
| 1037 | On systems where the grep command supports it, directories will be | 1113 | On systems where the grep command supports it, directories will be |
| 1038 | skipped. | 1114 | skipped. |
| 1039 | 1115 | ||
| 1116 | *** Commands that use 'grep-find' now follow symlinks for command-line args. | ||
| 1117 | This is because the default value of 'grep-find-template' now includes | ||
| 1118 | the 'find' option '-H'. Commands that use that variable, including | ||
| 1119 | indirectly via a call to 'xref-matches-in-directory', might be | ||
| 1120 | affected. In particular, there should be no need anymore to ensure | ||
| 1121 | any directory names on the 'find' command lines end in a slash. | ||
| 1122 | This change is for better compatibility with old versions of non-GNU | ||
| 1123 | 'find', such as the one used on macOS. | ||
| 1124 | |||
| 1040 | ** Help | 1125 | ** Help |
| 1041 | 1126 | ||
| 1042 | --- | 1127 | --- |
| @@ -1057,14 +1142,14 @@ GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t. | |||
| 1057 | +++ | 1142 | +++ |
| 1058 | *** New command 'describe-command' shows help for a command. | 1143 | *** New command 'describe-command' shows help for a command. |
| 1059 | This can be used instead of 'describe-function' for interactive | 1144 | This can be used instead of 'describe-function' for interactive |
| 1060 | commands and is globally bound to `C-h x'. | 1145 | commands and is globally bound to 'C-h x'. |
| 1061 | 1146 | ||
| 1062 | +++ | 1147 | +++ |
| 1063 | *** New command 'describe-keymap' describes keybindings in a keymap. | 1148 | *** New command 'describe-keymap' describes keybindings in a keymap. |
| 1064 | 1149 | ||
| 1065 | --- | 1150 | --- |
| 1066 | *** New user option 'describe-bindings-outline'. | 1151 | *** New user option 'describe-bindings-outline'. |
| 1067 | It enables outlines in the output buffer of `describe-bindings' that | 1152 | It enables outlines in the output buffer of 'describe-bindings' that |
| 1068 | can provide a better overview in a long list of available bindings. | 1153 | can provide a better overview in a long list of available bindings. |
| 1069 | 1154 | ||
| 1070 | --- | 1155 | --- |
| @@ -1252,6 +1337,12 @@ it when producing a doc string. | |||
| 1252 | This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the | 1337 | This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the |
| 1253 | command line under point (and any following output). | 1338 | command line under point (and any following output). |
| 1254 | 1339 | ||
| 1340 | --- | ||
| 1341 | *** New user option 'shell-has-auto-cd'. | ||
| 1342 | If non-nil, 'shell-mode' handles implicit "cd" commands, changing the | ||
| 1343 | directory if the command is a directory. Useful for shells like "zsh" | ||
| 1344 | that has this feature. | ||
| 1345 | |||
| 1255 | ** Eshell | 1346 | ** Eshell |
| 1256 | 1347 | ||
| 1257 | --- | 1348 | --- |
| @@ -1541,6 +1632,11 @@ symbol property to the browsing commands. With a new command | |||
| 1541 | 'browse-url-with-browser-kind', an URL can explicitly be browsed with | 1632 | 'browse-url-with-browser-kind', an URL can explicitly be browsed with |
| 1542 | either an internal or external browser. | 1633 | either an internal or external browser. |
| 1543 | 1634 | ||
| 1635 | --- | ||
| 1636 | *** Support for browsing of remote files. | ||
| 1637 | If a remote file is taken, a local temporary copy of that file is | ||
| 1638 | passed to the browser. | ||
| 1639 | |||
| 1544 | *** Support for the conkeror browser is now obsolete. | 1640 | *** Support for the conkeror browser is now obsolete. |
| 1545 | 1641 | ||
| 1546 | *** Support for the Mosaic browser has been removed. | 1642 | *** Support for the Mosaic browser has been removed. |
| @@ -1991,6 +2087,15 @@ Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. | |||
| 1991 | 2087 | ||
| 1992 | ** Miscellaneous | 2088 | ** Miscellaneous |
| 1993 | 2089 | ||
| 2090 | --- | ||
| 2091 | *** New variable 'hl-line-overlay-priority'. | ||
| 2092 | This can be used to change the priority of the hl-line overlays. | ||
| 2093 | |||
| 2094 | +++ | ||
| 2095 | *** New command 'mailcap-view-file'. | ||
| 2096 | This command will open a viewer based on the file type, as determined | ||
| 2097 | by "~/.mailcap" and related files and variables. | ||
| 2098 | |||
| 1994 | +++ | 2099 | +++ |
| 1995 | *** New command 'C-x C-k Q' to force redisplay in keyboard macros. | 2100 | *** New command 'C-x C-k Q' to force redisplay in keyboard macros. |
| 1996 | 2101 | ||
| @@ -2451,6 +2556,13 @@ similar to prefix arguments, but are more flexible and discoverable. | |||
| 2451 | 2556 | ||
| 2452 | * Incompatible Editing Changes in Emacs 28.1 | 2557 | * Incompatible Editing Changes in Emacs 28.1 |
| 2453 | 2558 | ||
| 2559 | ** 'electric-indent-mode' now also indents inside strings and comments, | ||
| 2560 | (unless the indentation function doesn't, of course). | ||
| 2561 | To recover the previous behavior you can use: | ||
| 2562 | |||
| 2563 | (add-hook 'electric-indent-functions | ||
| 2564 | (lambda (_) (if (nth 8 (syntax-ppss)) 'no-indent))) | ||
| 2565 | |||
| 2454 | ** The 'M-o' ('facemenu-keymap') global binding has been removed. | 2566 | ** The 'M-o' ('facemenu-keymap') global binding has been removed. |
| 2455 | To restore the old binding, say something like: | 2567 | To restore the old binding, say something like: |
| 2456 | 2568 | ||
| @@ -2502,7 +2614,7 @@ In previous versions of Emacs, numbers with a trailing dot and an exponent | |||
| 2502 | were read as integers and the exponent ignored: 2.e6 was interpreted as the | 2614 | were read as integers and the exponent ignored: 2.e6 was interpreted as the |
| 2503 | integer 2. Such numerals are now read as floats with the exponent included: | 2615 | integer 2. Such numerals are now read as floats with the exponent included: |
| 2504 | 2.e6 is now read as the floating-point value 2000000.0. | 2616 | 2.e6 is now read as the floating-point value 2000000.0. |
| 2505 | That is, (read-from-string "1.e3") => (1000.0 . 4) now. | 2617 | That is, '(read-from-string "1.e3")' => '(1000.0 . 4)' now. |
| 2506 | 2618 | ||
| 2507 | +++ | 2619 | +++ |
| 2508 | ** The 'lexical-binding' local variable is always enabled. | 2620 | ** The 'lexical-binding' local variable is always enabled. |
| @@ -2711,7 +2823,7 @@ form should be exceedingly rare. See the Info node "(elisp) Backtracking" in | |||
| 2711 | the Emacs Lisp reference manual for background. | 2823 | the Emacs Lisp reference manual for background. |
| 2712 | 2824 | ||
| 2713 | --- | 2825 | --- |
| 2714 | ** 'sql-*-statement-starters' are no longer defcustoms. | 2826 | ** 'sql-*-statement-starters' are no longer user options. |
| 2715 | These variables describe facts about the SQL standard and | 2827 | These variables describe facts about the SQL standard and |
| 2716 | product-specific additions. There should be no need for users to | 2828 | product-specific additions. There should be no need for users to |
| 2717 | customize them. | 2829 | customize them. |
| @@ -2719,6 +2831,10 @@ customize them. | |||
| 2719 | 2831 | ||
| 2720 | * Lisp Changes in Emacs 28.1 | 2832 | * Lisp Changes in Emacs 28.1 |
| 2721 | 2833 | ||
| 2834 | +++ | ||
| 2835 | ** New function 'buffer-local-boundp'. | ||
| 2836 | This predicate says whether a symbol is bound in a specific buffer. | ||
| 2837 | |||
| 2722 | --- | 2838 | --- |
| 2723 | ** Emacs now attempts to test for high-rate subprocess output more fairly. | 2839 | ** Emacs now attempts to test for high-rate subprocess output more fairly. |
| 2724 | When several subprocesses produce output simultaneously at high rate, | 2840 | When several subprocesses produce output simultaneously at high rate, |
diff --git a/lib-src/etags.c b/lib-src/etags.c index d703183cef7..9f20e44caf4 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c | |||
| @@ -142,7 +142,14 @@ University of California, as described above. */ | |||
| 142 | # define CTAGS false | 142 | # define CTAGS false |
| 143 | #endif | 143 | #endif |
| 144 | 144 | ||
| 145 | /* Copy to DEST from SRC (containing LEN bytes), and append a NUL byte. */ | 145 | /* Define MERCURY_HEURISTICS_RATIO as it was necessary to disambiguate |
| 146 | Mercury from Objective C, which have same file extensions .m | ||
| 147 | See comments before function test_objc_is_mercury for details. */ | ||
| 148 | #ifndef MERCURY_HEURISTICS_RATIO | ||
| 149 | # define MERCURY_HEURISTICS_RATIO 0.5 | ||
| 150 | #endif | ||
| 151 | |||
| 152 | /* COPY to DEST from SRC (containing LEN bytes), and append a NUL byte. */ | ||
| 146 | static void | 153 | static void |
| 147 | memcpyz (void *dest, void const *src, ptrdiff_t len) | 154 | memcpyz (void *dest, void const *src, ptrdiff_t len) |
| 148 | { | 155 | { |
| @@ -359,6 +366,7 @@ static void HTML_labels (FILE *); | |||
| 359 | static void Lisp_functions (FILE *); | 366 | static void Lisp_functions (FILE *); |
| 360 | static void Lua_functions (FILE *); | 367 | static void Lua_functions (FILE *); |
| 361 | static void Makefile_targets (FILE *); | 368 | static void Makefile_targets (FILE *); |
| 369 | static void Mercury_functions (FILE *); | ||
| 362 | static void Pascal_functions (FILE *); | 370 | static void Pascal_functions (FILE *); |
| 363 | static void Perl_functions (FILE *); | 371 | static void Perl_functions (FILE *); |
| 364 | static void PHP_functions (FILE *); | 372 | static void PHP_functions (FILE *); |
| @@ -379,6 +387,7 @@ static ptrdiff_t readline_internal (linebuffer *, FILE *, char const *); | |||
| 379 | static bool nocase_tail (const char *); | 387 | static bool nocase_tail (const char *); |
| 380 | static void get_tag (char *, char **); | 388 | static void get_tag (char *, char **); |
| 381 | static void get_lispy_tag (char *); | 389 | static void get_lispy_tag (char *); |
| 390 | static void test_objc_is_mercury (char *, language **); | ||
| 382 | 391 | ||
| 383 | static void analyze_regex (char *); | 392 | static void analyze_regex (char *); |
| 384 | static void free_regexps (void); | 393 | static void free_regexps (void); |
| @@ -684,10 +693,22 @@ static const char Makefile_help [] = | |||
| 684 | "In makefiles, targets are tags; additionally, variables are tags\n\ | 693 | "In makefiles, targets are tags; additionally, variables are tags\n\ |
| 685 | unless you specify '--no-globals'."; | 694 | unless you specify '--no-globals'."; |
| 686 | 695 | ||
| 696 | /* Mercury and Objective C share the same .m file extensions. */ | ||
| 697 | static const char *Mercury_suffixes [] = | ||
| 698 | {"m", | ||
| 699 | NULL}; | ||
| 700 | static const char Mercury_help [] = | ||
| 701 | "In Mercury code, tags are all declarations beginning a line with ':-'\n\ | ||
| 702 | and optionally Prolog-like definitions (first rule for a predicate or \ | ||
| 703 | function).\n\ | ||
| 704 | To enable this behavior, run etags using --declarations."; | ||
| 705 | static bool with_mercury_definitions = false; | ||
| 706 | float mercury_heuristics_ratio = MERCURY_HEURISTICS_RATIO; | ||
| 707 | |||
| 687 | static const char *Objc_suffixes [] = | 708 | static const char *Objc_suffixes [] = |
| 688 | { "lm", /* Objective lex file */ | 709 | { "lm", /* Objective lex file */ |
| 689 | "m", /* Objective C file */ | 710 | "m", /* By default, Objective C file will be assumed. */ |
| 690 | NULL }; | 711 | NULL}; |
| 691 | static const char Objc_help [] = | 712 | static const char Objc_help [] = |
| 692 | "In Objective C code, tags include Objective C definitions for classes,\n\ | 713 | "In Objective C code, tags include Objective C definitions for classes,\n\ |
| 693 | class categories, methods and protocols. Tags for variables and\n\ | 714 | class categories, methods and protocols. Tags for variables and\n\ |
| @@ -831,7 +852,9 @@ static language lang_names [] = | |||
| 831 | { "lisp", Lisp_help, Lisp_functions, Lisp_suffixes }, | 852 | { "lisp", Lisp_help, Lisp_functions, Lisp_suffixes }, |
| 832 | { "lua", Lua_help,Lua_functions,Lua_suffixes,NULL,Lua_interpreters}, | 853 | { "lua", Lua_help,Lua_functions,Lua_suffixes,NULL,Lua_interpreters}, |
| 833 | { "makefile", Makefile_help,Makefile_targets,NULL,Makefile_filenames}, | 854 | { "makefile", Makefile_help,Makefile_targets,NULL,Makefile_filenames}, |
| 855 | /* objc listed before mercury as it is a better default for .m extensions. */ | ||
| 834 | { "objc", Objc_help, plain_C_entries, Objc_suffixes }, | 856 | { "objc", Objc_help, plain_C_entries, Objc_suffixes }, |
| 857 | { "mercury", Mercury_help, Mercury_functions, Mercury_suffixes }, | ||
| 835 | { "pascal", Pascal_help, Pascal_functions, Pascal_suffixes }, | 858 | { "pascal", Pascal_help, Pascal_functions, Pascal_suffixes }, |
| 836 | { "perl",Perl_help,Perl_functions,Perl_suffixes,NULL,Perl_interpreters}, | 859 | { "perl",Perl_help,Perl_functions,Perl_suffixes,NULL,Perl_interpreters}, |
| 837 | { "php", PHP_help, PHP_functions, PHP_suffixes }, | 860 | { "php", PHP_help, PHP_functions, PHP_suffixes }, |
| @@ -958,6 +981,9 @@ Relative ones are stored relative to the output file's directory.\n"); | |||
| 958 | puts | 981 | puts |
| 959 | ("\tand create tags for extern variables unless --no-globals is used."); | 982 | ("\tand create tags for extern variables unless --no-globals is used."); |
| 960 | 983 | ||
| 984 | puts ("In Mercury, tag both declarations starting a line with ':-' and first\n\ | ||
| 985 | predicates or functions in clauses."); | ||
| 986 | |||
| 961 | if (CTAGS) | 987 | if (CTAGS) |
| 962 | puts ("-d, --defines\n\ | 988 | puts ("-d, --defines\n\ |
| 963 | Create tag entries for C #define constants and enum constants, too."); | 989 | Create tag entries for C #define constants and enum constants, too."); |
| @@ -1783,6 +1809,11 @@ find_entries (FILE *inf) | |||
| 1783 | if (parser == NULL) | 1809 | if (parser == NULL) |
| 1784 | { | 1810 | { |
| 1785 | lang = get_language_from_filename (curfdp->infname, true); | 1811 | lang = get_language_from_filename (curfdp->infname, true); |
| 1812 | |||
| 1813 | /* Disambiguate file names between Objc and Mercury. */ | ||
| 1814 | if (lang != NULL && strcmp (lang->name, "objc") == 0) | ||
| 1815 | test_objc_is_mercury (curfdp->infname, &lang); | ||
| 1816 | |||
| 1786 | if (lang != NULL && lang->function != NULL) | 1817 | if (lang != NULL && lang->function != NULL) |
| 1787 | { | 1818 | { |
| 1788 | curfdp->lang = lang; | 1819 | curfdp->lang = lang; |
| @@ -6072,6 +6103,472 @@ prolog_atom (char *s, size_t pos) | |||
| 6072 | 6103 | ||
| 6073 | 6104 | ||
| 6074 | /* | 6105 | /* |
| 6106 | * Support for Mercury | ||
| 6107 | * | ||
| 6108 | * Assumes that the declarations start at column 0. | ||
| 6109 | * Original code by Sunichirou Sugou (1989) for Prolog. | ||
| 6110 | * Rewritten by Anders Lindgren (1996) for Prolog. | ||
| 6111 | * Adapted by Fabrice Nicol (2021) for Mercury. | ||
| 6112 | * Note: Prolog-support behavior is preserved if | ||
| 6113 | * --declarations is used, corresponding to | ||
| 6114 | * with_mercury_definitions=true. | ||
| 6115 | */ | ||
| 6116 | |||
| 6117 | static ptrdiff_t mercury_pr (char *, char *, ptrdiff_t); | ||
| 6118 | static void mercury_skip_comment (linebuffer *, FILE *); | ||
| 6119 | static bool is_mercury_type = false; | ||
| 6120 | static bool is_mercury_quantifier = false; | ||
| 6121 | static bool is_mercury_declaration = false; | ||
| 6122 | |||
| 6123 | /* | ||
| 6124 | * Objective-C and Mercury have identical file extension .m. | ||
| 6125 | * To disambiguate between Objective C and Mercury, parse file | ||
| 6126 | * with the following heuristics hook: | ||
| 6127 | * - if line starts with :-, choose Mercury unconditionally; | ||
| 6128 | * - if line starts with #, @, choose Objective-C; | ||
| 6129 | * - otherwise compute the following ratio: | ||
| 6130 | * | ||
| 6131 | * r = (number of lines with :- | ||
| 6132 | * or % in non-commented parts or . at trimmed EOL) | ||
| 6133 | * / (number of lines - number of lines starting by any amount | ||
| 6134 | * of whitespace, optionally followed by comment(s)) | ||
| 6135 | * | ||
| 6136 | * Note: strings are neglected in counts. | ||
| 6137 | * | ||
| 6138 | * If r > mercury_heuristics_ratio, choose Mercury. | ||
| 6139 | * Experimental tests show that a possibly optimal default value for | ||
| 6140 | * this floor value is around 0.5. This is the default value for | ||
| 6141 | * MERCURY_HEURISTICS_RATIO, defined in the first lines of this file. | ||
| 6142 | * The closer r is to 0.5, the closer the source code to pure Prolog. | ||
| 6143 | * Idiomatic Mercury is scored either with r = 1.0 or higher. | ||
| 6144 | * Objective-C is scored with r = 0.0. When this fails, the r-score | ||
| 6145 | * never rose above 0.1 in Objective-C tests. | ||
| 6146 | */ | ||
| 6147 | |||
| 6148 | static void | ||
| 6149 | test_objc_is_mercury (char *this_file, language **lang) | ||
| 6150 | { | ||
| 6151 | if (this_file == NULL) return; | ||
| 6152 | FILE* fp = fopen (this_file, "r"); | ||
| 6153 | if (fp == NULL) | ||
| 6154 | pfatal (this_file); | ||
| 6155 | |||
| 6156 | bool blank_line = false; /* Line starting with any amount of white space | ||
| 6157 | followed by optional comment(s). */ | ||
| 6158 | bool commented_line = false; | ||
| 6159 | bool found_dot = false; | ||
| 6160 | bool only_space_before = true; | ||
| 6161 | bool start_of_line = true; | ||
| 6162 | int c; | ||
| 6163 | intmax_t lines = 1; | ||
| 6164 | intmax_t mercury_dots = 0; | ||
| 6165 | intmax_t percentage_signs = 0; | ||
| 6166 | intmax_t rule_signs = 0; | ||
| 6167 | float ratio = 0; | ||
| 6168 | |||
| 6169 | while ((c = fgetc (fp)) != EOF) | ||
| 6170 | { | ||
| 6171 | switch (c) | ||
| 6172 | { | ||
| 6173 | case '\n': | ||
| 6174 | if (! blank_line) ++lines; | ||
| 6175 | blank_line = true; | ||
| 6176 | commented_line = false; | ||
| 6177 | start_of_line = true; | ||
| 6178 | if (found_dot) ++mercury_dots; | ||
| 6179 | found_dot = false; | ||
| 6180 | only_space_before = true; | ||
| 6181 | break; | ||
| 6182 | case '.': | ||
| 6183 | found_dot = ! commented_line; | ||
| 6184 | only_space_before = false; | ||
| 6185 | break; | ||
| 6186 | case '%': /* More frequent in Mercury. May be modulo in Obj.-C. */ | ||
| 6187 | if (! commented_line) | ||
| 6188 | { | ||
| 6189 | ++percentage_signs; | ||
| 6190 | /* Cannot tell if it is a comment or modulo yet for sure. | ||
| 6191 | Yet works for heuristic purposes. */ | ||
| 6192 | commented_line = true; | ||
| 6193 | } | ||
| 6194 | found_dot = false; | ||
| 6195 | start_of_line = false; | ||
| 6196 | only_space_before = false; | ||
| 6197 | break; | ||
| 6198 | case '/': | ||
| 6199 | { | ||
| 6200 | int d = fgetc (fp); | ||
| 6201 | found_dot = false; | ||
| 6202 | only_space_before = false; | ||
| 6203 | if (! commented_line) | ||
| 6204 | { | ||
| 6205 | if (d == '*') | ||
| 6206 | commented_line = true; | ||
| 6207 | else | ||
| 6208 | /* If d == '/', cannot tell if it is an Obj.-C comment: | ||
| 6209 | may be Mercury integ. division. */ | ||
| 6210 | blank_line = false; | ||
| 6211 | } | ||
| 6212 | } | ||
| 6213 | FALLTHROUGH; | ||
| 6214 | case ' ': | ||
| 6215 | case '\t': | ||
| 6216 | start_of_line = false; | ||
| 6217 | break; | ||
| 6218 | case ':': | ||
| 6219 | c = fgetc (fp); | ||
| 6220 | if (start_of_line) | ||
| 6221 | { | ||
| 6222 | if (c == '-') | ||
| 6223 | { | ||
| 6224 | ratio = 1.0; /* Failsafe, not an operator in Obj.-C. */ | ||
| 6225 | goto out; | ||
| 6226 | } | ||
| 6227 | start_of_line = false; | ||
| 6228 | } | ||
| 6229 | else | ||
| 6230 | { | ||
| 6231 | /* p :- q. Frequent in Mercury. | ||
| 6232 | Rare or in quoted exprs in Obj.-C. */ | ||
| 6233 | if (c == '-' && ! commented_line) | ||
| 6234 | ++rule_signs; | ||
| 6235 | } | ||
| 6236 | blank_line = false; | ||
| 6237 | found_dot = false; | ||
| 6238 | only_space_before = false; | ||
| 6239 | break; | ||
| 6240 | case '@': | ||
| 6241 | case '#': | ||
| 6242 | if (start_of_line || only_space_before) | ||
| 6243 | { | ||
| 6244 | ratio = 0.0; | ||
| 6245 | goto out; | ||
| 6246 | } | ||
| 6247 | FALLTHROUGH; | ||
| 6248 | default: | ||
| 6249 | start_of_line = false; | ||
| 6250 | blank_line = false; | ||
| 6251 | found_dot = false; | ||
| 6252 | only_space_before = false; | ||
| 6253 | } | ||
| 6254 | } | ||
| 6255 | |||
| 6256 | /* Fallback heuristic test. Not failsafe but errless in pratice. */ | ||
| 6257 | ratio = ((float) rule_signs + percentage_signs + mercury_dots) / lines; | ||
| 6258 | |||
| 6259 | out: | ||
| 6260 | if (fclose (fp) == EOF) | ||
| 6261 | pfatal (this_file); | ||
| 6262 | |||
| 6263 | if (ratio > mercury_heuristics_ratio) | ||
| 6264 | { | ||
| 6265 | /* Change the language from Objective-C to Mercury. */ | ||
| 6266 | static language lang0 = { "mercury", Mercury_help, Mercury_functions, | ||
| 6267 | Mercury_suffixes }; | ||
| 6268 | *lang = &lang0; | ||
| 6269 | } | ||
| 6270 | } | ||
| 6271 | |||
| 6272 | static void | ||
| 6273 | Mercury_functions (FILE *inf) | ||
| 6274 | { | ||
| 6275 | char *cp, *last = NULL; | ||
| 6276 | ptrdiff_t lastlen = 0, allocated = 0; | ||
| 6277 | if (declarations) with_mercury_definitions = true; | ||
| 6278 | |||
| 6279 | LOOP_ON_INPUT_LINES (inf, lb, cp) | ||
| 6280 | { | ||
| 6281 | if (cp[0] == '\0') /* Empty line. */ | ||
| 6282 | continue; | ||
| 6283 | else if (c_isspace (cp[0]) || cp[0] == '%') | ||
| 6284 | /* A Prolog-type comment or anything other than a declaration. */ | ||
| 6285 | continue; | ||
| 6286 | else if (cp[0] == '/' && cp[1] == '*') /* Mercury C-type comment. */ | ||
| 6287 | mercury_skip_comment (&lb, inf); | ||
| 6288 | else | ||
| 6289 | { | ||
| 6290 | is_mercury_declaration = (cp[0] == ':' && cp[1] == '-'); | ||
| 6291 | |||
| 6292 | if (is_mercury_declaration | ||
| 6293 | || with_mercury_definitions) | ||
| 6294 | { | ||
| 6295 | ptrdiff_t len = mercury_pr (cp, last, lastlen); | ||
| 6296 | if (0 < len) | ||
| 6297 | { | ||
| 6298 | /* Store the declaration to avoid generating duplicate | ||
| 6299 | tags later. */ | ||
| 6300 | if (allocated <= len) | ||
| 6301 | { | ||
| 6302 | xrnew (last, len + 1, 1); | ||
| 6303 | allocated = len + 1; | ||
| 6304 | } | ||
| 6305 | memcpyz (last, cp, len); | ||
| 6306 | lastlen = len; | ||
| 6307 | } | ||
| 6308 | } | ||
| 6309 | } | ||
| 6310 | } | ||
| 6311 | free (last); | ||
| 6312 | } | ||
| 6313 | |||
| 6314 | static void | ||
| 6315 | mercury_skip_comment (linebuffer *plb, FILE *inf) | ||
| 6316 | { | ||
| 6317 | char *cp; | ||
| 6318 | |||
| 6319 | do | ||
| 6320 | { | ||
| 6321 | for (cp = plb->buffer; *cp != '\0'; ++cp) | ||
| 6322 | if (cp[0] == '*' && cp[1] == '/') | ||
| 6323 | return; | ||
| 6324 | readline (plb, inf); | ||
| 6325 | } | ||
| 6326 | while (perhaps_more_input (inf)); | ||
| 6327 | } | ||
| 6328 | |||
| 6329 | /* | ||
| 6330 | * A declaration is added if it matches: | ||
| 6331 | * <beginning of line>:-<whitespace><Mercury Term><whitespace>( | ||
| 6332 | * If with_mercury_definitions == true, we also add: | ||
| 6333 | * <beginning of line><Mercury item><whitespace>( | ||
| 6334 | * or <beginning of line><Mercury item><whitespace>:- | ||
| 6335 | * As for Prolog support, different arities and types are not taken into | ||
| 6336 | * consideration. | ||
| 6337 | * Item is added to the tags database if it doesn't match the | ||
| 6338 | * name of the previous declaration. | ||
| 6339 | * | ||
| 6340 | * Consume a Mercury declaration. | ||
| 6341 | * Return the number of bytes consumed, or 0 if there was an error. | ||
| 6342 | * | ||
| 6343 | * A Mercury declaration must be one of: | ||
| 6344 | * :- type | ||
| 6345 | * :- solver type | ||
| 6346 | * :- pred | ||
| 6347 | * :- func | ||
| 6348 | * :- inst | ||
| 6349 | * :- mode | ||
| 6350 | * :- typeclass | ||
| 6351 | * :- instance | ||
| 6352 | * :- pragma | ||
| 6353 | * :- promise | ||
| 6354 | * :- initialise | ||
| 6355 | * :- finalise | ||
| 6356 | * :- mutable | ||
| 6357 | * :- module | ||
| 6358 | * :- interface | ||
| 6359 | * :- implementation | ||
| 6360 | * :- import_module | ||
| 6361 | * :- use_module | ||
| 6362 | * :- include_module | ||
| 6363 | * :- end_module | ||
| 6364 | * followed on the same line by an alphanumeric sequence, starting with a lower | ||
| 6365 | * case letter or by a single-quoted arbitrary string. | ||
| 6366 | * Single quotes can escape themselves. Backslash quotes everything. | ||
| 6367 | * | ||
| 6368 | * Return the size of the name of the declaration or 0 if no header was found. | ||
| 6369 | * As quantifiers may precede functions or predicates, we must list them too. | ||
| 6370 | */ | ||
| 6371 | |||
| 6372 | static const char *Mercury_decl_tags[] = {"type", "solver type", "pred", | ||
| 6373 | "func", "inst", "mode", "typeclass", "instance", "pragma", "promise", | ||
| 6374 | "initialise", "finalise", "mutable", "module", "interface", "implementation", | ||
| 6375 | "import_module", "use_module", "include_module", "end_module", "some", "all"}; | ||
| 6376 | |||
| 6377 | static size_t | ||
| 6378 | mercury_decl (char *s, size_t pos) | ||
| 6379 | { | ||
| 6380 | if (s == NULL) return 0; | ||
| 6381 | |||
| 6382 | size_t origpos; | ||
| 6383 | origpos = pos; | ||
| 6384 | |||
| 6385 | while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_')) ++pos; | ||
| 6386 | |||
| 6387 | unsigned char decl_type_length = pos - origpos; | ||
| 6388 | char buf[decl_type_length + 1]; | ||
| 6389 | memset (buf, 0, decl_type_length + 1); | ||
| 6390 | |||
| 6391 | /* Mercury declaration tags. Consume them, then check the declaration item | ||
| 6392 | following :- is legitimate, then go on as in the prolog case. */ | ||
| 6393 | |||
| 6394 | memcpy (buf, &s[origpos], decl_type_length); | ||
| 6395 | |||
| 6396 | bool found_decl_tag = false; | ||
| 6397 | |||
| 6398 | if (is_mercury_quantifier) | ||
| 6399 | { | ||
| 6400 | if (strcmp (buf, "pred") != 0 && strcmp (buf, "func") != 0) /* Bad syntax. */ | ||
| 6401 | return 0; | ||
| 6402 | is_mercury_quantifier = false; /* Reset to base value. */ | ||
| 6403 | found_decl_tag = true; | ||
| 6404 | } | ||
| 6405 | else | ||
| 6406 | { | ||
| 6407 | for (int j = 0; j < sizeof (Mercury_decl_tags) / sizeof (char*); ++j) | ||
| 6408 | { | ||
| 6409 | if (strcmp (buf, Mercury_decl_tags[j]) == 0) | ||
| 6410 | { | ||
| 6411 | found_decl_tag = true; | ||
| 6412 | if (strcmp (buf, "type") == 0) | ||
| 6413 | is_mercury_type = true; | ||
| 6414 | |||
| 6415 | if (strcmp (buf, "some") == 0 | ||
| 6416 | || strcmp (buf, "all") == 0) | ||
| 6417 | { | ||
| 6418 | is_mercury_quantifier = true; | ||
| 6419 | } | ||
| 6420 | |||
| 6421 | break; /* Found declaration tag of rank j. */ | ||
| 6422 | } | ||
| 6423 | else | ||
| 6424 | /* 'solver type' has a blank in the middle, | ||
| 6425 | so this is the hard case. */ | ||
| 6426 | if (strcmp (buf, "solver") == 0) | ||
| 6427 | { | ||
| 6428 | ++pos; | ||
| 6429 | while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_')) | ||
| 6430 | ++pos; | ||
| 6431 | |||
| 6432 | decl_type_length = pos - origpos; | ||
| 6433 | char buf2[decl_type_length + 1]; | ||
| 6434 | memset (buf2, 0, decl_type_length + 1); | ||
| 6435 | memcpy (buf2, &s[origpos], decl_type_length); | ||
| 6436 | |||
| 6437 | if (strcmp (buf2, "solver type") == 0) | ||
| 6438 | { | ||
| 6439 | found_decl_tag = false; | ||
| 6440 | break; /* Found declaration tag of rank j. */ | ||
| 6441 | } | ||
| 6442 | } | ||
| 6443 | } | ||
| 6444 | } | ||
| 6445 | |||
| 6446 | /* If with_mercury_definitions == false | ||
| 6447 | * this is a Mercury syntax error, ignoring... */ | ||
| 6448 | |||
| 6449 | if (with_mercury_definitions) | ||
| 6450 | { | ||
| 6451 | if (found_decl_tag) | ||
| 6452 | pos = skip_spaces (s + pos) - s; /* Skip len blanks again. */ | ||
| 6453 | else | ||
| 6454 | /* Prolog-like behavior | ||
| 6455 | * we have parsed the predicate once, yet inappropriately | ||
| 6456 | * so restarting again the parsing step. */ | ||
| 6457 | pos = 0; | ||
| 6458 | } | ||
| 6459 | else | ||
| 6460 | { | ||
| 6461 | if (found_decl_tag) | ||
| 6462 | pos = skip_spaces (s + pos) - s; /* Skip len blanks again. */ | ||
| 6463 | else | ||
| 6464 | return 0; | ||
| 6465 | } | ||
| 6466 | |||
| 6467 | /* From now on it is the same as for Prolog except for module dots. */ | ||
| 6468 | |||
| 6469 | if (c_islower (s[pos]) || s[pos] == '_' ) | ||
| 6470 | { | ||
| 6471 | /* The name is unquoted. | ||
| 6472 | Do not confuse module dots with end-of-declaration dots. */ | ||
| 6473 | |||
| 6474 | while (c_isalnum (s[pos]) | ||
| 6475 | || s[pos] == '_' | ||
| 6476 | || (s[pos] == '.' /* A module dot. */ | ||
| 6477 | && s + pos + 1 != NULL | ||
| 6478 | && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_'))) | ||
| 6479 | ++pos; | ||
| 6480 | |||
| 6481 | return pos - origpos; | ||
| 6482 | } | ||
| 6483 | else if (s[pos] == '\'') | ||
| 6484 | { | ||
| 6485 | ++pos; | ||
| 6486 | for (;;) | ||
| 6487 | { | ||
| 6488 | if (s[pos] == '\'') | ||
| 6489 | { | ||
| 6490 | ++pos; | ||
| 6491 | if (s[pos] != '\'') | ||
| 6492 | break; | ||
| 6493 | ++pos; /* A double quote. */ | ||
| 6494 | } | ||
| 6495 | else if (s[pos] == '\0') /* Multiline quoted atoms are ignored. */ | ||
| 6496 | return 0; | ||
| 6497 | else if (s[pos] == '\\') | ||
| 6498 | { | ||
| 6499 | if (s[pos+1] == '\0') | ||
| 6500 | return 0; | ||
| 6501 | pos += 2; | ||
| 6502 | } | ||
| 6503 | else | ||
| 6504 | ++pos; | ||
| 6505 | } | ||
| 6506 | return pos - origpos; | ||
| 6507 | } | ||
| 6508 | else if (is_mercury_quantifier && s[pos] == '[') /* :- some [T] pred/func. */ | ||
| 6509 | { | ||
| 6510 | for (++pos; s + pos != NULL && s[pos] != ']'; ++pos) {} | ||
| 6511 | if (s + pos == NULL) return 0; | ||
| 6512 | ++pos; | ||
| 6513 | pos = skip_spaces (s + pos) - s; | ||
| 6514 | return mercury_decl (s, pos) + pos - origpos; | ||
| 6515 | } | ||
| 6516 | else | ||
| 6517 | return 0; | ||
| 6518 | } | ||
| 6519 | |||
| 6520 | static ptrdiff_t | ||
| 6521 | mercury_pr (char *s, char *last, ptrdiff_t lastlen) | ||
| 6522 | { | ||
| 6523 | size_t len0 = 0; | ||
| 6524 | is_mercury_type = false; | ||
| 6525 | is_mercury_quantifier = false; | ||
| 6526 | |||
| 6527 | if (is_mercury_declaration) | ||
| 6528 | { | ||
| 6529 | /* Skip len0 blanks only for declarations. */ | ||
| 6530 | len0 = skip_spaces (s + 2) - s; | ||
| 6531 | } | ||
| 6532 | |||
| 6533 | size_t len = mercury_decl (s, len0); | ||
| 6534 | if (len == 0) return 0; | ||
| 6535 | len += len0; | ||
| 6536 | |||
| 6537 | if (( (s[len] == '.' /* This is a statement dot, not a module dot. */ | ||
| 6538 | || (s[len] == '(' && (len += 1)) | ||
| 6539 | || (s[len] == ':' /* Stopping in case of a rule. */ | ||
| 6540 | && s[len + 1] == '-' | ||
| 6541 | && (len += 2))) | ||
| 6542 | && (lastlen != len || memcmp (s, last, len) != 0) | ||
| 6543 | ) | ||
| 6544 | /* Types are often declared on several lines so keeping just | ||
| 6545 | the first line. */ | ||
| 6546 | || is_mercury_type) | ||
| 6547 | { | ||
| 6548 | char *name = skip_non_spaces (s + len0); | ||
| 6549 | size_t namelen; | ||
| 6550 | if (name >= s + len) | ||
| 6551 | { | ||
| 6552 | name = s; | ||
| 6553 | namelen = len; | ||
| 6554 | } | ||
| 6555 | else | ||
| 6556 | { | ||
| 6557 | name = skip_spaces (name); | ||
| 6558 | namelen = len - (name - s); | ||
| 6559 | } | ||
| 6560 | /* Remove trailing non-name characters. */ | ||
| 6561 | while (namelen > 0 && notinname (name[namelen - 1])) | ||
| 6562 | namelen--; | ||
| 6563 | make_tag (name, namelen, true, s, len, lineno, linecharno); | ||
| 6564 | return len; | ||
| 6565 | } | ||
| 6566 | |||
| 6567 | return 0; | ||
| 6568 | } | ||
| 6569 | |||
| 6570 | |||
| 6571 | /* | ||
| 6075 | * Support for Erlang | 6572 | * Support for Erlang |
| 6076 | * | 6573 | * |
| 6077 | * Generates tags for functions, defines, and records. | 6574 | * Generates tags for functions, defines, and records. |
diff --git a/lib/Makefile.in b/lib/Makefile.in index ec92f92fb3e..ccb90c3d1b3 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in | |||
| @@ -64,7 +64,7 @@ endif | |||
| 64 | ../config.status: $(top_srcdir)/configure.ac $(top_srcdir)/m4/*.m4 | 64 | ../config.status: $(top_srcdir)/configure.ac $(top_srcdir)/m4/*.m4 |
| 65 | $(MAKE) -C .. $(notdir $@) | 65 | $(MAKE) -C .. $(notdir $@) |
| 66 | Makefile: ../config.status $(srcdir)/Makefile.in | 66 | Makefile: ../config.status $(srcdir)/Makefile.in |
| 67 | $(MAKE) -C .. src/$@ | 67 | $(MAKE) -C .. lib/$@ |
| 68 | 68 | ||
| 69 | # Object modules that need not be built for Emacs. | 69 | # Object modules that need not be built for Emacs. |
| 70 | # Emacs does not need e-regex.o (it has its own regex-emacs.c), | 70 | # Emacs does not need e-regex.o (it has its own regex-emacs.c), |
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 8e0d9c4e5be..431217a9dac 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -274,7 +274,7 @@ $(THEFILE)c: | |||
| 274 | ifeq ($(HAVE_NATIVE_COMP),yes) | 274 | ifeq ($(HAVE_NATIVE_COMP),yes) |
| 275 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ | 275 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ |
| 276 | -l comp -f byte-compile-refresh-preloaded \ | 276 | -l comp -f byte-compile-refresh-preloaded \ |
| 277 | -f batch-byte-native-compile-for-bootstrap $(THEFILE) | 277 | -f batch-byte+native-compile $(THEFILE) |
| 278 | else | 278 | else |
| 279 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ | 279 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ |
| 280 | -l bytecomp -f byte-compile-refresh-preloaded \ | 280 | -l bytecomp -f byte-compile-refresh-preloaded \ |
| @@ -295,7 +295,7 @@ endif | |||
| 295 | ifeq ($(HAVE_NATIVE_COMP),yes) | 295 | ifeq ($(HAVE_NATIVE_COMP),yes) |
| 296 | .el.elc: | 296 | .el.elc: |
| 297 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ | 297 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ |
| 298 | -l comp -f batch-byte-native-compile-for-bootstrap $< | 298 | -l comp -f batch-byte+native-compile $< |
| 299 | else | 299 | else |
| 300 | .el.elc: | 300 | .el.elc: |
| 301 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< | 301 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< |
diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 2516b4b9fae..9ca28ebb0a9 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el | |||
| @@ -121,12 +121,12 @@ let-binding." | |||
| 121 | :initform nil | 121 | :initform nil |
| 122 | :documentation "Internal backend data.") | 122 | :documentation "Internal backend data.") |
| 123 | (create-function :initarg :create-function | 123 | (create-function :initarg :create-function |
| 124 | :initform ignore | 124 | :initform #'ignore |
| 125 | :type function | 125 | :type function |
| 126 | :custom function | 126 | :custom function |
| 127 | :documentation "The create function.") | 127 | :documentation "The create function.") |
| 128 | (search-function :initarg :search-function | 128 | (search-function :initarg :search-function |
| 129 | :initform ignore | 129 | :initform #'ignore |
| 130 | :type function | 130 | :type function |
| 131 | :custom function | 131 | :custom function |
| 132 | :documentation "The search function."))) | 132 | :documentation "The search function."))) |
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 3fcc023e0c6..103a37045cc 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el | |||
| @@ -47,7 +47,7 @@ | |||
| 47 | ;; and features of those files. | 47 | ;; and features of those files. |
| 48 | 48 | ||
| 49 | (defclass ede-target (eieio-speedbar-directory-button eieio-named) | 49 | (defclass ede-target (eieio-speedbar-directory-button eieio-named) |
| 50 | ((buttonface :initform speedbar-file-face) ;override for superclass | 50 | ((buttonface :initform 'speedbar-file-face) ;override for superclass |
| 51 | (name :initarg :name | 51 | (name :initarg :name |
| 52 | :type string | 52 | :type string |
| 53 | :custom string | 53 | :custom string |
| @@ -91,16 +91,16 @@ This is used to match target objects with the compilers they can use, and | |||
| 91 | which files this object is interested in." | 91 | which files this object is interested in." |
| 92 | :accessor ede-object-sourcecode) | 92 | :accessor ede-object-sourcecode) |
| 93 | (keybindings :allocation :class | 93 | (keybindings :allocation :class |
| 94 | :initform (("D" . ede-debug-target)) | 94 | :initform '(("D" . ede-debug-target)) |
| 95 | :documentation | 95 | :documentation |
| 96 | "Keybindings specialized to this type of target." | 96 | "Keybindings specialized to this type of target." |
| 97 | :accessor ede-object-keybindings) | 97 | :accessor ede-object-keybindings) |
| 98 | (menu :allocation :class | 98 | (menu :allocation :class |
| 99 | :initform ( [ "Debug target" ede-debug-target | 99 | :initform '( [ "Debug target" ede-debug-target |
| 100 | (ede-buffer-belongs-to-target-p) ] | 100 | (ede-buffer-belongs-to-target-p) ] |
| 101 | [ "Run target" ede-run-target | 101 | [ "Run target" ede-run-target |
| 102 | (ede-buffer-belongs-to-target-p) ] | 102 | (ede-buffer-belongs-to-target-p) ] |
| 103 | ) | 103 | ) |
| 104 | :documentation "Menu specialized to this type of target." | 104 | :documentation "Menu specialized to this type of target." |
| 105 | :accessor ede-object-menu) | 105 | :accessor ede-object-menu) |
| 106 | ) | 106 | ) |
| @@ -236,7 +236,7 @@ also be of a form used by TRAMP for use with scp, or rcp.") | |||
| 236 | This FTP site should be in Emacs form as needed by `ange-ftp'. | 236 | This FTP site should be in Emacs form as needed by `ange-ftp'. |
| 237 | If this slot is nil, then use `ftp-site' instead.") | 237 | If this slot is nil, then use `ftp-site' instead.") |
| 238 | (configurations :initarg :configurations | 238 | (configurations :initarg :configurations |
| 239 | :initform ("debug" "release") | 239 | :initform '("debug" "release") |
| 240 | :type list | 240 | :type list |
| 241 | :custom (repeat string) | 241 | :custom (repeat string) |
| 242 | :label "Configuration Options" | 242 | :label "Configuration Options" |
| @@ -258,25 +258,25 @@ and target specific elements such as build variables.") | |||
| 258 | :group (settings) | 258 | :group (settings) |
| 259 | :documentation "Project local variables") | 259 | :documentation "Project local variables") |
| 260 | (keybindings :allocation :class | 260 | (keybindings :allocation :class |
| 261 | :initform (("D" . ede-debug-target) | 261 | :initform '(("D" . ede-debug-target) |
| 262 | ("R" . ede-run-target)) | 262 | ("R" . ede-run-target)) |
| 263 | :documentation "Keybindings specialized to this type of target." | 263 | :documentation "Keybindings specialized to this type of target." |
| 264 | :accessor ede-object-keybindings) | 264 | :accessor ede-object-keybindings) |
| 265 | (menu :allocation :class | 265 | (menu :allocation :class |
| 266 | :initform | 266 | :initform |
| 267 | ( | 267 | '( |
| 268 | [ "Update Version" ede-update-version ede-object ] | 268 | [ "Update Version" ede-update-version ede-object ] |
| 269 | [ "Version Control Status" ede-vc-project-directory ede-object ] | 269 | [ "Version Control Status" ede-vc-project-directory ede-object ] |
| 270 | [ "Edit Project Homepage" ede-edit-web-page | 270 | [ "Edit Project Homepage" ede-edit-web-page |
| 271 | (and ede-object (oref (ede-toplevel) web-site-file)) ] | 271 | (and ede-object (oref (ede-toplevel) web-site-file)) ] |
| 272 | [ "Browse Project URL" ede-web-browse-home | 272 | [ "Browse Project URL" ede-web-browse-home |
| 273 | (and ede-object | 273 | (and ede-object |
| 274 | (not (string= "" (oref (ede-toplevel) web-site-url)))) ] | 274 | (not (string= "" (oref (ede-toplevel) web-site-url)))) ] |
| 275 | "--" | 275 | "--" |
| 276 | [ "Rescan Project Files" ede-rescan-toplevel t ] | 276 | [ "Rescan Project Files" ede-rescan-toplevel t ] |
| 277 | [ "Edit Projectfile" ede-edit-file-target | 277 | [ "Edit Projectfile" ede-edit-file-target |
| 278 | (ede-buffer-belongs-to-project-p) ] | 278 | (ede-buffer-belongs-to-project-p) ] |
| 279 | ) | 279 | ) |
| 280 | :documentation "Menu specialized to this type of target." | 280 | :documentation "Menu specialized to this type of target." |
| 281 | :accessor ede-object-menu) | 281 | :accessor ede-object-menu) |
| 282 | ) | 282 | ) |
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el index bc1810aa84f..98a0419e8bf 100644 --- a/lisp/cedet/ede/config.el +++ b/lisp/cedet/ede/config.el | |||
| @@ -96,7 +96,7 @@ and also want to save some extra level of configuration.") | |||
| 96 | This filename excludes the directory name and is used to | 96 | This filename excludes the directory name and is used to |
| 97 | initialize the :file slot of the persistent baseclass.") | 97 | initialize the :file slot of the persistent baseclass.") |
| 98 | (config-class | 98 | (config-class |
| 99 | :initform ede-extra-config | 99 | :initform 'ede-extra-config |
| 100 | :allocation :class | 100 | :allocation :class |
| 101 | :type class | 101 | :type class |
| 102 | :documentation | 102 | :documentation |
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el index b3b59b5dc35..4537f59ac9d 100644 --- a/lisp/cedet/ede/generic.el +++ b/lisp/cedet/ede/generic.el | |||
| @@ -137,7 +137,7 @@ subclasses of this base target will override the default value.") | |||
| 137 | ede-project-with-config-program | 137 | ede-project-with-config-program |
| 138 | ede-project-with-config-c | 138 | ede-project-with-config-c |
| 139 | ede-project-with-config-java) | 139 | ede-project-with-config-java) |
| 140 | ((config-class :initform ede-generic-config) | 140 | ((config-class :initform 'ede-generic-config) |
| 141 | (config-file-basename :initform "EDEConfig.el") | 141 | (config-file-basename :initform "EDEConfig.el") |
| 142 | (buildfile :initform "" | 142 | (buildfile :initform "" |
| 143 | :type string | 143 | :type string |
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el index 2ae62f4b38e..1b96376d3eb 100644 --- a/lisp/cedet/ede/proj-obj.el +++ b/lisp/cedet/ede/proj-obj.el | |||
| @@ -34,8 +34,8 @@ | |||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | (defclass ede-proj-target-makefile-objectcode (ede-proj-target-makefile) | 35 | (defclass ede-proj-target-makefile-objectcode (ede-proj-target-makefile) |
| 36 | (;; Give this a new default | 36 | (;; Give this a new default |
| 37 | (configuration-variables :initform ("debug" . (("CFLAGS" . "-g") | 37 | (configuration-variables :initform '("debug" . (("CFLAGS" . "-g") |
| 38 | ("LDFLAGS" . "-g")))) | 38 | ("LDFLAGS" . "-g")))) |
| 39 | ;; @TODO - add an include path. | 39 | ;; @TODO - add an include path. |
| 40 | (availablecompilers :initform '(ede-gcc-compiler | 40 | (availablecompilers :initform '(ede-gcc-compiler |
| 41 | ede-g++-compiler | 41 | ede-g++-compiler |
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index 6ff763016ef..c8c34d092f1 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el | |||
| @@ -220,7 +220,7 @@ This enables the creation of your target type." | |||
| 220 | ((extension :initform ".ede") | 220 | ((extension :initform ".ede") |
| 221 | (file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit") | 221 | (file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit") |
| 222 | (makefile-type :initarg :makefile-type | 222 | (makefile-type :initarg :makefile-type |
| 223 | :initform Makefile | 223 | :initform 'Makefile |
| 224 | :type symbol | 224 | :type symbol |
| 225 | :custom (choice (const Makefile) | 225 | :custom (choice (const Makefile) |
| 226 | ;(const Makefile.in) | 226 | ;(const Makefile.in) |
| @@ -240,7 +240,7 @@ in targets.") | |||
| 240 | :documentation "Variables to set in this Makefile.") | 240 | :documentation "Variables to set in this Makefile.") |
| 241 | (configuration-variables | 241 | (configuration-variables |
| 242 | :initarg :configuration-variables | 242 | :initarg :configuration-variables |
| 243 | :initform ("debug" (("DEBUG" . "1"))) | 243 | :initform '("debug" (("DEBUG" . "1"))) |
| 244 | :type list | 244 | :type list |
| 245 | :custom (repeat (cons (string :tag "Configuration") | 245 | :custom (repeat (cons (string :tag "Configuration") |
| 246 | (repeat | 246 | (repeat |
| @@ -269,10 +269,10 @@ These files can contain additional rules, variables, and customizations.") | |||
| 269 | :documentation | 269 | :documentation |
| 270 | "Non-nil to do implement automatic dependencies in the Makefile.") | 270 | "Non-nil to do implement automatic dependencies in the Makefile.") |
| 271 | (menu :initform | 271 | (menu :initform |
| 272 | ( | 272 | '( |
| 273 | [ "Regenerate Makefiles" ede-proj-regenerate t ] | 273 | [ "Regenerate Makefiles" ede-proj-regenerate t ] |
| 274 | [ "Upload Distribution" ede-upload-distribution t ] | 274 | [ "Upload Distribution" ede-upload-distribution t ] |
| 275 | ) | 275 | ) |
| 276 | ) | 276 | ) |
| 277 | (metasubproject | 277 | (metasubproject |
| 278 | :initarg :metasubproject | 278 | :initarg :metasubproject |
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index 682a4ccac48..8bc3b810a65 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el | |||
| @@ -79,7 +79,7 @@ be searched." | |||
| 79 | ;;; SEMANTIC Database related Code | 79 | ;;; SEMANTIC Database related Code |
| 80 | ;;; Classes: | 80 | ;;; Classes: |
| 81 | (defclass semanticdb-table-ebrowse (semanticdb-table) | 81 | (defclass semanticdb-table-ebrowse (semanticdb-table) |
| 82 | ((major-mode :initform c++-mode) | 82 | ((major-mode :initform #'c++-mode) |
| 83 | (ebrowse-tree :initform nil | 83 | (ebrowse-tree :initform nil |
| 84 | :initarg :ebrowse-tree | 84 | :initarg :ebrowse-tree |
| 85 | :documentation | 85 | :documentation |
| @@ -95,7 +95,7 @@ This table is composited from the ebrowse *Globals* section.") | |||
| 95 | 95 | ||
| 96 | (defclass semanticdb-project-database-ebrowse | 96 | (defclass semanticdb-project-database-ebrowse |
| 97 | (semanticdb-project-database) | 97 | (semanticdb-project-database) |
| 98 | ((new-table-class :initform semanticdb-table-ebrowse | 98 | ((new-table-class :initform 'semanticdb-table-ebrowse |
| 99 | :type class | 99 | :type class |
| 100 | :documentation | 100 | :documentation |
| 101 | "New tables created for this database are of this class.") | 101 | "New tables created for this database are of this class.") |
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 78339c375fb..41e48b0bc30 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el | |||
| @@ -40,7 +40,7 @@ | |||
| 40 | 40 | ||
| 41 | ;;; Classes: | 41 | ;;; Classes: |
| 42 | (defclass semanticdb-table-emacs-lisp (semanticdb-abstract-table) | 42 | (defclass semanticdb-table-emacs-lisp (semanticdb-abstract-table) |
| 43 | ((major-mode :initform emacs-lisp-mode) | 43 | ((major-mode :initform #'emacs-lisp-mode) |
| 44 | ) | 44 | ) |
| 45 | "A table for returning search results from Emacs.") | 45 | "A table for returning search results from Emacs.") |
| 46 | 46 | ||
| @@ -63,7 +63,7 @@ It does not need refreshing." | |||
| 63 | 63 | ||
| 64 | (defclass semanticdb-project-database-emacs-lisp | 64 | (defclass semanticdb-project-database-emacs-lisp |
| 65 | (semanticdb-project-database eieio-singleton) | 65 | (semanticdb-project-database eieio-singleton) |
| 66 | ((new-table-class :initform semanticdb-table-emacs-lisp | 66 | ((new-table-class :initform 'semanticdb-table-emacs-lisp |
| 67 | :type class | 67 | :type class |
| 68 | :documentation | 68 | :documentation |
| 69 | "New tables created for this database are of this class.") | 69 | "New tables created for this database are of this class.") |
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el index cad561e7967..bf3d6122954 100644 --- a/lisp/cedet/semantic/db-javascript.el +++ b/lisp/cedet/semantic/db-javascript.el | |||
| @@ -80,7 +80,7 @@ See bottom of this file for instructions on managing this list.") | |||
| 80 | 80 | ||
| 81 | ;;; Classes: | 81 | ;;; Classes: |
| 82 | (defclass semanticdb-table-javascript (semanticdb-search-results-table) | 82 | (defclass semanticdb-table-javascript (semanticdb-search-results-table) |
| 83 | ((major-mode :initform javascript-mode) | 83 | ((major-mode :initform #'javascript-mode) |
| 84 | ) | 84 | ) |
| 85 | "A table for returning search results from javascript.") | 85 | "A table for returning search results from javascript.") |
| 86 | 86 | ||
| @@ -88,7 +88,7 @@ See bottom of this file for instructions on managing this list.") | |||
| 88 | (semanticdb-project-database | 88 | (semanticdb-project-database |
| 89 | eieio-singleton ;this db is for js globals, so singleton is appropriate | 89 | eieio-singleton ;this db is for js globals, so singleton is appropriate |
| 90 | ) | 90 | ) |
| 91 | ((new-table-class :initform semanticdb-table-javascript | 91 | ((new-table-class :initform 'semanticdb-table-javascript |
| 92 | :type class | 92 | :type class |
| 93 | :documentation | 93 | :documentation |
| 94 | "New tables created for this database are of this class.") | 94 | "New tables created for this database are of this class.") |
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 8f9eceea554..38e2b34b0db 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el | |||
| @@ -321,12 +321,12 @@ Adds the number of tags in this file to the object print name." | |||
| 321 | '(list-of semanticdb-abstract-table)) | 321 | '(list-of semanticdb-abstract-table)) |
| 322 | 322 | ||
| 323 | (defclass semanticdb-project-database (eieio-instance-tracker) | 323 | (defclass semanticdb-project-database (eieio-instance-tracker) |
| 324 | ((tracking-symbol :initform semanticdb-database-list) | 324 | ((tracking-symbol :initform 'semanticdb-database-list) |
| 325 | (reference-directory :type string | 325 | (reference-directory :type string |
| 326 | :documentation "Directory this database refers to. | 326 | :documentation "Directory this database refers to. |
| 327 | When a cache directory is specified, then this refers to the directory | 327 | When a cache directory is specified, then this refers to the directory |
| 328 | this database contains symbols for.") | 328 | this database contains symbols for.") |
| 329 | (new-table-class :initform semanticdb-table | 329 | (new-table-class :initform 'semanticdb-table |
| 330 | :type class | 330 | :type class |
| 331 | :documentation | 331 | :documentation |
| 332 | "New tables created for this database are of this class.") | 332 | "New tables created for this database are of this class.") |
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index 6bb83526f6c..19d4184fa45 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el | |||
| @@ -38,13 +38,13 @@ | |||
| 38 | (keybindings :initform nil) | 38 | (keybindings :initform nil) |
| 39 | (phony :initform t) | 39 | (phony :initform t) |
| 40 | (sourcetype :initform | 40 | (sourcetype :initform |
| 41 | (semantic-ede-source-grammar-wisent | 41 | '(semantic-ede-source-grammar-wisent |
| 42 | semantic-ede-source-grammar-bovine | 42 | semantic-ede-source-grammar-bovine |
| 43 | )) | 43 | )) |
| 44 | (availablecompilers :initform | 44 | (availablecompilers :initform |
| 45 | (semantic-ede-grammar-compiler-wisent | 45 | '(semantic-ede-grammar-compiler-wisent |
| 46 | semantic-ede-grammar-compiler-bovine | 46 | semantic-ede-grammar-compiler-bovine |
| 47 | )) | 47 | )) |
| 48 | (aux-packages :initform '("semantic" "cedet-compat")) | 48 | (aux-packages :initform '("semantic" "cedet-compat")) |
| 49 | (pre-load-packages :initform '("cedet-compat" "semantic/grammar" "semantic/bovine/grammar" "semantic/wisent/grammar")) | 49 | (pre-load-packages :initform '("cedet-compat" "semantic/grammar" "semantic/bovine/grammar" "semantic/wisent/grammar")) |
| 50 | ) | 50 | ) |
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 46027f1f91e..180d779a780 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el | |||
| @@ -168,7 +168,7 @@ This shell should support pipe redirect syntax." | |||
| 168 | (erase-buffer) | 168 | (erase-buffer) |
| 169 | (setq default-directory rootdir) | 169 | (setq default-directory rootdir) |
| 170 | (let ((cmd (semantic-symref-grep-use-template | 170 | (let ((cmd (semantic-symref-grep-use-template |
| 171 | (file-name-as-directory (file-local-name rootdir)) | 171 | (directory-file-name (file-local-name rootdir)) |
| 172 | filepattern grepflags greppat))) | 172 | filepattern grepflags greppat))) |
| 173 | (process-file semantic-symref-grep-shell nil b nil | 173 | (process-file semantic-symref-grep-shell nil b nil |
| 174 | shell-command-switch cmd))) | 174 | shell-command-switch cmd))) |
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 36df1da9e33..15107ef1e43 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el | |||
| @@ -110,7 +110,12 @@ stack is broken." | |||
| 110 | :type (or null string) | 110 | :type (or null string) |
| 111 | :documentation | 111 | :documentation |
| 112 | "If there is a colon in the inserter's name, it represents | 112 | "If there is a colon in the inserter's name, it represents |
| 113 | additional static argument data.")) | 113 | additional static argument data.") |
| 114 | (key :initform nil :allocation :class | ||
| 115 | :documentation | ||
| 116 | "The character code used to identify inserters of this style. | ||
| 117 | All children of this class should specify `key' slot with appropriate | ||
| 118 | :initform value.")) | ||
| 114 | "This represents an item to be inserted via a template macro. | 119 | "This represents an item to be inserted via a template macro. |
| 115 | Plain text strings are not handled via this baseclass." | 120 | Plain text strings are not handled via this baseclass." |
| 116 | :abstract t) | 121 | :abstract t) |
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index ab0503c8d36..f20842b1d8a 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el | |||
| @@ -89,6 +89,8 @@ DICT-ENTRIES are additional dictionary values to add." | |||
| 89 | ;; for this insertion step. | 89 | ;; for this insertion step. |
| 90 | )) | 90 | )) |
| 91 | 91 | ||
| 92 | (eieio-declare-slots (point :allocation :class)) | ||
| 93 | |||
| 92 | (defun srecode-insert-fcn (template dictionary &optional stream skipresolver) | 94 | (defun srecode-insert-fcn (template dictionary &optional stream skipresolver) |
| 93 | "Insert TEMPLATE using DICTIONARY into STREAM. | 95 | "Insert TEMPLATE using DICTIONARY into STREAM. |
| 94 | Optional SKIPRESOLVER means to avoid refreshing the tag list, | 96 | Optional SKIPRESOLVER means to avoid refreshing the tag list, |
| @@ -134,13 +136,13 @@ has set everything up already." | |||
| 134 | ) | 136 | ) |
| 135 | (srecode-insert-method template dictionary)) | 137 | (srecode-insert-method template dictionary)) |
| 136 | ;; Handle specialization of the POINT inserter. | 138 | ;; Handle specialization of the POINT inserter. |
| 137 | (when (and (bufferp standard-output) | 139 | (when (bufferp standard-output) |
| 138 | (slot-boundp 'srecode-template-inserter-point 'point) | 140 | (let ((point (oref-default 'srecode-template-inserter-point point))) |
| 139 | ) | 141 | (when point |
| 140 | (set-buffer standard-output) | 142 | (set-buffer standard-output) |
| 141 | (setq end-mark (point-marker)) | 143 | (setq end-mark (point-marker)) |
| 142 | (goto-char (oref-default 'srecode-template-inserter-point point))) | 144 | (goto-char point)))) |
| 143 | (oset-default 'srecode-template-inserter-point point eieio-unbound) | 145 | (oset-default 'srecode-template-inserter-point point nil) |
| 144 | 146 | ||
| 145 | ;; Return the end-mark. | 147 | ;; Return the end-mark. |
| 146 | (or end-mark (point))) | 148 | (or end-mark (point))) |
| @@ -733,6 +735,7 @@ DEPTH.") | |||
| 733 | "The character code used to identify inserters of this style.") | 735 | "The character code used to identify inserters of this style.") |
| 734 | (point :type (or null marker) | 736 | (point :type (or null marker) |
| 735 | :allocation :class | 737 | :allocation :class |
| 738 | :initform nil | ||
| 736 | :documentation | 739 | :documentation |
| 737 | "Record the value of (point) in this class slot. | 740 | "Record the value of (point) in this class slot. |
| 738 | It is the responsibility of the inserter algorithm to clear this | 741 | It is the responsibility of the inserter algorithm to clear this |
diff --git a/lisp/custom.el b/lisp/custom.el index 078e3a8cf8e..1db3f4fd394 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -1528,7 +1528,7 @@ See `custom-enabled-themes' for a list of enabled themes." | |||
| 1528 | (let* ((prop (car s)) | 1528 | (let* ((prop (car s)) |
| 1529 | (symbol (cadr s)) | 1529 | (symbol (cadr s)) |
| 1530 | (val (assq-delete-all theme (get symbol prop)))) | 1530 | (val (assq-delete-all theme (get symbol prop)))) |
| 1531 | (custom-push-theme prop symbol theme 'reset) | 1531 | (put symbol prop val) |
| 1532 | (cond | 1532 | (cond |
| 1533 | ((eq prop 'theme-value) | 1533 | ((eq prop 'theme-value) |
| 1534 | (custom-theme-recalc-variable symbol) | 1534 | (custom-theme-recalc-variable symbol) |
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index a1dda3f5a20..54cfbbad034 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -1859,7 +1859,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil." | |||
| 1859 | (while blist | 1859 | (while blist |
| 1860 | (with-current-buffer (car blist) | 1860 | (with-current-buffer (car blist) |
| 1861 | (if (and buffer-file-name | 1861 | (if (and buffer-file-name |
| 1862 | (dired-in-this-tree-p buffer-file-name expanded-from-dir)) | 1862 | (file-in-directory-p buffer-file-name expanded-from-dir)) |
| 1863 | (let ((modflag (buffer-modified-p)) | 1863 | (let ((modflag (buffer-modified-p)) |
| 1864 | (to-file (replace-regexp-in-string | 1864 | (to-file (replace-regexp-in-string |
| 1865 | (concat "^" (regexp-quote from-dir)) | 1865 | (concat "^" (regexp-quote from-dir)) |
| @@ -1878,7 +1878,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil." | |||
| 1878 | (while alist | 1878 | (while alist |
| 1879 | (setq elt (car alist) | 1879 | (setq elt (car alist) |
| 1880 | alist (cdr alist)) | 1880 | alist (cdr alist)) |
| 1881 | (if (dired-in-this-tree-p (car elt) expanded-dir) | 1881 | (if (file-in-directory-p (car elt) expanded-dir) |
| 1882 | ;; ELT's subdir is affected by the rename | 1882 | ;; ELT's subdir is affected by the rename |
| 1883 | (dired-rename-subdir-2 elt dir to))) | 1883 | (dired-rename-subdir-2 elt dir to))) |
| 1884 | (if (equal dir default-directory) | 1884 | (if (equal dir default-directory) |
| @@ -1963,6 +1963,9 @@ or with the current marker character if MARKER-CHAR is t." | |||
| 1963 | (let (to overwrite-query | 1963 | (let (to overwrite-query |
| 1964 | overwrite-backup-query) ; for dired-handle-overwrite | 1964 | overwrite-backup-query) ; for dired-handle-overwrite |
| 1965 | (dolist (from fn-list) | 1965 | (dolist (from fn-list) |
| 1966 | ;; Position point on the current file -- this is useful if | ||
| 1967 | ;; handling a number of files to show where we're working at. | ||
| 1968 | (dired-goto-file from) | ||
| 1966 | (setq to (funcall name-constructor from)) | 1969 | (setq to (funcall name-constructor from)) |
| 1967 | (if (equal to from) | 1970 | (if (equal to from) |
| 1968 | (progn | 1971 | (progn |
| @@ -2704,7 +2707,7 @@ This function takes some pains to conform to `ls -lR' output." | |||
| 2704 | (setq switches (string-replace "R" "" switches)) | 2707 | (setq switches (string-replace "R" "" switches)) |
| 2705 | (dolist (cur-ass dired-subdir-alist) | 2708 | (dolist (cur-ass dired-subdir-alist) |
| 2706 | (let ((cur-dir (car cur-ass))) | 2709 | (let ((cur-dir (car cur-ass))) |
| 2707 | (and (dired-in-this-tree-p cur-dir dirname) | 2710 | (and (file-in-directory-p cur-dir dirname) |
| 2708 | (let ((cur-cons (assoc-string cur-dir dired-switches-alist))) | 2711 | (let ((cur-cons (assoc-string cur-dir dired-switches-alist))) |
| 2709 | (if cur-cons | 2712 | (if cur-cons |
| 2710 | (setcdr cur-cons switches) | 2713 | (setcdr cur-cons switches) |
| @@ -2716,7 +2719,7 @@ This function takes some pains to conform to `ls -lR' output." | |||
| 2716 | (defun dired-insert-subdir-validate (dirname &optional switches) | 2719 | (defun dired-insert-subdir-validate (dirname &optional switches) |
| 2717 | ;; Check that it is valid to insert DIRNAME with SWITCHES. | 2720 | ;; Check that it is valid to insert DIRNAME with SWITCHES. |
| 2718 | ;; Signal an error if invalid (e.g. user typed `i' on `..'). | 2721 | ;; Signal an error if invalid (e.g. user typed `i' on `..'). |
| 2719 | (or (dired-in-this-tree-p dirname (expand-file-name default-directory)) | 2722 | (or (file-in-directory-p dirname (expand-file-name default-directory)) |
| 2720 | (error "%s: not in this directory tree" dirname)) | 2723 | (error "%s: not in this directory tree" dirname)) |
| 2721 | (let ((real-switches (or switches dired-subdir-switches))) | 2724 | (let ((real-switches (or switches dired-subdir-switches))) |
| 2722 | (when real-switches | 2725 | (when real-switches |
| @@ -2757,7 +2760,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." | |||
| 2757 | (setq dir (car (car s-alist)) | 2760 | (setq dir (car (car s-alist)) |
| 2758 | s-alist (cdr s-alist)) | 2761 | s-alist (cdr s-alist)) |
| 2759 | (and (or kill-root (not (string-equal dir dirname))) | 2762 | (and (or kill-root (not (string-equal dir dirname))) |
| 2760 | (dired-in-this-tree-p dir dirname) | 2763 | (file-in-directory-p dir dirname) |
| 2761 | (dired-goto-subdir dir) | 2764 | (dired-goto-subdir dir) |
| 2762 | (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist)))) | 2765 | (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist)))) |
| 2763 | m-alist)) | 2766 | m-alist)) |
| @@ -2989,7 +2992,7 @@ Lower levels are unaffected." | |||
| 2989 | (while rest | 2992 | (while rest |
| 2990 | (setq elt (car rest) | 2993 | (setq elt (car rest) |
| 2991 | rest (cdr rest)) | 2994 | rest (cdr rest)) |
| 2992 | (if (dired-in-this-tree-p (directory-file-name (car elt)) dir) | 2995 | (if (file-in-directory-p (directory-file-name (car elt)) dir) |
| 2993 | (setq rest nil | 2996 | (setq rest nil |
| 2994 | pos (dired-goto-subdir (car elt)))))) | 2997 | pos (dired-goto-subdir (car elt)))))) |
| 2995 | (if pos | 2998 | (if pos |
diff --git a/lisp/dired.el b/lisp/dired.el index 8527634760a..bb428e21983 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -2820,10 +2820,12 @@ You can then feed the file name(s) to other commands with \\[yank]." | |||
| 2820 | 2820 | ||
| 2821 | ;; Keeping Dired buffers in sync with the filesystem and with each other | 2821 | ;; Keeping Dired buffers in sync with the filesystem and with each other |
| 2822 | 2822 | ||
| 2823 | (defun dired-buffers-for-dir (dir &optional file) | 2823 | (defun dired-buffers-for-dir (dir &optional file subdirs) |
| 2824 | "Return a list of buffers for DIR (top level or in-situ subdir). | 2824 | "Return a list of buffers for DIR (top level or in-situ subdir). |
| 2825 | If FILE is non-nil, include only those whose wildcard pattern (if any) | 2825 | If FILE is non-nil, include only those whose wildcard pattern (if any) |
| 2826 | matches FILE. | 2826 | matches FILE. |
| 2827 | If SUBDIRS is non-nil, also include the dired buffers of | ||
| 2828 | directories below DIR. | ||
| 2827 | The list is in reverse order of buffer creation, most recent last. | 2829 | The list is in reverse order of buffer creation, most recent last. |
| 2828 | As a side effect, killed dired buffers for DIR are removed from | 2830 | As a side effect, killed dired buffers for DIR are removed from |
| 2829 | dired-buffers." | 2831 | dired-buffers." |
| @@ -2835,19 +2837,20 @@ dired-buffers." | |||
| 2835 | ((null (buffer-name buf)) | 2837 | ((null (buffer-name buf)) |
| 2836 | ;; Buffer is killed - clean up: | 2838 | ;; Buffer is killed - clean up: |
| 2837 | (setq dired-buffers (delq elt dired-buffers))) | 2839 | (setq dired-buffers (delq elt dired-buffers))) |
| 2838 | ((dired-in-this-tree-p dir (car elt)) | 2840 | ((file-in-directory-p (car elt) dir) |
| 2839 | (with-current-buffer buf | 2841 | (with-current-buffer buf |
| 2840 | (and (assoc dir dired-subdir-alist) | 2842 | (when (and (or subdirs |
| 2841 | (or (null file) | 2843 | (assoc dir dired-subdir-alist)) |
| 2842 | (if (stringp dired-directory) | 2844 | (or (null file) |
| 2843 | (let ((wildcards (file-name-nondirectory | 2845 | (if (stringp dired-directory) |
| 2844 | dired-directory))) | 2846 | (let ((wildcards (file-name-nondirectory |
| 2845 | (or (zerop (length wildcards)) | 2847 | dired-directory))) |
| 2846 | (string-match-p (dired-glob-regexp wildcards) | 2848 | (or (zerop (length wildcards)) |
| 2847 | file))) | 2849 | (string-match-p (dired-glob-regexp wildcards) |
| 2848 | (member (expand-file-name file dir) | 2850 | file))) |
| 2849 | (cdr dired-directory)))) | 2851 | (member (expand-file-name file dir) |
| 2850 | (setq result (cons buf result))))))) | 2852 | (cdr dired-directory))))) |
| 2853 | (setq result (cons buf result))))))) | ||
| 2851 | result)) | 2854 | result)) |
| 2852 | 2855 | ||
| 2853 | (defun dired-glob-regexp (pattern) | 2856 | (defun dired-glob-regexp (pattern) |
| @@ -2912,6 +2915,7 @@ dired-buffers." | |||
| 2912 | ;;"Is FILE part of the directory tree starting at DIR?" | 2915 | ;;"Is FILE part of the directory tree starting at DIR?" |
| 2913 | (let (case-fold-search) | 2916 | (let (case-fold-search) |
| 2914 | (string-match-p (concat "^" (regexp-quote dir)) file))) | 2917 | (string-match-p (concat "^" (regexp-quote dir)) file))) |
| 2918 | (make-obsolete 'dired-in-this-tree-p 'file-in-directory-p "28.1") | ||
| 2915 | (define-obsolete-function-alias 'dired-in-this-tree | 2919 | (define-obsolete-function-alias 'dired-in-this-tree |
| 2916 | 'dired-in-this-tree-p "27.1") | 2920 | 'dired-in-this-tree-p "27.1") |
| 2917 | 2921 | ||
| @@ -3280,15 +3284,19 @@ non-empty directories is allowed." | |||
| 3280 | (interactive) | 3284 | (interactive) |
| 3281 | (let* ((dired-marker-char dired-del-marker) | 3285 | (let* ((dired-marker-char dired-del-marker) |
| 3282 | (regexp (dired-marker-regexp)) | 3286 | (regexp (dired-marker-regexp)) |
| 3283 | case-fold-search) | 3287 | case-fold-search markers) |
| 3284 | (if (save-excursion (goto-char (point-min)) | 3288 | (if (save-excursion (goto-char (point-min)) |
| 3285 | (re-search-forward regexp nil t)) | 3289 | (re-search-forward regexp nil t)) |
| 3286 | (dired-internal-do-deletions | 3290 | (dired-internal-do-deletions |
| 3287 | (nreverse | 3291 | (nreverse |
| 3288 | ;; this can't move point since ARG is nil | 3292 | ;; this can't move point since ARG is nil |
| 3289 | (dired-map-over-marks (cons (dired-get-filename) (point)) | 3293 | (dired-map-over-marks (cons (dired-get-filename) |
| 3294 | (let ((m (point-marker))) | ||
| 3295 | (push m markers) | ||
| 3296 | m)) | ||
| 3290 | nil)) | 3297 | nil)) |
| 3291 | nil t) | 3298 | nil t) |
| 3299 | (dolist (m markers) (set-marker m nil)) | ||
| 3292 | (or nomessage | 3300 | (or nomessage |
| 3293 | (message "(No deletions requested)"))))) | 3301 | (message "(No deletions requested)"))))) |
| 3294 | 3302 | ||
| @@ -3299,12 +3307,17 @@ non-empty directories is allowed." | |||
| 3299 | ;; This is more consistent with the file marking feature than | 3307 | ;; This is more consistent with the file marking feature than |
| 3300 | ;; dired-do-flagged-delete. | 3308 | ;; dired-do-flagged-delete. |
| 3301 | (interactive "P") | 3309 | (interactive "P") |
| 3302 | (dired-internal-do-deletions | 3310 | (let (markers) |
| 3303 | (nreverse | 3311 | (dired-internal-do-deletions |
| 3304 | ;; this may move point if ARG is an integer | 3312 | (nreverse |
| 3305 | (dired-map-over-marks (cons (dired-get-filename) (point)) | 3313 | ;; this may move point if ARG is an integer |
| 3306 | arg)) | 3314 | (dired-map-over-marks (cons (dired-get-filename) |
| 3307 | arg t)) | 3315 | (let ((m (point-marker))) |
| 3316 | (push m markers) | ||
| 3317 | m)) | ||
| 3318 | arg)) | ||
| 3319 | arg t) | ||
| 3320 | (dolist (m markers) (set-marker m nil)))) | ||
| 3308 | 3321 | ||
| 3309 | (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? | 3322 | (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? |
| 3310 | 3323 | ||
| @@ -3312,11 +3325,6 @@ non-empty directories is allowed." | |||
| 3312 | ;; L is an alist of files to delete, with their buffer positions. | 3325 | ;; L is an alist of files to delete, with their buffer positions. |
| 3313 | ;; ARG is the prefix arg. | 3326 | ;; ARG is the prefix arg. |
| 3314 | ;; Filenames are absolute. | 3327 | ;; Filenames are absolute. |
| 3315 | ;; (car L) *must* be the *last* (bottommost) file in the dired buffer. | ||
| 3316 | ;; That way as changes are made in the buffer they do not shift the | ||
| 3317 | ;; lines still to be changed, so the (point) values in L stay valid. | ||
| 3318 | ;; Also, for subdirs in natural order, a subdir's files are deleted | ||
| 3319 | ;; before the subdir itself - the other way around would not work. | ||
| 3320 | (let* ((files (mapcar #'car l)) | 3328 | (let* ((files (mapcar #'car l)) |
| 3321 | (count (length l)) | 3329 | (count (length l)) |
| 3322 | (succ 0) | 3330 | (succ 0) |
| @@ -3337,9 +3345,10 @@ non-empty directories is allowed." | |||
| 3337 | (make-progress-reporter | 3345 | (make-progress-reporter |
| 3338 | (if trashing "Trashing..." "Deleting...") | 3346 | (if trashing "Trashing..." "Deleting...") |
| 3339 | succ count)) | 3347 | succ count)) |
| 3340 | failures) ;; files better be in reverse order for this loop! | 3348 | failures) |
| 3341 | (while l | 3349 | (while l |
| 3342 | (goto-char (cdr (car l))) | 3350 | (goto-char (marker-position (cdr (car l)))) |
| 3351 | (dired-move-to-filename) | ||
| 3343 | (let ((inhibit-read-only t)) | 3352 | (let ((inhibit-read-only t)) |
| 3344 | (condition-case err | 3353 | (condition-case err |
| 3345 | (let ((fn (car (car l)))) | 3354 | (let ((fn (car (car l)))) |
| @@ -3422,7 +3431,8 @@ confirmation. To disable the confirmation, see | |||
| 3422 | (file-name-nondirectory fn)))) | 3431 | (file-name-nondirectory fn)))) |
| 3423 | (not dired-clean-confirm-killing-deleted-buffers)) | 3432 | (not dired-clean-confirm-killing-deleted-buffers)) |
| 3424 | (kill-buffer buf))) | 3433 | (kill-buffer buf))) |
| 3425 | (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) | 3434 | (let ((buf-list (dired-buffers-for-dir (expand-file-name fn) |
| 3435 | nil 'subdirs))) | ||
| 3426 | (and buf-list | 3436 | (and buf-list |
| 3427 | (or (and dired-clean-confirm-killing-deleted-buffers | 3437 | (or (and dired-clean-confirm-killing-deleted-buffers |
| 3428 | (y-or-n-p | 3438 | (y-or-n-p |
diff --git a/lisp/electric.el b/lisp/electric.el index 6701a36d8bb..4394fae4366 100644 --- a/lisp/electric.el +++ b/lisp/electric.el | |||
| @@ -245,10 +245,7 @@ or comment." | |||
| 245 | 'electric-indent-functions | 245 | 'electric-indent-functions |
| 246 | last-command-event) | 246 | last-command-event) |
| 247 | (memq last-command-event electric-indent-chars)))) | 247 | (memq last-command-event electric-indent-chars)))) |
| 248 | (not | 248 | (not (memq act '(nil no-indent)))))) |
| 249 | (or (memq act '(nil no-indent)) | ||
| 250 | ;; In a string or comment. | ||
| 251 | (unless (eq act 'do-indent) (nth 8 (syntax-ppss)))))))) | ||
| 252 | ;; If we error during indent, silently give up since this is an | 249 | ;; If we error during indent, silently give up since this is an |
| 253 | ;; automatic action that the user didn't explicitly request. | 250 | ;; automatic action that the user didn't explicitly request. |
| 254 | ;; But we don't want to suppress errors from elsewhere in *this* | 251 | ;; But we don't want to suppress errors from elsewhere in *this* |
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index 439d3bd363e..64c628822df 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el | |||
| @@ -37,8 +37,7 @@ | |||
| 37 | "Return the time in seconds elapsed for execution of FORMS." | 37 | "Return the time in seconds elapsed for execution of FORMS." |
| 38 | (declare (indent 0) (debug t)) | 38 | (declare (indent 0) (debug t)) |
| 39 | (let ((t1 (make-symbol "t1"))) | 39 | (let ((t1 (make-symbol "t1"))) |
| 40 | `(let (,t1) | 40 | `(let ((,t1 (current-time))) |
| 41 | (setq ,t1 (current-time)) | ||
| 42 | ,@forms | 41 | ,@forms |
| 43 | (float-time (time-since ,t1))))) | 42 | (float-time (time-since ,t1))))) |
| 44 | 43 | ||
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 10a50da4628..2fff0bd4a5f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el | |||
| @@ -343,7 +343,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") | |||
| 343 | (numberp expr) | 343 | (numberp expr) |
| 344 | (stringp expr) | 344 | (stringp expr) |
| 345 | (and (consp expr) | 345 | (and (consp expr) |
| 346 | (eq (car expr) 'quote) | 346 | (memq (car expr) '(quote function)) |
| 347 | (symbolp (cadr expr))) | 347 | (symbolp (cadr expr))) |
| 348 | (keywordp expr))) | 348 | (keywordp expr))) |
| 349 | 349 | ||
| @@ -1269,6 +1269,14 @@ See Info node `(elisp) Integer Basics'." | |||
| 1269 | form) | 1269 | form) |
| 1270 | form)) | 1270 | form)) |
| 1271 | 1271 | ||
| 1272 | (put 'cons 'byte-optimizer #'byte-optimize-cons) | ||
| 1273 | (defun byte-optimize-cons (form) | ||
| 1274 | ;; (cons X nil) => (list X) | ||
| 1275 | (if (and (= (safe-length form) 3) | ||
| 1276 | (null (nth 2 form))) | ||
| 1277 | `(list ,(nth 1 form)) | ||
| 1278 | form)) | ||
| 1279 | |||
| 1272 | ;; Fixme: delete-char -> delete-region (byte-coded) | 1280 | ;; Fixme: delete-char -> delete-region (byte-coded) |
| 1273 | ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte, | 1281 | ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte, |
| 1274 | ;; string-make-multibyte for constant args. | 1282 | ;; string-make-multibyte for constant args. |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 86c5d32c726..96a0da924fc 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -606,7 +606,7 @@ Each element is (INDEX . VALUE)") | |||
| 606 | "Non nil while native compiling.") | 606 | "Non nil while native compiling.") |
| 607 | (defvar byte-native-qualities nil | 607 | (defvar byte-native-qualities nil |
| 608 | "To spill default qualities from the compiled file.") | 608 | "To spill default qualities from the compiled file.") |
| 609 | (defvar byte-native-for-bootstrap nil | 609 | (defvar byte+native-compile nil |
| 610 | "Non nil while compiling for bootstrap." | 610 | "Non nil while compiling for bootstrap." |
| 611 | ;; During bootstrap we produce both the .eln and the .elc together. | 611 | ;; During bootstrap we produce both the .eln and the .elc together. |
| 612 | ;; Because the make target is the later this has to be produced as | 612 | ;; Because the make target is the later this has to be produced as |
| @@ -2109,7 +2109,7 @@ See also `emacs-lisp-byte-compile-and-load'." | |||
| 2109 | ;; recompiled). Previously this was accomplished by | 2109 | ;; recompiled). Previously this was accomplished by |
| 2110 | ;; deleting target-file before writing it. | 2110 | ;; deleting target-file before writing it. |
| 2111 | (if byte-native-compiling | 2111 | (if byte-native-compiling |
| 2112 | (if byte-native-for-bootstrap | 2112 | (if byte+native-compile |
| 2113 | ;; Defer elc final renaming. | 2113 | ;; Defer elc final renaming. |
| 2114 | (setf byte-to-native-output-file | 2114 | (setf byte-to-native-output-file |
| 2115 | (cons tempfile target-file)) | 2115 | (cons tempfile target-file)) |
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 5afc6d3bde3..0494497feaf 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el | |||
| @@ -203,7 +203,7 @@ Make sure the width/height is correct." | |||
| 203 | 203 | ||
| 204 | (defclass chart-bar (chart) | 204 | (defclass chart-bar (chart) |
| 205 | ((direction :initarg :direction | 205 | ((direction :initarg :direction |
| 206 | :initform vertical)) | 206 | :initform 'vertical)) |
| 207 | "Subclass for bar charts (vertical or horizontal).") | 207 | "Subclass for bar charts (vertical or horizontal).") |
| 208 | 208 | ||
| 209 | (cl-defmethod chart-draw ((c chart) &optional buff) | 209 | (cl-defmethod chart-draw ((c chart) &optional buff) |
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b09739cb92e..638d4b274cc 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el | |||
| @@ -200,6 +200,9 @@ Emacs Lisp file: | |||
| 200 | \;; Local Variables:\n;; no-native-compile: t\n;; End:") | 200 | \;; Local Variables:\n;; no-native-compile: t\n;; End:") |
| 201 | ;;;###autoload(put 'no-native-compile 'safe-local-variable 'booleanp) | 201 | ;;;###autoload(put 'no-native-compile 'safe-local-variable 'booleanp) |
| 202 | 202 | ||
| 203 | (defvar native-compile-target-directory nil | ||
| 204 | "When non-nil force the target directory for the eln files being compiled.") | ||
| 205 | |||
| 203 | (defvar comp-log-time-report nil | 206 | (defvar comp-log-time-report nil |
| 204 | "If non-nil, log a time report for each pass.") | 207 | "If non-nil, log a time report for each pass.") |
| 205 | 208 | ||
| @@ -1337,8 +1340,9 @@ clashes." | |||
| 1337 | (unless (comp-ctxt-output comp-ctxt) | 1340 | (unless (comp-ctxt-output comp-ctxt) |
| 1338 | (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename | 1341 | (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename |
| 1339 | filename | 1342 | filename |
| 1340 | (when byte-native-for-bootstrap | 1343 | (or native-compile-target-directory |
| 1341 | (car (last native-comp-eln-load-path)))))) | 1344 | (when byte+native-compile |
| 1345 | (car (last native-comp-eln-load-path))))))) | ||
| 1342 | (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed | 1346 | (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed |
| 1343 | byte-native-qualities) | 1347 | byte-native-qualities) |
| 1344 | (comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug | 1348 | (comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug |
| @@ -3643,7 +3647,7 @@ Prepare every function for final compilation and drive the C back-end." | |||
| 3643 | ;; unless during bootstrap or async compilation (bug#45056). GCC | 3647 | ;; unless during bootstrap or async compilation (bug#45056). GCC |
| 3644 | ;; leaks memory but also interfere with the ability of Emacs to | 3648 | ;; leaks memory but also interfere with the ability of Emacs to |
| 3645 | ;; detect when a sub-process completes (TODO understand why). | 3649 | ;; detect when a sub-process completes (TODO understand why). |
| 3646 | (if (or byte-native-for-bootstrap comp-async-compilation) | 3650 | (if (or byte+native-compile comp-async-compilation) |
| 3647 | (comp-final1) | 3651 | (comp-final1) |
| 3648 | ;; Call comp-final1 in a child process. | 3652 | ;; Call comp-final1 in a child process. |
| 3649 | (let* ((output (comp-ctxt-output comp-ctxt)) | 3653 | (let* ((output (comp-ctxt-output comp-ctxt)) |
| @@ -3941,7 +3945,11 @@ display a message." | |||
| 3941 | (load1 load) | 3945 | (load1 load) |
| 3942 | (process (make-process | 3946 | (process (make-process |
| 3943 | :name (concat "Compiling: " source-file) | 3947 | :name (concat "Compiling: " source-file) |
| 3944 | :buffer (get-buffer-create comp-async-buffer-name) | 3948 | :buffer (with-current-buffer |
| 3949 | (get-buffer-create | ||
| 3950 | comp-async-buffer-name) | ||
| 3951 | (setf buffer-read-only t) | ||
| 3952 | (current-buffer)) | ||
| 3945 | :command (list | 3953 | :command (list |
| 3946 | (expand-file-name invocation-name | 3954 | (expand-file-name invocation-name |
| 3947 | invocation-directory) | 3955 | invocation-directory) |
| @@ -3970,8 +3978,9 @@ display a message." | |||
| 3970 | (run-hooks 'native-comp-async-all-done-hook) | 3978 | (run-hooks 'native-comp-async-all-done-hook) |
| 3971 | (with-current-buffer (get-buffer-create comp-async-buffer-name) | 3979 | (with-current-buffer (get-buffer-create comp-async-buffer-name) |
| 3972 | (save-excursion | 3980 | (save-excursion |
| 3973 | (goto-char (point-max)) | 3981 | (let ((buffer-read-only nil)) |
| 3974 | (insert "Compilation finished.\n"))) | 3982 | (goto-char (point-max)) |
| 3983 | (insert "Compilation finished.\n")))) | ||
| 3975 | ;; `comp-deferred-pending-h' should be empty at this stage. | 3984 | ;; `comp-deferred-pending-h' should be empty at this stage. |
| 3976 | ;; Reset it anyway. | 3985 | ;; Reset it anyway. |
| 3977 | (clrhash comp-deferred-pending-h))) | 3986 | (clrhash comp-deferred-pending-h))) |
| @@ -4166,7 +4175,7 @@ it won’t work in an interactive Emacs. | |||
| 4166 | Native compilation equivalent to `batch-byte-compile'." | 4175 | Native compilation equivalent to `batch-byte-compile'." |
| 4167 | (comp-ensure-native-compiler) | 4176 | (comp-ensure-native-compiler) |
| 4168 | (cl-loop for file in command-line-args-left | 4177 | (cl-loop for file in command-line-args-left |
| 4169 | if (or (null byte-native-for-bootstrap) | 4178 | if (or (null byte+native-compile) |
| 4170 | (cl-notany (lambda (re) (string-match re file)) | 4179 | (cl-notany (lambda (re) (string-match re file)) |
| 4171 | native-comp-bootstrap-deny-list)) | 4180 | native-comp-bootstrap-deny-list)) |
| 4172 | do (comp--native-compile file) | 4181 | do (comp--native-compile file) |
| @@ -4174,18 +4183,18 @@ Native compilation equivalent to `batch-byte-compile'." | |||
| 4174 | do (byte-compile-file file))) | 4183 | do (byte-compile-file file))) |
| 4175 | 4184 | ||
| 4176 | ;;;###autoload | 4185 | ;;;###autoload |
| 4177 | (defun batch-byte-native-compile-for-bootstrap () | 4186 | (defun batch-byte+native-compile () |
| 4178 | "Like `batch-native-compile', but used for bootstrap. | 4187 | "Like `batch-native-compile', but used for bootstrap. |
| 4179 | Generate .elc files in addition to the .eln files. | 4188 | Generate .elc files in addition to the .eln files. |
| 4180 | Force the produced .eln to be outputted in the eln system | 4189 | Force the produced .eln to be outputted in the eln system |
| 4181 | directory (the last entry in `native-comp-eln-load-path'). | 4190 | directory (the last entry in `native-comp-eln-load-path') unless |
| 4182 | If the environment variable 'NATIVE_DISABLED' is set, only byte | 4191 | `native-compile-target-directory' is non-nil. If the environment |
| 4183 | compile." | 4192 | variable 'NATIVE_DISABLED' is set, only byte compile." |
| 4184 | (comp-ensure-native-compiler) | 4193 | (comp-ensure-native-compiler) |
| 4185 | (if (equal (getenv "NATIVE_DISABLED") "1") | 4194 | (if (equal (getenv "NATIVE_DISABLED") "1") |
| 4186 | (batch-byte-compile) | 4195 | (batch-byte-compile) |
| 4187 | (cl-assert (length= command-line-args-left 1)) | 4196 | (cl-assert (length= command-line-args-left 1)) |
| 4188 | (let ((byte-native-for-bootstrap t) | 4197 | (let ((byte+native-compile t) |
| 4189 | (byte-to-native-output-file nil)) | 4198 | (byte-to-native-output-file nil)) |
| 4190 | (batch-native-compile) | 4199 | (batch-native-compile) |
| 4191 | (pcase byte-to-native-output-file | 4200 | (pcase byte-to-native-output-file |
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 641882c9026..ec7c899bddc 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el | |||
| @@ -156,7 +156,7 @@ only one object ever exists." | |||
| 156 | ;; NOTE TO SELF: In next version, make `slot-boundp' support classes | 156 | ;; NOTE TO SELF: In next version, make `slot-boundp' support classes |
| 157 | ;; with class allocated slots or default values. | 157 | ;; with class allocated slots or default values. |
| 158 | (let ((old (oref-default class singleton))) | 158 | (let ((old (oref-default class singleton))) |
| 159 | (if (eq old eieio-unbound) | 159 | (if (eq old eieio--unbound) |
| 160 | (oset-default class singleton (cl-call-next-method)) | 160 | (oset-default class singleton (cl-call-next-method)) |
| 161 | old))) | 161 | old))) |
| 162 | 162 | ||
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 34b4575182e..8f1e38b613b 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -71,11 +71,10 @@ Currently under control of this var: | |||
| 71 | - Define <class>-child-p and <class>-list-p predicates. | 71 | - Define <class>-child-p and <class>-list-p predicates. |
| 72 | - Allow object names in constructors.") | 72 | - Allow object names in constructors.") |
| 73 | 73 | ||
| 74 | (defconst eieio-unbound | 74 | (define-obsolete-variable-alias 'eieio-unbound 'eieio--unbound "28.1") |
| 75 | (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) | 75 | (defvar eieio--unbound (make-symbol "eieio--unbound") |
| 76 | eieio-unbound | ||
| 77 | (make-symbol "unbound")) | ||
| 78 | "Uninterned symbol representing an unbound slot in an object.") | 76 | "Uninterned symbol representing an unbound slot in an object.") |
| 77 | (defvar eieio--unbound-form (macroexp-quote eieio--unbound)) | ||
| 79 | 78 | ||
| 80 | ;; This is a bootstrap for eieio-default-superclass so it has a value | 79 | ;; This is a bootstrap for eieio-default-superclass so it has a value |
| 81 | ;; while it is being built itself. | 80 | ;; while it is being built itself. |
| @@ -264,6 +263,7 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname) | |||
| 264 | (object-of-class-p obj class)))) | 263 | (object-of-class-p obj class)))) |
| 265 | 264 | ||
| 266 | (defvar eieio--known-slot-names nil) | 265 | (defvar eieio--known-slot-names nil) |
| 266 | (defvar eieio--known-class-slot-names nil) | ||
| 267 | 267 | ||
| 268 | (defun eieio-defclass-internal (cname superclasses slots options) | 268 | (defun eieio-defclass-internal (cname superclasses slots options) |
| 269 | "Define CNAME as a new subclass of SUPERCLASSES. | 269 | "Define CNAME as a new subclass of SUPERCLASSES. |
| @@ -381,7 +381,7 @@ See `defclass' for more information." | |||
| 381 | (pcase-dolist (`(,name . ,slot) slots) | 381 | (pcase-dolist (`(,name . ,slot) slots) |
| 382 | (let* ((init (or (plist-get slot :initform) | 382 | (let* ((init (or (plist-get slot :initform) |
| 383 | (if (member :initform slot) nil | 383 | (if (member :initform slot) nil |
| 384 | eieio-unbound))) | 384 | eieio--unbound-form))) |
| 385 | (initarg (plist-get slot :initarg)) | 385 | (initarg (plist-get slot :initarg)) |
| 386 | (docstr (plist-get slot :documentation)) | 386 | (docstr (plist-get slot :documentation)) |
| 387 | (prot (plist-get slot :protection)) | 387 | (prot (plist-get slot :protection)) |
| @@ -395,6 +395,14 @@ See `defclass' for more information." | |||
| 395 | (skip-nil (eieio--class-option-assoc options :allow-nil-initform)) | 395 | (skip-nil (eieio--class-option-assoc options :allow-nil-initform)) |
| 396 | ) | 396 | ) |
| 397 | 397 | ||
| 398 | (unless (or (macroexp-const-p init) | ||
| 399 | (eieio--eval-default-p init)) | ||
| 400 | ;; FIXME: We duplicate this test here and in `defclass' because | ||
| 401 | ;; if we move this part to `defclass' we may break some existing | ||
| 402 | ;; code (because the `fboundp' test in `eieio--eval-default-p' | ||
| 403 | ;; returns a different result at compile time). | ||
| 404 | (setq init (macroexp-quote init))) | ||
| 405 | |||
| 398 | ;; Clean up the meaning of protection. | 406 | ;; Clean up the meaning of protection. |
| 399 | (setq prot | 407 | (setq prot |
| 400 | (pcase prot | 408 | (pcase prot |
| @@ -457,8 +465,9 @@ See `defclass' for more information." | |||
| 457 | (n (length slots)) | 465 | (n (length slots)) |
| 458 | (v (make-vector n nil))) | 466 | (v (make-vector n nil))) |
| 459 | (dotimes (i n) | 467 | (dotimes (i n) |
| 460 | (setf (aref v i) (eieio-default-eval-maybe | 468 | (setf (aref v i) (eval |
| 461 | (cl--slot-descriptor-initform (aref slots i))))) | 469 | (cl--slot-descriptor-initform (aref slots i)) |
| 470 | t))) | ||
| 462 | (setf (eieio--class-class-allocation-values newc) v)) | 471 | (setf (eieio--class-class-allocation-values newc) v)) |
| 463 | 472 | ||
| 464 | ;; Attach slot symbols into a hash table, and store the index of | 473 | ;; Attach slot symbols into a hash table, and store the index of |
| @@ -513,7 +522,7 @@ See `defclass' for more information." | |||
| 513 | cname | 522 | cname |
| 514 | )) | 523 | )) |
| 515 | 524 | ||
| 516 | (defsubst eieio-eval-default-p (val) | 525 | (defun eieio--eval-default-p (val) |
| 517 | "Whether the default value VAL should be evaluated for use." | 526 | "Whether the default value VAL should be evaluated for use." |
| 518 | (and (consp val) (symbolp (car val)) (fboundp (car val)))) | 527 | (and (consp val) (symbolp (car val)) (fboundp (car val)))) |
| 519 | 528 | ||
| @@ -522,10 +531,10 @@ See `defclass' for more information." | |||
| 522 | If SKIPNIL is non-nil, then if default value is nil return t instead." | 531 | If SKIPNIL is non-nil, then if default value is nil return t instead." |
| 523 | (let ((value (cl--slot-descriptor-initform slot)) | 532 | (let ((value (cl--slot-descriptor-initform slot)) |
| 524 | (spec (cl--slot-descriptor-type slot))) | 533 | (spec (cl--slot-descriptor-type slot))) |
| 525 | (if (not (or (eieio-eval-default-p value) ;FIXME: Why? | 534 | (if (not (or (not (macroexp-const-p value)) |
| 526 | eieio-skip-typecheck | 535 | eieio-skip-typecheck |
| 527 | (and skipnil (null value)) | 536 | (and skipnil (null value)) |
| 528 | (eieio--perform-slot-validation spec value))) | 537 | (eieio--perform-slot-validation spec (eval value t)))) |
| 529 | (signal 'invalid-slot-type (list (cl--slot-descriptor-name slot) spec value))))) | 538 | (signal 'invalid-slot-type (list (cl--slot-descriptor-name slot) spec value))))) |
| 530 | 539 | ||
| 531 | (defun eieio--slot-override (old new skipnil) | 540 | (defun eieio--slot-override (old new skipnil) |
| @@ -546,7 +555,7 @@ If SKIPNIL is non-nil, then if default value is nil return t instead." | |||
| 546 | type tp a)) | 555 | type tp a)) |
| 547 | (setf (cl--slot-descriptor-type new) tp)) | 556 | (setf (cl--slot-descriptor-type new) tp)) |
| 548 | ;; If we have a repeat, only update the initarg... | 557 | ;; If we have a repeat, only update the initarg... |
| 549 | (unless (eq d eieio-unbound) | 558 | (unless (eq d eieio--unbound-form) |
| 550 | (eieio--perform-slot-validation-for-default new skipnil) | 559 | (eieio--perform-slot-validation-for-default new skipnil) |
| 551 | (setf (cl--slot-descriptor-initform old) d)) | 560 | (setf (cl--slot-descriptor-initform old) d)) |
| 552 | 561 | ||
| @@ -604,6 +613,8 @@ if default value is nil." | |||
| 604 | (cold (car (cl-member a (eieio--class-class-slots newc) | 613 | (cold (car (cl-member a (eieio--class-class-slots newc) |
| 605 | :key #'cl--slot-descriptor-name)))) | 614 | :key #'cl--slot-descriptor-name)))) |
| 606 | (cl-pushnew a eieio--known-slot-names) | 615 | (cl-pushnew a eieio--known-slot-names) |
| 616 | (when (eq alloc :class) | ||
| 617 | (cl-pushnew a eieio--known-class-slot-names)) | ||
| 607 | (condition-case nil | 618 | (condition-case nil |
| 608 | (if (sequencep d) (setq d (copy-sequence d))) | 619 | (if (sequencep d) (setq d (copy-sequence d))) |
| 609 | ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's | 620 | ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's |
| @@ -679,7 +690,7 @@ the new child class." | |||
| 679 | (defun eieio--perform-slot-validation (spec value) | 690 | (defun eieio--perform-slot-validation (spec value) |
| 680 | "Return non-nil if SPEC does not match VALUE." | 691 | "Return non-nil if SPEC does not match VALUE." |
| 681 | (or (eq spec t) ; t always passes | 692 | (or (eq spec t) ; t always passes |
| 682 | (eq value eieio-unbound) ; unbound always passes | 693 | (eq value eieio--unbound) ; unbound always passes |
| 683 | (cl-typep value spec))) | 694 | (cl-typep value spec))) |
| 684 | 695 | ||
| 685 | (defun eieio--validate-slot-value (class slot-idx value slot) | 696 | (defun eieio--validate-slot-value (class slot-idx value slot) |
| @@ -715,7 +726,7 @@ an error." | |||
| 715 | INSTANCE is the object being referenced. SLOTNAME is the offending | 726 | INSTANCE is the object being referenced. SLOTNAME is the offending |
| 716 | slot. If the slot is ok, return VALUE. | 727 | slot. If the slot is ok, return VALUE. |
| 717 | Argument FN is the function calling this verifier." | 728 | Argument FN is the function calling this verifier." |
| 718 | (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) | 729 | (if (and (eq value eieio--unbound) (not eieio-skip-typecheck)) |
| 719 | (slot-unbound instance (eieio--object-class instance) slotname fn) | 730 | (slot-unbound instance (eieio--object-class instance) slotname fn) |
| 720 | value)) | 731 | value)) |
| 721 | 732 | ||
| @@ -755,15 +766,29 @@ Argument FN is the function calling this verifier." | |||
| 755 | (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) | 766 | (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) |
| 756 | 767 | ||
| 757 | 768 | ||
| 758 | (defun eieio-oref-default (obj slot) | 769 | (defun eieio-oref-default (class slot) |
| 759 | "Do the work for the macro `oref-default' with similar parameters. | 770 | "Do the work for the macro `oref-default' with similar parameters. |
| 760 | Fills in OBJ's SLOT with its default value." | 771 | Fills in CLASS's SLOT with its default value." |
| 761 | (declare (gv-setter eieio-oset-default)) | 772 | (declare (gv-setter eieio-oset-default) |
| 762 | (cl-check-type obj (or eieio-object class)) | 773 | (compiler-macro |
| 774 | (lambda (exp) | ||
| 775 | (ignore class) | ||
| 776 | (pcase slot | ||
| 777 | ((and (or `',name (and name (pred keywordp))) | ||
| 778 | (guard (not (memq name eieio--known-slot-names)))) | ||
| 779 | (macroexp-warn-and-return | ||
| 780 | (format-message "Unknown slot `%S'" name) exp 'compile-only)) | ||
| 781 | ((and (or `',name (and name (pred keywordp))) | ||
| 782 | (guard (not (memq name eieio--known-class-slot-names)))) | ||
| 783 | (macroexp-warn-and-return | ||
| 784 | (format-message "Slot `%S' is not class-allocated" name) | ||
| 785 | exp 'compile-only)) | ||
| 786 | (_ exp))))) | ||
| 787 | (cl-check-type class (or eieio-object class)) | ||
| 763 | (cl-check-type slot symbol) | 788 | (cl-check-type slot symbol) |
| 764 | (let* ((cl (cond ((symbolp obj) (cl--find-class obj)) | 789 | (let* ((cl (cond ((symbolp class) (cl--find-class class)) |
| 765 | ((eieio-object-p obj) (eieio--object-class obj)) | 790 | ((eieio-object-p class) (eieio--object-class class)) |
| 766 | (t obj))) | 791 | (t class))) |
| 767 | (c (eieio--slot-name-index cl slot))) | 792 | (c (eieio--slot-name-index cl slot))) |
| 768 | (if (not c) | 793 | (if (not c) |
| 769 | ;; It might be missing because it is a :class allocated slot. | 794 | ;; It might be missing because it is a :class allocated slot. |
| @@ -773,27 +798,13 @@ Fills in OBJ's SLOT with its default value." | |||
| 773 | ;; Oref that slot. | 798 | ;; Oref that slot. |
| 774 | (aref (eieio--class-class-allocation-values cl) | 799 | (aref (eieio--class-class-allocation-values cl) |
| 775 | c) | 800 | c) |
| 776 | (slot-missing obj slot 'oref-default)) | 801 | (slot-missing class slot 'oref-default)) |
| 777 | (eieio-barf-if-slot-unbound | 802 | (eieio-barf-if-slot-unbound |
| 778 | (let ((val (cl--slot-descriptor-initform | 803 | (let ((val (cl--slot-descriptor-initform |
| 779 | (aref (eieio--class-slots cl) | 804 | (aref (eieio--class-slots cl) |
| 780 | (- c (eval-when-compile eieio--object-num-slots)))))) | 805 | (- c (eval-when-compile eieio--object-num-slots)))))) |
| 781 | (eieio-default-eval-maybe val)) | 806 | (eval val t)) |
| 782 | obj (eieio--class-name cl) 'oref-default)))) | 807 | class (eieio--class-name cl) 'oref-default)))) |
| 783 | |||
| 784 | (defun eieio-default-eval-maybe (val) | ||
| 785 | "Check VAL, and return what `oref-default' would provide." | ||
| 786 | ;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate | ||
| 787 | ;; variables as well? Why not just always call `eval'? | ||
| 788 | (cond | ||
| 789 | ;; Is it a function call? If so, evaluate it. | ||
| 790 | ((eieio-eval-default-p val) | ||
| 791 | (eval val t)) | ||
| 792 | ;;;; check for quoted things, and unquote them | ||
| 793 | ;;((and (consp val) (eq (car val) 'quote)) | ||
| 794 | ;; (car (cdr val))) | ||
| 795 | ;; return it verbatim | ||
| 796 | (t val))) | ||
| 797 | 808 | ||
| 798 | (defun eieio-oset (obj slot value) | 809 | (defun eieio-oset (obj slot value) |
| 799 | "Do the work for the macro `oset'. | 810 | "Do the work for the macro `oset'. |
| @@ -820,6 +831,20 @@ Fills in OBJ's SLOT with VALUE." | |||
| 820 | (defun eieio-oset-default (class slot value) | 831 | (defun eieio-oset-default (class slot value) |
| 821 | "Do the work for the macro `oset-default'. | 832 | "Do the work for the macro `oset-default'. |
| 822 | Fills in the default value in CLASS' in SLOT with VALUE." | 833 | Fills in the default value in CLASS' in SLOT with VALUE." |
| 834 | (declare (compiler-macro | ||
| 835 | (lambda (exp) | ||
| 836 | (ignore class value) | ||
| 837 | (pcase slot | ||
| 838 | ((and (or `',name (and name (pred keywordp))) | ||
| 839 | (guard (not (memq name eieio--known-slot-names)))) | ||
| 840 | (macroexp-warn-and-return | ||
| 841 | (format-message "Unknown slot `%S'" name) exp 'compile-only)) | ||
| 842 | ((and (or `',name (and name (pred keywordp))) | ||
| 843 | (guard (not (memq name eieio--known-class-slot-names)))) | ||
| 844 | (macroexp-warn-and-return | ||
| 845 | (format-message "Slot `%S' is not class-allocated" name) | ||
| 846 | exp 'compile-only)) | ||
| 847 | (_ exp))))) | ||
| 823 | (setq class (eieio--class-object class)) | 848 | (setq class (eieio--class-object class)) |
| 824 | (cl-check-type class eieio--class) | 849 | (cl-check-type class eieio--class) |
| 825 | (cl-check-type slot symbol) | 850 | (cl-check-type slot symbol) |
| @@ -836,22 +861,18 @@ Fills in the default value in CLASS' in SLOT with VALUE." | |||
| 836 | (signal 'invalid-slot-name (list (eieio--class-name class) slot))) | 861 | (signal 'invalid-slot-name (list (eieio--class-name class) slot))) |
| 837 | ;; `oset-default' on an instance-allocated slot is allowed by EIEIO but | 862 | ;; `oset-default' on an instance-allocated slot is allowed by EIEIO but |
| 838 | ;; not by CLOS and is mildly inconsistent with the :initform thingy, so | 863 | ;; not by CLOS and is mildly inconsistent with the :initform thingy, so |
| 839 | ;; it'd be nice to get of it. This said, it is/was used at one place by | 864 | ;; it'd be nice to get rid of it. |
| 840 | ;; gnus/registry.el, so it might be used elsewhere as well, so let's | 865 | ;; This said, it is/was used at one place by gnus/registry.el, so it |
| 841 | ;; keep it for now. | 866 | ;; might be used elsewhere as well, so let's keep it for now. |
| 842 | ;; FIXME: Generate a compile-time warning for it! | 867 | ;; FIXME: Generate a compile-time warning for it! |
| 843 | ;; (error "Can't `oset-default' an instance-allocated slot: %S of %S" | 868 | ;; (error "Can't `oset-default' an instance-allocated slot: %S of %S" |
| 844 | ;; slot class) | 869 | ;; slot class) |
| 845 | (eieio--validate-slot-value class c value slot) | 870 | (eieio--validate-slot-value class c value slot) |
| 846 | ;; Set this into the storage for defaults. | 871 | ;; Set this into the storage for defaults. |
| 847 | (if (eieio-eval-default-p value) | ||
| 848 | (error "Can't set default to a sexp that gets evaluated again")) | ||
| 849 | (setf (cl--slot-descriptor-initform | 872 | (setf (cl--slot-descriptor-initform |
| 850 | ;; FIXME: Apparently we set it both in `slots' and in | ||
| 851 | ;; `object-cache', which seems redundant. | ||
| 852 | (aref (eieio--class-slots class) | 873 | (aref (eieio--class-slots class) |
| 853 | (- c (eval-when-compile eieio--object-num-slots)))) | 874 | (- c (eval-when-compile eieio--object-num-slots)))) |
| 854 | value) | 875 | (macroexp-quote value)) |
| 855 | ;; Take the value, and put it into our cache object. | 876 | ;; Take the value, and put it into our cache object. |
| 856 | (eieio-oset (eieio--class-default-object-cache class) | 877 | (eieio-oset (eieio--class-default-object-cache class) |
| 857 | slot value) | 878 | slot value) |
| @@ -1093,8 +1114,20 @@ These match if the argument is the name of a subclass of CLASS." | |||
| 1093 | 1114 | ||
| 1094 | (defmacro eieio-declare-slots (&rest slots) | 1115 | (defmacro eieio-declare-slots (&rest slots) |
| 1095 | "Declare that SLOTS are known eieio object slot names." | 1116 | "Declare that SLOTS are known eieio object slot names." |
| 1096 | `(eval-when-compile | 1117 | (let ((slotnames (mapcar (lambda (s) (if (consp s) (car s) s)) slots)) |
| 1097 | (setq eieio--known-slot-names (append ',slots eieio--known-slot-names)))) | 1118 | (classslots (delq nil |
| 1119 | (mapcar (lambda (s) | ||
| 1120 | (when (and (consp s) | ||
| 1121 | (eq :class (plist-get (cdr s) | ||
| 1122 | :allocation))) | ||
| 1123 | (car s))) | ||
| 1124 | slots)))) | ||
| 1125 | `(eval-when-compile | ||
| 1126 | ,@(when classslots | ||
| 1127 | (mapcar (lambda (s) `(add-to-list 'eieio--known-class-slot-names ',s)) | ||
| 1128 | classslots)) | ||
| 1129 | ,@(mapcar (lambda (s) `(add-to-list 'eieio--known-slot-names ',s)) | ||
| 1130 | slotnames)))) | ||
| 1098 | 1131 | ||
| 1099 | (provide 'eieio-core) | 1132 | (provide 'eieio-core) |
| 1100 | 1133 | ||
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 8257f7a4bae..d7d078b2d94 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el | |||
| @@ -46,7 +46,7 @@ | |||
| 46 | :documentation "A string for testing custom. | 46 | :documentation "A string for testing custom. |
| 47 | This is the next line of documentation.") | 47 | This is the next line of documentation.") |
| 48 | (listostuff :initarg :listostuff | 48 | (listostuff :initarg :listostuff |
| 49 | :initform ("1" "2" "3") | 49 | :initform '("1" "2" "3") |
| 50 | :type list | 50 | :type list |
| 51 | :custom (repeat (string :tag "Stuff")) | 51 | :custom (repeat (string :tag "Stuff")) |
| 52 | :label "List of Strings" | 52 | :label "List of Strings" |
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index c25ea8acee9..3f2a6537ab8 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el | |||
| @@ -248,7 +248,7 @@ and take the appropriate action." | |||
| 248 | Possible values are those symbols supported by the `exp-button-type' argument | 248 | Possible values are those symbols supported by the `exp-button-type' argument |
| 249 | to `speedbar-make-tag-line'." | 249 | to `speedbar-make-tag-line'." |
| 250 | :allocation :class) | 250 | :allocation :class) |
| 251 | (buttonface :initform speedbar-tag-face | 251 | (buttonface :initform 'speedbar-tag-face |
| 252 | :type (or symbol face) | 252 | :type (or symbol face) |
| 253 | :documentation | 253 | :documentation |
| 254 | "The face used on the textual part of the button for this class. | 254 | "The face used on the textual part of the button for this class. |
| @@ -265,15 +265,15 @@ Add one of the child classes to this class to the parent list of a class." | |||
| 265 | :abstract t) | 265 | :abstract t) |
| 266 | 266 | ||
| 267 | (defclass eieio-speedbar-directory-button (eieio-speedbar) | 267 | (defclass eieio-speedbar-directory-button (eieio-speedbar) |
| 268 | ((buttontype :initform angle) | 268 | ((buttontype :initform 'angle) |
| 269 | (buttonface :initform speedbar-directory-face)) | 269 | (buttonface :initform 'speedbar-directory-face)) |
| 270 | "Class providing support for objects which behave like a directory." | 270 | "Class providing support for objects which behave like a directory." |
| 271 | :method-invocation-order :depth-first | 271 | :method-invocation-order :depth-first |
| 272 | :abstract t) | 272 | :abstract t) |
| 273 | 273 | ||
| 274 | (defclass eieio-speedbar-file-button (eieio-speedbar) | 274 | (defclass eieio-speedbar-file-button (eieio-speedbar) |
| 275 | ((buttontype :initform bracket) | 275 | ((buttontype :initform 'bracket) |
| 276 | (buttonface :initform speedbar-file-face)) | 276 | (buttonface :initform 'speedbar-file-face)) |
| 277 | "Class providing support for objects which behave like a file." | 277 | "Class providing support for objects which behave like a file." |
| 278 | :method-invocation-order :depth-first | 278 | :method-invocation-order :depth-first |
| 279 | :abstract t) | 279 | :abstract t) |
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 31b6b0945bb..1c8c372aaef 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -131,6 +131,7 @@ and reference them using the function `class-option'." | |||
| 131 | 131 | ||
| 132 | (let ((testsym1 (intern (concat (symbol-name name) "-p"))) | 132 | (let ((testsym1 (intern (concat (symbol-name name) "-p"))) |
| 133 | (testsym2 (intern (format "%s--eieio-childp" name))) | 133 | (testsym2 (intern (format "%s--eieio-childp" name))) |
| 134 | (warnings '()) | ||
| 134 | (accessors ())) | 135 | (accessors ())) |
| 135 | 136 | ||
| 136 | ;; Collect the accessors we need to define. | 137 | ;; Collect the accessors we need to define. |
| @@ -145,6 +146,8 @@ and reference them using the function `class-option'." | |||
| 145 | ;; Update eieio--known-slot-names already in case we compile code which | 146 | ;; Update eieio--known-slot-names already in case we compile code which |
| 146 | ;; uses this before the class is loaded. | 147 | ;; uses this before the class is loaded. |
| 147 | (cl-pushnew sname eieio--known-slot-names) | 148 | (cl-pushnew sname eieio--known-slot-names) |
| 149 | (when (eq alloc :class) | ||
| 150 | (cl-pushnew sname eieio--known-class-slot-names)) | ||
| 148 | 151 | ||
| 149 | (if eieio-error-unsupported-class-tags | 152 | (if eieio-error-unsupported-class-tags |
| 150 | (let ((tmp soptions)) | 153 | (let ((tmp soptions)) |
| @@ -176,8 +179,22 @@ and reference them using the function `class-option'." | |||
| 176 | (signal 'invalid-slot-type (list :label label))) | 179 | (signal 'invalid-slot-type (list :label label))) |
| 177 | 180 | ||
| 178 | ;; Is there an initarg, but allocation of class? | 181 | ;; Is there an initarg, but allocation of class? |
| 179 | (if (and initarg (eq alloc :class)) | 182 | (when (and initarg (eq alloc :class)) |
| 180 | (message "Class allocated slots do not need :initarg")) | 183 | (push (format "Meaningless :initarg for class allocated slot '%S'" |
| 184 | sname) | ||
| 185 | warnings)) | ||
| 186 | |||
| 187 | (let ((init (plist-get soptions :initform))) | ||
| 188 | (unless (or (macroexp-const-p init) | ||
| 189 | (eieio--eval-default-p init)) | ||
| 190 | ;; FIXME: Historically, EIEIO used a heuristic to try and guess | ||
| 191 | ;; whether the initform is a form to be evaluated or just | ||
| 192 | ;; a constant. We use `eieio--eval-default-p' to see what the | ||
| 193 | ;; heuristic says and if it disagrees with normal evaluation | ||
| 194 | ;; then tweak the initform to make it fit and emit | ||
| 195 | ;; a warning accordingly. | ||
| 196 | (push (format "Ambiguous initform needs quoting: %S" init) | ||
| 197 | warnings))) | ||
| 181 | 198 | ||
| 182 | ;; Anyone can have an accessor function. This creates a function | 199 | ;; Anyone can have an accessor function. This creates a function |
| 183 | ;; of the specified name, and also performs a `defsetf' if applicable | 200 | ;; of the specified name, and also performs a `defsetf' if applicable |
| @@ -223,6 +240,8 @@ This method is obsolete." | |||
| 223 | )) | 240 | )) |
| 224 | 241 | ||
| 225 | `(progn | 242 | `(progn |
| 243 | ,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w) 'compile-only)) | ||
| 244 | warnings) | ||
| 226 | ;; This test must be created right away so we can have self- | 245 | ;; This test must be created right away so we can have self- |
| 227 | ;; referencing classes. ei, a class whose slot can contain only | 246 | ;; referencing classes. ei, a class whose slot can contain only |
| 228 | ;; pointers to itself. | 247 | ;; pointers to itself. |
| @@ -282,9 +301,7 @@ This method is obsolete." | |||
| 282 | ;;; Get/Set slots in an object. | 301 | ;;; Get/Set slots in an object. |
| 283 | ;; | 302 | ;; |
| 284 | (defmacro oref (obj slot) | 303 | (defmacro oref (obj slot) |
| 285 | "Retrieve the value stored in OBJ in the slot named by SLOT. | 304 | "Retrieve the value stored in OBJ in the slot named by SLOT." |
| 286 | Slot is the name of the slot when created by `defclass' or the label | ||
| 287 | created by the :initarg tag." | ||
| 288 | (declare (debug (form symbolp))) | 305 | (declare (debug (form symbolp))) |
| 289 | `(eieio-oref ,obj (quote ,slot))) | 306 | `(eieio-oref ,obj (quote ,slot))) |
| 290 | 307 | ||
| @@ -292,13 +309,11 @@ created by the :initarg tag." | |||
| 292 | (defalias 'set-slot-value #'eieio-oset) | 309 | (defalias 'set-slot-value #'eieio-oset) |
| 293 | (make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1") | 310 | (make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1") |
| 294 | 311 | ||
| 295 | (defmacro oref-default (obj slot) | 312 | (defmacro oref-default (class slot) |
| 296 | "Get the default value of OBJ (maybe a class) for SLOT. | 313 | "Get the value of class allocated slot SLOT. |
| 297 | The default value is the value installed in a class with the :initform | 314 | CLASS can also be an object, in which case we use the object's class." |
| 298 | tag. SLOT can be the slot name, or the tag specified by the :initarg | ||
| 299 | tag in the `defclass' call." | ||
| 300 | (declare (debug (form symbolp))) | 315 | (declare (debug (form symbolp))) |
| 301 | `(eieio-oref-default ,obj (quote ,slot))) | 316 | `(eieio-oref-default ,class (quote ,slot))) |
| 302 | 317 | ||
| 303 | ;;; Handy CLOS macros | 318 | ;;; Handy CLOS macros |
| 304 | ;; | 319 | ;; |
| @@ -538,11 +553,11 @@ OBJECT can be an instance or a class." | |||
| 538 | ((eieio-object-p object) (eieio-oref object slot)) | 553 | ((eieio-object-p object) (eieio-oref object slot)) |
| 539 | ((symbolp object) (eieio-oref-default object slot)) | 554 | ((symbolp object) (eieio-oref-default object slot)) |
| 540 | (t (signal 'wrong-type-argument (list 'eieio-object-p object)))) | 555 | (t (signal 'wrong-type-argument (list 'eieio-object-p object)))) |
| 541 | eieio-unbound)))) | 556 | eieio--unbound)))) |
| 542 | 557 | ||
| 543 | (defun slot-makeunbound (object slot) | 558 | (defun slot-makeunbound (object slot) |
| 544 | "In OBJECT, make SLOT unbound." | 559 | "In OBJECT, make SLOT unbound." |
| 545 | (eieio-oset object slot eieio-unbound)) | 560 | (eieio-oset object slot eieio--unbound)) |
| 546 | 561 | ||
| 547 | (defun slot-exists-p (object-or-class slot) | 562 | (defun slot-exists-p (object-or-class slot) |
| 548 | "Return non-nil if OBJECT-OR-CLASS has SLOT." | 563 | "Return non-nil if OBJECT-OR-CLASS has SLOT." |
| @@ -740,18 +755,14 @@ dynamically set from SLOTS." | |||
| 740 | (slots (eieio--class-slots this-class))) | 755 | (slots (eieio--class-slots this-class))) |
| 741 | (dotimes (i (length slots)) | 756 | (dotimes (i (length slots)) |
| 742 | ;; For each slot, see if we need to evaluate it. | 757 | ;; For each slot, see if we need to evaluate it. |
| 743 | ;; | ||
| 744 | ;; Paul Landes said in an email: | ||
| 745 | ;; > CL evaluates it if it can, and otherwise, leaves it as | ||
| 746 | ;; > the quoted thing as you already have. This is by the | ||
| 747 | ;; > Sonya E. Keene book and other things I've look at on the | ||
| 748 | ;; > web. | ||
| 749 | (let* ((slot (aref slots i)) | 758 | (let* ((slot (aref slots i)) |
| 750 | (initform (cl--slot-descriptor-initform slot)) | 759 | (initform (cl--slot-descriptor-initform slot))) |
| 751 | (dflt (eieio-default-eval-maybe initform))) | 760 | ;; Those slots whose initform is constant already have the right |
| 752 | (when (not (eq dflt initform)) | 761 | ;; value set in the default-object. |
| 762 | (unless (macroexp-const-p initform) | ||
| 753 | ;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)! | 763 | ;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)! |
| 754 | (eieio-oset this (cl--slot-descriptor-name slot) dflt))))) | 764 | (eieio-oset this (cl--slot-descriptor-name slot) |
| 765 | (eval initform t)))))) | ||
| 755 | ;; Shared initialize will parse our slots for us. | 766 | ;; Shared initialize will parse our slots for us. |
| 756 | (shared-initialize this slots)) | 767 | (shared-initialize this slots)) |
| 757 | 768 | ||
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 2ee19a35b23..c2b026dc822 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el | |||
| @@ -483,6 +483,10 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." | |||
| 483 | 'face 'link | 483 | 'face 'link |
| 484 | 'help-echo "mouse-2 or RET jumps to definition"))) | 484 | 'help-echo "mouse-2 or RET jumps to definition"))) |
| 485 | 485 | ||
| 486 | (define-derived-mode elp-results-mode special-mode "ELP" | ||
| 487 | "Mode for ELP results." | ||
| 488 | :interactive nil) | ||
| 489 | |||
| 486 | ;;;###autoload | 490 | ;;;###autoload |
| 487 | (defun elp-results () | 491 | (defun elp-results () |
| 488 | "Display current profiling results. | 492 | "Display current profiling results. |
| @@ -490,11 +494,12 @@ If `elp-reset-after-results' is non-nil, then current profiling | |||
| 490 | information for all instrumented functions is reset after results are | 494 | information for all instrumented functions is reset after results are |
| 491 | displayed." | 495 | displayed." |
| 492 | (interactive) | 496 | (interactive) |
| 493 | (let ((curbuf (current-buffer)) | 497 | (pop-to-buffer |
| 494 | (resultsbuf (if elp-recycle-buffers-p | 498 | (if elp-recycle-buffers-p |
| 495 | (get-buffer-create elp-results-buffer) | 499 | (get-buffer-create elp-results-buffer) |
| 496 | (generate-new-buffer elp-results-buffer)))) | 500 | (generate-new-buffer elp-results-buffer))) |
| 497 | (set-buffer resultsbuf) | 501 | (elp-results-mode) |
| 502 | (let ((inhibit-read-only t)) | ||
| 498 | (erase-buffer) | 503 | (erase-buffer) |
| 499 | ;; get the length of the longest function name being profiled | 504 | ;; get the length of the longest function name being profiled |
| 500 | (let* ((longest 0) | 505 | (let* ((longest 0) |
| @@ -565,9 +570,6 @@ displayed." | |||
| 565 | (if elp-sort-by-function | 570 | (if elp-sort-by-function |
| 566 | (setq resvec (sort resvec elp-sort-by-function))) | 571 | (setq resvec (sort resvec elp-sort-by-function))) |
| 567 | (mapc 'elp-output-result resvec)) | 572 | (mapc 'elp-output-result resvec)) |
| 568 | ;; now pop up results buffer | ||
| 569 | (set-buffer curbuf) | ||
| 570 | (pop-to-buffer resultsbuf) | ||
| 571 | ;; copy results to standard-output? | 573 | ;; copy results to standard-output? |
| 572 | (if (or elp-use-standard-output noninteractive) | 574 | (if (or elp-use-standard-output noninteractive) |
| 573 | (princ (buffer-substring (point-min) (point-max))) | 575 | (princ (buffer-substring (point-min) (point-max))) |
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 38d8ad6cc12..16e83074764 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el | |||
| @@ -60,8 +60,10 @@ FUNCTIONS is a list of elements on the form: | |||
| 60 | :args ARGS | 60 | :args ARGS |
| 61 | :eval EXAMPLE-FORM | 61 | :eval EXAMPLE-FORM |
| 62 | :no-eval EXAMPLE-FORM | 62 | :no-eval EXAMPLE-FORM |
| 63 | :no-eval* EXAMPLE-FORM | ||
| 63 | :no-value EXAMPLE-FORM | 64 | :no-value EXAMPLE-FORM |
| 64 | :result RESULT-FORM | 65 | :result RESULT-FORM |
| 66 | :result-string RESULT-FORM | ||
| 65 | :eg-result RESULT-FORM | 67 | :eg-result RESULT-FORM |
| 66 | :eg-result-string RESULT-FORM) | 68 | :eg-result-string RESULT-FORM) |
| 67 | 69 | ||
| @@ -887,6 +889,52 @@ There can be any number of :example/:result elements." | |||
| 887 | (unlock-buffer | 889 | (unlock-buffer |
| 888 | :no-value (lock-buffer))) | 890 | :no-value (lock-buffer))) |
| 889 | 891 | ||
| 892 | (define-short-documentation-group overlay | ||
| 893 | "Predicates" | ||
| 894 | (overlayp | ||
| 895 | :no-eval (overlayp some-overlay) | ||
| 896 | :eg-result t) | ||
| 897 | "Creation and Deletion" | ||
| 898 | (make-overlay | ||
| 899 | :args (beg end &optional buffer) | ||
| 900 | :no-eval (make-overlay 1 10) | ||
| 901 | :eg-result-string "#<overlay from 1 to 10 in *foo*>") | ||
| 902 | (delete-overlay | ||
| 903 | :no-eval (delete-overlay foo) | ||
| 904 | :eg-result t) | ||
| 905 | "Searching Overlays" | ||
| 906 | (overlays-at | ||
| 907 | :no-eval (overlays-at 15) | ||
| 908 | :eg-result-string "(#<overlay from 1 to 10 in *foo*>)") | ||
| 909 | (overlays-in | ||
| 910 | :no-eval (overlays-in 1 30) | ||
| 911 | :eg-result-string "(#<overlay from 1 to 10 in *foo*>)") | ||
| 912 | (next-overlay-change | ||
| 913 | :no-eval (next-overlay-change 1) | ||
| 914 | :eg-result 20) | ||
| 915 | (previous-overlay-change | ||
| 916 | :no-eval (previous-overlay-change 30) | ||
| 917 | :eg-result 20) | ||
| 918 | "Overlay Properties" | ||
| 919 | (overlay-start | ||
| 920 | :no-eval (overlay-start foo) | ||
| 921 | :eg-result 1) | ||
| 922 | (overlay-end | ||
| 923 | :no-eval (overlay-end foo) | ||
| 924 | :eg-result 10) | ||
| 925 | (overlay-put | ||
| 926 | :no-eval (overlay-put foo 'happy t) | ||
| 927 | :eg-result t) | ||
| 928 | (overlay-get | ||
| 929 | :no-eval (overlay-get foo 'happy) | ||
| 930 | :eg-result t) | ||
| 931 | (overlay-buffer | ||
| 932 | :no-eval (overlay-buffer foo)) | ||
| 933 | "Moving Overlays" | ||
| 934 | (move-overlay | ||
| 935 | :no-eval (move-overlay foo 5 20) | ||
| 936 | :eg-result-string "#<overlay from 5 to 20 in *foo*>")) | ||
| 937 | |||
| 890 | (define-short-documentation-group process | 938 | (define-short-documentation-group process |
| 891 | (make-process | 939 | (make-process |
| 892 | :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) | 940 | :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) |
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 6d5b04b83bb..0bb1b8916b1 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el | |||
| @@ -125,6 +125,10 @@ otherwise nil. That construct can be a two character comment | |||
| 125 | delimiter or an Escaped or Char-quoted character.")) | 125 | delimiter or an Escaped or Char-quoted character.")) |
| 126 | 126 | ||
| 127 | (defun syntax-propertize-wholelines (start end) | 127 | (defun syntax-propertize-wholelines (start end) |
| 128 | "Extend the region delimited by START and END to whole lines. | ||
| 129 | This function is useful for | ||
| 130 | `syntax-propertize-extend-region-functions'; | ||
| 131 | see Info node `(elisp) Syntax Properties'." | ||
| 128 | (goto-char start) | 132 | (goto-char start) |
| 129 | (cons (line-beginning-position) | 133 | (cons (line-beginning-position) |
| 130 | (progn (goto-char end) | 134 | (progn (goto-char end) |
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index a33025b1125..ebdb1274218 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el | |||
| @@ -43,7 +43,8 @@ | |||
| 43 | 43 | ||
| 44 | This is used by `epa-ks-lookup-key', for looking up public keys." | 44 | This is used by `epa-ks-lookup-key', for looking up public keys." |
| 45 | :type '(choice :tag "Keyserver" | 45 | :type '(choice :tag "Keyserver" |
| 46 | (const random) | 46 | (repeat :tag "Random pool" |
| 47 | (string :tag "Keyserver address")) | ||
| 47 | (const "keyring.debian.org") | 48 | (const "keyring.debian.org") |
| 48 | (const "keys.gnupg.net") | 49 | (const "keys.gnupg.net") |
| 49 | (const "keyserver.ubuntu.com") | 50 | (const "keyserver.ubuntu.com") |
| @@ -141,20 +142,33 @@ Keys are marked using `epa-ks-mark-key-to-fetch'." | |||
| 141 | (epa-ks--fetch-key id)))) | 142 | (epa-ks--fetch-key id)))) |
| 142 | (tabulated-list-clear-all-tags)) | 143 | (tabulated-list-clear-all-tags)) |
| 143 | 144 | ||
| 145 | (defun epa-ks--query-url (query exact) | ||
| 146 | "Return URL for QUERY. | ||
| 147 | If EXACT is non-nil, don't accept approximate matches." | ||
| 148 | (format "https://%s/pks/lookup?%s" | ||
| 149 | (cond ((null epa-keyserver) | ||
| 150 | (user-error "Empty keyserver pool")) | ||
| 151 | ((listp epa-keyserver) | ||
| 152 | (nth (random (length epa-keyserver)) | ||
| 153 | epa-keyserver)) | ||
| 154 | ((stringp epa-keyserver) | ||
| 155 | epa-keyserver) | ||
| 156 | ((error "Invalid type for `epa-keyserver'"))) | ||
| 157 | (url-build-query-string | ||
| 158 | (append `(("search" ,query) | ||
| 159 | ("options" "mr") | ||
| 160 | ("op" "index")) | ||
| 161 | (and exact '(("exact" "on"))))))) | ||
| 162 | |||
| 144 | (defun epa-ks--fetch-key (id) | 163 | (defun epa-ks--fetch-key (id) |
| 145 | "Send request to import key with specified ID." | 164 | "Send request to import key with specified ID." |
| 146 | (url-retrieve | 165 | (url-retrieve |
| 147 | (format "https://%s/pks/lookup?%s" | 166 | (epa-ks--query-url (concat "0x" (url-hexify-string id)) t) |
| 148 | epa-keyserver | ||
| 149 | (url-build-query-string | ||
| 150 | `(("search" ,(concat "0x" (url-hexify-string id))) | ||
| 151 | ("options" "mr") | ||
| 152 | ("op" "get")))) | ||
| 153 | (lambda (status) | 167 | (lambda (status) |
| 154 | (when (plist-get status :error) | 168 | (when (plist-get status :error) |
| 155 | (error "Request failed: %s" | 169 | (error "Request failed: %s" |
| 156 | (caddr (assq (caddr (plist-get status :error)) | 170 | (caddr (assq (caddr (plist-get status :error)) |
| 157 | url-http-codes)))) | 171 | url-http-codes)))) |
| 158 | (forward-paragraph) | 172 | (forward-paragraph) |
| 159 | (save-excursion | 173 | (save-excursion |
| 160 | (goto-char (point-max)) | 174 | (goto-char (point-max)) |
| @@ -224,13 +238,7 @@ enough, since keyservers have strict timeout settings." | |||
| 224 | (erase-buffer)) | 238 | (erase-buffer)) |
| 225 | (epa-ks-search-mode)) | 239 | (epa-ks-search-mode)) |
| 226 | (url-retrieve | 240 | (url-retrieve |
| 227 | (format "https://%s/pks/lookup?%s" | 241 | (epa-ks--query-url query exact) |
| 228 | epa-keyserver | ||
| 229 | (url-build-query-string | ||
| 230 | (append `(("search" ,query) | ||
| 231 | ("options" "mr") | ||
| 232 | ("op" "index")) | ||
| 233 | (and exact '(("exact" "on")))))) | ||
| 234 | (lambda (status) | 242 | (lambda (status) |
| 235 | (when (plist-get status :error) | 243 | (when (plist-get status :error) |
| 236 | (when buf | 244 | (when buf |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 547056361a8..52452043e90 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -2225,7 +2225,7 @@ Non-interactively, it takes the keyword arguments | |||
| 2225 | 2225 | ||
| 2226 | That is, if called with | 2226 | That is, if called with |
| 2227 | 2227 | ||
| 2228 | (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\") | 2228 | (erc :server \"chat.freenode.net\" :full-name \"J. Random Hacker\") |
| 2229 | 2229 | ||
| 2230 | then the server and full-name will be set to those values, | 2230 | then the server and full-name will be set to those values, |
| 2231 | whereas `erc-compute-port' and `erc-compute-nick' will be invoked | 2231 | whereas `erc-compute-port' and `erc-compute-nick' will be invoked |
| @@ -2260,7 +2260,7 @@ Non-interactively, it takes the keyword arguments | |||
| 2260 | 2260 | ||
| 2261 | That is, if called with | 2261 | That is, if called with |
| 2262 | 2262 | ||
| 2263 | (erc-tls :server \"chat.freenode.net\" :full-name \"Harry S Truman\") | 2263 | (erc-tls :server \"chat.freenode.net\" :full-name \"J. Random Hacker\") |
| 2264 | 2264 | ||
| 2265 | then the server and full-name will be set to those values, | 2265 | then the server and full-name will be set to those values, |
| 2266 | whereas `erc-compute-port' and `erc-compute-nick' will be invoked | 2266 | whereas `erc-compute-port' and `erc-compute-nick' will be invoked |
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index e559f5b39fe..18e19a9d9a5 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el | |||
| @@ -379,7 +379,7 @@ input." | |||
| 379 | (if (eq eshell-hist-ignoredups 'erase) | 379 | (if (eq eshell-hist-ignoredups 'erase) |
| 380 | ;; Remove any old occurrences of the input, and put | 380 | ;; Remove any old occurrences of the input, and put |
| 381 | ;; the new one at the end. | 381 | ;; the new one at the end. |
| 382 | (progn | 382 | (unless (ring-empty-p eshell-history-ring) |
| 383 | (ring-remove eshell-history-ring | 383 | (ring-remove eshell-history-ring |
| 384 | (ring-member eshell-history-ring input)) | 384 | (ring-member eshell-history-ring input)) |
| 385 | t) | 385 | t) |
diff --git a/lisp/fileloop.el b/lisp/fileloop.el index cb9fe8f7769..8a2755d69a5 100644 --- a/lisp/fileloop.el +++ b/lisp/fileloop.el | |||
| @@ -171,7 +171,8 @@ operating on the next file and nil otherwise." | |||
| 171 | (goto-char pos)) | 171 | (goto-char pos)) |
| 172 | (push-mark original-point t)) | 172 | (push-mark original-point t)) |
| 173 | 173 | ||
| 174 | (switch-to-buffer (current-buffer)) | 174 | (let (switch-to-buffer-preserve-window-point) |
| 175 | (switch-to-buffer (current-buffer))) | ||
| 175 | 176 | ||
| 176 | ;; Now operate on the file. | 177 | ;; Now operate on the file. |
| 177 | ;; If value is non-nil, continue to scan the next file. | 178 | ;; If value is non-nil, continue to scan the next file. |
diff --git a/lisp/files.el b/lisp/files.el index c694507e78a..2450daf5bfc 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -6248,8 +6248,11 @@ Non-file buffers need a custom function." | |||
| 6248 | (dolist (regexp revert-without-query) | 6248 | (dolist (regexp revert-without-query) |
| 6249 | (when (string-match regexp file-name) | 6249 | (when (string-match regexp file-name) |
| 6250 | (throw 'found t))))) | 6250 | (throw 'found t))))) |
| 6251 | (yes-or-no-p (format "Revert buffer from file %s? " | 6251 | (yes-or-no-p |
| 6252 | file-name))) | 6252 | (format (if (buffer-modified-p) |
| 6253 | "Discard edits and reread from %s? " | ||
| 6254 | "Revert buffer from file %s? ") | ||
| 6255 | file-name))) | ||
| 6253 | (run-hooks 'before-revert-hook) | 6256 | (run-hooks 'before-revert-hook) |
| 6254 | ;; If file was backed up but has changed since, | 6257 | ;; If file was backed up but has changed since, |
| 6255 | ;; we should make another backup. | 6258 | ;; we should make another backup. |
diff --git a/lisp/format.el b/lisp/format.el index 3e2d92fef13..1e87d252844 100644 --- a/lisp/format.el +++ b/lisp/format.el | |||
| @@ -181,7 +181,7 @@ it should be a Lisp function. BUFFER is currently ignored." | |||
| 181 | ;; We should perhaps go via a temporary buffer and copy it | 181 | ;; We should perhaps go via a temporary buffer and copy it |
| 182 | ;; back, in case of errors. | 182 | ;; back, in case of errors. |
| 183 | (if (and (zerop (save-window-excursion | 183 | (if (and (zerop (save-window-excursion |
| 184 | (shell-command-on-region from to method t t | 184 | (shell-command-on-region from to method t 'no-mark |
| 185 | error-buff))) | 185 | error-buff))) |
| 186 | ;; gzip gives zero exit status with bad args, for instance. | 186 | ;; gzip gives zero exit status with bad args, for instance. |
| 187 | (zerop (with-current-buffer error-buff | 187 | (zerop (with-current-buffer error-buff |
diff --git a/lisp/fringe.el b/lisp/fringe.el index e2d7968adde..d73aae0459e 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el | |||
| @@ -181,7 +181,11 @@ When setting this variable in a Lisp program, call | |||
| 181 | `set-fringe-mode' afterward to make it take real effect. | 181 | `set-fringe-mode' afterward to make it take real effect. |
| 182 | 182 | ||
| 183 | To modify the appearance of the fringe in a specific frame, use | 183 | To modify the appearance of the fringe in a specific frame, use |
| 184 | the interactive function `set-fringe-style'." | 184 | the interactive function `set-fringe-style'. |
| 185 | |||
| 186 | Note that, despite the name, this is not a variable that controls | ||
| 187 | a (major or minor) Emacs mode, but controls the appearance of the | ||
| 188 | fringes." | ||
| 185 | :type `(choice | 189 | :type `(choice |
| 186 | ,@ (mapcar (lambda (style) | 190 | ,@ (mapcar (lambda (style) |
| 187 | (let ((name | 191 | (let ((name |
| @@ -248,7 +252,10 @@ Fringe widths set by `set-window-fringes' override the default | |||
| 248 | fringe widths set by this command. This command applies to all | 252 | fringe widths set by this command. This command applies to all |
| 249 | frames that exist and frames to be created in the future. If you | 253 | frames that exist and frames to be created in the future. If you |
| 250 | want to set the default appearance of fringes on the selected | 254 | want to set the default appearance of fringes on the selected |
| 251 | frame only, see the command `set-fringe-style'." | 255 | frame only, see the command `set-fringe-style'. |
| 256 | |||
| 257 | Note that, despite the name, this is not a (major or minor) Emacs | ||
| 258 | mode, but a command that controls the appearance of the fringes." | ||
| 252 | (interactive (list (fringe-query-style 'all-frames))) | 259 | (interactive (list (fringe-query-style 'all-frames))) |
| 253 | (set-fringe-mode mode)) | 260 | (set-fringe-mode mode)) |
| 254 | 261 | ||
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5ce03db1b9b..f2ec9462c5e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -170,12 +170,17 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." | |||
| 170 | "All headers that do not match this regexp will be hidden. | 170 | "All headers that do not match this regexp will be hidden. |
| 171 | This variable can also be a list of regexp of headers to remain visible. | 171 | This variable can also be a list of regexp of headers to remain visible. |
| 172 | If this variable is non-nil, `gnus-ignored-headers' will be ignored." | 172 | If this variable is non-nil, `gnus-ignored-headers' will be ignored." |
| 173 | :type '(choice | 173 | :type `(choice |
| 174 | (repeat :value-to-internal (lambda (widget value) | 174 | (repeat :value-to-internal |
| 175 | (custom-split-regexp-maybe value)) | 175 | ,(lambda (_widget value) |
| 176 | :match (lambda (widget value) | 176 | ;; FIXME: Are we sure this can't be used without |
| 177 | (or (stringp value) | 177 | ;; loading cus-edit? |
| 178 | (widget-editable-list-match widget value))) | 178 | (declare-function custom-split-regexp-maybe |
| 179 | "cus-edit" (regexp)) | ||
| 180 | (custom-split-regexp-maybe value)) | ||
| 181 | :match ,(lambda (widget value) | ||
| 182 | (or (stringp value) | ||
| 183 | (widget-editable-list-match widget value))) | ||
| 179 | regexp) | 184 | regexp) |
| 180 | (const :tag "Use gnus-ignored-headers" nil) | 185 | (const :tag "Use gnus-ignored-headers" nil) |
| 181 | regexp) | 186 | regexp) |
| @@ -402,14 +407,14 @@ the entire emphasized word. The third is a number that says what | |||
| 402 | regexp grouping should be displayed and highlighted. The fourth | 407 | regexp grouping should be displayed and highlighted. The fourth |
| 403 | is the face used for highlighting." | 408 | is the face used for highlighting." |
| 404 | :type | 409 | :type |
| 405 | '(repeat | 410 | `(repeat |
| 406 | (menu-choice | 411 | (menu-choice |
| 407 | :format "%[Customizing Style%]\n%v" | 412 | :format "%[Customizing Style%]\n%v" |
| 408 | :indent 2 | 413 | :indent 2 |
| 409 | (group :tag "Default" | 414 | (group :tag "Default" |
| 410 | :value ("" 0 0 default) | 415 | :value ("" 0 0 default) |
| 411 | :value-create | 416 | :value-create |
| 412 | (lambda (widget) | 417 | ,(lambda (widget) |
| 413 | (let ((value (widget-get | 418 | (let ((value (widget-get |
| 414 | (cadr (widget-get (widget-get widget :parent) | 419 | (cadr (widget-get (widget-get widget :parent) |
| 415 | :args)) | 420 | :args)) |
| @@ -3738,7 +3743,7 @@ is to run." | |||
| 3738 | (setq n 1)) | 3743 | (setq n 1)) |
| 3739 | (gnus-stop-date-timer) | 3744 | (gnus-stop-date-timer) |
| 3740 | (setq article-lapsed-timer | 3745 | (setq article-lapsed-timer |
| 3741 | (run-at-time 1 n 'article-update-date-lapsed))) | 3746 | (run-at-time 1 n #'article-update-date-lapsed))) |
| 3742 | 3747 | ||
| 3743 | (defun gnus-stop-date-timer () | 3748 | (defun gnus-stop-date-timer () |
| 3744 | "Stop the Date timer." | 3749 | "Stop the Date timer." |
| @@ -4405,7 +4410,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is | |||
| 4405 | "\M-g" gnus-article-read-summary-keys) | 4410 | "\M-g" gnus-article-read-summary-keys) |
| 4406 | 4411 | ||
| 4407 | (substitute-key-definition | 4412 | (substitute-key-definition |
| 4408 | 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) | 4413 | #'undefined #'gnus-article-read-summary-keys gnus-article-mode-map) |
| 4409 | 4414 | ||
| 4410 | (defvar gnus-article-send-map) | 4415 | (defvar gnus-article-send-map) |
| 4411 | (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) | 4416 | (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) |
| @@ -4483,12 +4488,12 @@ commands: | |||
| 4483 | (make-local-variable 'gnus-article-image-alist) | 4488 | (make-local-variable 'gnus-article-image-alist) |
| 4484 | (make-local-variable 'gnus-article-charset) | 4489 | (make-local-variable 'gnus-article-charset) |
| 4485 | (make-local-variable 'gnus-article-ignored-charsets) | 4490 | (make-local-variable 'gnus-article-ignored-charsets) |
| 4486 | (setq-local bookmark-make-record-function 'gnus-summary-bookmark-make-record) | 4491 | (setq-local bookmark-make-record-function #'gnus-summary-bookmark-make-record) |
| 4487 | ;; Prevent Emacs from displaying non-break space with | 4492 | ;; Prevent Emacs from displaying non-break space with |
| 4488 | ;; `nobreak-space' face. | 4493 | ;; `nobreak-space' face. |
| 4489 | (setq-local nobreak-char-display nil) | 4494 | (setq-local nobreak-char-display nil) |
| 4490 | ;; Enable `gnus-article-remove-images' to delete images shr.el renders. | 4495 | ;; Enable `gnus-article-remove-images' to delete images shr.el renders. |
| 4491 | (setq-local shr-put-image-function 'gnus-shr-put-image) | 4496 | (setq-local shr-put-image-function #'gnus-shr-put-image) |
| 4492 | (unless gnus-article-show-cursor | 4497 | (unless gnus-article-show-cursor |
| 4493 | (setq cursor-in-non-selected-windows nil)) | 4498 | (setq cursor-in-non-selected-windows nil)) |
| 4494 | (gnus-set-default-directory) | 4499 | (gnus-set-default-directory) |
| @@ -4723,16 +4728,17 @@ If ALL-HEADERS is non-nil, no headers are hidden." | |||
| 4723 | (define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle" | 4728 | (define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle" |
| 4724 | "Mode for sticky articles." | 4729 | "Mode for sticky articles." |
| 4725 | ;; Release bindings that won't work. | 4730 | ;; Release bindings that won't work. |
| 4726 | (substitute-key-definition 'gnus-article-read-summary-keys 'undefined | 4731 | (substitute-key-definition #'gnus-article-read-summary-keys #'undefined |
| 4727 | gnus-sticky-article-mode-map) | 4732 | gnus-sticky-article-mode-map) |
| 4728 | (substitute-key-definition 'gnus-article-refer-article 'undefined | 4733 | (substitute-key-definition #'gnus-article-refer-article #'undefined |
| 4729 | gnus-sticky-article-mode-map) | 4734 | gnus-sticky-article-mode-map) |
| 4730 | (dolist (k '("e" "h" "s" "F" "R")) | 4735 | (dolist (k '("e" "h" "s" "F" "R")) |
| 4731 | (define-key gnus-sticky-article-mode-map k nil)) | 4736 | (define-key gnus-sticky-article-mode-map k nil)) |
| 4732 | (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer) | 4737 | (define-key gnus-sticky-article-mode-map "k" |
| 4733 | (define-key gnus-sticky-article-mode-map "q" 'bury-buffer) | 4738 | #'gnus-kill-sticky-article-buffer) |
| 4734 | (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly) | 4739 | (define-key gnus-sticky-article-mode-map "q" #'bury-buffer) |
| 4735 | (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key)) | 4740 | (define-key gnus-sticky-article-mode-map "\C-hc" #'describe-key-briefly) |
| 4741 | (define-key gnus-sticky-article-mode-map "\C-hk" #'describe-key)) | ||
| 4736 | 4742 | ||
| 4737 | (defun gnus-sticky-article (arg) | 4743 | (defun gnus-sticky-article (arg) |
| 4738 | "Make the current article sticky. | 4744 | "Make the current article sticky. |
| @@ -4863,9 +4869,9 @@ General format specifiers can also be used. See Info node | |||
| 4863 | 4869 | ||
| 4864 | (defvar gnus-mime-button-map | 4870 | (defvar gnus-mime-button-map |
| 4865 | (let ((map (make-sparse-keymap))) | 4871 | (let ((map (make-sparse-keymap))) |
| 4866 | (define-key map "\r" 'gnus-article-push-button) | 4872 | (define-key map "\r" #'gnus-article-push-button) |
| 4867 | (define-key map [mouse-2] 'gnus-article-push-button) | 4873 | (define-key map [mouse-2] #'gnus-article-push-button) |
| 4868 | (define-key map [down-mouse-3] 'gnus-mime-button-menu) | 4874 | (define-key map [down-mouse-3] #'gnus-mime-button-menu) |
| 4869 | (dolist (c gnus-mime-button-commands) | 4875 | (dolist (c gnus-mime-button-commands) |
| 4870 | (define-key map (cadr c) (car c))) | 4876 | (define-key map (cadr c) (car c))) |
| 4871 | map)) | 4877 | map)) |
| @@ -6138,7 +6144,7 @@ If nil, don't show those extra buttons." | |||
| 6138 | (let* ((preferred (or preferred (mm-preferred-alternative handles))) | 6144 | (let* ((preferred (or preferred (mm-preferred-alternative handles))) |
| 6139 | (ihandles handles) | 6145 | (ihandles handles) |
| 6140 | (point (point)) | 6146 | (point (point)) |
| 6141 | handle (inhibit-read-only t) begend not-pref) ;; from | 6147 | (inhibit-read-only t) begend not-pref) ;; from |
| 6142 | (save-window-excursion | 6148 | (save-window-excursion |
| 6143 | (save-restriction | 6149 | (save-restriction |
| 6144 | (when ibegend | 6150 | (when ibegend |
| @@ -6152,8 +6158,8 @@ If nil, don't show those extra buttons." | |||
| 6152 | (mm-remove-parts handles)) | 6158 | (mm-remove-parts handles)) |
| 6153 | (setq begend (list (point-marker))) | 6159 | (setq begend (list (point-marker))) |
| 6154 | ;; Do the toggle. | 6160 | ;; Do the toggle. |
| 6155 | (unless (setq not-pref (cadr (member preferred ihandles))) | 6161 | (setq not-pref (or (cadr (member preferred ihandles)) |
| 6156 | (setq not-pref (car ihandles))) | 6162 | (car ihandles))) |
| 6157 | (when (or ibegend | 6163 | (when (or ibegend |
| 6158 | (not preferred) | 6164 | (not preferred) |
| 6159 | (not (gnus-unbuttonized-mime-type-p | 6165 | (not (gnus-unbuttonized-mime-type-p |
| @@ -6164,22 +6170,22 @@ If nil, don't show those extra buttons." | |||
| 6164 | (progn | 6170 | (progn |
| 6165 | (insert (format "%d. " id)) | 6171 | (insert (format "%d. " id)) |
| 6166 | (point)) | 6172 | (point)) |
| 6167 | `(gnus-callback | 6173 | (let ((gamha gnus-article-mime-handle-alist)) |
| 6168 | (lambda (handles) | 6174 | `(gnus-callback |
| 6169 | (unless ,(not ibegend) | 6175 | ,(lambda (_handles) |
| 6170 | (setq gnus-article-mime-handle-alist | 6176 | (unless (not ibegend) |
| 6171 | ',gnus-article-mime-handle-alist)) | 6177 | (setq gnus-article-mime-handle-alist gamha)) |
| 6172 | (gnus-mime-display-alternative | 6178 | (gnus-mime-display-alternative |
| 6173 | ',ihandles ',not-pref ',begend ,id)) | 6179 | ihandles not-pref begend id)) |
| 6174 | keymap ,gnus-mime-button-map | 6180 | keymap ,gnus-mime-button-map |
| 6175 | mouse-face ,gnus-article-mouse-face | 6181 | mouse-face ,gnus-article-mouse-face |
| 6176 | face ,gnus-article-button-face | 6182 | face ,gnus-article-button-face |
| 6177 | follow-link t | 6183 | follow-link t |
| 6178 | gnus-part ,id | 6184 | gnus-part ,id |
| 6179 | article-type multipart | 6185 | article-type multipart |
| 6180 | rear-nonsticky t)) | 6186 | rear-nonsticky t))) |
| 6181 | ;; Do the handles | 6187 | ;; Do the handles |
| 6182 | (while (setq handle (pop handles)) | 6188 | (dolist (handle handles) |
| 6183 | (add-text-properties | 6189 | (add-text-properties |
| 6184 | ;; (setq from | 6190 | ;; (setq from |
| 6185 | (point) ;; ) | 6191 | (point) ;; ) |
| @@ -6188,22 +6194,22 @@ If nil, don't show those extra buttons." | |||
| 6188 | (if (equal handle preferred) ?* ? ) | 6194 | (if (equal handle preferred) ?* ? ) |
| 6189 | (mm-handle-media-type handle))) | 6195 | (mm-handle-media-type handle))) |
| 6190 | (point)) | 6196 | (point)) |
| 6191 | `(gnus-callback | 6197 | (let ((gamha gnus-article-mime-handle-alist)) |
| 6192 | (lambda (handles) | 6198 | `(gnus-callback |
| 6193 | (unless ,(not ibegend) | 6199 | ,(lambda (_handles) |
| 6194 | (setq gnus-article-mime-handle-alist | 6200 | (unless (not ibegend) |
| 6195 | ',gnus-article-mime-handle-alist)) | 6201 | (setq gnus-article-mime-handle-alist gamha)) |
| 6196 | (gnus-mime-display-alternative | 6202 | (gnus-mime-display-alternative |
| 6197 | ',ihandles ',handle ',begend ,id)) | 6203 | ihandles handle begend id)) |
| 6198 | keymap ,gnus-mime-button-map | 6204 | keymap ,gnus-mime-button-map |
| 6199 | mouse-face ,gnus-article-mouse-face | 6205 | mouse-face ,gnus-article-mouse-face |
| 6200 | face ,gnus-article-button-face | 6206 | face ,gnus-article-button-face |
| 6201 | follow-link t | 6207 | follow-link t |
| 6202 | gnus-part ,id | 6208 | gnus-part ,id |
| 6203 | button t | 6209 | button t |
| 6204 | category t | 6210 | category t |
| 6205 | gnus-data ,handle | 6211 | gnus-data ,handle |
| 6206 | rear-nonsticky t)) | 6212 | rear-nonsticky t))) |
| 6207 | (insert " ")) | 6213 | (insert " ")) |
| 6208 | (insert "\n\n")) | 6214 | (insert "\n\n")) |
| 6209 | (when preferred | 6215 | (when preferred |
| @@ -6308,7 +6314,8 @@ is the string to use when it is inactive.") | |||
| 6308 | (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) | 6314 | (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) |
| 6309 | (gnus-delete-wash-type category))) | 6315 | (gnus-delete-wash-type category))) |
| 6310 | 6316 | ||
| 6311 | (defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) | 6317 | (defalias 'gnus-article-hide-headers-if-wanted |
| 6318 | #'gnus-article-maybe-hide-headers) | ||
| 6312 | 6319 | ||
| 6313 | (defun gnus-article-maybe-hide-headers () | 6320 | (defun gnus-article-maybe-hide-headers () |
| 6314 | "Hide unwanted headers if `gnus-have-all-headers' is nil. | 6321 | "Hide unwanted headers if `gnus-have-all-headers' is nil. |
| @@ -6874,7 +6881,7 @@ then we display only bindings that start with that prefix." | |||
| 6874 | parent agent draft) | 6881 | parent agent draft) |
| 6875 | (define-key keymap "S" map) | 6882 | (define-key keymap "S" map) |
| 6876 | (define-key map [t] nil) | 6883 | (define-key map [t] nil) |
| 6877 | (define-key summap [t] 'undefined) | 6884 | (define-key summap [t] #'undefined) |
| 6878 | (with-current-buffer gnus-article-current-summary | 6885 | (with-current-buffer gnus-article-current-summary |
| 6879 | (dolist (key sumkeys) | 6886 | (dolist (key sumkeys) |
| 6880 | (define-key summap key (key-binding key (current-local-map)))) | 6887 | (define-key summap key (key-binding key (current-local-map)))) |
| @@ -6910,10 +6917,11 @@ then we display only bindings that start with that prefix." | |||
| 6910 | (setq-local gnus-agent-summary-mode agent) | 6917 | (setq-local gnus-agent-summary-mode agent) |
| 6911 | (setq-local gnus-draft-mode draft) | 6918 | (setq-local gnus-draft-mode draft) |
| 6912 | (describe-bindings prefix)) | 6919 | (describe-bindings prefix)) |
| 6913 | (let ((item `((lambda (prefix) | 6920 | (let* ((cb (current-buffer)) |
| 6914 | (with-current-buffer ,(current-buffer) | 6921 | (item `(,(lambda (prefix) |
| 6915 | (gnus-article-describe-bindings prefix))) | 6922 | (with-current-buffer cb |
| 6916 | ,prefix))) | 6923 | (gnus-article-describe-bindings prefix))) |
| 6924 | ,prefix))) | ||
| 6917 | ;; Loading `help-mode' here is necessary if `describe-bindings' | 6925 | ;; Loading `help-mode' here is necessary if `describe-bindings' |
| 6918 | ;; is replaced with something, e.g. `helm-descbinds'. | 6926 | ;; is replaced with something, e.g. `helm-descbinds'. |
| 6919 | (require 'help-mode) | 6927 | (require 'help-mode) |
| @@ -8394,14 +8402,14 @@ url is put as the `gnus-button-url' overlay property on the button." | |||
| 8394 | 8402 | ||
| 8395 | (defvar gnus-prev-page-map | 8403 | (defvar gnus-prev-page-map |
| 8396 | (let ((map (make-sparse-keymap))) | 8404 | (let ((map (make-sparse-keymap))) |
| 8397 | (define-key map [mouse-2] 'gnus-button-prev-page) | 8405 | (define-key map [mouse-2] #'gnus-button-prev-page) |
| 8398 | (define-key map "\r" 'gnus-button-prev-page) | 8406 | (define-key map "\r" #'gnus-button-prev-page) |
| 8399 | map)) | 8407 | map)) |
| 8400 | 8408 | ||
| 8401 | (defvar gnus-next-page-map | 8409 | (defvar gnus-next-page-map |
| 8402 | (let ((map (make-sparse-keymap))) | 8410 | (let ((map (make-sparse-keymap))) |
| 8403 | (define-key map [mouse-2] 'gnus-button-next-page) | 8411 | (define-key map [mouse-2] #'gnus-button-next-page) |
| 8404 | (define-key map "\r" 'gnus-button-next-page) | 8412 | (define-key map "\r" #'gnus-button-next-page) |
| 8405 | map)) | 8413 | map)) |
| 8406 | 8414 | ||
| 8407 | (defun gnus-insert-prev-page-button () | 8415 | (defun gnus-insert-prev-page-button () |
| @@ -8705,9 +8713,9 @@ For example: | |||
| 8705 | 8713 | ||
| 8706 | (defvar gnus-mime-security-button-map | 8714 | (defvar gnus-mime-security-button-map |
| 8707 | (let ((map (make-sparse-keymap))) | 8715 | (let ((map (make-sparse-keymap))) |
| 8708 | (define-key map "\r" 'gnus-article-push-button) | 8716 | (define-key map "\r" #'gnus-article-push-button) |
| 8709 | (define-key map [mouse-2] 'gnus-article-push-button) | 8717 | (define-key map [mouse-2] #'gnus-article-push-button) |
| 8710 | (define-key map [down-mouse-3] 'gnus-mime-security-button-menu) | 8718 | (define-key map [down-mouse-3] #'gnus-mime-security-button-menu) |
| 8711 | (dolist (c gnus-mime-security-button-commands) | 8719 | (dolist (c gnus-mime-security-button-commands) |
| 8712 | (define-key map (cadr c) (car c))) | 8720 | (define-key map (cadr c) (car c))) |
| 8713 | map)) | 8721 | map)) |
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8c62c9424de..c8b95d91856 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -894,14 +894,14 @@ simple manner." | |||
| 894 | ["Sort by real name" gnus-group-sort-selected-groups-by-real-name | 894 | ["Sort by real name" gnus-group-sort-selected-groups-by-real-name |
| 895 | (not (gnus-topic-mode-p))]) | 895 | (not (gnus-topic-mode-p))]) |
| 896 | ("Mark" | 896 | ("Mark" |
| 897 | ["Mark group" gnus-group-mark-group | 897 | ["Toggle/Set mark" gnus-group-mark-group |
| 898 | (and (gnus-group-group-name) | 898 | (and (gnus-group-group-name) |
| 899 | (not (memq (gnus-group-group-name) gnus-group-marked)))] | 899 | (not (memq (gnus-group-group-name) gnus-group-marked)))] |
| 900 | ["Unmark group" gnus-group-unmark-group | 900 | ["Remove mark" gnus-group-unmark-group |
| 901 | (and (gnus-group-group-name) | 901 | (and (gnus-group-group-name) |
| 902 | (memq (gnus-group-group-name) gnus-group-marked))] | 902 | (memq (gnus-group-group-name) gnus-group-marked))] |
| 903 | ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] | 903 | ["Remove all marks" gnus-group-unmark-all-groups gnus-group-marked] |
| 904 | ["Mark regexp..." gnus-group-mark-regexp t] | 904 | ["Mark by regexp..." gnus-group-mark-regexp t] |
| 905 | ["Mark region" gnus-group-mark-region :active mark-active] | 905 | ["Mark region" gnus-group-mark-region :active mark-active] |
| 906 | ["Mark buffer" gnus-group-mark-buffer t] | 906 | ["Mark buffer" gnus-group-mark-buffer t] |
| 907 | ["Execute command" gnus-group-universal-argument | 907 | ["Execute command" gnus-group-universal-argument |
| @@ -1865,7 +1865,7 @@ If FIRST-TOO, the current line is also eligible as a target." | |||
| 1865 | (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) | 1865 | (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) |
| 1866 | (eq (char-after) gnus-process-mark))) | 1866 | (eq (char-after) gnus-process-mark))) |
| 1867 | 1867 | ||
| 1868 | (defun gnus-group-mark-group (n &optional unmark no-advance) | 1868 | (defun gnus-group-mark-group (n &optional unmark no-advance no-toggle) |
| 1869 | "Mark the current group." | 1869 | "Mark the current group." |
| 1870 | (interactive "p" gnus-group-mode) | 1870 | (interactive "p" gnus-group-mode) |
| 1871 | (let ((buffer-read-only nil) | 1871 | (let ((buffer-read-only nil) |
| @@ -1877,23 +1877,33 @@ If FIRST-TOO, the current line is also eligible as a target." | |||
| 1877 | (beginning-of-line) | 1877 | (beginning-of-line) |
| 1878 | (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) | 1878 | (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) |
| 1879 | (delete-char 1) | 1879 | (delete-char 1) |
| 1880 | (if unmark | 1880 | (if (and gnus-process-mark-toggle (not no-toggle)) |
| 1881 | (progn | 1881 | (if (memq group gnus-group-marked) |
| 1882 | (setq gnus-group-marked (delete group gnus-group-marked)) | 1882 | (gnus-group-mark-update group t) |
| 1883 | (insert-char ?\s 1 t)) | 1883 | (gnus-group-mark-update group)) |
| 1884 | (setq gnus-group-marked | 1884 | (gnus-group-mark-update group unmark))) |
| 1885 | (cons group (delete group gnus-group-marked))) | ||
| 1886 | (insert-char gnus-process-mark 1 t))) | ||
| 1887 | (unless no-advance | 1885 | (unless no-advance |
| 1888 | (gnus-group-next-group 1)) | 1886 | (gnus-group-next-group 1)) |
| 1889 | (cl-decf n)) | 1887 | (cl-decf n)) |
| 1890 | (gnus-group-position-point) | 1888 | (gnus-group-position-point) |
| 1891 | n)) | 1889 | n)) |
| 1892 | 1890 | ||
| 1891 | (defun gnus-group-mark-update (n &optional unmark) | ||
| 1892 | "Set the process mark on current group and update the group line." | ||
| 1893 | (if unmark | ||
| 1894 | (progn | ||
| 1895 | (setq gnus-group-marked | ||
| 1896 | (delete n gnus-group-marked)) | ||
| 1897 | (insert-char ?\s 1 t)) | ||
| 1898 | (progn | ||
| 1899 | (setq gnus-group-marked | ||
| 1900 | (cons n (delete n gnus-group-marked))) | ||
| 1901 | (insert-char gnus-process-mark 1 t)))) | ||
| 1902 | |||
| 1893 | (defun gnus-group-unmark-group (n) | 1903 | (defun gnus-group-unmark-group (n) |
| 1894 | "Remove the mark from the current group." | 1904 | "Remove the mark from the current group." |
| 1895 | (interactive "p" gnus-group-mode) | 1905 | (interactive "p" gnus-group-mode) |
| 1896 | (gnus-group-mark-group n 'unmark) | 1906 | (gnus-group-mark-group n 'unmark nil t) |
| 1897 | (gnus-group-position-point)) | 1907 | (gnus-group-position-point)) |
| 1898 | 1908 | ||
| 1899 | (defun gnus-group-unmark-all-groups () | 1909 | (defun gnus-group-unmark-all-groups () |
| @@ -1910,7 +1920,7 @@ If UNMARK, remove the mark instead." | |||
| 1910 | (let ((num (count-lines beg end))) | 1920 | (let ((num (count-lines beg end))) |
| 1911 | (save-excursion | 1921 | (save-excursion |
| 1912 | (goto-char beg) | 1922 | (goto-char beg) |
| 1913 | (- num (gnus-group-mark-group num unmark))))) | 1923 | (- num (gnus-group-mark-group num unmark nil t))))) |
| 1914 | 1924 | ||
| 1915 | (defun gnus-group-mark-buffer (&optional unmark) | 1925 | (defun gnus-group-mark-buffer (&optional unmark) |
| 1916 | "Mark all groups in the buffer. | 1926 | "Mark all groups in the buffer. |
| @@ -1935,7 +1945,7 @@ If UNMARK, remove the mark instead." | |||
| 1935 | Return nil if the group isn't displayed." | 1945 | Return nil if the group isn't displayed." |
| 1936 | (if (gnus-group-goto-group group nil test-marked) | 1946 | (if (gnus-group-goto-group group nil test-marked) |
| 1937 | (save-excursion | 1947 | (save-excursion |
| 1938 | (gnus-group-mark-group 1 'unmark t) | 1948 | (gnus-group-mark-group 1 'unmark t t) |
| 1939 | t) | 1949 | t) |
| 1940 | (setq gnus-group-marked | 1950 | (setq gnus-group-marked |
| 1941 | (delete group gnus-group-marked)) | 1951 | (delete group gnus-group-marked)) |
| @@ -1945,7 +1955,7 @@ Return nil if the group isn't displayed." | |||
| 1945 | "Set the process mark on GROUP." | 1955 | "Set the process mark on GROUP." |
| 1946 | (if (gnus-group-goto-group group) | 1956 | (if (gnus-group-goto-group group) |
| 1947 | (save-excursion | 1957 | (save-excursion |
| 1948 | (gnus-group-mark-group 1 nil t)) | 1958 | (gnus-group-mark-group 1 nil t t)) |
| 1949 | (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) | 1959 | (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) |
| 1950 | 1960 | ||
| 1951 | (defun gnus-group-universal-argument (arg &optional _groups func) | 1961 | (defun gnus-group-universal-argument (arg &optional _groups func) |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index aa4c7532878..bcd76dda29f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -2774,7 +2774,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) | |||
| 2774 | ["Hide marked" gnus-summary-limit-exclude-marks t] | 2774 | ["Hide marked" gnus-summary-limit-exclude-marks t] |
| 2775 | ["Show expunged" gnus-summary-limit-include-expunged t]) | 2775 | ["Show expunged" gnus-summary-limit-include-expunged t]) |
| 2776 | ("Process Mark" | 2776 | ("Process Mark" |
| 2777 | ["Set mark" gnus-summary-mark-as-processable t] | 2777 | ["Toggle/Set mark" gnus-summary-mark-as-processable t] |
| 2778 | ["Remove mark" gnus-summary-unmark-as-processable t] | 2778 | ["Remove mark" gnus-summary-unmark-as-processable t] |
| 2779 | ["Remove all marks" gnus-summary-unmark-all-processable t] | 2779 | ["Remove all marks" gnus-summary-unmark-all-processable t] |
| 2780 | ["Invert marks" gnus-uu-invert-processable t] | 2780 | ["Invert marks" gnus-uu-invert-processable t] |
| @@ -8247,7 +8247,7 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp." | |||
| 8247 | (let ((articles (gnus-summary-find-matching | 8247 | (let ((articles (gnus-summary-find-matching |
| 8248 | (or header "subject") subject 'all nil nil | 8248 | (or header "subject") subject 'all nil nil |
| 8249 | not-matching))) | 8249 | not-matching))) |
| 8250 | (unless articles | 8250 | (unless (or articles not-matching) |
| 8251 | (error "Found no matches for \"%s\"" subject)) | 8251 | (error "Found no matches for \"%s\"" subject)) |
| 8252 | (gnus-summary-limit articles)) | 8252 | (gnus-summary-limit articles)) |
| 8253 | (gnus-summary-position-point)))) | 8253 | (gnus-summary-position-point)))) |
| @@ -8318,7 +8318,7 @@ To and Cc headers are checked. You need to include them in | |||
| 8318 | (and (memq a to) a)) | 8318 | (and (memq a to) a)) |
| 8319 | cc) | 8319 | cc) |
| 8320 | (nconc to cc)))) | 8320 | (nconc to cc)))) |
| 8321 | (unless articles | 8321 | (unless (or articles not-matching) |
| 8322 | (error "Found no matches for \"%s\"" recipient)) | 8322 | (error "Found no matches for \"%s\"" recipient)) |
| 8323 | (gnus-summary-limit articles)) | 8323 | (gnus-summary-limit articles)) |
| 8324 | (gnus-summary-position-point)))) | 8324 | (gnus-summary-position-point)))) |
| @@ -8374,7 +8374,7 @@ in `nnmail-extra-headers'." | |||
| 8374 | (nconc (if (eq to t) nil to) | 8374 | (nconc (if (eq to t) nil to) |
| 8375 | (if (eq cc t) nil cc) | 8375 | (if (eq cc t) nil cc) |
| 8376 | from)))) | 8376 | from)))) |
| 8377 | (unless articles | 8377 | (unless (or articles not-matching) |
| 8378 | (error "Found no matches for \"%s\"" address)) | 8378 | (error "Found no matches for \"%s\"" address)) |
| 8379 | (gnus-summary-limit articles)) | 8379 | (gnus-summary-limit articles)) |
| 8380 | (gnus-summary-position-point)))) | 8380 | (gnus-summary-position-point)))) |
| @@ -8465,7 +8465,7 @@ articles that are younger than AGE days." | |||
| 8465 | (let ((articles (gnus-summary-find-matching | 8465 | (let ((articles (gnus-summary-find-matching |
| 8466 | (cons 'extra header) regexp 'all nil nil | 8466 | (cons 'extra header) regexp 'all nil nil |
| 8467 | not-matching))) | 8467 | not-matching))) |
| 8468 | (unless articles | 8468 | (unless (or articles not-matching) |
| 8469 | (error "Found no matches for \"%s\"" regexp)) | 8469 | (error "Found no matches for \"%s\"" regexp)) |
| 8470 | (gnus-summary-limit articles)) | 8470 | (gnus-summary-limit articles)) |
| 8471 | (gnus-summary-position-point)))) | 8471 | (gnus-summary-position-point)))) |
| @@ -10951,10 +10951,14 @@ number of articles marked is returned." | |||
| 10951 | (n (abs n))) | 10951 | (n (abs n))) |
| 10952 | (while (and | 10952 | (while (and |
| 10953 | (> n 0) | 10953 | (> n 0) |
| 10954 | (if unmark | 10954 | (let ((article (gnus-summary-article-number))) |
| 10955 | (gnus-summary-remove-process-mark | 10955 | (if unmark |
| 10956 | (gnus-summary-article-number)) | 10956 | (gnus-summary-remove-process-mark article) |
| 10957 | (gnus-summary-set-process-mark (gnus-summary-article-number))) | 10957 | (if gnus-process-mark-toggle |
| 10958 | (if (memq article gnus-newsgroup-processable) | ||
| 10959 | (gnus-summary-remove-process-mark article) | ||
| 10960 | (gnus-summary-set-process-mark article)) | ||
| 10961 | (gnus-summary-set-process-mark article)))) | ||
| 10958 | (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) | 10962 | (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) |
| 10959 | (setq n (1- n))) | 10963 | (setq n (1- n))) |
| 10960 | (when (/= 0 n) | 10964 | (when (/= 0 n) |
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index b3d17bc03fb..b974dff372b 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el | |||
| @@ -1112,7 +1112,7 @@ articles in the topic and its subtopics." | |||
| 1112 | ["Delete" gnus-topic-delete t] | 1112 | ["Delete" gnus-topic-delete t] |
| 1113 | ["Rename..." gnus-topic-rename t] | 1113 | ["Rename..." gnus-topic-rename t] |
| 1114 | ["Create..." gnus-topic-create-topic t] | 1114 | ["Create..." gnus-topic-create-topic t] |
| 1115 | ["Mark" gnus-topic-mark-topic t] | 1115 | ["Toggle/Set mark" gnus-topic-mark-topic t] |
| 1116 | ["Indent" gnus-topic-indent t] | 1116 | ["Indent" gnus-topic-indent t] |
| 1117 | ["Sort" gnus-topic-sort-topics t] | 1117 | ["Sort" gnus-topic-sort-topics t] |
| 1118 | ["Previous topic" gnus-topic-goto-previous-topic t] | 1118 | ["Previous topic" gnus-topic-goto-previous-topic t] |
| @@ -1436,7 +1436,7 @@ If PERMANENT, make it stay shown in subsequent sessions as well." | |||
| 1436 | (setcar (cdr (cadr topic)) 'visible) | 1436 | (setcar (cdr (cadr topic)) 'visible) |
| 1437 | (gnus-group-list-groups))))) | 1437 | (gnus-group-list-groups))))) |
| 1438 | 1438 | ||
| 1439 | (defun gnus-topic-mark-topic (topic &optional unmark non-recursive) | 1439 | (defun gnus-topic-mark-topic (topic &optional unmark non-recursive no-toggle) |
| 1440 | "Mark all groups in the TOPIC with the process mark. | 1440 | "Mark all groups in the TOPIC with the process mark. |
| 1441 | If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." | 1441 | If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." |
| 1442 | (interactive | 1442 | (interactive |
| @@ -1450,8 +1450,13 @@ If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." | |||
| 1450 | (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil | 1450 | (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil |
| 1451 | (not non-recursive)))) | 1451 | (not non-recursive)))) |
| 1452 | (while groups | 1452 | (while groups |
| 1453 | (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) | 1453 | (let ((group (gnus-info-group (nth 1 (pop groups))))) |
| 1454 | (gnus-info-group (nth 1 (pop groups))))))))) | 1454 | (if (and gnus-process-mark-toggle (not no-toggle)) |
| 1455 | (if (memq group gnus-group-marked) | ||
| 1456 | (gnus-group-remove-mark group ) | ||
| 1457 | (gnus-group-set-mark group)) | ||
| 1458 | (if unmark (gnus-group-remove-mark group) | ||
| 1459 | (gnus-group-set-mark group))))))))) | ||
| 1455 | 1460 | ||
| 1456 | (defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive) | 1461 | (defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive) |
| 1457 | "Remove the process mark from all groups in the TOPIC. | 1462 | "Remove the process mark from all groups in the TOPIC. |
| @@ -1462,7 +1467,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." | |||
| 1462 | gnus-topic-mode) | 1467 | gnus-topic-mode) |
| 1463 | (if (not topic) | 1468 | (if (not topic) |
| 1464 | (call-interactively 'gnus-group-unmark-group) | 1469 | (call-interactively 'gnus-group-unmark-group) |
| 1465 | (gnus-topic-mark-topic topic t non-recursive))) | 1470 | (gnus-topic-mark-topic topic t non-recursive t))) |
| 1466 | 1471 | ||
| 1467 | (defun gnus-topic-get-new-news-this-topic (&optional n) | 1472 | (defun gnus-topic-get-new-news-this-topic (&optional n) |
| 1468 | "Check for new news in the current topic." | 1473 | "Check for new news in the current topic." |
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 7de1cd1ddb1..7dde799a5b8 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -1183,6 +1183,14 @@ newsgroups." | |||
| 1183 | :group 'gnus-summary-marks | 1183 | :group 'gnus-summary-marks |
| 1184 | :type 'character) | 1184 | :type 'character) |
| 1185 | 1185 | ||
| 1186 | (defcustom gnus-process-mark-toggle t | ||
| 1187 | "If nil the process mark command only sets the process mark." | ||
| 1188 | :version "28.1" | ||
| 1189 | :group 'gnus-summary | ||
| 1190 | :group 'gnus-group-various | ||
| 1191 | :group 'gnus-group-topic | ||
| 1192 | :type 'boolean) | ||
| 1193 | |||
| 1186 | (defcustom gnus-large-newsgroup 200 | 1194 | (defcustom gnus-large-newsgroup 200 |
| 1187 | "The number of articles which indicates a large newsgroup. | 1195 | "The number of articles which indicates a large newsgroup. |
| 1188 | If the number of articles in a newsgroup is greater than this value, | 1196 | If the number of articles in a newsgroup is greater than this value, |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index f869f586d94..3e2a202a6cf 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -428,8 +428,9 @@ during splitting, which may be slow." | |||
| 428 | (time-subtract | 428 | (time-subtract |
| 429 | now | 429 | now |
| 430 | (nnimap-last-command-time nnimap-object)))) | 430 | (nnimap-last-command-time nnimap-object)))) |
| 431 | (ignore-errors ;E.g. "buffer foo has no process". | 431 | (with-local-quit |
| 432 | (nnimap-send-command "NOOP")))))))) | 432 | (ignore-errors ;E.g. "buffer foo has no process". |
| 433 | (nnimap-send-command "NOOP"))))))))) | ||
| 433 | 434 | ||
| 434 | (defun nnimap-open-connection (buffer) | 435 | (defun nnimap-open-connection (buffer) |
| 435 | ;; Be backwards-compatible -- the earlier value of nnimap-stream was | 436 | ;; Be backwards-compatible -- the earlier value of nnimap-stream was |
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 0b0ae4364c8..133763add15 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -126,29 +126,35 @@ with the current prefix. The files are chosen according to | |||
| 126 | :group 'help | 126 | :group 'help |
| 127 | :version "26.3") | 127 | :version "26.3") |
| 128 | 128 | ||
| 129 | (defun help--symbol-class (s) | ||
| 130 | "Return symbol class characters for symbol S." | ||
| 131 | (when (stringp s) | ||
| 132 | (setq s (intern-soft s))) | ||
| 133 | (cond ((commandp s) | ||
| 134 | "c") ; command | ||
| 135 | ((eq (car-safe (symbol-function s)) 'macro) | ||
| 136 | "m") ; macro | ||
| 137 | ((fboundp s) | ||
| 138 | "f") ; function | ||
| 139 | ((custom-variable-p s) | ||
| 140 | "u") ; user option | ||
| 141 | ((boundp s) | ||
| 142 | "v") ; variable | ||
| 143 | ((facep s) | ||
| 144 | "a") ; fAce | ||
| 145 | ((and (fboundp 'cl-find-class) | ||
| 146 | (cl-find-class s)) | ||
| 147 | "t") ; CL type | ||
| 148 | (" ") ; something else | ||
| 149 | )) | ||
| 150 | |||
| 129 | (defun help--symbol-completion-table-affixation (completions) | 151 | (defun help--symbol-completion-table-affixation (completions) |
| 130 | (mapcar (lambda (c) | 152 | (mapcar (lambda (c) |
| 131 | (let* ((s (intern c)) | 153 | (let* ((s (intern c)) |
| 132 | (doc (condition-case nil (documentation s) (error nil))) | 154 | (doc (condition-case nil (documentation s) (error nil))) |
| 133 | (doc (and doc (substring doc 0 (string-match "\n" doc))))) | 155 | (doc (and doc (substring doc 0 (string-match "\n" doc))))) |
| 134 | (list c (propertize | 156 | (list c (propertize |
| 135 | (concat (cond ((commandp s) | 157 | (concat (help--symbol-class s) " ") ; prefix separator |
| 136 | "c") ; command | ||
| 137 | ((eq (car-safe (symbol-function s)) 'macro) | ||
| 138 | "m") ; macro | ||
| 139 | ((fboundp s) | ||
| 140 | "f") ; function | ||
| 141 | ((custom-variable-p s) | ||
| 142 | "u") ; user option | ||
| 143 | ((boundp s) | ||
| 144 | "v") ; variable | ||
| 145 | ((facep s) | ||
| 146 | "a") ; fAce | ||
| 147 | ((and (fboundp 'cl-find-class) | ||
| 148 | (cl-find-class s)) | ||
| 149 | "t") ; CL type | ||
| 150 | (" ")) ; something else | ||
| 151 | " ") ; prefix separator | ||
| 152 | 'face 'completions-annotations) | 158 | 'face 'completions-annotations) |
| 153 | (if doc (propertize (format " -- %s" doc) | 159 | (if doc (propertize (format " -- %s" doc) |
| 154 | 'face 'completions-annotations) | 160 | 'face 'completions-annotations) |
| @@ -268,7 +274,9 @@ If we can't find the file name, nil is returned." | |||
| 268 | (let ((docbuf (get-buffer-create " *DOC*")) | 274 | (let ((docbuf (get-buffer-create " *DOC*")) |
| 269 | (name (if (eq 'var kind) | 275 | (name (if (eq 'var kind) |
| 270 | (concat "V" (symbol-name subr-or-var)) | 276 | (concat "V" (symbol-name subr-or-var)) |
| 271 | (concat "F" (subr-name (advice--cd*r subr-or-var)))))) | 277 | (concat "F" (if (symbolp subr-or-var) |
| 278 | (symbol-name subr-or-var) | ||
| 279 | (subr-name (advice--cd*r subr-or-var))))))) | ||
| 272 | (with-current-buffer docbuf | 280 | (with-current-buffer docbuf |
| 273 | (goto-char (point-min)) | 281 | (goto-char (point-min)) |
| 274 | (if (eobp) | 282 | (if (eobp) |
| @@ -1022,12 +1030,12 @@ it is displayed along with the global value." | |||
| 1022 | (format-prompt "Describe variable" (and (symbolp v) v)) | 1030 | (format-prompt "Describe variable" (and (symbolp v) v)) |
| 1023 | #'help--symbol-completion-table | 1031 | #'help--symbol-completion-table |
| 1024 | (lambda (vv) | 1032 | (lambda (vv) |
| 1025 | ;; In case the variable only exists in the buffer | 1033 | (or (get vv 'variable-documentation) |
| 1026 | ;; the command we switch back to that buffer before | 1034 | (and (not (keywordp vv)) |
| 1027 | ;; we examine the variable. | 1035 | ;; Since the variable may only exist in the |
| 1028 | (with-current-buffer orig-buffer | 1036 | ;; original buffer, we have to look for it |
| 1029 | (or (get vv 'variable-documentation) | 1037 | ;; there. |
| 1030 | (and (boundp vv) (not (keywordp vv)))))) | 1038 | (buffer-local-boundp vv orig-buffer)))) |
| 1031 | t nil nil | 1039 | t nil nil |
| 1032 | (if (symbolp v) (symbol-name v)))) | 1040 | (if (symbolp v) (symbol-name v)))) |
| 1033 | (list (if (equal val "") | 1041 | (list (if (equal val "") |
diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 82952e934b6..26cfcc3f9cc 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el | |||
| @@ -125,6 +125,9 @@ This variable is expected to be made buffer-local by modes.") | |||
| 125 | (defvar hl-line-overlay-buffer nil | 125 | (defvar hl-line-overlay-buffer nil |
| 126 | "Most recently visited buffer in which Hl-Line mode is enabled.") | 126 | "Most recently visited buffer in which Hl-Line mode is enabled.") |
| 127 | 127 | ||
| 128 | (defvar hl-line-overlay-priority -50 | ||
| 129 | "Priority used on the overlay used by hl-line.") | ||
| 130 | |||
| 128 | ;;;###autoload | 131 | ;;;###autoload |
| 129 | (define-minor-mode hl-line-mode | 132 | (define-minor-mode hl-line-mode |
| 130 | "Toggle highlighting of the current line (Hl-Line mode). | 133 | "Toggle highlighting of the current line (Hl-Line mode). |
| @@ -152,7 +155,7 @@ line about point in the selected window only." | |||
| 152 | 155 | ||
| 153 | (defun hl-line-make-overlay () | 156 | (defun hl-line-make-overlay () |
| 154 | (let ((ol (make-overlay (point) (point)))) | 157 | (let ((ol (make-overlay (point) (point)))) |
| 155 | (overlay-put ol 'priority -50) ;(bug#16192) | 158 | (overlay-put ol 'priority hl-line-overlay-priority) ;(bug#16192) |
| 156 | (overlay-put ol 'face hl-line-face) | 159 | (overlay-put ol 'face hl-line-face) |
| 157 | ol)) | 160 | ol)) |
| 158 | 161 | ||
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index c80222ed0f4..9088f31053b 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el | |||
| @@ -1079,8 +1079,11 @@ a new window in the current frame, splitting vertically." | |||
| 1079 | ;; Make sure that redisplay is performed, otherwise there can be a | 1079 | ;; Make sure that redisplay is performed, otherwise there can be a |
| 1080 | ;; bad interaction with code in the window-scroll-functions hook | 1080 | ;; bad interaction with code in the window-scroll-functions hook |
| 1081 | (redisplay t) | 1081 | (redisplay t) |
| 1082 | (fit-window-to-buffer nil (when owin (/ (frame-height) | 1082 | (when (buffer-local-value 'ibuffer-auto-mode (window-buffer)) |
| 1083 | (length (window-list (selected-frame))))))) | 1083 | (fit-window-to-buffer |
| 1084 | nil (and owin | ||
| 1085 | (/ (frame-height) | ||
| 1086 | (length (window-list (selected-frame)))))))) | ||
| 1084 | 1087 | ||
| 1085 | (defun ibuffer-confirm-operation-on (operation names) | 1088 | (defun ibuffer-confirm-operation-on (operation names) |
| 1086 | "Display a buffer asking whether to perform OPERATION on NAMES." | 1089 | "Display a buffer asking whether to perform OPERATION on NAMES." |
diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 91bbb600136..08b4ef2030a 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el | |||
| @@ -50,6 +50,8 @@ | |||
| 50 | ;;; Code: | 50 | ;;; Code: |
| 51 | 51 | ||
| 52 | (require 'rfn-eshadow) ; rfn-eshadow-overlay | 52 | (require 'rfn-eshadow) ; rfn-eshadow-overlay |
| 53 | (require 'simple) ; max-mini-window-lines | ||
| 54 | (require 'cl-lib) | ||
| 53 | 55 | ||
| 54 | (defgroup icomplete nil | 56 | (defgroup icomplete nil |
| 55 | "Show completions dynamically in minibuffer." | 57 | "Show completions dynamically in minibuffer." |
| @@ -99,6 +101,10 @@ Otherwise this should be a list of the completion tables (e.g., | |||
| 99 | "Face used by Icomplete for highlighting first match." | 101 | "Face used by Icomplete for highlighting first match." |
| 100 | :version "24.4") | 102 | :version "24.4") |
| 101 | 103 | ||
| 104 | (defface icomplete-selected-match '((t :inherit highlight)) | ||
| 105 | "Face used by `icomplete-vertical-mode' for the selected candidate." | ||
| 106 | :version "24.4") | ||
| 107 | |||
| 102 | ;;;_* User Customization variables | 108 | ;;;_* User Customization variables |
| 103 | (defcustom icomplete-prospects-height 2 | 109 | (defcustom icomplete-prospects-height 2 |
| 104 | ;; We used to compute how many lines 100 characters would take in | 110 | ;; We used to compute how many lines 100 characters would take in |
| @@ -109,7 +115,7 @@ Otherwise this should be a list of the completion tables (e.g., | |||
| 109 | :type 'integer | 115 | :type 'integer |
| 110 | :version "26.1") | 116 | :version "26.1") |
| 111 | 117 | ||
| 112 | (defcustom icomplete-compute-delay .3 | 118 | (defcustom icomplete-compute-delay .15 |
| 113 | "Completions-computation stall, used only with large-number completions. | 119 | "Completions-computation stall, used only with large-number completions. |
| 114 | See `icomplete-delay-completions-threshold'." | 120 | See `icomplete-delay-completions-threshold'." |
| 115 | :type 'number) | 121 | :type 'number) |
| @@ -118,7 +124,7 @@ See `icomplete-delay-completions-threshold'." | |||
| 118 | "Pending-completions number over which to apply `icomplete-compute-delay'." | 124 | "Pending-completions number over which to apply `icomplete-compute-delay'." |
| 119 | :type 'integer) | 125 | :type 'integer) |
| 120 | 126 | ||
| 121 | (defcustom icomplete-max-delay-chars 3 | 127 | (defcustom icomplete-max-delay-chars 2 |
| 122 | "Maximum number of initial chars to apply `icomplete-compute-delay'." | 128 | "Maximum number of initial chars to apply `icomplete-compute-delay'." |
| 123 | :type 'integer) | 129 | :type 'integer) |
| 124 | 130 | ||
| @@ -152,10 +158,6 @@ icompletion is occurring." | |||
| 152 | "Initial input in the minibuffer when icomplete-mode was activated. | 158 | "Initial input in the minibuffer when icomplete-mode was activated. |
| 153 | Used to implement the option `icomplete-show-matches-on-no-input'.") | 159 | Used to implement the option `icomplete-show-matches-on-no-input'.") |
| 154 | 160 | ||
| 155 | (defun icomplete-pre-command-hook () | ||
| 156 | (let ((non-essential t)) | ||
| 157 | (icomplete-tidy))) | ||
| 158 | |||
| 159 | (defun icomplete-post-command-hook () | 161 | (defun icomplete-post-command-hook () |
| 160 | (let ((non-essential t)) ;E.g. don't prompt for password! | 162 | (let ((non-essential t)) ;E.g. don't prompt for password! |
| 161 | (icomplete-exhibit))) | 163 | (icomplete-exhibit))) |
| @@ -215,6 +217,29 @@ the default otherwise." | |||
| 215 | ;; We're not at all interested in cycling here (bug#34077). | 217 | ;; We're not at all interested in cycling here (bug#34077). |
| 216 | (minibuffer-force-complete nil nil 'dont-cycle)) | 218 | (minibuffer-force-complete nil nil 'dont-cycle)) |
| 217 | 219 | ||
| 220 | ;; Apropos `icomplete-scroll', we implement "scrolling icomplete" | ||
| 221 | ;; within classic icomplete, which is "rotating", by contrast. | ||
| 222 | ;; | ||
| 223 | ;; The two variables supporing this are | ||
| 224 | ;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'. | ||
| 225 | ;; They come into play when: | ||
| 226 | ;; | ||
| 227 | ;; - The user invokes commands `icomplete-forward-completions' and | ||
| 228 | ;; `icomplete-backward-completions', thus "manually" scrolling to a | ||
| 229 | ;; given position; | ||
| 230 | ;; | ||
| 231 | ;; - The user re-filters a selection that had already been manually | ||
| 232 | ;; scrolled. The system attempts to keep the previous selection | ||
| 233 | ;; stable in the face of the new filtering. This is mostly done in | ||
| 234 | ;; `icomplete--render-vertical'. | ||
| 235 | ;; | ||
| 236 | (defvar icomplete-scroll nil | ||
| 237 | "If non-nil, scroll candidates list instead of rotating it.") | ||
| 238 | (defvar icomplete--scrolled-completions nil | ||
| 239 | "If non-nil, tail of completions list manually scrolled to.") | ||
| 240 | (defvar icomplete--scrolled-past nil | ||
| 241 | "If non-nil, reverse tail of completions scrolled past.") | ||
| 242 | |||
| 218 | (defun icomplete-forward-completions () | 243 | (defun icomplete-forward-completions () |
| 219 | "Step forward completions by one entry. | 244 | "Step forward completions by one entry. |
| 220 | Second entry becomes the first and can be selected with | 245 | Second entry becomes the first and can be selected with |
| @@ -223,10 +248,14 @@ Second entry becomes the first and can be selected with | |||
| 223 | (let* ((beg (icomplete--field-beg)) | 248 | (let* ((beg (icomplete--field-beg)) |
| 224 | (end (icomplete--field-end)) | 249 | (end (icomplete--field-end)) |
| 225 | (comps (completion-all-sorted-completions beg end)) | 250 | (comps (completion-all-sorted-completions beg end)) |
| 226 | (last (last comps))) | 251 | (last (last comps))) |
| 227 | (when comps | 252 | (when (consp (cdr comps)) |
| 228 | (setcdr last (cons (car comps) (cdr last))) | 253 | (cond (icomplete-scroll |
| 229 | (completion--cache-all-sorted-completions beg end (cdr comps))))) | 254 | (push (pop comps) icomplete--scrolled-past) |
| 255 | (setq icomplete--scrolled-completions comps)) | ||
| 256 | (t | ||
| 257 | (setcdr (last comps) (cons (pop comps) (cdr last))))) | ||
| 258 | (completion--cache-all-sorted-completions beg end comps)))) | ||
| 230 | 259 | ||
| 231 | (defun icomplete-backward-completions () | 260 | (defun icomplete-backward-completions () |
| 232 | "Step backward completions by one entry. | 261 | "Step backward completions by one entry. |
| @@ -236,12 +265,16 @@ Last entry becomes the first and can be selected with | |||
| 236 | (let* ((beg (icomplete--field-beg)) | 265 | (let* ((beg (icomplete--field-beg)) |
| 237 | (end (icomplete--field-end)) | 266 | (end (icomplete--field-end)) |
| 238 | (comps (completion-all-sorted-completions beg end)) | 267 | (comps (completion-all-sorted-completions beg end)) |
| 239 | (last-but-one (last comps 2)) | 268 | last-but-one) |
| 240 | (last (cdr last-but-one))) | 269 | (cond ((and icomplete-scroll icomplete--scrolled-past) |
| 241 | (when (consp last) ; At least two elements in comps | 270 | (push (pop icomplete--scrolled-past) comps) |
| 242 | (setcdr last-but-one (cdr last)) | 271 | (setq icomplete--scrolled-completions comps)) |
| 243 | (push (car last) comps) | 272 | ((and (not icomplete-scroll) |
| 244 | (completion--cache-all-sorted-completions beg end comps)))) | 273 | (consp (cdr (setq last-but-one (last comps 2))))) |
| 274 | ;; At least two elements in comps | ||
| 275 | (push (car (cdr last-but-one)) comps) | ||
| 276 | (setcdr last-but-one (cdr (cdr last-but-one))))) | ||
| 277 | (completion--cache-all-sorted-completions beg end comps))) | ||
| 245 | 278 | ||
| 246 | ;;; Helpers for `fido-mode' (or `ido-mode' emulation) | 279 | ;;; Helpers for `fido-mode' (or `ido-mode' emulation) |
| 247 | ;;; | 280 | ;;; |
| @@ -298,7 +331,8 @@ require user confirmation." | |||
| 298 | (file-name-directory (icomplete--field-string)))) | 331 | (file-name-directory (icomplete--field-string)))) |
| 299 | (current (car completion-all-sorted-completions)) | 332 | (current (car completion-all-sorted-completions)) |
| 300 | (probe (and dir current | 333 | (probe (and dir current |
| 301 | (expand-file-name (directory-file-name current) dir)))) | 334 | (expand-file-name (directory-file-name current) |
| 335 | (substitute-env-vars dir))))) | ||
| 302 | (cond ((and probe (file-directory-p probe) (not (string= current "./"))) | 336 | (cond ((and probe (file-directory-p probe) (not (string= current "./"))) |
| 303 | (icomplete-force-complete)) | 337 | (icomplete-force-complete)) |
| 304 | (t | 338 | (t |
| @@ -351,6 +385,7 @@ if that doesn't produce a completion match." | |||
| 351 | (setq-local icomplete-tidy-shadowed-file-names t | 385 | (setq-local icomplete-tidy-shadowed-file-names t |
| 352 | icomplete-show-matches-on-no-input t | 386 | icomplete-show-matches-on-no-input t |
| 353 | icomplete-hide-common-prefix nil | 387 | icomplete-hide-common-prefix nil |
| 388 | icomplete-scroll (not (null icomplete-vertical-mode)) | ||
| 354 | completion-styles '(flex) | 389 | completion-styles '(flex) |
| 355 | completion-flex-nospace nil | 390 | completion-flex-nospace nil |
| 356 | completion-category-defaults nil | 391 | completion-category-defaults nil |
| @@ -449,9 +484,9 @@ Usually run by inclusion in `minibuffer-setup-hook'." | |||
| 449 | (when (and icomplete-mode (icomplete-simple-completing-p)) | 484 | (when (and icomplete-mode (icomplete-simple-completing-p)) |
| 450 | (setq-local icomplete--initial-input (icomplete--field-string)) | 485 | (setq-local icomplete--initial-input (icomplete--field-string)) |
| 451 | (setq-local completion-show-inline-help nil) | 486 | (setq-local completion-show-inline-help nil) |
| 487 | (setq icomplete--scrolled-completions nil) | ||
| 452 | (use-local-map (make-composed-keymap icomplete-minibuffer-map | 488 | (use-local-map (make-composed-keymap icomplete-minibuffer-map |
| 453 | (current-local-map))) | 489 | (current-local-map))) |
| 454 | (add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t) | ||
| 455 | (add-hook 'post-command-hook #'icomplete-post-command-hook nil t) | 490 | (add-hook 'post-command-hook #'icomplete-post-command-hook nil t) |
| 456 | (run-hooks 'icomplete-minibuffer-setup-hook))) | 491 | (run-hooks 'icomplete-minibuffer-setup-hook))) |
| 457 | 492 | ||
| @@ -465,7 +500,6 @@ Usually run by inclusion in `minibuffer-setup-hook'." | |||
| 465 | (setq icomplete--in-region-buffer nil) | 500 | (setq icomplete--in-region-buffer nil) |
| 466 | (delete-overlay icomplete-overlay) | 501 | (delete-overlay icomplete-overlay) |
| 467 | (kill-local-variable 'completion-show-inline-help) | 502 | (kill-local-variable 'completion-show-inline-help) |
| 468 | (remove-hook 'pre-command-hook 'icomplete-pre-command-hook t) | ||
| 469 | (remove-hook 'post-command-hook 'icomplete-post-command-hook t) | 503 | (remove-hook 'post-command-hook 'icomplete-post-command-hook t) |
| 470 | (message nil))) | 504 | (message nil))) |
| 471 | (when (and completion-in-region-mode | 505 | (when (and completion-in-region-mode |
| @@ -477,12 +511,12 @@ Usually run by inclusion in `minibuffer-setup-hook'." | |||
| 477 | (unless (memq icomplete-minibuffer-map (cdr tem)) | 511 | (unless (memq icomplete-minibuffer-map (cdr tem)) |
| 478 | (setcdr tem (make-composed-keymap icomplete-minibuffer-map | 512 | (setcdr tem (make-composed-keymap icomplete-minibuffer-map |
| 479 | (cdr tem))))) | 513 | (cdr tem))))) |
| 480 | (add-hook 'pre-command-hook 'icomplete-pre-command-hook nil t) | ||
| 481 | (add-hook 'post-command-hook 'icomplete-post-command-hook nil t))) | 514 | (add-hook 'post-command-hook 'icomplete-post-command-hook nil t))) |
| 482 | 515 | ||
| 483 | (defun icomplete--sorted-completions () | 516 | (defun icomplete--sorted-completions () |
| 484 | (or completion-all-sorted-completions | 517 | (or completion-all-sorted-completions |
| 485 | (cl-loop | 518 | (cl-loop |
| 519 | initially (setq icomplete--scrolled-past nil) ; Invalidate scrolled state | ||
| 486 | with beg = (icomplete--field-beg) | 520 | with beg = (icomplete--field-beg) |
| 487 | with end = (icomplete--field-end) | 521 | with end = (icomplete--field-end) |
| 488 | with all = (completion-all-sorted-completions beg end) | 522 | with all = (completion-all-sorted-completions beg end) |
| @@ -593,18 +627,13 @@ resized depends on `resize-mini-windows'." | |||
| 593 | (add-hook 'icomplete-minibuffer-setup-hook | 627 | (add-hook 'icomplete-minibuffer-setup-hook |
| 594 | #'icomplete--vertical-minibuffer-setup))) | 628 | #'icomplete--vertical-minibuffer-setup))) |
| 595 | 629 | ||
| 630 | (defalias 'fido-vertical-mode 'icomplete-vertical-mode) | ||
| 631 | |||
| 596 | 632 | ||
| 597 | 633 | ||
| 598 | 634 | ||
| 599 | ;;;_* Completion | 635 | ;;;_* Completion |
| 600 | 636 | ||
| 601 | ;;;_ > icomplete-tidy () | ||
| 602 | (defun icomplete-tidy () | ||
| 603 | "Remove completions display (if any) prior to new user input. | ||
| 604 | Should be run in on the minibuffer `pre-command-hook'. | ||
| 605 | See `icomplete-mode' and `minibuffer-setup-hook'." | ||
| 606 | (delete-overlay icomplete-overlay)) | ||
| 607 | |||
| 608 | ;;;_ > icomplete-exhibit () | 637 | ;;;_ > icomplete-exhibit () |
| 609 | (defun icomplete-exhibit () | 638 | (defun icomplete-exhibit () |
| 610 | "Insert Icomplete completions display. | 639 | "Insert Icomplete completions display. |
| @@ -659,13 +688,126 @@ See `icomplete-mode' and `minibuffer-setup-hook'." | |||
| 659 | deactivate-mark) | 688 | deactivate-mark) |
| 660 | ;; Do nothing if while-no-input was aborted. | 689 | ;; Do nothing if while-no-input was aborted. |
| 661 | (when (stringp text) | 690 | (when (stringp text) |
| 662 | (move-overlay icomplete-overlay (point) (point) (current-buffer)) | 691 | (move-overlay icomplete-overlay (point-min) (point) (current-buffer)) |
| 663 | ;; The current C cursor code doesn't know to use the overlay's | 692 | ;; The current C cursor code doesn't know to use the overlay's |
| 664 | ;; marker's stickiness to figure out whether to place the cursor | 693 | ;; marker's stickiness to figure out whether to place the cursor |
| 665 | ;; before or after the string, so let's spoon-feed it the pos. | 694 | ;; before or after the string, so let's spoon-feed it the pos. |
| 666 | (put-text-property 0 1 'cursor t text) | 695 | (put-text-property 0 1 'cursor t text) |
| 696 | (overlay-put | ||
| 697 | icomplete-overlay 'before-string | ||
| 698 | (and icomplete-scroll | ||
| 699 | (let ((past (length icomplete--scrolled-past))) | ||
| 700 | (format | ||
| 701 | "%s/%s " | ||
| 702 | (1+ past) | ||
| 703 | (+ past | ||
| 704 | (safe-length completion-all-sorted-completions)))))) | ||
| 667 | (overlay-put icomplete-overlay 'after-string text)))))))) | 705 | (overlay-put icomplete-overlay 'after-string text)))))))) |
| 668 | 706 | ||
| 707 | (defun icomplete--affixate (md prospects) | ||
| 708 | "Affixate PROSPECTS given completion metadata MD. | ||
| 709 | Return a list of (COMP PREFIX SUFFIX)." | ||
| 710 | (let ((aff-fun (or (completion-metadata-get md 'affixation-function) | ||
| 711 | (plist-get completion-extra-properties :affixation-function))) | ||
| 712 | (ann-fun (or (completion-metadata-get md 'annotation-function) | ||
| 713 | (plist-get completion-extra-properties :annotation-function)))) | ||
| 714 | (cond (aff-fun | ||
| 715 | (funcall aff-fun prospects)) | ||
| 716 | (ann-fun | ||
| 717 | (mapcar | ||
| 718 | (lambda (comp) | ||
| 719 | (let ((suffix (or (funcall ann-fun comp) ""))) | ||
| 720 | (list comp "" | ||
| 721 | ;; The default completion UI adds the | ||
| 722 | ;; `completions-annotations' face if no | ||
| 723 | ;; other faces are present. | ||
| 724 | (if (text-property-not-all 0 (length suffix) 'face nil suffix) | ||
| 725 | suffix | ||
| 726 | (propertize suffix 'face 'completions-annotations))))) | ||
| 727 | prospects)) | ||
| 728 | (prospects)))) | ||
| 729 | |||
| 730 | (cl-defun icomplete--render-vertical (comps md &aux scroll-above scroll-below) | ||
| 731 | ;; Welcome to loopapalooza! | ||
| 732 | ;; | ||
| 733 | ;; First, be mindful of `icomplete-scroll' and manual scrolls. If | ||
| 734 | ;; `icomplete--scrolled-completions' and `icomplete--scrolled-past' | ||
| 735 | ;; are: | ||
| 736 | ;; | ||
| 737 | ;; - both nil, there is no manual scroll; | ||
| 738 | ;; - both non-nil, there is a healthy manual scroll the doesn't need | ||
| 739 | ;; to be readjusted (user just moved around the minibuffer, for | ||
| 740 | ;; example)l | ||
| 741 | ;; - non-nil and nil, respectively, a refiltering took place and we | ||
| 742 | ;; need attempt to readjust them to the new filtered `comps'. | ||
| 743 | (when (and icomplete-scroll | ||
| 744 | icomplete--scrolled-completions | ||
| 745 | (null icomplete--scrolled-past)) | ||
| 746 | (cl-loop with preds | ||
| 747 | for (comp . rest) on comps | ||
| 748 | when (equal comp (car icomplete--scrolled-completions)) | ||
| 749 | do | ||
| 750 | (setq icomplete--scrolled-past preds | ||
| 751 | comps (cons comp rest)) | ||
| 752 | (completion--cache-all-sorted-completions | ||
| 753 | (icomplete--field-beg) | ||
| 754 | (icomplete--field-end) | ||
| 755 | comps) | ||
| 756 | and return nil | ||
| 757 | do (push comp preds) | ||
| 758 | finally (setq icomplete--scrolled-completions nil))) | ||
| 759 | ;; Then, in this pretty ugly loop, collect completions to display | ||
| 760 | ;; above and below the selected one, considering scrolling | ||
| 761 | ;; positions. | ||
| 762 | (cl-loop with preds = icomplete--scrolled-past | ||
| 763 | with succs = (cdr comps) | ||
| 764 | with max-lines = (1- (min | ||
| 765 | icomplete-prospects-height | ||
| 766 | (truncate (max-mini-window-lines) 1))) | ||
| 767 | with max-above = (- max-lines | ||
| 768 | 1 | ||
| 769 | (cl-loop for (_ . r) on comps | ||
| 770 | repeat (truncate max-lines 2) | ||
| 771 | while (listp r) | ||
| 772 | count 1)) | ||
| 773 | repeat max-lines | ||
| 774 | for neighbour = nil | ||
| 775 | if (and preds (> max-above 0)) do | ||
| 776 | (push (setq neighbour (pop preds)) scroll-above) | ||
| 777 | (cl-decf max-above) | ||
| 778 | else if (consp succs) collect | ||
| 779 | (setq neighbour (pop succs)) into scroll-below-aux | ||
| 780 | while neighbour | ||
| 781 | finally (setq scroll-below scroll-below-aux)) | ||
| 782 | ;; Now figure out spacing and layout | ||
| 783 | ;; | ||
| 784 | (cl-loop | ||
| 785 | with selected = (substring (car comps)) | ||
| 786 | initially (add-face-text-property 0 (length selected) | ||
| 787 | 'icomplete-selected-match 'append selected) | ||
| 788 | with torender = (nconc scroll-above (list selected) scroll-below) | ||
| 789 | with triplets = (icomplete--affixate md torender) | ||
| 790 | initially (when (eq triplets torender) | ||
| 791 | (cl-return-from icomplete--render-vertical | ||
| 792 | (concat | ||
| 793 | " \n" | ||
| 794 | (mapconcat #'identity torender icomplete-separator)))) | ||
| 795 | for (comp prefix) in triplets | ||
| 796 | maximizing (length prefix) into max-prefix-len | ||
| 797 | maximizing (length comp) into max-comp-len | ||
| 798 | finally return | ||
| 799 | ;; Finally, render | ||
| 800 | ;; | ||
| 801 | (concat | ||
| 802 | " \n" | ||
| 803 | (cl-loop for (comp prefix suffix) in triplets | ||
| 804 | concat prefix | ||
| 805 | concat (make-string (- max-prefix-len (length prefix)) ? ) | ||
| 806 | concat comp | ||
| 807 | concat (make-string (- max-comp-len (length comp)) ? ) | ||
| 808 | concat suffix | ||
| 809 | concat icomplete-separator)))) | ||
| 810 | |||
| 669 | ;;;_ > icomplete-completions (name candidates predicate require-match) | 811 | ;;;_ > icomplete-completions (name candidates predicate require-match) |
| 670 | (defun icomplete-completions (name candidates predicate require-match) | 812 | (defun icomplete-completions (name candidates predicate require-match) |
| 671 | "Identify prospective candidates for minibuffer completion. | 813 | "Identify prospective candidates for minibuffer completion. |
| @@ -703,126 +845,126 @@ matches exist." | |||
| 703 | predicate)) | 845 | predicate)) |
| 704 | (md (completion--field-metadata (icomplete--field-beg))) | 846 | (md (completion--field-metadata (icomplete--field-beg))) |
| 705 | (comps (icomplete--sorted-completions)) | 847 | (comps (icomplete--sorted-completions)) |
| 706 | (last (if (consp comps) (last comps))) | ||
| 707 | (base-size (cdr last)) | ||
| 708 | (open-bracket (if require-match "(" "[")) | 848 | (open-bracket (if require-match "(" "[")) |
| 709 | (close-bracket (if require-match ")" "]"))) | 849 | (close-bracket (if require-match ")" "]"))) |
| 710 | ;; `concat'/`mapconcat' is the slow part. | 850 | ;; `concat'/`mapconcat' is the slow part. |
| 711 | (if (not (consp comps)) | 851 | (if (not (consp comps)) |
| 712 | (progn ;;(debug (format "Candidates=%S field=%S" candidates name)) | 852 | (progn ;;(debug (format "Candidates=%S field=%S" candidates name)) |
| 713 | (format " %sNo matches%s" open-bracket close-bracket)) | 853 | (format " %sNo matches%s" open-bracket close-bracket)) |
| 714 | (if last (setcdr last nil)) | 854 | (if icomplete-vertical-mode |
| 715 | (let* ((most-try | 855 | (icomplete--render-vertical comps md) |
| 716 | (if (and base-size (> base-size 0)) | 856 | (let* ((last (if (consp comps) (last comps))) |
| 857 | ;; Save the "base size" encoded in `comps' then | ||
| 858 | ;; removing making `comps' a proper list. | ||
| 859 | (base-size (prog1 (cdr last) | ||
| 860 | (if last (setcdr last nil)))) | ||
| 861 | (most-try | ||
| 862 | (if (and base-size (> base-size 0)) | ||
| 863 | (completion-try-completion | ||
| 864 | name candidates predicate (length name) md) | ||
| 865 | ;; If the `comps' are 0-based, the result should be | ||
| 866 | ;; the same with `comps'. | ||
| 717 | (completion-try-completion | 867 | (completion-try-completion |
| 718 | name candidates predicate (length name) md) | 868 | name comps nil (length name) md))) |
| 719 | ;; If the `comps' are 0-based, the result should be | 869 | (most (if (consp most-try) (car most-try) |
| 720 | ;; the same with `comps'. | 870 | (if most-try (car comps) ""))) |
| 721 | (completion-try-completion | 871 | ;; Compare name and most, so we can determine if name is |
| 722 | name comps nil (length name) md))) | 872 | ;; a prefix of most, or something else. |
| 723 | (most (if (consp most-try) (car most-try) | 873 | (compare (compare-strings name nil nil |
| 724 | (if most-try (car comps) ""))) | 874 | most nil nil completion-ignore-case)) |
| 725 | ;; Compare name and most, so we can determine if name is | 875 | (ellipsis (if (char-displayable-p ?…) "…" "...")) |
| 726 | ;; a prefix of most, or something else. | 876 | (determ (unless (or (eq t compare) (eq t most-try) |
| 727 | (compare (compare-strings name nil nil | 877 | (= (setq compare (1- (abs compare))) |
| 728 | most nil nil completion-ignore-case)) | 878 | (length most))) |
| 729 | (ellipsis (if (char-displayable-p ?…) "…" "...")) | 879 | (concat open-bracket |
| 730 | (determ (unless (or (eq t compare) (eq t most-try) | 880 | (cond |
| 731 | (= (setq compare (1- (abs compare))) | 881 | ((= compare (length name)) |
| 732 | (length most))) | 882 | ;; Typical case: name is a prefix. |
| 733 | (concat open-bracket | 883 | (substring most compare)) |
| 734 | (cond | 884 | ;; Don't bother truncating if it doesn't gain |
| 735 | ((= compare (length name)) | 885 | ;; us at least 2 columns. |
| 736 | ;; Typical case: name is a prefix. | 886 | ((< compare (+ 2 (string-width ellipsis))) most) |
| 737 | (substring most compare)) | 887 | (t (concat ellipsis (substring most compare)))) |
| 738 | ;; Don't bother truncating if it doesn't gain | 888 | close-bracket))) |
| 739 | ;; us at least 2 columns. | 889 | ;;"-prospects" - more than one candidate |
| 740 | ((< compare (+ 2 (string-width ellipsis))) most) | 890 | (prospects-len (+ (string-width |
| 741 | (t (concat ellipsis (substring most compare)))) | 891 | (or determ (concat open-bracket close-bracket))) |
| 742 | close-bracket))) | 892 | (string-width icomplete-separator) |
| 743 | ;;"-prospects" - more than one candidate | 893 | (+ 2 (string-width ellipsis)) ;; take {…} into account |
| 744 | (prospects-len (+ (string-width | 894 | (string-width (buffer-string)))) |
| 745 | (or determ (concat open-bracket close-bracket))) | 895 | (prospects-max |
| 746 | (string-width icomplete-separator) | 896 | ;; Max total length to use, including the minibuffer content. |
| 747 | (+ 2 (string-width ellipsis)) ;; take {…} into account | 897 | (* (+ icomplete-prospects-height |
| 748 | (string-width (buffer-string)))) | 898 | ;; If the minibuffer content already uses up more than |
| 749 | (prospects-max | 899 | ;; one line, increase the allowable space accordingly. |
| 750 | ;; Max total length to use, including the minibuffer content. | 900 | (/ prospects-len (window-width))) |
| 751 | (* (+ icomplete-prospects-height | 901 | (window-width))) |
| 752 | ;; If the minibuffer content already uses up more than | 902 | ;; Find the common prefix among `comps'. |
| 753 | ;; one line, increase the allowable space accordingly. | 903 | ;; We can't use the optimization below because its assumptions |
| 754 | (/ prospects-len (window-width))) | 904 | ;; aren't always true, e.g. when completion-cycling (bug#10850): |
| 755 | (window-width))) | 905 | ;; (if (eq t (compare-strings (car comps) nil (length most) |
| 756 | ;; Find the common prefix among `comps'. | 906 | ;; most nil nil completion-ignore-case)) |
| 757 | ;; We can't use the optimization below because its assumptions | 907 | ;; ;; Common case. |
| 758 | ;; aren't always true, e.g. when completion-cycling (bug#10850): | 908 | ;; (length most) |
| 759 | ;; (if (eq t (compare-strings (car comps) nil (length most) | 909 | ;; Else, use try-completion. |
| 760 | ;; most nil nil completion-ignore-case)) | 910 | (prefix (when icomplete-hide-common-prefix |
| 761 | ;; ;; Common case. | 911 | (try-completion "" comps))) |
| 762 | ;; (length most) | 912 | (prefix-len |
| 763 | ;; Else, use try-completion. | 913 | (and (stringp prefix) |
| 764 | (prefix (when icomplete-hide-common-prefix | 914 | ;; Only hide the prefix if the corresponding info |
| 765 | (try-completion "" comps))) | 915 | ;; is already displayed via `most'. |
| 766 | (prefix-len | 916 | (string-prefix-p prefix most t) |
| 767 | (and (stringp prefix) | 917 | (length prefix))) ;;) |
| 768 | ;; Only hide the prefix if the corresponding info | 918 | prospects comp limit) |
| 769 | ;; is already displayed via `most'. | 919 | (prog1 |
| 770 | (string-prefix-p prefix most t) | 920 | (if (or (eq most-try t) (and (not icomplete-scroll) |
| 771 | (length prefix))) ;;) | 921 | (not (consp (cdr comps))))) |
| 772 | prospects comp limit) | 922 | (concat determ " [Matched]") |
| 773 | (if (or (eq most-try t) (not (consp (cdr comps)))) | 923 | (when (member name comps) |
| 774 | (setq prospects nil) | 924 | ;; NAME is complete but not unique. This scenario poses |
| 775 | (when (member name comps) | 925 | ;; following UI issues: |
| 776 | ;; NAME is complete but not unique. This scenario poses | 926 | ;; |
| 777 | ;; following UI issues: | 927 | ;; - When `icomplete-hide-common-prefix' is non-nil, NAME |
| 778 | ;; | 928 | ;; is stripped empty. This would make the entry |
| 779 | ;; - When `icomplete-hide-common-prefix' is non-nil, NAME | 929 | ;; inconspicuous. |
| 780 | ;; is stripped empty. This would make the entry | 930 | ;; |
| 781 | ;; inconspicuous. | 931 | ;; - Due to sorting of completions, NAME may not be the |
| 782 | ;; | 932 | ;; first of the prospects and could be hidden deep in |
| 783 | ;; - Due to sorting of completions, NAME may not be the | 933 | ;; the displayed string. |
| 784 | ;; first of the prospects and could be hidden deep in | 934 | ;; |
| 785 | ;; the displayed string. | 935 | ;; - Because of `icomplete-prospects-height' , NAME may |
| 786 | ;; | 936 | ;; not even be displayed to the user. |
| 787 | ;; - Because of `icomplete-prospects-height' , NAME may | 937 | ;; |
| 788 | ;; not even be displayed to the user. | 938 | ;; To circumvent all the above problems, provide a visual |
| 789 | ;; | 939 | ;; cue to the user via an "empty string" in the try |
| 790 | ;; To circumvent all the above problems, provide a visual | 940 | ;; completion field. |
| 791 | ;; cue to the user via an "empty string" in the try | 941 | (setq determ (concat open-bracket "" close-bracket))) |
| 792 | ;; completion field. | 942 | (while (and comps (not limit)) |
| 793 | (setq determ (concat open-bracket "" close-bracket))) | 943 | (setq comp |
| 794 | ;; Compute prospects for display. | 944 | (if prefix-len (substring (car comps) prefix-len) (car comps)) |
| 795 | (while (and comps (not limit)) | 945 | comps (cdr comps)) |
| 796 | (setq comp | 946 | (setq prospects-len |
| 797 | (if prefix-len (substring (car comps) prefix-len) (car comps)) | 947 | (+ (string-width comp) |
| 798 | comps (cdr comps)) | 948 | (string-width icomplete-separator) |
| 799 | (setq prospects-len | 949 | prospects-len)) |
| 800 | (+ (string-width comp) | 950 | (if (< prospects-len prospects-max) |
| 801 | (string-width icomplete-separator) | 951 | (push comp prospects) |
| 802 | prospects-len)) | 952 | (setq limit t))) |
| 803 | (if (< prospects-len prospects-max) | 953 | (setq prospects (nreverse prospects)) |
| 804 | (push comp prospects) | 954 | ;; Decorate first of the prospects. |
| 805 | (setq limit t)))) | 955 | (when prospects |
| 806 | (setq prospects (nreverse prospects)) | 956 | (let ((first (copy-sequence (pop prospects)))) |
| 807 | ;; Decorate first of the prospects. | 957 | (put-text-property 0 (length first) |
| 808 | (when prospects | 958 | 'face 'icomplete-first-match first) |
| 809 | (let ((first (copy-sequence (pop prospects)))) | 959 | (push first prospects))) |
| 810 | (put-text-property 0 (length first) | 960 | (concat determ |
| 811 | 'face 'icomplete-first-match first) | 961 | "{" |
| 812 | (push first prospects))) | 962 | (mapconcat 'identity prospects icomplete-separator) |
| 813 | ;; Restore the base-size info, since completion-all-sorted-completions | 963 | (concat (and limit (concat icomplete-separator ellipsis)) |
| 814 | ;; is cached. | 964 | "}"))) |
| 815 | (if last (setcdr last base-size)) | 965 | ;; Restore the base-size info, since completion-all-sorted-completions |
| 816 | (if prospects | 966 | ;; is cached. |
| 817 | (concat determ | 967 | (if last (setcdr last base-size)))))))) |
| 818 | (if icomplete-vertical-mode " \n" "{") | ||
| 819 | (mapconcat 'identity prospects (if icomplete-vertical-mode | ||
| 820 | "\n" | ||
| 821 | icomplete-separator)) | ||
| 822 | (unless icomplete-vertical-mode | ||
| 823 | (concat (and limit (concat icomplete-separator ellipsis)) | ||
| 824 | "}"))) | ||
| 825 | (concat determ " [Matched]")))))) | ||
| 826 | 968 | ||
| 827 | ;;; Iswitchb compatibility | 969 | ;;; Iswitchb compatibility |
| 828 | 970 | ||
diff --git a/lisp/indent.el b/lisp/indent.el index 285b8e2038f..a33d9620098 100644 --- a/lisp/indent.el +++ b/lisp/indent.el | |||
| @@ -39,8 +39,8 @@ | |||
| 39 | (defvar indent-line-function 'indent-relative | 39 | (defvar indent-line-function 'indent-relative |
| 40 | "Function to indent the current line. | 40 | "Function to indent the current line. |
| 41 | This function will be called with no arguments. | 41 | This function will be called with no arguments. |
| 42 | If it is called somewhere where auto-indentation cannot be done | 42 | If it is called somewhere where it cannot auto-indent, the function |
| 43 | \(e.g. inside a string), the function should simply return `noindent'. | 43 | should return `noindent' to signal that it didn't. |
| 44 | Setting this function is all you need to make TAB indent appropriately. | 44 | Setting this function is all you need to make TAB indent appropriately. |
| 45 | Don't rebind TAB unless you really need to.") | 45 | Don't rebind TAB unless you really need to.") |
| 46 | 46 | ||
diff --git a/lisp/isearch.el b/lisp/isearch.el index 232a994dfa7..c8bd62875f4 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el | |||
| @@ -404,7 +404,7 @@ A value of nil means highlight all matches shown on the screen." | |||
| 404 | (integer :tag "Some")) | 404 | (integer :tag "Some")) |
| 405 | :group 'lazy-highlight) | 405 | :group 'lazy-highlight) |
| 406 | 406 | ||
| 407 | (defcustom lazy-highlight-buffer-max-at-a-time 20 | 407 | (defcustom lazy-highlight-buffer-max-at-a-time 200 ; 20 (bug#48581) |
| 408 | "Maximum matches to highlight at a time (for `lazy-highlight-buffer'). | 408 | "Maximum matches to highlight at a time (for `lazy-highlight-buffer'). |
| 409 | Larger values may reduce Isearch's responsiveness to user input; | 409 | Larger values may reduce Isearch's responsiveness to user input; |
| 410 | smaller values make matches highlight slowly. | 410 | smaller values make matches highlight slowly. |
| @@ -412,7 +412,7 @@ A value of nil means highlight all matches in the buffer." | |||
| 412 | :type '(choice (const :tag "All" nil) | 412 | :type '(choice (const :tag "All" nil) |
| 413 | (integer :tag "Some")) | 413 | (integer :tag "Some")) |
| 414 | :group 'lazy-highlight | 414 | :group 'lazy-highlight |
| 415 | :version "27.1") | 415 | :version "28.1") |
| 416 | 416 | ||
| 417 | (defcustom lazy-highlight-buffer nil | 417 | (defcustom lazy-highlight-buffer nil |
| 418 | "Controls the lazy-highlighting of the full buffer. | 418 | "Controls the lazy-highlighting of the full buffer. |
| @@ -3462,10 +3462,6 @@ Can be changed via `isearch-search-fun-function' for special needs." | |||
| 3462 | (if isearch-forward #'re-search-forward #'re-search-backward) | 3462 | (if isearch-forward #'re-search-forward #'re-search-backward) |
| 3463 | regexp bound noerror count)))) | 3463 | regexp bound noerror count)))) |
| 3464 | 3464 | ||
| 3465 | ;; This is for when we compile this file during bootstrap, with | ||
| 3466 | ;; loaddefs.el still not loaded. | ||
| 3467 | (declare-function multi-isearch-switch-buffer "misearch" ()) | ||
| 3468 | |||
| 3469 | (defun isearch-search-string (string bound noerror) | 3465 | (defun isearch-search-string (string bound noerror) |
| 3470 | "Search for the first occurrence of STRING or its translation. | 3466 | "Search for the first occurrence of STRING or its translation. |
| 3471 | STRING's characters are translated using `translation-table-for-input' | 3467 | STRING's characters are translated using `translation-table-for-input' |
diff --git a/lisp/kmacro.el b/lisp/kmacro.el index afc486f4edc..8821e35c2d1 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el | |||
| @@ -482,7 +482,7 @@ without repeating the prefix." | |||
| 482 | 482 | ||
| 483 | 483 | ||
| 484 | (defun kmacro-view-ring-2nd () | 484 | (defun kmacro-view-ring-2nd () |
| 485 | "Display the current head of the keyboard macro ring." | 485 | "Display the second macro in the keyboard macro ring." |
| 486 | (interactive) | 486 | (interactive) |
| 487 | (unless (kmacro-ring-empty-p) | 487 | (unless (kmacro-ring-empty-p) |
| 488 | (kmacro-display (car (car kmacro-ring)) nil "2nd macro"))) | 488 | (kmacro-display (car (car kmacro-ring)) nil "2nd macro"))) |
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 613223b3c56..f490bfbb355 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el | |||
| @@ -1063,7 +1063,7 @@ or a non-nil `apropos-do-all' argument. | |||
| 1063 | 1063 | ||
| 1064 | \(fn PATTERN)" t nil) | 1064 | \(fn PATTERN)" t nil) |
| 1065 | 1065 | ||
| 1066 | (defalias 'command-apropos 'apropos-command) | 1066 | (defalias 'command-apropos #'apropos-command) |
| 1067 | 1067 | ||
| 1068 | (autoload 'apropos-command "apropos" "\ | 1068 | (autoload 'apropos-command "apropos" "\ |
| 1069 | Show commands (interactively callable functions) that match PATTERN. | 1069 | Show commands (interactively callable functions) that match PATTERN. |
| @@ -5339,14 +5339,14 @@ clashes. | |||
| 5339 | \(fn NAME PREFIX &optional FIRST)" nil nil) | 5339 | \(fn NAME PREFIX &optional FIRST)" nil nil) |
| 5340 | 5340 | ||
| 5341 | (autoload 'comp-clean-up-stale-eln "comp" "\ | 5341 | (autoload 'comp-clean-up-stale-eln "comp" "\ |
| 5342 | Given FILE remove all its *.eln files in `comp-eln-load-path' | 5342 | Given FILE remove all its *.eln files in `native-comp-eln-load-path' |
| 5343 | sharing the original source filename (including FILE). | 5343 | sharing the original source filename (including FILE). |
| 5344 | 5344 | ||
| 5345 | \(fn FILE)" nil nil) | 5345 | \(fn FILE)" nil nil) |
| 5346 | 5346 | ||
| 5347 | (autoload 'comp-lookup-eln "comp" "\ | 5347 | (autoload 'comp-lookup-eln "comp" "\ |
| 5348 | Given a Lisp source FILENAME return the corresponding .eln file if found. | 5348 | Given a Lisp source FILENAME return the corresponding .eln file if found. |
| 5349 | Search happens in `comp-eln-load-path'. | 5349 | Search happens in `native-comp-eln-load-path'. |
| 5350 | 5350 | ||
| 5351 | \(fn FILENAME)" nil nil) | 5351 | \(fn FILENAME)" nil nil) |
| 5352 | 5352 | ||
| @@ -5374,7 +5374,7 @@ Native compilation equivalent to `batch-byte-compile'." nil nil) | |||
| 5374 | Like `batch-native-compile', but used for bootstrap. | 5374 | Like `batch-native-compile', but used for bootstrap. |
| 5375 | Generate .elc files in addition to the .eln files. | 5375 | Generate .elc files in addition to the .eln files. |
| 5376 | Force the produced .eln to be outputted in the eln system | 5376 | Force the produced .eln to be outputted in the eln system |
| 5377 | directory (the last entry in `comp-eln-load-path'). | 5377 | directory (the last entry in `native-comp-eln-load-path'). |
| 5378 | If the environment variable 'NATIVE_DISABLED' is set, only byte | 5378 | If the environment variable 'NATIVE_DISABLED' is set, only byte |
| 5379 | compile." nil nil) | 5379 | compile." nil nil) |
| 5380 | 5380 | ||
| @@ -5394,7 +5394,7 @@ nil -- Select all files. | |||
| 5394 | a string -- A regular expression selecting files with matching names. | 5394 | a string -- A regular expression selecting files with matching names. |
| 5395 | a function -- A function selecting files with matching names. | 5395 | a function -- A function selecting files with matching names. |
| 5396 | 5396 | ||
| 5397 | The variable `comp-async-jobs-number' specifies the number | 5397 | The variable `native-comp-async-jobs-number' specifies the number |
| 5398 | of (commands) to run simultaneously. | 5398 | of (commands) to run simultaneously. |
| 5399 | 5399 | ||
| 5400 | \(fn FILES &optional RECURSIVELY LOAD SELECTOR)" nil nil) | 5400 | \(fn FILES &optional RECURSIVELY LOAD SELECTOR)" nil nil) |
| @@ -7209,6 +7209,12 @@ information on adapting behavior of commands in Delete Selection mode. | |||
| 7209 | 7209 | ||
| 7210 | \(fn &optional ARG)" t nil) | 7210 | \(fn &optional ARG)" t nil) |
| 7211 | 7211 | ||
| 7212 | (autoload 'delete-active-region "delsel" "\ | ||
| 7213 | Delete the active region. | ||
| 7214 | If KILLP in not-nil, the active region is killed instead of deleted. | ||
| 7215 | |||
| 7216 | \(fn &optional KILLP)" t nil) | ||
| 7217 | |||
| 7212 | (register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit")) | 7218 | (register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit")) |
| 7213 | 7219 | ||
| 7214 | ;;;*** | 7220 | ;;;*** |
| @@ -9389,6 +9395,26 @@ an EDE controlled project. | |||
| 9389 | ;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0)) | 9395 | ;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0)) |
| 9390 | ;;; Generated autoloads from emacs-lisp/edebug.el | 9396 | ;;; Generated autoloads from emacs-lisp/edebug.el |
| 9391 | 9397 | ||
| 9398 | (defvar edebug-all-defs nil "\ | ||
| 9399 | If non-nil, evaluating defining forms instruments for Edebug. | ||
| 9400 | This applies to `eval-defun', `eval-region', `eval-buffer', and | ||
| 9401 | `eval-current-buffer'. `eval-region' is also called by | ||
| 9402 | `eval-last-sexp', and `eval-print-last-sexp'. | ||
| 9403 | |||
| 9404 | You can use the command `edebug-all-defs' to toggle the value of this | ||
| 9405 | variable. You may wish to make it local to each buffer with | ||
| 9406 | \(make-local-variable \\='edebug-all-defs) in your | ||
| 9407 | `emacs-lisp-mode-hook'.") | ||
| 9408 | |||
| 9409 | (custom-autoload 'edebug-all-defs "edebug" t) | ||
| 9410 | |||
| 9411 | (defvar edebug-all-forms nil "\ | ||
| 9412 | Non-nil means evaluation of all forms will instrument for Edebug. | ||
| 9413 | This doesn't apply to loading or evaluations in the minibuffer. | ||
| 9414 | Use the command `edebug-all-forms' to toggle the value of this option.") | ||
| 9415 | |||
| 9416 | (custom-autoload 'edebug-all-forms "edebug" t) | ||
| 9417 | |||
| 9392 | (autoload 'edebug-basic-spec "edebug" "\ | 9418 | (autoload 'edebug-basic-spec "edebug" "\ |
| 9393 | Return t if SPEC uses only extant spec symbols. | 9419 | Return t if SPEC uses only extant spec symbols. |
| 9394 | An extant spec symbol is a symbol that is not a function and has a | 9420 | An extant spec symbol is a symbol that is not a function and has a |
| @@ -10545,6 +10571,26 @@ Encrypt marked files." t nil) | |||
| 10545 | 10571 | ||
| 10546 | ;;;*** | 10572 | ;;;*** |
| 10547 | 10573 | ||
| 10574 | ;;;### (autoloads nil "epa-ks" "epa-ks.el" (0 0 0 0)) | ||
| 10575 | ;;; Generated autoloads from epa-ks.el | ||
| 10576 | |||
| 10577 | (autoload 'epa-search-keys "epa-ks" "\ | ||
| 10578 | Ask a keyserver for all keys matching QUERY. | ||
| 10579 | |||
| 10580 | The keyserver to be used is specified by `epa-keyserver'. | ||
| 10581 | |||
| 10582 | If EXACT is non-nil (interactively, prefix argument), require | ||
| 10583 | exact matches. | ||
| 10584 | |||
| 10585 | Note that the request may fail if the query is not specific | ||
| 10586 | enough, since keyservers have strict timeout settings. | ||
| 10587 | |||
| 10588 | \(fn QUERY EXACT)" t nil) | ||
| 10589 | |||
| 10590 | (register-definition-prefixes "epa-ks" '("epa-k")) | ||
| 10591 | |||
| 10592 | ;;;*** | ||
| 10593 | |||
| 10548 | ;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0)) | 10594 | ;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0)) |
| 10549 | ;;; Generated autoloads from epa-mail.el | 10595 | ;;; Generated autoloads from epa-mail.el |
| 10550 | 10596 | ||
| @@ -10758,8 +10804,8 @@ Example usage: | |||
| 10758 | 10804 | ||
| 10759 | (erc-tls :server \"chat.freenode.net\" :port 6697 | 10805 | (erc-tls :server \"chat.freenode.net\" :port 6697 |
| 10760 | :client-certificate | 10806 | :client-certificate |
| 10761 | '(\"/data/bandali/my-cert.key\" | 10807 | '(\"/home/bandali/my-cert.key\" |
| 10762 | \"/data/bandali/my-cert.crt\")) | 10808 | \"/home/bandali/my-cert.crt\")) |
| 10763 | 10809 | ||
| 10764 | \(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE)" t nil) | 10810 | \(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE)" t nil) |
| 10765 | 10811 | ||
| @@ -12603,6 +12649,10 @@ Being on a `#include' line pulls in that file. | |||
| 12603 | If optional IN-OTHER-WINDOW is non-nil, find the file in the other window. | 12649 | If optional IN-OTHER-WINDOW is non-nil, find the file in the other window. |
| 12604 | If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines. | 12650 | If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines. |
| 12605 | 12651 | ||
| 12652 | If optional EVENT is non-nil (default `last-nonmenu-event', move | ||
| 12653 | point to the end position of that event before calling the | ||
| 12654 | various ff-* hooks. | ||
| 12655 | |||
| 12606 | Variables of interest include: | 12656 | Variables of interest include: |
| 12607 | 12657 | ||
| 12608 | - `ff-case-fold-search' | 12658 | - `ff-case-fold-search' |
| @@ -15762,6 +15812,12 @@ When called from lisp, FUNCTION may also be a function object. | |||
| 15762 | 15812 | ||
| 15763 | \(fn FUNCTION)" t nil) | 15813 | \(fn FUNCTION)" t nil) |
| 15764 | 15814 | ||
| 15815 | (autoload 'describe-command "help-fns" "\ | ||
| 15816 | Display the full documentation of COMMAND (a symbol). | ||
| 15817 | When called from lisp, COMMAND may also be a function object. | ||
| 15818 | |||
| 15819 | \(fn COMMAND)" t nil) | ||
| 15820 | |||
| 15765 | (autoload 'help-C-file-name "help-fns" "\ | 15821 | (autoload 'help-C-file-name "help-fns" "\ |
| 15766 | Return the name of the C file where SUBR-OR-VAR is defined. | 15822 | Return the name of the C file where SUBR-OR-VAR is defined. |
| 15767 | KIND should be `var' for a variable or `subr' for a subroutine. | 15823 | KIND should be `var' for a variable or `subr' for a subroutine. |
| @@ -16076,22 +16132,30 @@ also supported. | |||
| 16076 | 16132 | ||
| 16077 | There are several ways to change text in hexl mode: | 16133 | There are several ways to change text in hexl mode: |
| 16078 | 16134 | ||
| 16079 | ASCII characters (character between space (0x20) and tilde (0x7E)) are | 16135 | Self-inserting characters are bound to `hexl-self-insert' so you |
| 16080 | bound to self-insert so you can simply type the character and it will | 16136 | can simply type the character and it will insert itself (actually |
| 16081 | insert itself (actually overstrike) into the buffer. | 16137 | overstrike) into the buffer. However, inserting non-ASCII characters |
| 16138 | requires caution: the buffer's coding-system should correspond to | ||
| 16139 | the encoding on disk, and multibyte characters should be inserted | ||
| 16140 | with cursor on the first byte of a multibyte sequence whose length | ||
| 16141 | is identical to the length of the multibyte sequence to be inserted, | ||
| 16142 | otherwise this could produce invalid multibyte sequences. Non-ASCII | ||
| 16143 | characters in ISO-2022 encodings should preferably inserted byte by | ||
| 16144 | byte, to avoid problems caused by the designation sequences before | ||
| 16145 | the actual characters. | ||
| 16082 | 16146 | ||
| 16083 | \\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if | 16147 | \\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if |
| 16084 | it isn't bound to self-insert. An octal number can be supplied in place | 16148 | it isn't bound to self-insert. An octal number can be supplied in place |
| 16085 | of another key to insert the octal number's ASCII representation. | 16149 | of another key to insert the octal number's ASCII representation. |
| 16086 | 16150 | ||
| 16087 | \\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF) | 16151 | \\[hexl-insert-hex-char] will insert a given hexadecimal value |
| 16088 | into the buffer at the current point. | 16152 | into the buffer at the current address. |
| 16089 | 16153 | ||
| 16090 | \\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377) | 16154 | \\[hexl-insert-octal-char] will insert a given octal value |
| 16091 | into the buffer at the current point. | 16155 | into the buffer at the current address. |
| 16092 | 16156 | ||
| 16093 | \\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255) | 16157 | \\[hexl-insert-decimal-char] will insert a given decimal value |
| 16094 | into the buffer at the current point. | 16158 | into the buffer at the current address.. |
| 16095 | 16159 | ||
| 16096 | \\[hexl-mode-exit] will exit `hexl-mode'. | 16160 | \\[hexl-mode-exit] will exit `hexl-mode'. |
| 16097 | 16161 | ||
| @@ -16107,7 +16171,8 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. | |||
| 16107 | (autoload 'hexl-find-file "hexl" "\ | 16171 | (autoload 'hexl-find-file "hexl" "\ |
| 16108 | Edit file FILENAME as a binary file in hex dump format. | 16172 | Edit file FILENAME as a binary file in hex dump format. |
| 16109 | Switch to a buffer visiting file FILENAME, creating one if none exists, | 16173 | Switch to a buffer visiting file FILENAME, creating one if none exists, |
| 16110 | and edit the file in `hexl-mode'. | 16174 | and edit the file in `hexl-mode'. The buffer's coding-system will be |
| 16175 | no-conversion, unlike if you visit it normally and then invoke `hexl-mode'. | ||
| 16111 | 16176 | ||
| 16112 | \(fn FILENAME)" t nil) | 16177 | \(fn FILENAME)" t nil) |
| 16113 | 16178 | ||
| @@ -17195,7 +17260,7 @@ resized depends on `resize-mini-windows'. | |||
| 17195 | (make-obsolete 'iswitchb-mode | 17260 | (make-obsolete 'iswitchb-mode |
| 17196 | "use `icomplete-mode' or `ido-mode' instead." "24.4")) | 17261 | "use `icomplete-mode' or `ido-mode' instead." "24.4")) |
| 17197 | 17262 | ||
| 17198 | (register-definition-prefixes "icomplete" '("icomplete-")) | 17263 | (register-definition-prefixes "icomplete" '("fido-vertical-mode" "icomplete-")) |
| 17199 | 17264 | ||
| 17200 | ;;;*** | 17265 | ;;;*** |
| 17201 | 17266 | ||
| @@ -19272,7 +19337,7 @@ It is not recommended to set this variable permanently to anything but nil.") | |||
| 19272 | Uninstall jka-compr. | 19337 | Uninstall jka-compr. |
| 19273 | This removes the entries in `file-name-handler-alist' and `auto-mode-alist' | 19338 | This removes the entries in `file-name-handler-alist' and `auto-mode-alist' |
| 19274 | and `inhibit-local-variables-suffixes' that were added | 19339 | and `inhibit-local-variables-suffixes' that were added |
| 19275 | by `jka-compr-installed'." nil nil) | 19340 | by `jka-compr-install'." nil nil) |
| 19276 | 19341 | ||
| 19277 | (register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-")) | 19342 | (register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-")) |
| 19278 | 19343 | ||
| @@ -19437,12 +19502,12 @@ and the return value is the length of the conversion. | |||
| 19437 | 19502 | ||
| 19438 | ;;;### (autoloads nil "kmacro" "kmacro.el" (0 0 0 0)) | 19503 | ;;;### (autoloads nil "kmacro" "kmacro.el" (0 0 0 0)) |
| 19439 | ;;; Generated autoloads from kmacro.el | 19504 | ;;; Generated autoloads from kmacro.el |
| 19440 | (global-set-key "\C-x(" 'kmacro-start-macro) | 19505 | (global-set-key "\C-x(" #'kmacro-start-macro) |
| 19441 | (global-set-key "\C-x)" 'kmacro-end-macro) | 19506 | (global-set-key "\C-x)" #'kmacro-end-macro) |
| 19442 | (global-set-key "\C-xe" 'kmacro-end-and-call-macro) | 19507 | (global-set-key "\C-xe" #'kmacro-end-and-call-macro) |
| 19443 | (global-set-key [f3] 'kmacro-start-macro-or-insert-counter) | 19508 | (global-set-key [f3] #'kmacro-start-macro-or-insert-counter) |
| 19444 | (global-set-key [f4] 'kmacro-end-or-call-macro) | 19509 | (global-set-key [f4] #'kmacro-end-or-call-macro) |
| 19445 | (global-set-key "\C-x\C-k" 'kmacro-keymap) | 19510 | (global-set-key "\C-x\C-k" #'kmacro-keymap) |
| 19446 | (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) | 19511 | (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) |
| 19447 | 19512 | ||
| 19448 | (autoload 'kmacro-exec-ring-item "kmacro" "\ | 19513 | (autoload 'kmacro-exec-ring-item "kmacro" "\ |
| @@ -19950,28 +20015,28 @@ except that FILTER is not optional. | |||
| 19950 | ;;; Generated autoloads from vc/log-edit.el | 20015 | ;;; Generated autoloads from vc/log-edit.el |
| 19951 | 20016 | ||
| 19952 | (autoload 'log-edit "log-edit" "\ | 20017 | (autoload 'log-edit "log-edit" "\ |
| 19953 | Setup a buffer to enter a log message. | 20018 | Setup a buffer to enter a VC commit log message. |
| 19954 | The buffer is put in mode MODE or `log-edit-mode' if MODE is nil. | 20019 | The buffer is put in mode MODE, or `log-edit-mode' if MODE is nil. |
| 19955 | \\<log-edit-mode-map> | 20020 | \\<log-edit-mode-map> |
| 19956 | If SETUP is non-nil, erase the buffer and run `log-edit-hook'. | 20021 | If SETUP is non-nil, erase the buffer and run `log-edit-hook'. |
| 19957 | Set mark and point around the entire contents of the buffer, so | 20022 | Set mark and point around the entire contents of the buffer, so |
| 19958 | that it is easy to kill the contents of the buffer with | 20023 | that it is easy to kill the contents of the buffer with |
| 19959 | \\[kill-region]. Once the user is done editing the message, | 20024 | \\[kill-region]. Once the user is done editing the message, he |
| 19960 | invoking the command \\[log-edit-done] (`log-edit-done') will | 20025 | or she is expected to invoke the command \\[log-edit-done] (`log-edit-done'), |
| 19961 | call CALLBACK to do the actual commit. | 20026 | which will call CALLBACK, a function to do the actual commit. |
| 19962 | 20027 | ||
| 19963 | PARAMS if non-nil is an alist of variables and buffer-local | 20028 | PARAMS, if non-nil, is an alist of variables and buffer-local |
| 19964 | values to give them in the Log Edit buffer. Possible keys and | 20029 | values to give to those variables in the Log Edit buffer. Possible |
| 19965 | associated values: | 20030 | keys and associated values are: |
| 19966 | `log-edit-listfun' -- function taking no arguments that returns the list of | 20031 | `log-edit-listfun' -- function taking no arguments that returns the list of |
| 19967 | files that are concerned by the current operation (using relative names); | 20032 | files that are concerned by the current operation (using relative names); |
| 19968 | `log-edit-diff-function' -- function taking no arguments that | 20033 | `log-edit-diff-function' -- function taking no arguments that |
| 19969 | displays a diff of the files concerned by the current operation. | 20034 | displays a diff of the files concerned by the current operation. |
| 19970 | `vc-log-fileset' -- the VC fileset to be committed (if any). | 20035 | `vc-log-fileset' -- the VC fileset to be committed (if any). |
| 19971 | 20036 | ||
| 19972 | If BUFFER is non-nil `log-edit' will jump to that buffer, use it | 20037 | If BUFFER is non-nil, `log-edit' will switch to that buffer, use it |
| 19973 | to edit the log message and go back to the current buffer when | 20038 | to edit the log message and go back to the current buffer when |
| 19974 | done. Otherwise, it uses the current buffer. | 20039 | done. Otherwise, this function will use the current buffer. |
| 19975 | 20040 | ||
| 19976 | \(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil) | 20041 | \(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil) |
| 19977 | 20042 | ||
| @@ -20511,6 +20576,50 @@ The mail client is taken to be the handler of mailto URLs." nil nil) | |||
| 20511 | ;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0)) | 20576 | ;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0)) |
| 20512 | ;;; Generated autoloads from net/mairix.el | 20577 | ;;; Generated autoloads from net/mairix.el |
| 20513 | 20578 | ||
| 20579 | (autoload 'mairix-search "mairix" "\ | ||
| 20580 | Call Mairix with SEARCH. | ||
| 20581 | If THREADS is non-nil, also display whole threads of found | ||
| 20582 | messages. Results will be put into the default search file. | ||
| 20583 | |||
| 20584 | \(fn SEARCH THREADS)" t nil) | ||
| 20585 | |||
| 20586 | (autoload 'mairix-use-saved-search "mairix" "\ | ||
| 20587 | Use a saved search for querying Mairix." t nil) | ||
| 20588 | |||
| 20589 | (autoload 'mairix-edit-saved-searches-customize "mairix" "\ | ||
| 20590 | Edit the list of saved searches in a customization buffer." t nil) | ||
| 20591 | |||
| 20592 | (autoload 'mairix-search-from-this-article "mairix" "\ | ||
| 20593 | Search messages from sender of the current article. | ||
| 20594 | This is effectively a shortcut for calling `mairix-search' with | ||
| 20595 | f:current_from. If prefix THREADS is non-nil, include whole | ||
| 20596 | threads. | ||
| 20597 | |||
| 20598 | \(fn THREADS)" t nil) | ||
| 20599 | |||
| 20600 | (autoload 'mairix-search-thread-this-article "mairix" "\ | ||
| 20601 | Search thread for the current article. | ||
| 20602 | This is effectively a shortcut for calling `mairix-search' | ||
| 20603 | with m:msgid of the current article and enabled threads." t nil) | ||
| 20604 | |||
| 20605 | (autoload 'mairix-widget-search-based-on-article "mairix" "\ | ||
| 20606 | Create mairix query based on current article using widgets." t nil) | ||
| 20607 | |||
| 20608 | (autoload 'mairix-edit-saved-searches "mairix" "\ | ||
| 20609 | Edit current mairix searches." t nil) | ||
| 20610 | |||
| 20611 | (autoload 'mairix-widget-search "mairix" "\ | ||
| 20612 | Create mairix query interactively using graphical widgets. | ||
| 20613 | MVALUES may contain values from current article. | ||
| 20614 | |||
| 20615 | \(fn &optional MVALUES)" t nil) | ||
| 20616 | |||
| 20617 | (autoload 'mairix-update-database "mairix" "\ | ||
| 20618 | Call mairix for updating the database for SERVERS. | ||
| 20619 | Mairix will be called asynchronously unless | ||
| 20620 | `mairix-synchronous-update' is t. Mairix will be called with | ||
| 20621 | `mairix-update-options'." t nil) | ||
| 20622 | |||
| 20514 | (register-definition-prefixes "mairix" '("mairix-")) | 20623 | (register-definition-prefixes "mairix" '("mairix-")) |
| 20515 | 20624 | ||
| 20516 | ;;;*** | 20625 | ;;;*** |
| @@ -21518,6 +21627,9 @@ Sequence of files visited by multiple file buffers Isearch.") | |||
| 21518 | Set up isearch to search multiple buffers. | 21627 | Set up isearch to search multiple buffers. |
| 21519 | Intended to be added to `isearch-mode-hook'." nil nil) | 21628 | Intended to be added to `isearch-mode-hook'." nil nil) |
| 21520 | 21629 | ||
| 21630 | (autoload 'multi-isearch-switch-buffer "misearch" "\ | ||
| 21631 | Switch to the next buffer in multi-buffer search." nil nil) | ||
| 21632 | |||
| 21521 | (autoload 'multi-isearch-buffers "misearch" "\ | 21633 | (autoload 'multi-isearch-buffers "misearch" "\ |
| 21522 | Start multi-buffer Isearch on a list of BUFFERS. | 21634 | Start multi-buffer Isearch on a list of BUFFERS. |
| 21523 | This list can contain live buffers or their names. | 21635 | This list can contain live buffers or their names. |
| @@ -24243,7 +24355,7 @@ Turning on outline mode calls the value of `text-mode-hook' and then of | |||
| 24243 | 24355 | ||
| 24244 | \(fn)" t nil) | 24356 | \(fn)" t nil) |
| 24245 | (put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp) | 24357 | (put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp) |
| 24246 | (put 'outline-minor-mode-highlight 'safe-local-variable 'booleanp) | 24358 | (put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp) |
| 24247 | 24359 | ||
| 24248 | (autoload 'outline-minor-mode "outline" "\ | 24360 | (autoload 'outline-minor-mode "outline" "\ |
| 24249 | Toggle Outline minor mode. | 24361 | Toggle Outline minor mode. |
| @@ -25312,14 +25424,14 @@ Macroexpand EXPRESSION and pretty-print its value. | |||
| 25312 | 25424 | ||
| 25313 | (autoload 'pp-eval-last-sexp "pp" "\ | 25425 | (autoload 'pp-eval-last-sexp "pp" "\ |
| 25314 | Run `pp-eval-expression' on sexp before point. | 25426 | Run `pp-eval-expression' on sexp before point. |
| 25315 | With argument, pretty-print output into current buffer. | 25427 | With ARG, pretty-print output into current buffer. |
| 25316 | Ignores leading comment characters. | 25428 | Ignores leading comment characters. |
| 25317 | 25429 | ||
| 25318 | \(fn ARG)" t nil) | 25430 | \(fn ARG)" t nil) |
| 25319 | 25431 | ||
| 25320 | (autoload 'pp-macroexpand-last-sexp "pp" "\ | 25432 | (autoload 'pp-macroexpand-last-sexp "pp" "\ |
| 25321 | Run `pp-macroexpand-expression' on sexp before point. | 25433 | Run `pp-macroexpand-expression' on sexp before point. |
| 25322 | With argument, pretty-print output into current buffer. | 25434 | With ARG, pretty-print output into current buffer. |
| 25323 | Ignores leading comment characters. | 25435 | Ignores leading comment characters. |
| 25324 | 25436 | ||
| 25325 | \(fn ARG)" t nil) | 25437 | \(fn ARG)" t nil) |
| @@ -26996,7 +27108,12 @@ the regexp builder. It displays a buffer named \"*RE-Builder*\" | |||
| 26996 | in another window, initially containing an empty regexp. | 27108 | in another window, initially containing an empty regexp. |
| 26997 | 27109 | ||
| 26998 | As you edit the regexp in the \"*RE-Builder*\" buffer, the | 27110 | As you edit the regexp in the \"*RE-Builder*\" buffer, the |
| 26999 | matching parts of the target buffer will be highlighted." t nil) | 27111 | matching parts of the target buffer will be highlighted. |
| 27112 | |||
| 27113 | Case-sensitivity can be toggled with \\[reb-toggle-case]. The | ||
| 27114 | regexp builder supports three different forms of input which can | ||
| 27115 | be set with \\[reb-change-syntax]. More options and details are | ||
| 27116 | provided in the Commentary section of this library." t nil) | ||
| 27000 | 27117 | ||
| 27001 | (register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-")) | 27118 | (register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-")) |
| 27002 | 27119 | ||
| @@ -28016,28 +28133,37 @@ than appending to it. Deletes the message after writing if | |||
| 28016 | ;;; Generated autoloads from emacs-lisp/rmc.el | 28133 | ;;; Generated autoloads from emacs-lisp/rmc.el |
| 28017 | 28134 | ||
| 28018 | (autoload 'read-multiple-choice "rmc" "\ | 28135 | (autoload 'read-multiple-choice "rmc" "\ |
| 28019 | Ask user a multiple choice question. | 28136 | Ask user to select an entry from CHOICES, promting with PROMPT. |
| 28020 | PROMPT should be a string that will be displayed as the prompt. | 28137 | This function allows to ask the user a multiple-choice question. |
| 28021 | 28138 | ||
| 28022 | CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a | 28139 | CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). |
| 28023 | character to be entered. NAME is a short name for the entry to | 28140 | KEY is a character the user should type to select the entry. |
| 28024 | be displayed while prompting (if there's room, it might be | 28141 | NAME is a short name for the entry to be displayed while prompting |
| 28025 | shortened). DESCRIPTION is an optional longer explanation that | 28142 | \(if there's no room, it might be shortened). |
| 28026 | will be displayed in a help buffer if the user requests more | 28143 | DESCRIPTION is an optional longer description of the entry; it will |
| 28027 | help. | 28144 | be displayed in a help buffer if the user requests more help. This |
| 28145 | help description has a fixed format in columns. For greater | ||
| 28146 | flexibility, instead of passing a DESCRIPTION, the caller can pass | ||
| 28147 | the optional argument HELP-STRING. This argument is a string that | ||
| 28148 | should contain a more detailed description of all of the possible | ||
| 28149 | choices. `read-multiple-choice' will display that description in a | ||
| 28150 | help buffer if the user requests that. | ||
| 28028 | 28151 | ||
| 28029 | This function translates user input into responses by consulting | 28152 | This function translates user input into responses by consulting |
| 28030 | the bindings in `query-replace-map'; see the documentation of | 28153 | the bindings in `query-replace-map'; see the documentation of |
| 28031 | that variable for more information. In this case, the useful | 28154 | that variable for more information. The relevant bindings for the |
| 28032 | bindings are `recenter', `scroll-up', and `scroll-down'. If the | 28155 | purposes of this function are `recenter', `scroll-up', `scroll-down', |
| 28033 | user enters `recenter', `scroll-up', or `scroll-down' responses, | 28156 | and `edit'. |
| 28034 | perform the requested window recentering or scrolling and ask | 28157 | If the user types the `recenter', `scroll-up', or `scroll-down' |
| 28035 | again. | 28158 | responses, the function performs the requested window recentering or |
| 28036 | 28159 | scrolling, and then asks the question again. If the user enters `edit', | |
| 28037 | When `use-dialog-box' is t (the default), this function can pop | 28160 | the function starts a recursive edit. When the user exit the recursive |
| 28038 | up a dialog window to collect the user input. That functionality | 28161 | edit, the multiple-choice prompt gains focus again. |
| 28039 | requires `display-popup-menus-p' to return t. Otherwise, a | 28162 | |
| 28040 | text dialog will be used. | 28163 | When `use-dialog-box' is t (the default), and the command using this |
| 28164 | function was invoked via the mouse, this function pops up a GUI dialog | ||
| 28165 | to collect the user input, but only if Emacs is capable of using GUI | ||
| 28166 | dialogs. Otherwise, the function will always use text-mode dialogs. | ||
| 28041 | 28167 | ||
| 28042 | The return value is the matching entry from the CHOICES list. | 28168 | The return value is the matching entry from the CHOICES list. |
| 28043 | 28169 | ||
| @@ -28048,7 +28174,7 @@ Usage example: | |||
| 28048 | (?s \"session only\") | 28174 | (?s \"session only\") |
| 28049 | (?n \"no\"))) | 28175 | (?n \"no\"))) |
| 28050 | 28176 | ||
| 28051 | \(fn PROMPT CHOICES)" nil nil) | 28177 | \(fn PROMPT CHOICES &optional HELP-STRING)" nil nil) |
| 28052 | 28178 | ||
| 28053 | ;;;*** | 28179 | ;;;*** |
| 28054 | 28180 | ||
| @@ -28559,7 +28685,7 @@ For more details, see Info node `(elisp) Extending Rx'. | |||
| 28559 | 28685 | ||
| 28560 | (function-put 'rx-define 'lisp-indent-function 'defun) | 28686 | (function-put 'rx-define 'lisp-indent-function 'defun) |
| 28561 | 28687 | ||
| 28562 | (eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.\nREGEXPS are interpreted as in `rx'. The pattern matches any\nstring that is a match for REGEXPS, as if by `string-match'.\n\nIn addition to the usual `rx' syntax, REGEXPS can contain the\nfollowing constructs:\n\n (let REF RX...) binds the symbol REF to a submatch that matches\n the regular expressions RX. REF is bound in\n CODE to the string of the submatch or nil, but\n can also be used in `backref'.\n (backref REF) matches whatever the submatch REF matched.\n REF can be a number, as usual, or a name\n introduced by a previous (let REF ...)\n construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps)))) (nvars (length rx--pcase-vars))) `(and (pred stringp) ,(if (zerop nvars) `(pred (string-match ,regexp)) `(app (lambda (s) (and (string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b)) (mapcar (lambda (i) `(match-string ,i s)) (number-sequence 1 nvars))))) ,(list '\` (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) (reverse rx--pcase-vars)))))))))) | 28688 | (eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.\nREGEXPS are interpreted as in `rx'. The pattern matches any\nstring that is a match for REGEXPS, as if by `string-match'.\n\nIn addition to the usual `rx' syntax, REGEXPS can contain the\nfollowing constructs:\n\n (let REF RX...) binds the symbol REF to a submatch that matches\n the regular expressions RX. REF is bound in\n CODE to the string of the submatch or nil, but\n can also be used in `backref'.\n (backref REF) matches whatever the submatch REF matched.\n REF can be a number, as usual, or a name\n introduced by a previous (let REF ...)\n construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) `(and (pred stringp) ,(pcase (length rx--pcase-vars) (0 `(pred (string-match ,regexp))) (1 `(app (lambda (s) (if (string-match ,regexp s) (match-string 1 s) 0)) (and ,(car rx--pcase-vars) (pred (not numberp))))) (nvars `(app (lambda (s) (and (string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b)) (mapcar (lambda (i) `(match-string ,i s)) (number-sequence 1 nvars))))) ,(list '\` (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) (reverse rx--pcase-vars))))))))))) |
| 28563 | 28689 | ||
| 28564 | (define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil) | 28690 | (define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil) |
| 28565 | 28691 | ||
| @@ -29934,7 +30060,7 @@ Pop to a buffer with short documentation summary for functions in GROUP. | |||
| 29934 | 30060 | ||
| 29935 | \(fn GROUP)" t nil) | 30061 | \(fn GROUP)" t nil) |
| 29936 | 30062 | ||
| 29937 | (register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "process" "regexp" "sequence" "shortdoc-" "string" "vector")) | 30063 | (register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "overlay" "process" "regexp" "sequence" "shortdoc-" "string" "vector")) |
| 29938 | 30064 | ||
| 29939 | ;;;*** | 30065 | ;;;*** |
| 29940 | 30066 | ||
| @@ -34136,10 +34262,10 @@ match file names at root of the underlying local file system, | |||
| 34136 | like \"/sys\" or \"/C:\".") | 34262 | like \"/sys\" or \"/C:\".") |
| 34137 | 34263 | ||
| 34138 | (defun tramp-autoload-file-name-handler (operation &rest args) "\ | 34264 | (defun tramp-autoload-file-name-handler (operation &rest args) "\ |
| 34139 | Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) | 34265 | Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (when (bound-and-true-p tramp-archive-autoload) (load "tramp-archive" 'noerror 'nomessage)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) |
| 34140 | 34266 | ||
| 34141 | (defun tramp-register-autoload-file-name-handlers nil "\ | 34267 | (defun tramp-register-autoload-file-name-handlers nil "\ |
| 34142 | Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t)) | 34268 | Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t)) |
| 34143 | (tramp-register-autoload-file-name-handlers) | 34269 | (tramp-register-autoload-file-name-handlers) |
| 34144 | 34270 | ||
| 34145 | (defun tramp-unload-file-name-handlers nil "\ | 34271 | (defun tramp-unload-file-name-handlers nil "\ |
| @@ -34177,7 +34303,8 @@ It must be supported by libarchive(3).") | |||
| 34177 | (defmacro tramp-archive-autoload-file-name-regexp nil "\ | 34303 | (defmacro tramp-archive-autoload-file-name-regexp nil "\ |
| 34178 | Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) | 34304 | Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) |
| 34179 | 34305 | ||
| 34180 | (defalias 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler) | 34306 | (defun tramp-archive-autoload-file-name-handler (operation &rest args) "\ |
| 34307 | Load Tramp archive file name handler, and perform OPERATION." (when tramp-archive-enabled (let ((default-directory temporary-file-directory) (tramp-archive-autoload t)) tramp-archive-autoload (apply #'tramp-autoload-file-name-handler operation args)))) | ||
| 34181 | 34308 | ||
| 34182 | (defun tramp-register-archive-file-name-handler nil "\ | 34309 | (defun tramp-register-archive-file-name-handler nil "\ |
| 34183 | Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))) | 34310 | Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))) |
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 8b1e5203613..2146304f156 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el | |||
| @@ -279,13 +279,17 @@ system, including many technical ones. Examples: | |||
| 279 | ("\\Vdash" ?⊩) | 279 | ("\\Vdash" ?⊩) |
| 280 | ("\\Vert" ?‖) | 280 | ("\\Vert" ?‖) |
| 281 | ("\\Vvdash" ?⊪) | 281 | ("\\Vvdash" ?⊪) |
| 282 | ("\\above" ?┴) | ||
| 282 | ("\\aleph" ?ℵ) | 283 | ("\\aleph" ?ℵ) |
| 283 | ("\\amalg" ?∐) | 284 | ("\\amalg" ?∐) |
| 284 | ("\\angle" ?∠) | 285 | ("\\angle" ?∠) |
| 286 | ("\\aoint" ?∳) | ||
| 285 | ("\\approx" ?≈) | 287 | ("\\approx" ?≈) |
| 286 | ("\\approxeq" ?≊) | 288 | ("\\approxeq" ?≊) |
| 289 | ("\\asmash" ?⬆) | ||
| 287 | ("\\ast" ?∗) | 290 | ("\\ast" ?∗) |
| 288 | ("\\asymp" ?≍) | 291 | ("\\asymp" ?≍) |
| 292 | ("\\atop" ?¦) | ||
| 289 | ("\\backcong" ?≌) | 293 | ("\\backcong" ?≌) |
| 290 | ("\\backepsilon" ?∍) | 294 | ("\\backepsilon" ?∍) |
| 291 | ("\\backprime" ?‵) | 295 | ("\\backprime" ?‵) |
| @@ -294,11 +298,18 @@ system, including many technical ones. Examples: | |||
| 294 | ("\\backslash" ?\\) | 298 | ("\\backslash" ?\\) |
| 295 | ("\\barwedge" ?⊼) | 299 | ("\\barwedge" ?⊼) |
| 296 | ("\\because" ?∵) | 300 | ("\\because" ?∵) |
| 301 | ("\\begin" ?\〖) | ||
| 302 | ("\\below" ?┬) | ||
| 297 | ("\\beth" ?ℶ) | 303 | ("\\beth" ?ℶ) |
| 298 | ("\\between" ?≬) | 304 | ("\\between" ?≬) |
| 299 | ("\\bigcap" ?⋂) | 305 | ("\\bigcap" ?⋂) |
| 300 | ("\\bigcirc" ?◯) | 306 | ("\\bigcirc" ?◯) |
| 301 | ("\\bigcup" ?⋃) | 307 | ("\\bigcup" ?⋃) |
| 308 | ("\\bigodot" ?⨀) | ||
| 309 | ("\\bigoplus" ?⨁) | ||
| 310 | ("\\bigotimes" ?⨂) | ||
| 311 | ("\\bigsqcup" ?⨆) | ||
| 312 | ("\\biguplus" ?⨄) | ||
| 302 | ("\\bigstar" ?★) | 313 | ("\\bigstar" ?★) |
| 303 | ("\\bigtriangledown" ?▽) | 314 | ("\\bigtriangledown" ?▽) |
| 304 | ("\\bigtriangleup" ?△) | 315 | ("\\bigtriangleup" ?△) |
| @@ -315,6 +326,7 @@ system, including many technical ones. Examples: | |||
| 315 | ("\\boxminus" ?⊟) | 326 | ("\\boxminus" ?⊟) |
| 316 | ("\\boxplus" ?⊞) | 327 | ("\\boxplus" ?⊞) |
| 317 | ("\\boxtimes" ?⊠) | 328 | ("\\boxtimes" ?⊠) |
| 329 | ("\\bra" ?\⟨) | ||
| 318 | ("\\bullet" ?•) | 330 | ("\\bullet" ?•) |
| 319 | ("\\bumpeq" ?≏) | 331 | ("\\bumpeq" ?≏) |
| 320 | ("\\cap" ?∩) | 332 | ("\\cap" ?∩) |
| @@ -331,7 +343,9 @@ system, including many technical ones. Examples: | |||
| 331 | ("\\circledast" ?⊛) | 343 | ("\\circledast" ?⊛) |
| 332 | ("\\circledcirc" ?⊚) | 344 | ("\\circledcirc" ?⊚) |
| 333 | ("\\circleddash" ?⊝) | 345 | ("\\circleddash" ?⊝) |
| 346 | ("\\close" ?┤) | ||
| 334 | ("\\clubsuit" ?♣) | 347 | ("\\clubsuit" ?♣) |
| 348 | ("\\coint" ?∲) | ||
| 335 | ("\\coloneq" ?≔) | 349 | ("\\coloneq" ?≔) |
| 336 | ("\\complement" ?∁) | 350 | ("\\complement" ?∁) |
| 337 | ("\\cong" ?≅) | 351 | ("\\cong" ?≅) |
| @@ -349,8 +363,12 @@ system, including many technical ones. Examples: | |||
| 349 | ("\\dagger" ?†) | 363 | ("\\dagger" ?†) |
| 350 | ("\\daleth" ?ℸ) | 364 | ("\\daleth" ?ℸ) |
| 351 | ("\\dashv" ?⊣) | 365 | ("\\dashv" ?⊣) |
| 366 | ("\\Dd" ?ⅅ) | ||
| 367 | ("\\dd" ?ⅆ) | ||
| 352 | ("\\ddag" ?‡) | 368 | ("\\ddag" ?‡) |
| 353 | ("\\ddagger" ?‡) | 369 | ("\\ddagger" ?‡) |
| 370 | ("\\ddddot" ?⃜) | ||
| 371 | ("\\dddot" ?⃛) | ||
| 354 | ("\\ddots" ?⋱) | 372 | ("\\ddots" ?⋱) |
| 355 | ("\\diamond" ?⋄) | 373 | ("\\diamond" ?⋄) |
| 356 | ("\\diamondsuit" ?♢) | 374 | ("\\diamondsuit" ?♢) |
| @@ -363,8 +381,12 @@ system, including many technical ones. Examples: | |||
| 363 | ("\\downdownarrows" ?⇊) | 381 | ("\\downdownarrows" ?⇊) |
| 364 | ("\\downleftharpoon" ?⇃) | 382 | ("\\downleftharpoon" ?⇃) |
| 365 | ("\\downrightharpoon" ?⇂) | 383 | ("\\downrightharpoon" ?⇂) |
| 384 | ("\\dsmash" ?⬇) | ||
| 385 | ("\\ee" ?ⅇ) | ||
| 366 | ("\\ell" ?ℓ) | 386 | ("\\ell" ?ℓ) |
| 367 | ("\\emptyset" ?∅) | 387 | ("\\emptyset" ?∅) |
| 388 | ("\\end" ?\〗) | ||
| 389 | ("\\eqarray" ?█) | ||
| 368 | ("\\eqcirc" ?≖) | 390 | ("\\eqcirc" ?≖) |
| 369 | ("\\eqcolon" ?≕) | 391 | ("\\eqcolon" ?≕) |
| 370 | ("\\eqslantgtr" ?⋝) | 392 | ("\\eqslantgtr" ?⋝) |
| @@ -414,16 +436,25 @@ system, including many technical ones. Examples: | |||
| 414 | ("\\heartsuit" ?♥) | 436 | ("\\heartsuit" ?♥) |
| 415 | ("\\hookleftarrow" ?↩) | 437 | ("\\hookleftarrow" ?↩) |
| 416 | ("\\hookrightarrow" ?↪) | 438 | ("\\hookrightarrow" ?↪) |
| 439 | ("\\hphantom" ?⬄) | ||
| 440 | ("\\hsmash" ?⬌) | ||
| 417 | ("\\iff" ?⇔) | 441 | ("\\iff" ?⇔) |
| 442 | ("\\ii" ?ⅈ) | ||
| 443 | ("\\iiiint" ?⨌) | ||
| 444 | ("\\iiint" ?∭) | ||
| 445 | ("\\iint" ?∬) | ||
| 418 | ("\\imath" ?ı) | 446 | ("\\imath" ?ı) |
| 419 | ("\\in" ?∈) | 447 | ("\\in" ?∈) |
| 420 | ("\\infty" ?∞) | 448 | ("\\infty" ?∞) |
| 421 | ("\\int" ?∫) | 449 | ("\\int" ?∫) |
| 422 | ("\\intercal" ?⊺) | 450 | ("\\intercal" ?⊺) |
| 451 | ("\\jj" ?ⅉ) | ||
| 452 | ("\\jmath" ?ȷ) | ||
| 423 | ("\\langle" ?⟨) ;; Was ?〈, see bug#12948. | 453 | ("\\langle" ?⟨) ;; Was ?〈, see bug#12948. |
| 424 | ("\\lbrace" ?{) | 454 | ("\\lbrace" ?{) |
| 425 | ("\\lbrack" ?\[) | 455 | ("\\lbrack" ?\[) |
| 426 | ("\\lceil" ?⌈) | 456 | ("\\lceil" ?⌈) |
| 457 | ("\\ldiv" ?∕) | ||
| 427 | ("\\ldots" ?…) | 458 | ("\\ldots" ?…) |
| 428 | ("\\le" ?≤) | 459 | ("\\le" ?≤) |
| 429 | ("\\leadsto" ?↝) | 460 | ("\\leadsto" ?↝) |
| @@ -529,16 +560,25 @@ system, including many technical ones. Examples: | |||
| 529 | ("\\nvdash" ?⊬) | 560 | ("\\nvdash" ?⊬) |
| 530 | ("\\nwarrow" ?↖) | 561 | ("\\nwarrow" ?↖) |
| 531 | ("\\odot" ?⊙) | 562 | ("\\odot" ?⊙) |
| 563 | ("\\oiiint" ?∰) | ||
| 564 | ("\\oiint" ?∯) | ||
| 532 | ("\\oint" ?∮) | 565 | ("\\oint" ?∮) |
| 533 | ("\\ominus" ?⊖) | 566 | ("\\ominus" ?⊖) |
| 534 | ("\\oplus" ?⊕) | 567 | ("\\oplus" ?⊕) |
| 535 | ("\\oslash" ?⊘) | 568 | ("\\oslash" ?⊘) |
| 536 | ("\\otimes" ?⊗) | 569 | ("\\otimes" ?⊗) |
| 570 | ("\\overbrace" ?⏞) | ||
| 571 | ("\\overparen" ?⏜) | ||
| 537 | ("\\par" ? ) | 572 | ("\\par" ? ) |
| 538 | ("\\parallel" ?∥) | 573 | ("\\parallel" ?∥) |
| 539 | ("\\partial" ?∂) | 574 | ("\\partial" ?∂) |
| 540 | ("\\perp" ?⊥) | 575 | ("\\perp" ?⊥) |
| 576 | ("\\phantom" ?⟡) | ||
| 541 | ("\\pitchfork" ?⋔) | 577 | ("\\pitchfork" ?⋔) |
| 578 | ("\\pppprime" ?⁗) | ||
| 579 | ("\\ppprime" ?‴) | ||
| 580 | ("\\pprime" ?″) | ||
| 581 | ("\\prcue" ?≼) | ||
| 542 | ("\\prec" ?≺) | 582 | ("\\prec" ?≺) |
| 543 | ("\\precapprox" ?≾) | 583 | ("\\precapprox" ?≾) |
| 544 | ("\\preceq" ?≼) | 584 | ("\\preceq" ?≼) |
| @@ -548,12 +588,16 @@ system, including many technical ones. Examples: | |||
| 548 | ("\\prime" ?′) | 588 | ("\\prime" ?′) |
| 549 | ("\\prod" ?∏) | 589 | ("\\prod" ?∏) |
| 550 | ("\\propto" ?∝) | 590 | ("\\propto" ?∝) |
| 591 | ("\\qdrt" ?∜) | ||
| 551 | ("\\qed" ?∎) | 592 | ("\\qed" ?∎) |
| 552 | ("\\quad" ? ) | 593 | ("\\quad" ? ) |
| 553 | ("\\rangle" ?\⟩) ;; Was ?〉, see bug#12948. | 594 | ("\\rangle" ?\⟩) ;; Was ?〉, see bug#12948. |
| 595 | ("\\ratio" ?∶) | ||
| 554 | ("\\rbrace" ?}) | 596 | ("\\rbrace" ?}) |
| 555 | ("\\rbrack" ?\]) | 597 | ("\\rbrack" ?\]) |
| 556 | ("\\rceil" ?⌉) | 598 | ("\\rceil" ?⌉) |
| 599 | ("\\rddots" ?⋰) | ||
| 600 | ("\\rect" ?▭) | ||
| 557 | ("\\rfloor" ?⌋) | 601 | ("\\rfloor" ?⌋) |
| 558 | ("\\rightarrow" ?→) | 602 | ("\\rightarrow" ?→) |
| 559 | ("\\rightarrowtail" ?↣) | 603 | ("\\rightarrowtail" ?↣) |
| @@ -565,6 +609,8 @@ system, including many technical ones. Examples: | |||
| 565 | ("\\rightrightarrows" ?⇉) | 609 | ("\\rightrightarrows" ?⇉) |
| 566 | ("\\rightthreetimes" ?⋌) | 610 | ("\\rightthreetimes" ?⋌) |
| 567 | ("\\risingdotseq" ?≓) | 611 | ("\\risingdotseq" ?≓) |
| 612 | ("\\rrect" ?▢) | ||
| 613 | ("\\sdiv" ?⁄) | ||
| 568 | ("\\rtimes" ?⋊) | 614 | ("\\rtimes" ?⋊) |
| 569 | ("\\sbs" ?﹨) | 615 | ("\\sbs" ?﹨) |
| 570 | ("\\searrow" ?↘) | 616 | ("\\searrow" ?↘) |
| @@ -577,6 +623,7 @@ system, including many technical ones. Examples: | |||
| 577 | ("\\smallamalg" ?∐) | 623 | ("\\smallamalg" ?∐) |
| 578 | ("\\smallsetminus" ?∖) | 624 | ("\\smallsetminus" ?∖) |
| 579 | ("\\smallsmile" ?⌣) | 625 | ("\\smallsmile" ?⌣) |
| 626 | ("\\smash" ?⬍) | ||
| 580 | ("\\smile" ?⌣) | 627 | ("\\smile" ?⌣) |
| 581 | ("\\spadesuit" ?♠) | 628 | ("\\spadesuit" ?♠) |
| 582 | ("\\sphericalangle" ?∢) | 629 | ("\\sphericalangle" ?∢) |
| @@ -627,12 +674,16 @@ system, including many technical ones. Examples: | |||
| 627 | ("\\ulcorner" ?⌜) | 674 | ("\\ulcorner" ?⌜) |
| 628 | ("\\uparrow" ?↑) | 675 | ("\\uparrow" ?↑) |
| 629 | ("\\updownarrow" ?↕) | 676 | ("\\updownarrow" ?↕) |
| 677 | ("\\underbar" ?▁) | ||
| 678 | ("\\underbrace" ?⏟) | ||
| 679 | ("\\underparen" ?⏝) | ||
| 630 | ("\\upleftharpoon" ?↿) | 680 | ("\\upleftharpoon" ?↿) |
| 631 | ("\\uplus" ?⊎) | 681 | ("\\uplus" ?⊎) |
| 632 | ("\\uprightharpoon" ?↾) | 682 | ("\\uprightharpoon" ?↾) |
| 633 | ("\\upuparrows" ?⇈) | 683 | ("\\upuparrows" ?⇈) |
| 634 | ("\\urcorner" ?⌝) | 684 | ("\\urcorner" ?⌝) |
| 635 | ("\\u{i}" ?ĭ) | 685 | ("\\u{i}" ?ĭ) |
| 686 | ("\\vbar" ?│) | ||
| 636 | ("\\vDash" ?⊨) | 687 | ("\\vDash" ?⊨) |
| 637 | 688 | ||
| 638 | ((lambda (name char) | 689 | ((lambda (name char) |
| @@ -655,6 +706,7 @@ system, including many technical ones. Examples: | |||
| 655 | ("\\vee" ?∨) | 706 | ("\\vee" ?∨) |
| 656 | ("\\veebar" ?⊻) | 707 | ("\\veebar" ?⊻) |
| 657 | ("\\vert" ?|) | 708 | ("\\vert" ?|) |
| 709 | ("\\vphantom" ?⇳) | ||
| 658 | ("\\wedge" ?∧) | 710 | ("\\wedge" ?∧) |
| 659 | ("\\wp" ?℘) | 711 | ("\\wp" ?℘) |
| 660 | ("\\wr" ?≀) | 712 | ("\\wr" ?≀) |
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index f8122677a54..9cd2c62b7b8 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el | |||
| @@ -2241,6 +2241,7 @@ Buffers menu is regenerated." | |||
| 2241 | "String to display in buffer listings for buffers not visiting a file.") | 2241 | "String to display in buffer listings for buffers not visiting a file.") |
| 2242 | 2242 | ||
| 2243 | (defun menu-bar-select-buffer () | 2243 | (defun menu-bar-select-buffer () |
| 2244 | (declare (obsolete nil "28.1")) | ||
| 2244 | (interactive) | 2245 | (interactive) |
| 2245 | (switch-to-buffer last-command-event)) | 2246 | (switch-to-buffer last-command-event)) |
| 2246 | 2247 | ||
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 1aac3374153..e935cfda97e 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el | |||
| @@ -738,8 +738,11 @@ is described by the variable `mh-variants'." | |||
| 738 | ;; Make a unique list of directories, keeping the given order. | 738 | ;; Make a unique list of directories, keeping the given order. |
| 739 | ;; We don't want the same MH variant to be listed multiple times. | 739 | ;; We don't want the same MH variant to be listed multiple times. |
| 740 | (cl-loop for dir in (append mh-path mh-sys-path exec-path) do | 740 | (cl-loop for dir in (append mh-path mh-sys-path exec-path) do |
| 741 | (setq dir (file-chase-links (directory-file-name dir))) | 741 | ;; skip relative dirs, typically "." |
| 742 | (cl-pushnew dir list-unique :test #'equal)) | 742 | (if (file-name-absolute-p dir) |
| 743 | (progn | ||
| 744 | (setq dir (file-chase-links (directory-file-name dir))) | ||
| 745 | (cl-pushnew dir list-unique :test #'equal)))) | ||
| 743 | (cl-loop for dir in (nreverse list-unique) do | 746 | (cl-loop for dir in (nreverse list-unique) do |
| 744 | (when (and dir (file-accessible-directory-p dir)) | 747 | (when (and dir (file-accessible-directory-p dir)) |
| 745 | (let ((variant (mh-variant-info dir))) | 748 | (let ((variant (mh-variant-info dir))) |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ec21b7b93b6..d09a348211f 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -741,14 +741,16 @@ If ARGS are provided, then pass MESSAGE through `format-message'." | |||
| 741 | ;; Don't overwrite the face properties the caller has set | 741 | ;; Don't overwrite the face properties the caller has set |
| 742 | (text-properties-at 0 message)) | 742 | (text-properties-at 0 message)) |
| 743 | (setq message (apply #'propertize message minibuffer-message-properties))) | 743 | (setq message (apply #'propertize message minibuffer-message-properties))) |
| 744 | (let ((ol (make-overlay (point-max) (point-max) nil t t)) | 744 | ;; Put overlay either on `minibuffer-message' property, or at EOB. |
| 745 | ;; A quit during sit-for normally only interrupts the sit-for, | 745 | (let* ((ovpos (minibuffer--message-overlay-pos)) |
| 746 | ;; but since minibuffer-message is used at the end of a command, | 746 | (ol (make-overlay ovpos ovpos nil t t)) |
| 747 | ;; at a time when the command has virtually finished already, a C-g | 747 | ;; A quit during sit-for normally only interrupts the sit-for, |
| 748 | ;; should really cause an abort-recursive-edit instead (i.e. as if | 748 | ;; but since minibuffer-message is used at the end of a command, |
| 749 | ;; the C-g had been typed at top-level). Binding inhibit-quit here | 749 | ;; at a time when the command has virtually finished already, a C-g |
| 750 | ;; is an attempt to get that behavior. | 750 | ;; should really cause an abort-recursive-edit instead (i.e. as if |
| 751 | (inhibit-quit t)) | 751 | ;; the C-g had been typed at top-level). Binding inhibit-quit here |
| 752 | ;; is an attempt to get that behavior. | ||
| 753 | (inhibit-quit t)) | ||
| 752 | (unwind-protect | 754 | (unwind-protect |
| 753 | (progn | 755 | (progn |
| 754 | (unless (zerop (length message)) | 756 | (unless (zerop (length message)) |
| @@ -757,6 +759,12 @@ If ARGS are provided, then pass MESSAGE through `format-message'." | |||
| 757 | ;; before or after the string, so let's spoon-feed it the pos. | 759 | ;; before or after the string, so let's spoon-feed it the pos. |
| 758 | (put-text-property 0 1 'cursor t message)) | 760 | (put-text-property 0 1 'cursor t message)) |
| 759 | (overlay-put ol 'after-string message) | 761 | (overlay-put ol 'after-string message) |
| 762 | ;; Make sure the overlay with the message is displayed before | ||
| 763 | ;; any other overlays in that position, in case they have | ||
| 764 | ;; resize-mini-windows set to nil and the other overlay strings | ||
| 765 | ;; are too long for the mini-window width. This makes sure the | ||
| 766 | ;; temporary message will always be visible. | ||
| 767 | (overlay-put ol 'priority 1100) | ||
| 760 | (sit-for (or minibuffer-message-timeout 1000000))) | 768 | (sit-for (or minibuffer-message-timeout 1000000))) |
| 761 | (delete-overlay ol))))) | 769 | (delete-overlay ol))))) |
| 762 | 770 | ||
| @@ -778,8 +786,10 @@ and `clear-minibuffer-message' called automatically via | |||
| 778 | (defvar minibuffer-message-overlay nil) | 786 | (defvar minibuffer-message-overlay nil) |
| 779 | 787 | ||
| 780 | (defun minibuffer--message-overlay-pos () | 788 | (defun minibuffer--message-overlay-pos () |
| 781 | "Return position where `set-minibuffer-message' shall put message overlay." | 789 | "Return position where minibuffer message functions shall put message overlay. |
| 782 | ;; Starting from point, look for non-nil 'minibuffer-message' | 790 | The minibuffer message functions include `minibuffer-message' and |
| 791 | `set-minibuffer-message'." | ||
| 792 | ;; Starting from point, look for non-nil `minibuffer-message' | ||
| 783 | ;; property, and return its position. If none found, return the EOB | 793 | ;; property, and return its position. If none found, return the EOB |
| 784 | ;; position. | 794 | ;; position. |
| 785 | (let* ((pt (point)) | 795 | (let* ((pt (point)) |
| @@ -824,7 +834,7 @@ via `set-message-function'." | |||
| 824 | ;; The current C cursor code doesn't know to use the overlay's | 834 | ;; The current C cursor code doesn't know to use the overlay's |
| 825 | ;; marker's stickiness to figure out whether to place the cursor | 835 | ;; marker's stickiness to figure out whether to place the cursor |
| 826 | ;; before or after the string, so let's spoon-feed it the pos. | 836 | ;; before or after the string, so let's spoon-feed it the pos. |
| 827 | (put-text-property 0 1 'cursor 1 message)) | 837 | (put-text-property 0 1 'cursor t message)) |
| 828 | (overlay-put minibuffer-message-overlay 'after-string message) | 838 | (overlay-put minibuffer-message-overlay 'after-string message) |
| 829 | ;; Make sure the overlay with the message is displayed before | 839 | ;; Make sure the overlay with the message is displayed before |
| 830 | ;; any other overlays in that position, in case they have | 840 | ;; any other overlays in that position, in case they have |
| @@ -3484,7 +3494,8 @@ between 0 and 1, and with faces `completions-common-part', | |||
| 3484 | (when completions | 3494 | (when completions |
| 3485 | (let* ((re (completion-pcm--pattern->regex pattern 'group)) | 3495 | (let* ((re (completion-pcm--pattern->regex pattern 'group)) |
| 3486 | (point-idx (completion-pcm--pattern-point-idx pattern)) | 3496 | (point-idx (completion-pcm--pattern-point-idx pattern)) |
| 3487 | (case-fold-search completion-ignore-case)) | 3497 | (case-fold-search completion-ignore-case) |
| 3498 | last-md) | ||
| 3488 | (mapcar | 3499 | (mapcar |
| 3489 | (lambda (str) | 3500 | (lambda (str) |
| 3490 | ;; Don't modify the string itself. | 3501 | ;; Don't modify the string itself. |
| @@ -3493,7 +3504,7 @@ between 0 and 1, and with faces `completions-common-part', | |||
| 3493 | (error "Internal error: %s does not match %s" re str)) | 3504 | (error "Internal error: %s does not match %s" re str)) |
| 3494 | (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0))) | 3505 | (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0))) |
| 3495 | (match-end (match-end 0)) | 3506 | (match-end (match-end 0)) |
| 3496 | (md (cddr (match-data))) | 3507 | (md (cddr (setq last-md (match-data t last-md)))) |
| 3497 | (from 0) | 3508 | (from 0) |
| 3498 | (end (length str)) | 3509 | (end (length str)) |
| 3499 | ;; To understand how this works, consider these simple | 3510 | ;; To understand how this works, consider these simple |
diff --git a/lisp/mpc.el b/lisp/mpc.el index f7302750389..ab572aa539a 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el | |||
| @@ -125,14 +125,13 @@ | |||
| 125 | (unless (member elem seen) (push elem res))))) | 125 | (unless (member elem seen) (push elem res))))) |
| 126 | (nreverse res))) | 126 | (nreverse res))) |
| 127 | 127 | ||
| 128 | (defun mpc-intersection (l1 l2 &optional selectfun) | 128 | (defun mpc-intersection (l1 l2 selectfun) |
| 129 | "Return L1 after removing all elements not found in L2. | 129 | "Return L1 after removing all elements not found in L2. |
| 130 | If SELECTFUN is non-nil, elements aren't compared directly, but instead | 130 | Elements aren't compared directly, but instead |
| 131 | they are passed through SELECTFUN before comparison." | 131 | they are passed through SELECTFUN before comparison." |
| 132 | (when selectfun | 132 | (seq-intersection l1 l2 (lambda (x y) |
| 133 | (setq l1 (mapcar selectfun l1)) | 133 | (equal (funcall selectfun x) |
| 134 | (setq l2 (mapcar selectfun l2))) | 134 | (funcall selectfun y))))) |
| 135 | (seq-intersection l1 l2)) | ||
| 136 | 135 | ||
| 137 | (defun mpc-event-set-point (event) | 136 | (defun mpc-event-set-point (event) |
| 138 | (condition-case nil (posn-set-point (event-end event)) | 137 | (condition-case nil (posn-set-point (event-end event)) |
| @@ -1027,10 +1026,14 @@ If PLAYLIST is t or nil or missing, use the main playlist." | |||
| 1027 | (let ((dir (file-name-directory (cdr (assq 'file info))))) | 1026 | (let ((dir (file-name-directory (cdr (assq 'file info))))) |
| 1028 | ;; (debug) | 1027 | ;; (debug) |
| 1029 | (setq pred | 1028 | (setq pred |
| 1030 | (lambda (info) | 1029 | ;; We want the closure to capture the current |
| 1031 | (and (funcall pred info) | 1030 | ;; value of `pred' and not a reference to the |
| 1032 | (equal dir (file-name-directory | 1031 | ;; variable itself. |
| 1033 | (cdr (assq 'file info))))))) | 1032 | (let ((oldpred pred)) |
| 1033 | (lambda (info) | ||
| 1034 | (and (funcall oldpred info) | ||
| 1035 | (equal dir (file-name-directory | ||
| 1036 | (cdr (assq 'file info)))))))) | ||
| 1034 | (if-let* ((covers '(".folder.png" "cover.jpg" "folder.jpg")) | 1037 | (if-let* ((covers '(".folder.png" "cover.jpg" "folder.jpg")) |
| 1035 | (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir)) | 1038 | (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir)) |
| 1036 | if (member (downcase file) covers) | 1039 | if (member (downcase file) covers) |
| @@ -1057,9 +1060,13 @@ If PLAYLIST is t or nil or missing, use the main playlist." | |||
| 1057 | (when (and (null val) (eq tag 'Title)) | 1060 | (when (and (null val) (eq tag 'Title)) |
| 1058 | (setq val (cdr (assq 'file info)))) | 1061 | (setq val (cdr (assq 'file info)))) |
| 1059 | (setq pred | 1062 | (setq pred |
| 1060 | (lambda (info) | 1063 | ;; We want the closure to capture the current |
| 1061 | (and (funcall pred info) | 1064 | ;; value of `pred' and not a reference to the |
| 1062 | (equal val (cdr (assq ',tag info)))))) | 1065 | ;; variable itself. |
| 1066 | (let ((oldpred pred)) | ||
| 1067 | (lambda (info) | ||
| 1068 | (and (funcall oldpred info) | ||
| 1069 | (equal val (cdr (assq tag info))))))) | ||
| 1063 | (cond | 1070 | (cond |
| 1064 | ((not (and (eq tag 'Date) (stringp val))) val) | 1071 | ((not (and (eq tag 'Date) (stringp val))) val) |
| 1065 | ;; For "date", only keep the year! | 1072 | ;; For "date", only keep the year! |
diff --git a/lisp/msb.el b/lisp/msb.el index 1064f940905..1f05e9db589 100644 --- a/lisp/msb.el +++ b/lisp/msb.el | |||
| @@ -1052,9 +1052,12 @@ variable `msb-menu-cond'." | |||
| 1052 | (msb--split-menus-2 list 0 nil) | 1052 | (msb--split-menus-2 list 0 nil) |
| 1053 | list)) | 1053 | list)) |
| 1054 | 1054 | ||
| 1055 | (defun msb--select-buffer () | ||
| 1056 | (interactive) | ||
| 1057 | (switch-to-buffer last-command-event)) | ||
| 1058 | |||
| 1055 | (defun msb--make-keymap-menu (raw-menu) | 1059 | (defun msb--make-keymap-menu (raw-menu) |
| 1056 | (let ((end 'menu-bar-select-buffer) | 1060 | (let ((mcount 0)) |
| 1057 | (mcount 0)) | ||
| 1058 | (mapcar | 1061 | (mapcar |
| 1059 | (lambda (sub-menu) | 1062 | (lambda (sub-menu) |
| 1060 | (cond | 1063 | (cond |
| @@ -1063,7 +1066,7 @@ variable `msb-menu-cond'." | |||
| 1063 | (t | 1066 | (t |
| 1064 | (let ((buffers (mapcar (lambda (item) | 1067 | (let ((buffers (mapcar (lambda (item) |
| 1065 | (cons (buffer-name (cdr item)) | 1068 | (cons (buffer-name (cdr item)) |
| 1066 | (cons (car item) end))) | 1069 | (cons (car item) 'msb--select-buffer))) |
| 1067 | (cdr sub-menu)))) | 1070 | (cdr sub-menu)))) |
| 1068 | (nconc (list (cl-incf mcount) (car sub-menu) | 1071 | (nconc (list (cl-incf mcount) (car sub-menu) |
| 1069 | 'keymap (car sub-menu)) | 1072 | 'keymap (car sub-menu)) |
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 8621491138c..96da0c5374f 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el | |||
| @@ -47,6 +47,7 @@ | |||
| 47 | ;; browse-url-xdg-open freedesktop.org xdg-open | 47 | ;; browse-url-xdg-open freedesktop.org xdg-open |
| 48 | ;; browse-url-kde KDE konqueror (kfm) | 48 | ;; browse-url-kde KDE konqueror (kfm) |
| 49 | ;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT) | 49 | ;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT) |
| 50 | ;; eww-browse-url Emacs Web Wowser | ||
| 50 | 51 | ||
| 51 | ;; Browsers can cache Web pages so it may be necessary to tell them to | 52 | ;; Browsers can cache Web pages so it may be necessary to tell them to |
| 52 | ;; reload the current page if it has changed (e.g., if you have edited | 53 | ;; reload the current page if it has changed (e.g., if you have edited |
| @@ -758,7 +759,7 @@ for use in `interactive'." | |||
| 758 | 759 | ||
| 759 | ;;;###autoload | 760 | ;;;###autoload |
| 760 | (defun browse-url-of-file (&optional file) | 761 | (defun browse-url-of-file (&optional file) |
| 761 | "Ask a WWW browser to display FILE. | 762 | "Use a web browser to display FILE. |
| 762 | Display the current buffer's file if FILE is nil or if called | 763 | Display the current buffer's file if FILE is nil or if called |
| 763 | interactively. Turn the filename into a URL with function | 764 | interactively. Turn the filename into a URL with function |
| 764 | `browse-url-file-url'. Pass the URL to a browser using the | 765 | `browse-url-file-url'. Pass the URL to a browser using the |
| @@ -773,6 +774,8 @@ interactively. Turn the filename into a URL with function | |||
| 773 | (cond ((not (buffer-modified-p))) | 774 | (cond ((not (buffer-modified-p))) |
| 774 | (browse-url-save-file (save-buffer)) | 775 | (browse-url-save-file (save-buffer)) |
| 775 | (t (message "%s modified since last save" file)))))) | 776 | (t (message "%s modified since last save" file)))))) |
| 777 | (when (file-remote-p file) | ||
| 778 | (setq file (file-local-copy file))) | ||
| 776 | (browse-url (browse-url-file-url file)) | 779 | (browse-url (browse-url-file-url file)) |
| 777 | (run-hooks 'browse-url-of-file-hook)) | 780 | (run-hooks 'browse-url-of-file-hook)) |
| 778 | 781 | ||
| @@ -793,7 +796,9 @@ Use variable `browse-url-filename-alist' to map filenames to URLs." | |||
| 793 | 796 | ||
| 794 | ;;;###autoload | 797 | ;;;###autoload |
| 795 | (defun browse-url-of-buffer (&optional buffer) | 798 | (defun browse-url-of-buffer (&optional buffer) |
| 796 | "Ask a WWW browser to display BUFFER. | 799 | "Use a web browser to display BUFFER. |
| 800 | See `browse-url' for details. | ||
| 801 | |||
| 797 | Display the current buffer if BUFFER is nil. Display only the | 802 | Display the current buffer if BUFFER is nil. Display only the |
| 798 | currently visible part of BUFFER (from a temporary file) if buffer is | 803 | currently visible part of BUFFER (from a temporary file) if buffer is |
| 799 | narrowed." | 804 | narrowed." |
| @@ -842,7 +847,8 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead." | |||
| 842 | 847 | ||
| 843 | ;;;###autoload | 848 | ;;;###autoload |
| 844 | (defun browse-url-of-region (min max) | 849 | (defun browse-url-of-region (min max) |
| 845 | "Ask a WWW browser to display the current region." | 850 | "Use a web browser to display the current region. |
| 851 | See `browse-url' for details." | ||
| 846 | (interactive "r") | 852 | (interactive "r") |
| 847 | (save-excursion | 853 | (save-excursion |
| 848 | (save-restriction | 854 | (save-restriction |
| @@ -856,14 +862,18 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead." | |||
| 856 | 862 | ||
| 857 | ;;;###autoload | 863 | ;;;###autoload |
| 858 | (defun browse-url (url &rest args) | 864 | (defun browse-url (url &rest args) |
| 859 | "Ask a WWW browser to load URL. | 865 | "Open URL using a configurable method. |
| 860 | Prompt for a URL, defaulting to the URL at or before point. | 866 | This will typically (by default) open URL with an external web |
| 861 | Invokes a suitable browser function which does the actual job. | 867 | browser, but a wide variety of different methods can be used, |
| 868 | depending on the URL type. | ||
| 862 | 869 | ||
| 863 | The variables `browse-url-browser-function', | 870 | The variables `browse-url-browser-function', |
| 864 | `browse-url-handlers', and `browse-url-default-handlers' | 871 | `browse-url-handlers', and `browse-url-default-handlers' |
| 865 | determine which browser function to use. | 872 | determine which browser function to use. |
| 866 | 873 | ||
| 874 | This command prompts for a URL, defaulting to the URL at or | ||
| 875 | before point. | ||
| 876 | |||
| 867 | The additional ARGS are passed to the browser function. See the | 877 | The additional ARGS are passed to the browser function. See the |
| 868 | doc strings of the actual functions, starting with | 878 | doc strings of the actual functions, starting with |
| 869 | `browse-url-browser-function', for information about the | 879 | `browse-url-browser-function', for information about the |
| @@ -904,8 +914,8 @@ If ARGS are omitted, the default is to pass | |||
| 904 | 914 | ||
| 905 | ;;;###autoload | 915 | ;;;###autoload |
| 906 | (defun browse-url-at-point (&optional arg) | 916 | (defun browse-url-at-point (&optional arg) |
| 907 | "Ask a WWW browser to load the URL at or before point. | 917 | "Open URL at point using a configurable method. |
| 908 | Variable `browse-url-browser-function' says which browser to use. | 918 | See `browse-url' for details. |
| 909 | Optional prefix argument ARG non-nil inverts the value of the option | 919 | Optional prefix argument ARG non-nil inverts the value of the option |
| 910 | `browse-url-new-window-flag'." | 920 | `browse-url-new-window-flag'." |
| 911 | (interactive "P") | 921 | (interactive "P") |
| @@ -946,10 +956,11 @@ opposite of the browser kind of `browse-url-browser-function'." | |||
| 946 | 956 | ||
| 947 | ;;;###autoload | 957 | ;;;###autoload |
| 948 | (defun browse-url-at-mouse (event) | 958 | (defun browse-url-at-mouse (event) |
| 949 | "Ask a WWW browser to load a URL clicked with the mouse. | 959 | "Use a web browser to load a URL clicked with the mouse. |
| 950 | The URL is the one around or before the position of the mouse click | 960 | See `browse-url' for details. |
| 951 | but point is not changed. Variable `browse-url-browser-function' | 961 | |
| 952 | says which browser to use." | 962 | The URL is the one around or before the position of the mouse |
| 963 | click but point is not changed." | ||
| 953 | (interactive "e") | 964 | (interactive "e") |
| 954 | (save-excursion | 965 | (save-excursion |
| 955 | (mouse-set-point event) | 966 | (mouse-set-point event) |
| @@ -1791,6 +1802,7 @@ external browser instead of the default one." | |||
| 1791 | (funcall browse-url-secondary-browser-function url) | 1802 | (funcall browse-url-secondary-browser-function url) |
| 1792 | (browse-url url)))) | 1803 | (browse-url url)))) |
| 1793 | 1804 | ||
| 1805 | ;;;###autoload | ||
| 1794 | (defun browse-url-button-open-url (url) | 1806 | (defun browse-url-button-open-url (url) |
| 1795 | "Open URL using `browse-url'. | 1807 | "Open URL using `browse-url'. |
| 1796 | If `current-prefix-arg' is non-nil, use | 1808 | If `current-prefix-arg' is non-nil, use |
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 3097c9a671e..54f7f416aba 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el | |||
| @@ -1156,6 +1156,29 @@ current buffer after passing its contents to the shell command." | |||
| 1156 | (mailcap--async-shell method file)) | 1156 | (mailcap--async-shell method file)) |
| 1157 | (funcall method)))) | 1157 | (funcall method)))) |
| 1158 | 1158 | ||
| 1159 | (defun mailcap-view-file (file) | ||
| 1160 | "View FILE according to rules given by the mailcap system. | ||
| 1161 | This normally involves executing some external program to display | ||
| 1162 | the file. | ||
| 1163 | |||
| 1164 | See \"~/.mailcap\", `mailcap-mime-data' and related files and variables." | ||
| 1165 | (interactive "fOpen file with mailcap: ") | ||
| 1166 | (setq file (expand-file-name file)) | ||
| 1167 | (mailcap-parse-mailcaps) | ||
| 1168 | (let ((command (mailcap-mime-info | ||
| 1169 | (mailcap-extension-to-mime (file-name-extension file))))) | ||
| 1170 | (unless command | ||
| 1171 | (error "No viewer for %s" (file-name-extension file))) | ||
| 1172 | ;; Remove quotes around the file name - we'll use shell-quote-argument. | ||
| 1173 | (while (string-match "['\"]%s['\"]" command) | ||
| 1174 | (setq command (replace-match "%s" t t command))) | ||
| 1175 | (setq command (replace-regexp-in-string | ||
| 1176 | "%s" | ||
| 1177 | (shell-quote-argument (convert-standard-filename file)) | ||
| 1178 | command | ||
| 1179 | nil t)) | ||
| 1180 | (start-process-shell-command command nil command))) | ||
| 1181 | |||
| 1159 | (provide 'mailcap) | 1182 | (provide 'mailcap) |
| 1160 | 1183 | ||
| 1161 | ;;; mailcap.el ends here | 1184 | ;;; mailcap.el ends here |
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 7251640bf27..4fdb63e2eb6 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el | |||
| @@ -2502,7 +2502,8 @@ If ARG is given, opens the URL in a new browser window." | |||
| 2502 | 'follow-link t | 2502 | 'follow-link t |
| 2503 | 'rcirc-url url | 2503 | 'rcirc-url url |
| 2504 | 'action (lambda (button) | 2504 | 'action (lambda (button) |
| 2505 | (browse-url (button-get button 'rcirc-url)))) | 2505 | (browse-url-button-open-url |
| 2506 | (button-get button 'rcirc-url)))) | ||
| 2506 | ;; Record the URL if it is not already the latest stored URL. | 2507 | ;; Record the URL if it is not already the latest stored URL. |
| 2507 | (unless (string= url (caar rcirc-urls)) | 2508 | (unless (string= url (caar rcirc-urls)) |
| 2508 | (push (cons url start) rcirc-urls))))) | 2509 | (push (cons url start) rcirc-urls))))) |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4fd7a322d4b..838464e88b2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -2048,7 +2048,7 @@ function is meant for debugging purposes." | |||
| 2048 | 2048 | ||
| 2049 | (put #'tramp-backtrace 'tramp-suppress-trace t) | 2049 | (put #'tramp-backtrace 'tramp-suppress-trace t) |
| 2050 | 2050 | ||
| 2051 | (defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments) | 2051 | (defun tramp-error (vec-or-proc signal fmt-string &rest arguments) |
| 2052 | "Emit an error. | 2052 | "Emit an error. |
| 2053 | VEC-OR-PROC identifies the connection to use, SIGNAL is the | 2053 | VEC-OR-PROC identifies the connection to use, SIGNAL is the |
| 2054 | signal identifier to be raised, remaining arguments passed to | 2054 | signal identifier to be raised, remaining arguments passed to |
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 13717b1b894..f0180ceeeca 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el | |||
| @@ -1808,7 +1808,7 @@ argument is passed to `next-file', which see)." | |||
| 1808 | (defun tags-search (regexp &optional files) | 1808 | (defun tags-search (regexp &optional files) |
| 1809 | "Search through all files listed in tags table for match for REGEXP. | 1809 | "Search through all files listed in tags table for match for REGEXP. |
| 1810 | Stops when a match is found. | 1810 | Stops when a match is found. |
| 1811 | To continue searching for next match, use command \\[tags-loop-continue]. | 1811 | To continue searching for next match, use the command \\[fileloop-continue]. |
| 1812 | 1812 | ||
| 1813 | If FILES if non-nil should be a list or an iterator returning the | 1813 | If FILES if non-nil should be a list or an iterator returning the |
| 1814 | files to search. The search will be restricted to these files. | 1814 | files to search. The search will be restricted to these files. |
| @@ -1834,7 +1834,7 @@ Also see the documentation of the `tags-file-name' variable." | |||
| 1834 | "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. | 1834 | "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. |
| 1835 | Third arg DELIMITED (prefix arg) means replace only word-delimited matches. | 1835 | Third arg DELIMITED (prefix arg) means replace only word-delimited matches. |
| 1836 | If you exit (\\[keyboard-quit], RET or q), you can resume the query replace | 1836 | If you exit (\\[keyboard-quit], RET or q), you can resume the query replace |
| 1837 | with the command \\[tags-loop-continue]. | 1837 | with the command \\[fileloop-continue]. |
| 1838 | For non-interactive use, superseded by `fileloop-initialize-replace'." | 1838 | For non-interactive use, superseded by `fileloop-initialize-replace'." |
| 1839 | (declare (advertised-calling-convention (from to &optional delimited) "27.1")) | 1839 | (declare (advertised-calling-convention (from to &optional delimited) "27.1")) |
| 1840 | (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) | 1840 | (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) |
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 3bef3986a10..707226fb2a5 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el | |||
| @@ -650,74 +650,6 @@ Used in the Fortran entry in `hs-special-modes-alist'.") | |||
| 650 | (define-key map "7" 'fortran-electric-line-number) | 650 | (define-key map "7" 'fortran-electric-line-number) |
| 651 | (define-key map "8" 'fortran-electric-line-number) | 651 | (define-key map "8" 'fortran-electric-line-number) |
| 652 | (define-key map "9" 'fortran-electric-line-number) | 652 | (define-key map "9" 'fortran-electric-line-number) |
| 653 | |||
| 654 | (easy-menu-define fortran-menu map "Menu for Fortran mode." | ||
| 655 | `("Fortran" | ||
| 656 | ["Manual" (info "(emacs)Fortran") :active t | ||
| 657 | :help "Read the Emacs manual chapter on Fortran mode"] | ||
| 658 | ("Customization" | ||
| 659 | ,(custom-menu-create 'fortran) | ||
| 660 | ;; FIXME useless? | ||
| 661 | ["Set" Custom-set :active t | ||
| 662 | :help "Set current value of all edited settings in the buffer"] | ||
| 663 | ["Save" Custom-save :active t | ||
| 664 | :help "Set and save all edited settings"] | ||
| 665 | ["Reset to Current" Custom-reset-current :active t | ||
| 666 | :help "Reset all edited settings to current"] | ||
| 667 | ["Reset to Saved" Custom-reset-saved :active t | ||
| 668 | :help "Reset all edited or set settings to saved"] | ||
| 669 | ["Reset to Standard Settings" Custom-reset-standard :active t | ||
| 670 | :help "Erase all customizations in buffer"] | ||
| 671 | ) | ||
| 672 | "--" | ||
| 673 | ["Comment Region" fortran-comment-region mark-active] | ||
| 674 | ["Uncomment Region" | ||
| 675 | (fortran-comment-region (region-beginning) (region-end) 1) | ||
| 676 | mark-active] | ||
| 677 | ["Indent Region" indent-region mark-active] | ||
| 678 | ["Indent Subprogram" fortran-indent-subprogram t] | ||
| 679 | "--" | ||
| 680 | ["Beginning of Subprogram" fortran-beginning-of-subprogram :active t | ||
| 681 | :help "Move point to the start of the current subprogram"] | ||
| 682 | ["End of Subprogram" fortran-end-of-subprogram :active t | ||
| 683 | :help "Move point to the end of the current subprogram"] | ||
| 684 | ("Mark" | ||
| 685 | :help "Mark a region of code" | ||
| 686 | ["Subprogram" mark-defun t] | ||
| 687 | ["IF Block" fortran-mark-if t] | ||
| 688 | ["DO Block" fortran-mark-do t] | ||
| 689 | ) | ||
| 690 | ["Narrow to Subprogram" narrow-to-defun t] | ||
| 691 | ["Widen" widen t] | ||
| 692 | "--" | ||
| 693 | ["Temporary Column Ruler" fortran-column-ruler :active t | ||
| 694 | :help "Briefly display Fortran column numbers"] | ||
| 695 | ;; May not be '72', depending on fortran-line-length, but this | ||
| 696 | ;; seems ok for a menu item. | ||
| 697 | ["72-column Window" fortran-window-create :active t | ||
| 698 | :help "Set window width to Fortran line length"] | ||
| 699 | ["Full Width Window" | ||
| 700 | (enlarge-window-horizontally (- (frame-width) (window-width))) | ||
| 701 | :active (not (window-full-width-p)) | ||
| 702 | :help "Make window full width"] | ||
| 703 | ["Momentary 72-Column Window" fortran-window-create-momentarily | ||
| 704 | :active t :help "Briefly set window width to Fortran line length"] | ||
| 705 | "--" | ||
| 706 | ["Break Line at Point" fortran-split-line :active t | ||
| 707 | :help "Break the current line at point"] | ||
| 708 | ["Join Line" fortran-join-line :active t | ||
| 709 | :help "Join the current line to the previous one"] | ||
| 710 | ["Fill Statement/Comment" fill-paragraph t] | ||
| 711 | "--" | ||
| 712 | ["Toggle Auto Fill" auto-fill-mode :selected auto-fill-function | ||
| 713 | :style toggle | ||
| 714 | :help "Automatically fill text while typing in this buffer"] | ||
| 715 | ["Toggle Abbrev Mode" abbrev-mode :selected abbrev-mode | ||
| 716 | :style toggle :help "Expand abbreviations while typing in this buffer"] | ||
| 717 | ["Add Imenu Menu" imenu-add-menubar-index | ||
| 718 | :active (not (lookup-key (current-local-map) [menu-bar index])) | ||
| 719 | :included (fboundp 'imenu-add-to-menubar) | ||
| 720 | :help "Add an index menu to the menu-bar"])) | ||
| 721 | map) | 653 | map) |
| 722 | "Keymap used in Fortran mode.") | 654 | "Keymap used in Fortran mode.") |
| 723 | 655 | ||
| @@ -2209,6 +2141,81 @@ arg DO-SPACE prevents stripping the whitespace." | |||
| 2209 | (point))))) | 2141 | (point))))) |
| 2210 | "main")))) | 2142 | "main")))) |
| 2211 | 2143 | ||
| 2144 | ;; The menu is defined at the end because `custom-menu-create' is | ||
| 2145 | ;; called at load time and will result in (recursively) loading this | ||
| 2146 | ;; file otherwise. | ||
| 2147 | (easy-menu-define fortran-menu fortran-mode-map "Menu for Fortran mode." | ||
| 2148 | `("Fortran" | ||
| 2149 | ["Manual" (info "(emacs)Fortran") :active t | ||
| 2150 | :help "Read the Emacs manual chapter on Fortran mode"] | ||
| 2151 | ("Customization" | ||
| 2152 | ,(progn | ||
| 2153 | ;; Tell the byte compiler that `features' is lexical. | ||
| 2154 | (with-no-warnings (defvar features)) | ||
| 2155 | (let ((features (cons 'fortran features))) | ||
| 2156 | (custom-menu-create 'fortran))) | ||
| 2157 | ;; FIXME useless? | ||
| 2158 | ["Set" Custom-set :active t | ||
| 2159 | :help "Set current value of all edited settings in the buffer"] | ||
| 2160 | ["Save" Custom-save :active t | ||
| 2161 | :help "Set and save all edited settings"] | ||
| 2162 | ["Reset to Current" Custom-reset-current :active t | ||
| 2163 | :help "Reset all edited settings to current"] | ||
| 2164 | ["Reset to Saved" Custom-reset-saved :active t | ||
| 2165 | :help "Reset all edited or set settings to saved"] | ||
| 2166 | ["Reset to Standard Settings" Custom-reset-standard :active t | ||
| 2167 | :help "Erase all customizations in buffer"] | ||
| 2168 | ) | ||
| 2169 | "--" | ||
| 2170 | ["Comment Region" fortran-comment-region mark-active] | ||
| 2171 | ["Uncomment Region" | ||
| 2172 | (fortran-comment-region (region-beginning) (region-end) 1) | ||
| 2173 | mark-active] | ||
| 2174 | ["Indent Region" indent-region mark-active] | ||
| 2175 | ["Indent Subprogram" fortran-indent-subprogram t] | ||
| 2176 | "--" | ||
| 2177 | ["Beginning of Subprogram" fortran-beginning-of-subprogram :active t | ||
| 2178 | :help "Move point to the start of the current subprogram"] | ||
| 2179 | ["End of Subprogram" fortran-end-of-subprogram :active t | ||
| 2180 | :help "Move point to the end of the current subprogram"] | ||
| 2181 | ("Mark" | ||
| 2182 | :help "Mark a region of code" | ||
| 2183 | ["Subprogram" mark-defun t] | ||
| 2184 | ["IF Block" fortran-mark-if t] | ||
| 2185 | ["DO Block" fortran-mark-do t] | ||
| 2186 | ) | ||
| 2187 | ["Narrow to Subprogram" narrow-to-defun t] | ||
| 2188 | ["Widen" widen t] | ||
| 2189 | "--" | ||
| 2190 | ["Temporary Column Ruler" fortran-column-ruler :active t | ||
| 2191 | :help "Briefly display Fortran column numbers"] | ||
| 2192 | ;; May not be '72', depending on fortran-line-length, but this | ||
| 2193 | ;; seems ok for a menu item. | ||
| 2194 | ["72-column Window" fortran-window-create :active t | ||
| 2195 | :help "Set window width to Fortran line length"] | ||
| 2196 | ["Full Width Window" | ||
| 2197 | (enlarge-window-horizontally (- (frame-width) (window-width))) | ||
| 2198 | :active (not (window-full-width-p)) | ||
| 2199 | :help "Make window full width"] | ||
| 2200 | ["Momentary 72-Column Window" fortran-window-create-momentarily | ||
| 2201 | :active t :help "Briefly set window width to Fortran line length"] | ||
| 2202 | "--" | ||
| 2203 | ["Break Line at Point" fortran-split-line :active t | ||
| 2204 | :help "Break the current line at point"] | ||
| 2205 | ["Join Line" fortran-join-line :active t | ||
| 2206 | :help "Join the current line to the previous one"] | ||
| 2207 | ["Fill Statement/Comment" fill-paragraph t] | ||
| 2208 | "--" | ||
| 2209 | ["Toggle Auto Fill" auto-fill-mode :selected auto-fill-function | ||
| 2210 | :style toggle | ||
| 2211 | :help "Automatically fill text while typing in this buffer"] | ||
| 2212 | ["Toggle Abbrev Mode" abbrev-mode :selected abbrev-mode | ||
| 2213 | :style toggle :help "Expand abbreviations while typing in this buffer"] | ||
| 2214 | ["Add Imenu Menu" imenu-add-menubar-index | ||
| 2215 | :active (not (lookup-key (current-local-map) [menu-bar index])) | ||
| 2216 | :included (fboundp 'imenu-add-to-menubar) | ||
| 2217 | :help "Add an index menu to the menu-bar"])) | ||
| 2218 | |||
| 2212 | (provide 'fortran) | 2219 | (provide 'fortran) |
| 2213 | 2220 | ||
| 2214 | ;;; fortran.el ends here | 2221 | ;;; fortran.el ends here |
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 80c3e7840f0..462ea51e2ce 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el | |||
| @@ -473,7 +473,7 @@ buffer `default-directory'." | |||
| 473 | (1 (if (eq (char-after (match-beginning 1)) ?\0) | 473 | (1 (if (eq (char-after (match-beginning 1)) ?\0) |
| 474 | `(face nil display ,(match-string 2))))) | 474 | `(face nil display ,(match-string 2))))) |
| 475 | ;; Hide excessive part of rgrep command | 475 | ;; Hide excessive part of rgrep command |
| 476 | ("^find \\(\\. -type d .*\\(?:\\\\)\\|\")\"\\)\\)" | 476 | ("^find \\(\\(?:-H \\)?\\. -type d .*\\(?:\\\\)\\|\")\"\\)\\)" |
| 477 | (1 (if grep-find-abbreviate grep-find-abbreviate-properties | 477 | (1 (if grep-find-abbreviate grep-find-abbreviate-properties |
| 478 | '(face nil abbreviated-command t)))) | 478 | '(face nil abbreviated-command t)))) |
| 479 | ;; Hide excessive part of lgrep command | 479 | ;; Hide excessive part of lgrep command |
| @@ -774,25 +774,24 @@ The value depends on `grep-command', `grep-template', | |||
| 774 | (let ((gcmd (format "%s <C> %s <R>" | 774 | (let ((gcmd (format "%s <C> %s <R>" |
| 775 | grep-program grep-options)) | 775 | grep-program grep-options)) |
| 776 | (null (if grep-use-null-device | 776 | (null (if grep-use-null-device |
| 777 | (format "%s " (null-device)) | 777 | (format "%s " (null-device)) |
| 778 | ""))) | 778 | ""))) |
| 779 | (cond ((eq grep-find-use-xargs 'gnu) | 779 | (cond ((eq grep-find-use-xargs 'gnu) |
| 780 | (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s" | 780 | (format "%s -H <D> <X> -type f <F> -print0 | \"%s\" -0 %s" |
| 781 | find-program xargs-program gcmd)) | 781 | find-program xargs-program gcmd)) |
| 782 | ((eq grep-find-use-xargs 'gnu-sort) | 782 | ((eq grep-find-use-xargs 'gnu-sort) |
| 783 | (format "%s <D> <X> -type f <F> -print0 | sort -z | \"%s\" -0 %s" | 783 | (format "%s -H <D> <X> -type f <F> -print0 | sort -z | \"%s\" -0 %s" |
| 784 | find-program xargs-program gcmd)) | 784 | find-program xargs-program gcmd)) |
| 785 | ((eq grep-find-use-xargs 'exec) | 785 | ((eq grep-find-use-xargs 'exec) |
| 786 | (format "%s <D> <X> -type f <F> -exec %s %s %s%s" | 786 | (format "%s -H <D> <X> -type f <F> -exec %s %s %s%s" |
| 787 | find-program gcmd quot-braces null quot-scolon)) | 787 | find-program gcmd quot-braces null quot-scolon)) |
| 788 | ((eq grep-find-use-xargs 'exec-plus) | 788 | ((eq grep-find-use-xargs 'exec-plus) |
| 789 | (format "%s <D> <X> -type f <F> -exec %s %s%s +" | 789 | (format "%s -H <D> <X> -type f <F> -exec %s %s%s +" |
| 790 | find-program gcmd null quot-braces)) | 790 | find-program gcmd null quot-braces)) |
| 791 | (t | 791 | (t |
| 792 | (format "%s <D> <X> -type f <F> -print | \"%s\" %s" | 792 | (format "%s -H <D> <X> -type f <F> -print | \"%s\" %s" |
| 793 | find-program xargs-program gcmd)))))))) | 793 | find-program xargs-program gcmd)))))))) |
| 794 | 794 | ;; Save defaults for this host. | |
| 795 | ;; Save defaults for this host. | ||
| 796 | (setq grep-host-defaults-alist | 795 | (setq grep-host-defaults-alist |
| 797 | (delete (assq host-id grep-host-defaults-alist) | 796 | (delete (assq host-id grep-host-defaults-alist) |
| 798 | grep-host-defaults-alist)) | 797 | grep-host-defaults-alist)) |
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 0d9b4b7a363..d127575255a 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el | |||
| @@ -55,10 +55,10 @@ | |||
| 55 | ;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol. | 55 | ;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol. |
| 56 | ;; | 56 | ;; |
| 57 | ;; If you define or undefine a symbol while hide-ifdef-mode is in effect, | 57 | ;; If you define or undefine a symbol while hide-ifdef-mode is in effect, |
| 58 | ;; the display will be updated. Only the define list for the current | 58 | ;; the display will be updated. The global define list hide-ifdef-env |
| 59 | ;; buffer will be affected. You can save changes to the local define | 59 | ;; is affected accordingly. You can save changes to this globally define |
| 60 | ;; list with hide-ifdef-set-define-alist. This adds entries | 60 | ;; list with hide-ifdef-set-define-alist. This adds entries to |
| 61 | ;; to hide-ifdef-define-alist. | 61 | ;; hide-ifdef-define-alist. |
| 62 | ;; | 62 | ;; |
| 63 | ;; If you have defined a hide-ifdef-mode-hook, you can set | 63 | ;; If you have defined a hide-ifdef-mode-hook, you can set |
| 64 | ;; up a list of symbols that may be used by hide-ifdefs as in the | 64 | ;; up a list of symbols that may be used by hide-ifdefs as in the |
| @@ -68,10 +68,19 @@ | |||
| 68 | ;; (lambda () | 68 | ;; (lambda () |
| 69 | ;; (unless hide-ifdef-define-alist | 69 | ;; (unless hide-ifdef-define-alist |
| 70 | ;; (setq hide-ifdef-define-alist | 70 | ;; (setq hide-ifdef-define-alist |
| 71 | ;; '((list1 ONE TWO) | 71 | ;; '((list1 (ONE . 1) (TWO . 2)) |
| 72 | ;; (list2 TWO THREE)))) | 72 | ;; (list2 (TWO . 2) (THREE . 3))))) |
| 73 | ;; (hide-ifdef-use-define-alist 'list2))) ; use list2 by default | 73 | ;; (hide-ifdef-use-define-alist 'list2))) ; use list2 by default |
| 74 | ;; | 74 | ;; |
| 75 | ;; Currently recursive #include is not yet supported, a quick and reliable | ||
| 76 | ;; way is to let the compiler generates all the #include-d defined macros | ||
| 77 | ;; into a file, then open it in Emacs with hide-ifdefs (C-c @ h). | ||
| 78 | ;; Take gcc and hello.c for example, hello.c #include-s <stdio.h>: | ||
| 79 | ;; | ||
| 80 | ;; $ gcc -dM -E hello.c -o hello.hh | ||
| 81 | ;; | ||
| 82 | ;; Then, open hello.hh and perform hide-ifdefs. | ||
| 83 | ;; | ||
| 75 | ;; You can call hide-ifdef-use-define-alist (C-c @ U) at any time to specify | 84 | ;; You can call hide-ifdef-use-define-alist (C-c @ U) at any time to specify |
| 76 | ;; another list to use. | 85 | ;; another list to use. |
| 77 | ;; | 86 | ;; |
| @@ -99,7 +108,11 @@ | |||
| 99 | ;; Extensively modified by Daniel LaLiberte (while at Gould). | 108 | ;; Extensively modified by Daniel LaLiberte (while at Gould). |
| 100 | ;; | 109 | ;; |
| 101 | ;; Extensively modified by Luke Lee in 2013 to support complete C expression | 110 | ;; Extensively modified by Luke Lee in 2013 to support complete C expression |
| 102 | ;; evaluation and argumented macro expansion. | 111 | ;; evaluation and argumented macro expansion; C++11, C++14, C++17, GCC |
| 112 | ;; extension literals and gcc/clang matching behaviours are supported in 2021. | ||
| 113 | ;; Various floating point types and operations are also supported but the | ||
| 114 | ;; actual precision is limited by the Emacs internal floating representation, | ||
| 115 | ;; which is the C data type "double" or IEEE binary64 format. | ||
| 103 | 116 | ||
| 104 | ;;; Code: | 117 | ;;; Code: |
| 105 | 118 | ||
| @@ -136,7 +149,10 @@ | |||
| 136 | :type '(choice (const nil) string) | 149 | :type '(choice (const nil) string) |
| 137 | :version "25.1") | 150 | :version "25.1") |
| 138 | 151 | ||
| 139 | (defcustom hide-ifdef-expand-reinclusion-protection t | 152 | (define-obsolete-variable-alias 'hide-ifdef-expand-reinclusion-protection |
| 153 | 'hide-ifdef-expand-reinclusion-guard "28.1") | ||
| 154 | |||
| 155 | (defcustom hide-ifdef-expand-reinclusion-guard t | ||
| 140 | "Non-nil means don't hide an entire header file enclosed by #ifndef...#endif. | 156 | "Non-nil means don't hide an entire header file enclosed by #ifndef...#endif. |
| 141 | Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion: | 157 | Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion: |
| 142 | 158 | ||
| @@ -161,7 +177,7 @@ outermost #if is always visible." | |||
| 161 | (defcustom hide-ifdef-header-regexp | 177 | (defcustom hide-ifdef-header-regexp |
| 162 | "\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'" | 178 | "\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'" |
| 163 | "C/C++ header file name patterns to determine if current buffer is a header. | 179 | "C/C++ header file name patterns to determine if current buffer is a header. |
| 164 | Effective only if `hide-ifdef-expand-reinclusion-protection' is t." | 180 | Effective only if `hide-ifdef-expand-reinclusion-guard' is t." |
| 165 | :type 'regexp | 181 | :type 'regexp |
| 166 | :version "25.1") | 182 | :version "25.1") |
| 167 | 183 | ||
| @@ -195,6 +211,21 @@ Effective only if `hide-ifdef-expand-reinclusion-protection' is t." | |||
| 195 | :type 'key-sequence | 211 | :type 'key-sequence |
| 196 | :version "27.1") | 212 | :version "27.1") |
| 197 | 213 | ||
| 214 | (defcustom hide-ifdef-verbose nil | ||
| 215 | "Show some defining symbols on hiding for a visible feedback." | ||
| 216 | :type 'boolean | ||
| 217 | :version "28.1") | ||
| 218 | |||
| 219 | (defcustom hide-ifdef-evalulate-enter-hook nil | ||
| 220 | "Hook function to be called when entering `hif-evaluate-macro'." | ||
| 221 | :type 'hook | ||
| 222 | :version "28.1") | ||
| 223 | |||
| 224 | (defcustom hide-ifdef-evalulate-leave-hook nil | ||
| 225 | "Hook function to be called when leaving `hif-evaluate-macro'." | ||
| 226 | :type 'hook | ||
| 227 | :version "28.1") | ||
| 228 | |||
| 198 | (defvar hide-ifdef-mode-map | 229 | (defvar hide-ifdef-mode-map |
| 199 | ;; Set up the mode's main map, which leads via the prefix key to the submap. | 230 | ;; Set up the mode's main map, which leads via the prefix key to the submap. |
| 200 | (let ((map (make-sparse-keymap))) | 231 | (let ((map (make-sparse-keymap))) |
| @@ -306,9 +337,9 @@ Several variables affect how the hiding is done: | |||
| 306 | ;; (default-value 'hide-ifdef-env)) | 337 | ;; (default-value 'hide-ifdef-env)) |
| 307 | (setq hide-ifdef-env (default-value 'hide-ifdef-env)) | 338 | (setq hide-ifdef-env (default-value 'hide-ifdef-env)) |
| 308 | ;; Some C/C++ headers might have other ways to prevent reinclusion and | 339 | ;; Some C/C++ headers might have other ways to prevent reinclusion and |
| 309 | ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil. | 340 | ;; thus would like `hide-ifdef-expand-reinclusion-guard' to be nil. |
| 310 | (setq-local hide-ifdef-expand-reinclusion-protection | 341 | (setq-local hide-ifdef-expand-reinclusion-guard |
| 311 | (default-value 'hide-ifdef-expand-reinclusion-protection)) | 342 | (default-value 'hide-ifdef-expand-reinclusion-guard)) |
| 312 | (setq-local hide-ifdef-hiding | 343 | (setq-local hide-ifdef-hiding |
| 313 | (default-value 'hide-ifdef-hiding)) | 344 | (default-value 'hide-ifdef-hiding)) |
| 314 | (setq-local hif-outside-read-only buffer-read-only) | 345 | (setq-local hif-outside-read-only buffer-read-only) |
| @@ -330,23 +361,42 @@ Several variables affect how the hiding is done: | |||
| 330 | (defun hif-clear-all-ifdef-defined () | 361 | (defun hif-clear-all-ifdef-defined () |
| 331 | "Clears all symbols defined in `hide-ifdef-env'. | 362 | "Clears all symbols defined in `hide-ifdef-env'. |
| 332 | It will backup this variable to `hide-ifdef-env-backup' before clearing to | 363 | It will backup this variable to `hide-ifdef-env-backup' before clearing to |
| 333 | prevent accidental clearance." | 364 | prevent accidental clearance. |
| 365 | When prefixed, it swaps current symbols with the backup ones." | ||
| 334 | (interactive) | 366 | (interactive) |
| 335 | (when (y-or-n-p "Clear all #defined symbols? ") | 367 | (if current-prefix-arg |
| 336 | (setq hide-ifdef-env-backup hide-ifdef-env) | 368 | (if hide-ifdef-env-backup |
| 337 | (setq hide-ifdef-env nil))) | 369 | (when (y-or-n-p (format |
| 338 | 370 | "Restore all %d #defined symbols just cleared? " | |
| 339 | (defun hif-show-all () | 371 | (length hide-ifdef-env-backup))) |
| 340 | "Show all of the text in the current buffer." | 372 | (let ((tmp hide-ifdef-env-backup)) |
| 341 | (interactive) | 373 | (setq hide-ifdef-env hide-ifdef-env-backup) |
| 342 | (hif-show-ifdef-region (point-min) (point-max))) | 374 | (setq hide-ifdef-env-backup tmp)) |
| 375 | (message "Backup symbols restored.")) | ||
| 376 | (message "No backup symbol to restore.")) | ||
| 377 | (when (y-or-n-p (format "Clear all %d #defined symbols? " | ||
| 378 | (length hide-ifdef-env))) | ||
| 379 | (if hide-ifdef-env ;; backup only if not empty | ||
| 380 | (setq hide-ifdef-env-backup hide-ifdef-env)) | ||
| 381 | (setq hide-ifdef-env nil) | ||
| 382 | (message "All defined symbols cleared." )))) | ||
| 383 | |||
| 384 | (defun hif-show-all (&optional start end) | ||
| 385 | "Show all of the text in the current buffer. | ||
| 386 | If there is a marked region from START to END it only shows the symbols within." | ||
| 387 | (interactive | ||
| 388 | (if (use-region-p) | ||
| 389 | (list (region-beginning) (region-end)) | ||
| 390 | (list (point-min) (point-max)))) | ||
| 391 | (hif-show-ifdef-region | ||
| 392 | (or start (point-min)) (or end (point-max)))) | ||
| 343 | 393 | ||
| 344 | ;; By putting this on after-revert-hook, we arrange that it only | 394 | ;; By putting this on after-revert-hook, we arrange that it only |
| 345 | ;; does anything when revert-buffer avoids turning off the mode. | 395 | ;; does anything when revert-buffer avoids turning off the mode. |
| 346 | ;; (That can happen in VC.) | 396 | ;; (That can happen in VC.) |
| 347 | (defun hif-after-revert-function () | 397 | (defun hif-after-revert-function () |
| 348 | (and hide-ifdef-mode hide-ifdef-hiding | 398 | (and hide-ifdef-mode hide-ifdef-hiding |
| 349 | (hide-ifdefs t))) | 399 | (hide-ifdefs nil nil t))) |
| 350 | (add-hook 'after-revert-hook 'hif-after-revert-function) | 400 | (add-hook 'after-revert-hook 'hif-after-revert-function) |
| 351 | 401 | ||
| 352 | (defun hif-end-of-line () | 402 | (defun hif-end-of-line () |
| @@ -427,9 +477,17 @@ Everything including these lines is made invisible." | |||
| 427 | 477 | ||
| 428 | ;;===%%SF%% evaluation (Start) === | 478 | ;;===%%SF%% evaluation (Start) === |
| 429 | 479 | ||
| 480 | (defun hif-eval (form) | ||
| 481 | "Evaluate hideif internal representation." | ||
| 482 | (let ((val (eval form))) | ||
| 483 | (if (stringp val) | ||
| 484 | (or (get-text-property 0 'hif-value val) | ||
| 485 | val) | ||
| 486 | val))) | ||
| 487 | |||
| 430 | ;; It is not useful to set this to anything but `eval'. | 488 | ;; It is not useful to set this to anything but `eval'. |
| 431 | ;; In fact, the variable might as well be eliminated. | 489 | ;; In fact, the variable might as well be eliminated. |
| 432 | (defvar hide-ifdef-evaluator 'eval | 490 | (defvar hide-ifdef-evaluator #'hif-eval |
| 433 | "The function to use to evaluate a form. | 491 | "The function to use to evaluate a form. |
| 434 | The evaluator is given a canonical form and returns t if text under | 492 | The evaluator is given a canonical form and returns t if text under |
| 435 | that form should be displayed.") | 493 | that form should be displayed.") |
| @@ -442,23 +500,42 @@ that form should be displayed.") | |||
| 442 | "Prepend (VAR VALUE) pair to `hide-ifdef-env'." | 500 | "Prepend (VAR VALUE) pair to `hide-ifdef-env'." |
| 443 | (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env))) | 501 | (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env))) |
| 444 | 502 | ||
| 503 | (defconst hif-predefine-alist | ||
| 504 | '((__LINE__ . hif-__LINE__) | ||
| 505 | (__FILE__ . hif-__FILE__) | ||
| 506 | (__COUNTER__ . hif-__COUNTER__) | ||
| 507 | (__cplusplus . hif-__cplusplus) | ||
| 508 | (__DATE__ . hif-__DATE__) | ||
| 509 | (__TIME__ . hif-__TIME__) | ||
| 510 | (__STDC__ . hif-__STDC__) | ||
| 511 | (__STDC_VERSION__ . hif-__STDC_VERSION__) | ||
| 512 | (__STDC_HOST__ . hif-__STDC_HOST__) | ||
| 513 | (__BASE_FILE__ . hif-__FILE__))) | ||
| 514 | |||
| 445 | (declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var)) | 515 | (declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var)) |
| 446 | (declare-function semantic-c-hideif-defined "semantic/bovine/c" (var)) | 516 | (declare-function semantic-c-hideif-defined "semantic/bovine/c" (var)) |
| 447 | 517 | ||
| 448 | (defun hif-lookup (var) | 518 | (defun hif-lookup (var) |
| 449 | (or (when (bound-and-true-p semantic-c-takeover-hideif) | 519 | (or (when (bound-and-true-p semantic-c-takeover-hideif) |
| 450 | (semantic-c-hideif-lookup var)) | 520 | (semantic-c-hideif-lookup var)) |
| 451 | (let ((val (assoc var hide-ifdef-env))) | 521 | (let ((val (assq var hide-ifdef-env))) |
| 452 | (if val | 522 | (if val |
| 453 | (cdr val) | 523 | (cdr val) |
| 454 | hif-undefined-symbol)))) | 524 | (if (setq val (assq var hif-predefine-alist)) |
| 525 | (funcall (cdr val)) | ||
| 526 | hif-undefined-symbol))))) | ||
| 455 | 527 | ||
| 456 | (defun hif-defined (var) | 528 | (defun hif-defined (var) |
| 457 | (cond | 529 | (let (def) |
| 458 | ((bound-and-true-p semantic-c-takeover-hideif) | 530 | (cond |
| 459 | (semantic-c-hideif-defined var)) | 531 | ((bound-and-true-p semantic-c-takeover-hideif) |
| 460 | ((assoc var hide-ifdef-env) 1) | 532 | (semantic-c-hideif-defined var)) |
| 461 | (t 0))) | 533 | ;; Here we can't use hif-lookup as an empty definition like `#define EMPTY' |
| 534 | ;; is considered defined but is evaluated as `nil'. | ||
| 535 | ((assq var hide-ifdef-env) 1) | ||
| 536 | ((and (setq def (assq var hif-predefine-alist)) | ||
| 537 | (funcall (cdr def))) 1) | ||
| 538 | (t 0)))) | ||
| 462 | 539 | ||
| 463 | ;;===%%SF%% evaluation (End) === | 540 | ;;===%%SF%% evaluation (End) === |
| 464 | 541 | ||
| @@ -484,7 +561,7 @@ that form should be displayed.") | |||
| 484 | (defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)")) | 561 | (defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)")) |
| 485 | (defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*")) | 562 | (defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*")) |
| 486 | (defconst hif-macroref-regexp | 563 | (defconst hif-macroref-regexp |
| 487 | (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp | 564 | (concat hif-white-regexp "\\(" hif-id-regexp "\\)" |
| 488 | "\\(" | 565 | "\\(" |
| 489 | "(" hif-white-regexp | 566 | "(" hif-white-regexp |
| 490 | "\\(" hif-id-regexp "\\)?" hif-white-regexp | 567 | "\\(" hif-id-regexp "\\)?" hif-white-regexp |
| @@ -493,6 +570,75 @@ that form should be displayed.") | |||
| 493 | ")" | 570 | ")" |
| 494 | "\\)?" )) | 571 | "\\)?" )) |
| 495 | 572 | ||
| 573 | ;; The point here is *NOT* to do "syntax error checking" for C(++) compiler, but | ||
| 574 | ;; to parse and recognize *already valid* numeric literals. Therefore we don't | ||
| 575 | ;; need to worry if number like "0x12'" is invalid, leave it to the compiler. | ||
| 576 | ;; Otherwise, the runtime performance of hideif would be poor. | ||
| 577 | ;; | ||
| 578 | ;; GCC fixed-point literal extension: | ||
| 579 | ;; | ||
| 580 | ;; ‘ullk’ or ‘ULLK’ for unsigned long long _Accum and _Sat unsigned long long _Accum | ||
| 581 | ;; ‘ullr’ or ‘ULLR’ for unsigned long long _Fract and _Sat unsigned long long _Fract | ||
| 582 | ;; | ||
| 583 | ;; ‘llk’ or ‘LLK’ for long long _Accum and _Sat long long _Accum | ||
| 584 | ;; ‘llr’ or ‘LLR’ for long long _Fract and _Sat long long _Fract | ||
| 585 | ;; ‘uhk’ or ‘UHK’ for unsigned short _Accum and _Sat unsigned short _Accum | ||
| 586 | ;; ‘ulk’ or ‘ULK’ for unsigned long _Accum and _Sat unsigned long _Accum | ||
| 587 | ;; ‘uhr’ or ‘UHR’ for unsigned short _Fract and _Sat unsigned short _Fract | ||
| 588 | ;; ‘ulr’ or ‘ULR’ for unsigned long _Fract and _Sat unsigned long _Fract | ||
| 589 | ;; | ||
| 590 | ;; ‘lk’ or ‘LK’ for long _Accum and _Sat long _Accum | ||
| 591 | ;; ‘lr’ or ‘LR’ for long _Fract and _Sat long _Fract | ||
| 592 | ;; ‘uk’ or ‘UK’ for unsigned _Accum and _Sat unsigned _Accum | ||
| 593 | ;; ‘ur’ or ‘UR’ for unsigned _Fract and _Sat unsigned _Fract | ||
| 594 | ;; ‘hk’ or ‘HK’ for short _Accum and _Sat short _Accum | ||
| 595 | ;; ‘hr’ or ‘HR’ for short _Fract and _Sat short _Fract | ||
| 596 | ;; | ||
| 597 | ;; ‘r’ or ‘R’ for _Fract and _Sat _Fract | ||
| 598 | ;; ‘k’ or ‘K’ for _Accum and _Sat _Accum | ||
| 599 | |||
| 600 | ;; C++14 also include '0b' for binary and "'" as separator | ||
| 601 | (defconst hif-numtype-suffix-regexp | ||
| 602 | ;; "\\(ll[uU]\\|LL[uU]\\|[uU]?ll\\|[uU]?LL\\|[lL][uU]\\|[uU][lL]\\|[uUlLfF]\\)" | ||
| 603 | (concat | ||
| 604 | "\\(\\(ll[uU]\\|LL[uU]\\|[uU]?ll\\|[uU]?LL\\|[lL][uU]\\|[uU][lL]\\|" | ||
| 605 | "[uU][hH]\\)[kKrR]?\\|" ; GCC fixed-point extension | ||
| 606 | "[dD][dDfFlL]\\|" ; GCC floating-point extension | ||
| 607 | "[uUlLfF]\\)")) | ||
| 608 | (defconst hif-bin-regexp | ||
| 609 | (concat "[+-]?0[bB]\\([01']+\\)" | ||
| 610 | hif-numtype-suffix-regexp "?")) | ||
| 611 | (defconst hif-hex-regexp | ||
| 612 | (concat "[+-]?0[xX]\\([[:xdigit:]']+\\)" | ||
| 613 | hif-numtype-suffix-regexp "?")) | ||
| 614 | (defconst hif-oct-regexp | ||
| 615 | (concat "[+-]?0[0-7']+" | ||
| 616 | hif-numtype-suffix-regexp "?")) | ||
| 617 | (defconst hif-dec-regexp | ||
| 618 | (concat "[+-]?\\(0\\|[1-9][0-9']*\\)" | ||
| 619 | hif-numtype-suffix-regexp "?")) | ||
| 620 | |||
| 621 | (defconst hif-decfloat-regexp | ||
| 622 | ;; `hif-string-to-decfloat' relies on the number and ordering of parentheses | ||
| 623 | (concat | ||
| 624 | "\\(?:" | ||
| 625 | "\\([+-]?[0-9]+\\)\\([eE][+-]?[0-9]+\\)?[dD]?[fFlL]?" | ||
| 626 | "\\|\\([+-]?[0-9]+\\)\\.\\([eE][+-]?[0-9]+\\)?[dD]?[dDfFlL]?" | ||
| 627 | "\\|\\([+-]?[0-9]*\\.[0-9]+\\)\\([eE][+-]?[0-9]+\\)?[dD]?[dDfFlL]?" | ||
| 628 | "\\)")) | ||
| 629 | |||
| 630 | ;; C++17 hexadecimal floating point literal | ||
| 631 | (defconst hif-hexfloat-regexp | ||
| 632 | ;; `hif-string-to-hexfloat' relies on the ordering of regexp groupings | ||
| 633 | (concat | ||
| 634 | "[+-]?\\(?:" | ||
| 635 | "0[xX]\\([[:xdigit:]']+\\)[pP]\\([+-]?[0-9']+\\)[fFlL]?" | ||
| 636 | "\\|" | ||
| 637 | "0[xX]\\([[:xdigit:]']+\\)\\.[pP]\\([+-]?[0-9']+\\)[fFlL]?" | ||
| 638 | "\\|" | ||
| 639 | "0[xX]\\([[:xdigit:]']*\\)\\.\\([[:xdigit:]']+\\)[pP]\\([+-]?[0-9']+\\)[fFlL]?" | ||
| 640 | "\\)")) | ||
| 641 | |||
| 496 | ;; Store the current token and the whole token list during parsing. | 642 | ;; Store the current token and the whole token list during parsing. |
| 497 | ;; Bound dynamically. | 643 | ;; Bound dynamically. |
| 498 | (defvar hif-token) | 644 | (defvar hif-token) |
| @@ -530,29 +676,113 @@ that form should be displayed.") | |||
| 530 | (":" . hif-colon) | 676 | (":" . hif-colon) |
| 531 | ("," . hif-comma) | 677 | ("," . hif-comma) |
| 532 | ("#" . hif-stringify) | 678 | ("#" . hif-stringify) |
| 533 | ("..." . hif-etc))) | 679 | ("..." . hif-etc) |
| 680 | ("defined" . hif-defined))) | ||
| 534 | 681 | ||
| 535 | (defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) | 682 | (defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) |
| 536 | 683 | ||
| 537 | (defconst hif-token-regexp | 684 | (defconst hif-token-regexp |
| 538 | (concat (regexp-opt (mapcar 'car hif-token-alist)) | 685 | ;; The ordering of regexp grouping is crutial to `hif-strtok' |
| 539 | "\\|0x[[:xdigit:]]+\\.?[[:xdigit:]]*" | 686 | (concat |
| 540 | "\\|[0-9]+\\.?[0-9]*" ;; decimal/octal | 687 | ;; hex/binary: |
| 541 | "\\|\\w+")) | 688 | "\\([+-]?0[xXbB]\\([[:xdigit:]']+\\)?\\.?\\([[:xdigit:]']+\\)?\\([pP]\\([+-]?[0-9]+\\)\\)?" |
| 542 | 689 | hif-numtype-suffix-regexp "?\\)" | |
| 543 | (defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)") | 690 | ;; decimal/octal: |
| 691 | "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?" | ||
| 692 | hif-numtype-suffix-regexp "?\\)" | ||
| 693 | "\\|" (regexp-opt (mapcar 'car hif-token-alist) t) | ||
| 694 | "\\|\\(\\w+\\)")) | ||
| 695 | |||
| 696 | ;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"") | ||
| 697 | (defconst hif-unicode-prefix-regexp "\\(?:u8R?\\|[uUL]R?\\\|R\\)") | ||
| 698 | (defconst hif-string-literal-regexp | ||
| 699 | (concat hif-unicode-prefix-regexp "?" | ||
| 700 | "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)")) | ||
| 701 | |||
| 702 | ;; matching and conversion | ||
| 703 | |||
| 704 | (defun hif-full-match (regexp string) | ||
| 705 | "A full REGEXP match of STRING instead of partially match." | ||
| 706 | (string-match (concat "\\`" regexp "\\'") string)) | ||
| 707 | |||
| 708 | (defun hif-is-number (string) | ||
| 709 | "Check if STRING is a valid C(++) numeric literal." | ||
| 710 | (or (hif-full-match hif-dec-regexp string) | ||
| 711 | (hif-full-match hif-hex-regexp string) | ||
| 712 | (hif-full-match hif-oct-regexp string) | ||
| 713 | (hif-full-match hif-bin-regexp string))) | ||
| 714 | |||
| 715 | (defun hif-is-float (string) | ||
| 716 | "Check if STRING is a valid C(++) floating point literal." | ||
| 717 | (or (hif-full-match hif-decfloat-regexp string) | ||
| 718 | (hif-full-match hif-hexfloat-regexp string))) | ||
| 719 | |||
| 720 | (defun hif-delete-char-in-string (char string) | ||
| 721 | "Delete CHAR in STRING inplace." | ||
| 722 | (let ((i (length string)) | ||
| 723 | (s nil)) | ||
| 724 | (while (> i 0) | ||
| 725 | (setq i (1- i)) | ||
| 726 | (unless (eq (aref string i) char) | ||
| 727 | (setq s (cons (aref string i) s)))) | ||
| 728 | (concat s))) | ||
| 729 | |||
| 730 | (defun hif-string-to-decfloat (string &optional fix exp) | ||
| 731 | "Convert a C(++) decimal floating formatted string into float. | ||
| 732 | Assuming we've just regexp-matched with `hif-decfloat-regexp' and it matched. | ||
| 733 | if REMATCH is t, do a rematch." | ||
| 734 | ;; In elisp `(string-to-number "01.e2")' will return 1 instead of the expected | ||
| 735 | ;; 100.0; therefore we need to write our own. | ||
| 736 | ;; This function relies on the regexp groups of `hif-dexfloat-regexp' | ||
| 737 | (if (or fix exp) | ||
| 738 | (setq fix (hif-delete-char-in-string ?' fix) | ||
| 739 | exp (hif-delete-char-in-string ?' exp)) | ||
| 740 | ;; rematch | ||
| 741 | (setq string (hif-delete-char-in-string ?' string)) | ||
| 742 | (hif-full-match hif-decfloat-regexp string) | ||
| 743 | (setq fix (or (match-string 1 string) | ||
| 744 | (match-string 3 string) | ||
| 745 | (match-string 5 string)) | ||
| 746 | exp (or (match-string 2 string) | ||
| 747 | (match-string 4 string) | ||
| 748 | (match-string 6 string)))) | ||
| 749 | (setq fix (string-to-number fix) | ||
| 750 | exp (if (zerop (length exp)) ;; nil or "" | ||
| 751 | 0 (string-to-number (substring-no-properties exp 1)))) | ||
| 752 | (* fix (expt 10 exp))) | ||
| 753 | |||
| 754 | (defun hif-string-to-hexfloat (string &optional int fra exp) | ||
| 755 | "Convert a C++17 hex float formatted string into float. | ||
| 756 | Assuming we've just regexp-matched with `hif-hexfloat-regexp' and it matched. | ||
| 757 | if REMATCH is t, do a rematch." | ||
| 758 | ;; This function relies on the regexp groups of `hif-hexfloat-regexp' | ||
| 759 | (let ((negate (if (eq ?- (aref string 0)) -1.0 1.0))) | ||
| 760 | (if (or int fra exp) | ||
| 761 | (setq int (hif-delete-char-in-string ?' int) | ||
| 762 | fra (hif-delete-char-in-string ?' fra) | ||
| 763 | exp (hif-delete-char-in-string ?' exp)) | ||
| 764 | (setq string (hif-delete-char-in-string ?' string)) | ||
| 765 | (hif-full-match hif-hexfloat-regexp string) | ||
| 766 | (setq int (or (match-string 1 string) | ||
| 767 | (match-string 3 string) | ||
| 768 | (match-string 5 string)) | ||
| 769 | fra (or (match-string 2 string) | ||
| 770 | (match-string 4 string) | ||
| 771 | (match-string 6 string)) | ||
| 772 | exp (match-string 7 string))) | ||
| 773 | (setq int (if (zerop (length int)) ;; nil or "" | ||
| 774 | 0 (string-to-number int 16)) | ||
| 775 | fra (if (zerop (length fra)) | ||
| 776 | 0 (/ (string-to-number fra 16) | ||
| 777 | (expt 16.0 (length fra)))) | ||
| 778 | exp (if (zerop (length exp)) | ||
| 779 | 0 (string-to-number exp))) | ||
| 780 | (* negate (+ int fra) (expt 2.0 exp)))) | ||
| 544 | 781 | ||
| 545 | (defun hif-string-to-number (string &optional base) | 782 | (defun hif-string-to-number (string &optional base) |
| 546 | "Like `string-to-number', but it understands non-decimal floats." | 783 | "Like `string-to-number', but it understands C(++) literals." |
| 547 | (if (or (not base) (= base 10)) | 784 | (setq string (hif-delete-char-in-string ?' string)) |
| 548 | (string-to-number string base) | 785 | (string-to-number string base)) |
| 549 | (let* ((parts (split-string string "\\." t "[ \t]+")) | ||
| 550 | (frac (cadr parts)) | ||
| 551 | (fraclen (length frac)) | ||
| 552 | (quot (expt (if (zerop fraclen) | ||
| 553 | base | ||
| 554 | (* base 1.0)) fraclen))) | ||
| 555 | (/ (string-to-number (concat (car parts) frac) base) quot)))) | ||
| 556 | 786 | ||
| 557 | ;; The dynamic binding variable `hif-simple-token-only' is shared only by | 787 | ;; The dynamic binding variable `hif-simple-token-only' is shared only by |
| 558 | ;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize' | 788 | ;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize' |
| @@ -562,52 +792,204 @@ that form should be displayed.") | |||
| 562 | ;; Check the long comments before `hif-find-define' for more details. [lukelee] | 792 | ;; Check the long comments before `hif-find-define' for more details. [lukelee] |
| 563 | (defvar hif-simple-token-only) | 793 | (defvar hif-simple-token-only) |
| 564 | 794 | ||
| 795 | (defsubst hif-is-white (c) | ||
| 796 | (memq c '(? ?\t ?\n ?\r))) | ||
| 797 | |||
| 798 | (defun hif-strtok (string &optional rematch) | ||
| 799 | "Convert STRING into a hideif mode internal token. | ||
| 800 | Assuming we've just performed a `hif-token-regexp' lookup." | ||
| 801 | ;; This function relies on the regexp groups of `hif-token-regexp' | ||
| 802 | ;; New hideif internal number representation: a text string with `hif-value' | ||
| 803 | ;; property to keep its value. Strings without `hif-value' property is a | ||
| 804 | ;; normal C(++) string. This is mainly for stringification. The original | ||
| 805 | ;; implementation only keep the value thus a C++ number like octal 01234 | ||
| 806 | ;; will become "668" after being stringified instead of the expected "01234". | ||
| 807 | (let (bufstr m1 m3 m5 m6 m8 neg ch val dec) | ||
| 808 | (when rematch | ||
| 809 | (string-match hif-token-regexp string) | ||
| 810 | (setq bufstr string)) | ||
| 811 | |||
| 812 | (cond | ||
| 813 | |||
| 814 | ;; decimal/octal | ||
| 815 | ((match-string 8 bufstr) | ||
| 816 | (setq m6 (match-string 9 bufstr)) | ||
| 817 | (setq val | ||
| 818 | (if (or (setq m8 (match-string 11 bufstr)) | ||
| 819 | (match-string 10 bufstr)) ;; floating | ||
| 820 | ;; TODO: do we need to add 'hif-type property for | ||
| 821 | ;; type-checking, but this will slow things down | ||
| 822 | (hif-string-to-decfloat string m6 m8) | ||
| 823 | (setq ch (aref string 0)) | ||
| 824 | (hif-string-to-number | ||
| 825 | string | ||
| 826 | ;; octal begin with `0' | ||
| 827 | (if (and (> (length string) 1) | ||
| 828 | (or (eq ch ?0) | ||
| 829 | ;; -0... or +0... | ||
| 830 | (and (memq ch '(?- ?+)) | ||
| 831 | (eq (aref string 1) ?0)))) | ||
| 832 | 8 (setq dec 10))))) | ||
| 833 | ;; Decimal integer without sign and extension is identical to its | ||
| 834 | ;; string form, make it as simple as possible | ||
| 835 | (if (and dec | ||
| 836 | (null (match-string 12 bufstr)) ;; no extension like 'UL' | ||
| 837 | (not (memq ch '(?- ?+)))) | ||
| 838 | val | ||
| 839 | (add-text-properties 0 1 (list 'hif-value val) string) | ||
| 840 | string)) | ||
| 841 | |||
| 842 | ;; hex/binary | ||
| 843 | ((match-string 1 bufstr) | ||
| 844 | (setq m3 (match-string 3 bufstr)) | ||
| 845 | (add-text-properties | ||
| 846 | 0 1 | ||
| 847 | (list 'hif-value | ||
| 848 | (if (or (setq m5 (match-string 5 bufstr)) | ||
| 849 | m3) | ||
| 850 | (hif-string-to-hexfloat | ||
| 851 | string | ||
| 852 | (match-string 2 bufstr) m3 m5) ;; hexfloat | ||
| 853 | (setq neg (if (eq (aref string 0) ?-) -1 1)) | ||
| 854 | (* neg | ||
| 855 | (hif-string-to-number | ||
| 856 | ;; (5-(-1))/2=3; (5-1)/2=2 | ||
| 857 | (substring-no-properties string (ash (- 5 neg) -1)) | ||
| 858 | ;; (3-(-1))/2=2; (3-1)/2=1 | ||
| 859 | (if (or (eq (setq ch (aref string (ash (- 3 neg) -1))) ?x) | ||
| 860 | (eq ch ?X)) ;; hex | ||
| 861 | 16 2))))) | ||
| 862 | string) string) | ||
| 863 | |||
| 864 | ;; operator | ||
| 865 | ((setq m1 (match-string 14 bufstr)) | ||
| 866 | (cdr (assoc m1 hif-token-alist #'string-equal))) | ||
| 867 | |||
| 868 | (t | ||
| 869 | (setq hif-simple-token-only nil) | ||
| 870 | (intern-safe string))))) | ||
| 871 | |||
| 872 | (defun hif-backward-comment (&optional start end) | ||
| 873 | "If we're currently within a C(++) comment, skip them backwards." | ||
| 874 | ;; Ignore trailing white spaces after comment | ||
| 875 | (setq end (or end (point))) | ||
| 876 | (while (and (> (1- end) 1) | ||
| 877 | (hif-is-white (char-after (1- end)))) | ||
| 878 | (cl-decf end)) | ||
| 879 | (let ((p0 end) | ||
| 880 | p cmt ce ws we ;; ce:comment start, ws:white start, we whilte end | ||
| 881 | cmtlist) ;; pair of (start.end) of comments | ||
| 882 | (setq start (or start (progn (beginning-of-line) (point))) | ||
| 883 | p start) | ||
| 884 | (while (< (1+ p) end) | ||
| 885 | (if (char-equal ?/ (char-after p)) ; / | ||
| 886 | (if (char-equal ?/ (char-after (1+ p))) ; // | ||
| 887 | (progn | ||
| 888 | ;; merge whites immediately ahead | ||
| 889 | (setq ce (if (and we (= (1- p) we)) ws p)) | ||
| 890 | ;; scan for end of line | ||
| 891 | (while (and (< (cl-incf p) end) | ||
| 892 | (not (char-equal ?\n (char-after p))) | ||
| 893 | (not (char-equal ?\r (char-after p))))) | ||
| 894 | ;; Merge with previous comment if immediately followed | ||
| 895 | (push (cons (if (and cmtlist | ||
| 896 | (= (cdr (car cmtlist)) ce)) | ||
| 897 | (car (pop cmtlist)) ;; extend previous comment | ||
| 898 | ce) | ||
| 899 | p) | ||
| 900 | cmtlist)) | ||
| 901 | (when (char-equal ?* (char-after (1+ p))) ; /* | ||
| 902 | ;; merge whites immediately ahead | ||
| 903 | (setq ce (if (and we (= (1- p) we)) ws p)) | ||
| 904 | ;; Check if it immediately follows previous /*...*/ comment; | ||
| 905 | ;; if yes, extend and merge into previous comment | ||
| 906 | (setq cmt (if (and cmtlist | ||
| 907 | (= (cdr (car cmtlist)) ce)) | ||
| 908 | (car (pop cmtlist)) ;; extend previous comment | ||
| 909 | ce)) | ||
| 910 | (setq p (+ 2 p)) | ||
| 911 | ;; Scanning for `*/' | ||
| 912 | (catch 'break | ||
| 913 | (while (< (1+ p) end) | ||
| 914 | (if (not (and (char-equal ?* (char-after p)) | ||
| 915 | (char-equal ?/ (char-after (1+ p))))) | ||
| 916 | (cl-incf p) | ||
| 917 | ;; found `*/', mark end pos | ||
| 918 | (push (cons cmt (1+ (setq p (1+ p)))) cmtlist) | ||
| 919 | (throw 'break nil))) | ||
| 920 | ;; (1+ p) >= end | ||
| 921 | (push (cons cmt end) cmtlist)))) | ||
| 922 | ;; Trace most recent continuous white spaces before a comment | ||
| 923 | (if (char-equal ? (char-after p)) | ||
| 924 | (if (and ws (= we (1- p))) ;; continued | ||
| 925 | (setq we p) | ||
| 926 | (setq ws p | ||
| 927 | we p)) | ||
| 928 | (setq ws nil | ||
| 929 | we nil))) | ||
| 930 | (cl-incf p)) | ||
| 931 | ;; Goto beginning of the last comment, if we're within | ||
| 932 | (setq cmt (car cmtlist)) ;; last cmt | ||
| 933 | (setq cmt (if (and cmt | ||
| 934 | (>= p0 (car cmt)) | ||
| 935 | (<= p0 (cdr cmt))) | ||
| 936 | (car cmt) ;; beginning of the last comment | ||
| 937 | p0)) | ||
| 938 | ;; Ignore leading whites ahead of comment | ||
| 939 | (while (and (> (1- cmt) 1) | ||
| 940 | (hif-is-white (char-after (1- cmt)))) | ||
| 941 | (cl-decf cmt)) | ||
| 942 | (goto-char cmt))) | ||
| 943 | |||
| 565 | (defun hif-tokenize (start end) | 944 | (defun hif-tokenize (start end) |
| 566 | "Separate string between START and END into a list of tokens." | 945 | "Separate string between START and END into a list of tokens." |
| 567 | (let ((token-list nil)) | 946 | (let ((token-list nil) |
| 947 | (white-regexp "[ \t]+") | ||
| 948 | token) | ||
| 568 | (setq hif-simple-token-only t) | 949 | (setq hif-simple-token-only t) |
| 569 | (with-syntax-table hide-ifdef-syntax-table | 950 | (with-syntax-table hide-ifdef-syntax-table |
| 570 | (save-excursion | 951 | (save-excursion |
| 571 | (goto-char start) | 952 | (save-restriction |
| 572 | (while (progn (forward-comment (point-max)) (< (point) end)) | 953 | ;; Narrow down to the focusing region so that the ending white spaces |
| 573 | ;; (message "expr-start = %d" expr-start) (sit-for 1) | 954 | ;; of that line will not be treated as a white, as `looking-at' won't |
| 574 | (cond | 955 | ;; look outside the restriction; otherwise it will note the last token |
| 575 | ((looking-at "\\\\\n") | 956 | ;; or string as one with an `hif-space' property. |
| 576 | (forward-char 2)) | 957 | (setq end (hif-backward-comment start end)) |
| 577 | 958 | (narrow-to-region start end) | |
| 578 | ((looking-at hif-string-literal-regexp) | 959 | (goto-char start) |
| 579 | (push (substring-no-properties (match-string 1)) token-list) | 960 | (while (progn (forward-comment (point-max)) (< (point) end)) |
| 580 | (goto-char (match-end 0))) | 961 | ;; (message "expr-start = %d" expr-start) (sit-for 1) |
| 581 | 962 | (cond | |
| 582 | ((looking-at hif-token-regexp) | 963 | ((looking-at "\\\\\n") |
| 583 | (let ((token (buffer-substring-no-properties | 964 | (forward-char 2)) |
| 584 | (point) (match-end 0)))) | 965 | |
| 966 | ((looking-at hif-string-literal-regexp) | ||
| 967 | (setq token (substring-no-properties (match-string 1))) | ||
| 968 | (goto-char (match-end 0)) | ||
| 969 | (when (looking-at white-regexp) | ||
| 970 | (add-text-properties 0 1 '(hif-space t) token) | ||
| 971 | (goto-char (match-end 0))) | ||
| 972 | (push token token-list)) | ||
| 973 | |||
| 974 | ((looking-at hif-token-regexp) | ||
| 585 | (goto-char (match-end 0)) | 975 | (goto-char (match-end 0)) |
| 586 | ;; (message "token: %s" token) (sit-for 1) | 976 | (setq token (hif-strtok |
| 587 | (push | 977 | (substring-no-properties (match-string 0)))) |
| 588 | (or (cdr (assoc token hif-token-alist)) | 978 | (push token token-list) |
| 589 | (if (string-equal token "defined") 'hif-defined) | 979 | (when (looking-at white-regexp) |
| 590 | ;; TODO: | 980 | ;; We can't just append a space to the token string, otherwise |
| 591 | ;; 1. postfix 'l', 'll', 'ul' and 'ull' | 981 | ;; `0xf0 ' ## `01' will become `0xf0 01' instead of the expected |
| 592 | ;; 2. floating number formats (like 1.23e4) | 982 | ;; `0xf001', hence a standalone `hif-space' is placed instead. |
| 593 | ;; 3. 098 is interpreted as octal conversion error | 983 | (push 'hif-space token-list) |
| 594 | (if (string-match "0x\\([[:xdigit:]]+\\.?[[:xdigit:]]*\\)" | 984 | (goto-char (match-end 0)))) |
| 595 | token) | 985 | |
| 596 | (hif-string-to-number (match-string 1 token) 16)) ;; hex | 986 | ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in |
| 597 | (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token) | 987 | (forward-char 1)) ; the source code. Let's not get stuck here. |
| 598 | (hif-string-to-number token 8)) ;; octal | 988 | |
| 599 | (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'" | 989 | (t (error "Bad #if expression: %s" (buffer-string))))))) |
| 600 | token) | 990 | (if (eq 'hif-space (car token-list)) |
| 601 | (string-to-number token)) ;; decimal | 991 | (setq token-list (cdr token-list))) ;; remove trailing white space |
| 602 | (prog1 (intern token) | 992 | (nreverse token-list)))) |
| 603 | (setq hif-simple-token-only nil))) | ||
| 604 | token-list))) | ||
| 605 | |||
| 606 | ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in | ||
| 607 | (forward-char 1)) ; the source code. Let's not get stuck here. | ||
| 608 | (t (error "Bad #if expression: %s" (buffer-string))))))) | ||
| 609 | |||
| 610 | (nreverse token-list))) | ||
| 611 | 993 | ||
| 612 | ;;------------------------------------------------------------------------ | 994 | ;;------------------------------------------------------------------------ |
| 613 | ;; Translate C preprocessor #if expressions using recursive descent. | 995 | ;; Translate C preprocessor #if expressions using recursive descent. |
| @@ -637,50 +1019,96 @@ that form should be displayed.") | |||
| 637 | ;; | | ^= = | | | 1019 | ;; | | ^= = | | |
| 638 | ;; | Comma | , | left-to-right | | 1020 | ;; | Comma | , | left-to-right | |
| 639 | 1021 | ||
| 640 | (defsubst hif-nexttoken () | 1022 | (defun hif-nexttoken (&optional keep-space) |
| 641 | "Pop the next token from token-list into the let variable `hif-token'." | 1023 | "Pop the next token from token-list into the let variable `hif-token'." |
| 642 | (setq hif-token (pop hif-token-list))) | 1024 | (let ((prevtoken hif-token)) |
| 1025 | (while (progn | ||
| 1026 | (setq hif-token (pop hif-token-list)) | ||
| 1027 | (if keep-space ; keep only one space | ||
| 1028 | (and (eq prevtoken 'hif-space) | ||
| 1029 | (eq hif-token 'hif-space)) | ||
| 1030 | (eq hif-token 'hif-space))))) | ||
| 1031 | hif-token) | ||
| 1032 | |||
| 1033 | (defun hif-split-signed-token () | ||
| 1034 | "Split current numeric token into two (hif-plus/minus num)." | ||
| 1035 | (let* (val ch0 head) | ||
| 1036 | (when (and (stringp hif-token) | ||
| 1037 | (setq val (get-text-property 0 'hif-value hif-token)) | ||
| 1038 | ;; explicitly signed? | ||
| 1039 | (memq (setq ch0 (aref hif-token 0)) '(?+ ?-))) | ||
| 1040 | (if (eq ch0 ?+) | ||
| 1041 | (setq head 'hif-plus) | ||
| 1042 | (setq head 'hif-minus | ||
| 1043 | val (- val))) | ||
| 1044 | (setq hif-token (substring hif-token 1)) | ||
| 1045 | (add-text-properties 0 1 (list 'hif-value val) hif-token) | ||
| 1046 | (push hif-token hif-token-list) | ||
| 1047 | (setq hif-token head)))) | ||
| 643 | 1048 | ||
| 644 | (defsubst hif-if-valid-identifier-p (id) | 1049 | (defsubst hif-if-valid-identifier-p (id) |
| 645 | (not (or (numberp id) | 1050 | (not (or (numberp id) |
| 646 | (stringp id)))) | 1051 | (stringp id) |
| 1052 | (and (atom id) | ||
| 1053 | (eq 'defined id))))) | ||
| 647 | 1054 | ||
| 648 | (defun hif-define-operator (tokens) | 1055 | (defun hif-define-operator (tokens) |
| 649 | "\"Upgrade\" hif-define XXX to `(hif-define XXX)' so it won't be substituted." | 1056 | "\"Upgrade\" hif-define XXX to `(hif-define XXX)' so it won't be substituted." |
| 650 | (let ((result nil) | 1057 | (if (memq 'hif-defined tokens) |
| 651 | (tok nil)) | 1058 | (let* ((hif-token-list tokens) |
| 652 | (while (setq tok (pop tokens)) | 1059 | hif-token |
| 653 | (push | 1060 | target |
| 654 | (if (eq tok 'hif-defined) | 1061 | paren) |
| 655 | (progn | 1062 | (setq tokens nil) ;; now it becomes the result |
| 656 | (setq tok (cadr tokens)) | 1063 | (while (hif-nexttoken t) ;; keep `hif-space' |
| 657 | (if (eq (car tokens) 'hif-lparen) | 1064 | (when (eq hif-token 'hif-defined) |
| 658 | (if (and (hif-if-valid-identifier-p tok) | 1065 | ;; defined XXX, start ignoring `hif-space' |
| 659 | (eq (nth 2 tokens) 'hif-rparen)) | 1066 | (hif-nexttoken) |
| 660 | (setq tokens (cl-cdddr tokens)) | 1067 | (if (setq paren (eq hif-token 'hif-lparen)) |
| 661 | (error "#define followed by non-identifier: %S" tok)) | 1068 | (hif-nexttoken)) |
| 662 | (setq tok (car tokens) | 1069 | (if (not (hif-if-valid-identifier-p |
| 663 | tokens (cdr tokens)) | 1070 | (setq target hif-token))) |
| 664 | (unless (hif-if-valid-identifier-p tok) | 1071 | (error "`defined' followed by non-identifier: %S" target)) |
| 665 | (error "#define followed by non-identifier: %S" tok))) | 1072 | (if (and paren |
| 666 | (list 'hif-defined 'hif-lparen tok 'hif-rparen)) | 1073 | (not (eq (hif-nexttoken) 'hif-rparen))) |
| 667 | tok) | 1074 | (error "missing right parenthesis for `defined'")) |
| 668 | result)) | 1075 | (setq hif-token |
| 669 | (nreverse result))) | 1076 | (list 'hif-defined 'hif-lparen target 'hif-rparen))) |
| 1077 | (push hif-token tokens)) | ||
| 1078 | (nreverse tokens)) | ||
| 1079 | tokens)) | ||
| 670 | 1080 | ||
| 671 | (define-obsolete-function-alias 'hif-flatten #'flatten-tree "27.1") | 1081 | (define-obsolete-function-alias 'hif-flatten #'flatten-tree "27.1") |
| 672 | 1082 | ||
| 673 | (defun hif-expand-token-list (tokens &optional macroname expand_list) | 1083 | (defun hif-keep-single (l e) |
| 1084 | "Prevent two or more consecutive E in list L." | ||
| 1085 | (if (memq e l) | ||
| 1086 | (let (prev curr result) | ||
| 1087 | (while (progn | ||
| 1088 | (setq prev curr | ||
| 1089 | curr (car l) | ||
| 1090 | l (cdr l)) | ||
| 1091 | curr) | ||
| 1092 | (unless (and (eq prev e) | ||
| 1093 | (eq curr e)) | ||
| 1094 | (push curr result))) | ||
| 1095 | (nreverse result)) | ||
| 1096 | l)) | ||
| 1097 | |||
| 1098 | (defun hif-expand-token-list (tokens &optional macroname expand_list level) | ||
| 674 | "Perform expansion on TOKENS till everything expanded. | 1099 | "Perform expansion on TOKENS till everything expanded. |
| 675 | Self-reference (directly or indirectly) tokens are not expanded. | 1100 | Self-reference (directly or indirectly) tokens are not expanded. |
| 676 | EXPAND_LIST is the list of macro names currently being expanded, used for | 1101 | EXPAND_LIST is the list of macro names currently being expanded, used for |
| 677 | detecting self-reference." | 1102 | detecting self-reference. |
| 1103 | Function-like macros with calling depth LEVEL 0 does not expand arguments, | ||
| 1104 | this is to emulate the stringification behavior of C++ preprocessor." | ||
| 678 | (catch 'self-referencing | 1105 | (catch 'self-referencing |
| 679 | (let ((expanded nil) | 1106 | (let ((expanded nil) |
| 680 | (remains (hif-define-operator | 1107 | (remains (hif-define-operator |
| 681 | (hif-token-concatenation | 1108 | (hif-token-concatenation |
| 682 | (hif-token-stringification tokens)))) | 1109 | (hif-token-stringification tokens)))) |
| 683 | tok rep) | 1110 | tok rep) |
| 1111 | (setq level (if level level 0)) | ||
| 684 | (if macroname | 1112 | (if macroname |
| 685 | (setq expand_list (cons macroname expand_list))) | 1113 | (setq expand_list (cons macroname expand_list))) |
| 686 | ;; Expanding all tokens till list exhausted | 1114 | ;; Expanding all tokens till list exhausted |
| @@ -699,21 +1127,31 @@ detecting self-reference." | |||
| 699 | (if (and (listp rep) | 1127 | (if (and (listp rep) |
| 700 | (eq (car rep) 'hif-define-macro)) ; A defined macro | 1128 | (eq (car rep) 'hif-define-macro)) ; A defined macro |
| 701 | ;; Recursively expand it | 1129 | ;; Recursively expand it |
| 1130 | ;; only in defined macro do we increase the nesting LEVEL | ||
| 702 | (if (cadr rep) ; Argument list is not nil | 1131 | (if (cadr rep) ; Argument list is not nil |
| 703 | (if (not (eq (car remains) 'hif-lparen)) | 1132 | (if (not (or (eq (car remains) 'hif-lparen) |
| 1133 | ;; hif-space hif-lparen | ||
| 1134 | (and (eq (car remains) 'hif-space) | ||
| 1135 | (eq (cadr remains) 'hif-lparen) | ||
| 1136 | (setq remains (cdr remains))))) | ||
| 704 | ;; No argument, no invocation | 1137 | ;; No argument, no invocation |
| 705 | tok | 1138 | tok |
| 706 | ;; Argumented macro, get arguments and invoke it. | 1139 | ;; Argumented macro, get arguments and invoke it. |
| 707 | ;; Dynamically bind hif-token-list and hif-token | 1140 | ;; Dynamically bind `hif-token-list' and `hif-token' |
| 708 | ;; for hif-macro-supply-arguments | 1141 | ;; for `hif-macro-supply-arguments' |
| 709 | (let* ((hif-token-list (cdr remains)) | 1142 | (let* ((hif-token-list (cdr remains)) |
| 710 | (hif-token nil) | 1143 | (hif-token nil) |
| 711 | (parmlist (mapcar #'hif-expand-token-list | 1144 | (parmlist |
| 712 | (hif-get-argument-list))) | 1145 | (if (zerop level) |
| 1146 | (hif-get-argument-list t) | ||
| 1147 | (mapcar (lambda (a) | ||
| 1148 | (hif-expand-token-list | ||
| 1149 | a nil nil (1+ level))) | ||
| 1150 | (hif-get-argument-list t)))) | ||
| 713 | (result | 1151 | (result |
| 714 | (hif-expand-token-list | 1152 | (hif-expand-token-list |
| 715 | (hif-macro-supply-arguments tok parmlist) | 1153 | (hif-macro-supply-arguments tok parmlist) |
| 716 | tok expand_list))) | 1154 | tok expand_list (1+ level)))) |
| 717 | (setq remains (cons hif-token hif-token-list)) | 1155 | (setq remains (cons hif-token hif-token-list)) |
| 718 | result)) | 1156 | result)) |
| 719 | ;; Argument list is nil, direct expansion | 1157 | ;; Argument list is nil, direct expansion |
| @@ -745,16 +1183,20 @@ detecting self-reference." | |||
| 745 | "Parse the TOKEN-LIST. | 1183 | "Parse the TOKEN-LIST. |
| 746 | Return translated list in prefix form. MACRONAME is applied when invoking | 1184 | Return translated list in prefix form. MACRONAME is applied when invoking |
| 747 | macros to prevent self-reference." | 1185 | macros to prevent self-reference." |
| 748 | (let ((hif-token-list (hif-expand-token-list token-list macroname))) | 1186 | (let ((hif-token-list (hif-expand-token-list token-list macroname nil)) |
| 1187 | (hif-token nil)) | ||
| 749 | (hif-nexttoken) | 1188 | (hif-nexttoken) |
| 750 | (prog1 | 1189 | (prog1 |
| 751 | (and hif-token | 1190 | (and hif-token |
| 752 | (hif-exprlist)) | 1191 | (hif-exprlist)) |
| 753 | (if hif-token ; is there still a token? | 1192 | (if hif-token ; is there still a token? |
| 754 | (error "Error: unexpected token: %s" hif-token))))) | 1193 | (error "Error: unexpected token at line %d: `%s'" |
| 1194 | (line-number-at-pos) | ||
| 1195 | (or (car (rassq hif-token hif-token-alist)) | ||
| 1196 | hif-token)))))) | ||
| 755 | 1197 | ||
| 756 | (defun hif-exprlist () | 1198 | (defun hif-exprlist () |
| 757 | "Parse an exprlist: expr { `,' expr}." | 1199 | "Parse an exprlist: expr { `,' expr }." |
| 758 | (let ((result (hif-expr))) | 1200 | (let ((result (hif-expr))) |
| 759 | (if (eq hif-token 'hif-comma) | 1201 | (if (eq hif-token 'hif-comma) |
| 760 | (let ((temp (list result))) | 1202 | (let ((temp (list result))) |
| @@ -824,7 +1266,7 @@ expr : or-expr | or-expr `?' expr `:' expr." | |||
| 824 | (defun hif-eq-expr () | 1266 | (defun hif-eq-expr () |
| 825 | "Parse an eq-expr : comp | eq-expr `=='|`!=' comp." | 1267 | "Parse an eq-expr : comp | eq-expr `=='|`!=' comp." |
| 826 | (let ((result (hif-comp-expr)) | 1268 | (let ((result (hif-comp-expr)) |
| 827 | (eq-token nil)) | 1269 | (eq-token nil)) |
| 828 | (while (memq hif-token '(hif-equal hif-notequal)) | 1270 | (while (memq hif-token '(hif-equal hif-notequal)) |
| 829 | (setq eq-token hif-token) | 1271 | (setq eq-token hif-token) |
| 830 | (hif-nexttoken) | 1272 | (hif-nexttoken) |
| @@ -857,7 +1299,9 @@ expr : or-expr | or-expr `?' expr `:' expr." | |||
| 857 | math : muldiv | math `+'|`-' muldiv." | 1299 | math : muldiv | math `+'|`-' muldiv." |
| 858 | (let ((result (hif-muldiv-expr)) | 1300 | (let ((result (hif-muldiv-expr)) |
| 859 | (math-op nil)) | 1301 | (math-op nil)) |
| 860 | (while (memq hif-token '(hif-plus hif-minus)) | 1302 | (while (or (memq hif-token '(hif-plus hif-minus)) |
| 1303 | ;; One token lookahead | ||
| 1304 | (hif-split-signed-token)) | ||
| 861 | (setq math-op hif-token) | 1305 | (setq math-op hif-token) |
| 862 | (hif-nexttoken) | 1306 | (hif-nexttoken) |
| 863 | (setq result (list math-op result (hif-muldiv-expr)))) | 1307 | (setq result (list math-op result (hif-muldiv-expr)))) |
| @@ -876,7 +1320,7 @@ expr : or-expr | or-expr `?' expr `:' expr." | |||
| 876 | 1320 | ||
| 877 | (defun hif-factor () | 1321 | (defun hif-factor () |
| 878 | "Parse a factor. | 1322 | "Parse a factor. |
| 879 | factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' | | 1323 | factor : `!' factor | `~' factor | `(' exprlist `)' | `defined(' id `)' | |
| 880 | id `(' parmlist `)' | strings | id." | 1324 | id `(' parmlist `)' | strings | id." |
| 881 | (cond | 1325 | (cond |
| 882 | ((eq hif-token 'hif-not) | 1326 | ((eq hif-token 'hif-not) |
| @@ -908,10 +1352,14 @@ factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' | | |||
| 908 | (hif-nexttoken) | 1352 | (hif-nexttoken) |
| 909 | `(hif-defined (quote ,ident)))) | 1353 | `(hif-defined (quote ,ident)))) |
| 910 | 1354 | ||
| 1355 | ((stringp hif-token) | ||
| 1356 | (if (get-text-property 0 'hif-value hif-token) | ||
| 1357 | ;; new hideif internal number format for string concatenation | ||
| 1358 | (prog1 hif-token (hif-nexttoken)) | ||
| 1359 | (hif-string-concatenation))) | ||
| 1360 | |||
| 911 | ((numberp hif-token) | 1361 | ((numberp hif-token) |
| 912 | (prog1 hif-token (hif-nexttoken))) | 1362 | (prog1 hif-token (hif-nexttoken))) |
| 913 | ((stringp hif-token) | ||
| 914 | (hif-string-concatenation)) | ||
| 915 | 1363 | ||
| 916 | ;; Unary plus/minus. | 1364 | ;; Unary plus/minus. |
| 917 | ((memq hif-token '(hif-minus hif-plus)) | 1365 | ((memq hif-token '(hif-minus hif-plus)) |
| @@ -924,12 +1372,12 @@ factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' | | |||
| 924 | (hif-place-macro-invocation ident) | 1372 | (hif-place-macro-invocation ident) |
| 925 | `(hif-lookup (quote ,ident))))))) | 1373 | `(hif-lookup (quote ,ident))))))) |
| 926 | 1374 | ||
| 927 | (defun hif-get-argument-list () | 1375 | (defun hif-get-argument-list (&optional keep-space) |
| 928 | (let ((nest 0) | 1376 | (let ((nest 0) |
| 929 | (parmlist nil) ; A "token" list of parameters, will later be parsed | 1377 | (parmlist nil) ; A "token" list of parameters, will later be parsed |
| 930 | (parm nil)) | 1378 | (parm nil)) |
| 931 | 1379 | ||
| 932 | (while (or (not (eq (hif-nexttoken) 'hif-rparen)) | 1380 | (while (or (not (eq (hif-nexttoken keep-space) 'hif-rparen)) |
| 933 | (/= nest 0)) | 1381 | (/= nest 0)) |
| 934 | (if (eq (car (last parm)) 'hif-comma) | 1382 | (if (eq (car (last parm)) 'hif-comma) |
| 935 | (setq parm nil)) | 1383 | (setq parm nil)) |
| @@ -945,7 +1393,7 @@ factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' | | |||
| 945 | (push hif-token parm)) | 1393 | (push hif-token parm)) |
| 946 | 1394 | ||
| 947 | (push (nreverse parm) parmlist) ; Okay even if PARM is nil | 1395 | (push (nreverse parm) parmlist) ; Okay even if PARM is nil |
| 948 | (hif-nexttoken) ; Drop the `hif-rparen', get next token | 1396 | (hif-nexttoken keep-space) ; Drop the `hif-rparen', get next token |
| 949 | (nreverse parmlist))) | 1397 | (nreverse parmlist))) |
| 950 | 1398 | ||
| 951 | (defun hif-place-macro-invocation (ident) | 1399 | (defun hif-place-macro-invocation (ident) |
| @@ -973,10 +1421,21 @@ This macro cannot be evaluated alone without parameters input." | |||
| 973 | (cond | 1421 | (cond |
| 974 | ((numberp a) | 1422 | ((numberp a) |
| 975 | (number-to-string a)) | 1423 | (number-to-string a)) |
| 976 | ((atom a) | ||
| 977 | (symbol-name a)) | ||
| 978 | ((stringp a) | 1424 | ((stringp a) |
| 979 | (concat "\"" a "\"")) | 1425 | ;; Remove properties here otherwise a string like "0x12 + 0x34" will be |
| 1426 | ;; later evaluated as (0x12 + 0x34) and become 0x70. | ||
| 1427 | ;; See also `hif-eval' and `hif-mathify'. | ||
| 1428 | (concat (substring-no-properties a) | ||
| 1429 | (if (get-text-property 0 'hif-space a) " "))) | ||
| 1430 | ((atom a) | ||
| 1431 | (if (memq a hif-valid-token-list) | ||
| 1432 | (car (rassq a hif-token-alist)) | ||
| 1433 | (if (eq a 'hif-space) | ||
| 1434 | " " | ||
| 1435 | (symbol-name a)))) | ||
| 1436 | ((listp a) ;; stringify each element then concat | ||
| 1437 | (cl-loop for e in a | ||
| 1438 | concat (hif-stringify e))) | ||
| 980 | (t | 1439 | (t |
| 981 | (error "Invalid token to stringify")))) | 1440 | (error "Invalid token to stringify")))) |
| 982 | 1441 | ||
| @@ -984,32 +1443,34 @@ This macro cannot be evaluated alone without parameters input." | |||
| 984 | (if (stringp str) | 1443 | (if (stringp str) |
| 985 | (intern str))) | 1444 | (intern str))) |
| 986 | 1445 | ||
| 987 | (defun hif-token-concat (a b) | 1446 | (defun hif-token-concat (l) |
| 988 | "Concatenate two tokens into a longer token. | 1447 | "Concatenate a list of tokens into a longer token. |
| 989 | Currently support only simple token concatenation. Also support weird (but | 1448 | Also support weird (but valid) token concatenation like `>' ## `>' becomes `>>'. |
| 990 | valid) token concatenation like `>' ## `>' becomes `>>'. Here we take care only | 1449 | Here we take care only those that can be evaluated during preprocessing time and |
| 991 | those that can be evaluated during preprocessing time and ignore all those that | 1450 | ignore all those that can only be evaluated at C(++) runtime (like `++', `--' |
| 992 | can only be evaluated at C(++) runtime (like `++', `--' and `+='...)." | 1451 | and `+='...)." |
| 993 | (if (or (memq a hif-valid-token-list) | 1452 | (let ((str nil)) |
| 994 | (memq b hif-valid-token-list)) | 1453 | (dolist (i l) |
| 995 | (let* ((ra (car (rassq a hif-token-alist))) | 1454 | ;;(assert (not (eq i 'hif-space)) nil ;; debug |
| 996 | (rb (car (rassq b hif-token-alist))) | 1455 | ;; "Internal error: should not be concatenating `hif-space'") |
| 997 | (result (and ra rb | 1456 | (setq str |
| 998 | (cdr (assoc (concat ra rb) hif-token-alist))))) | 1457 | (concat str |
| 999 | (or result | 1458 | (if (memq i hif-valid-token-list) |
| 1000 | ;;(error "Invalid token to concatenate") | 1459 | (car (rassq i hif-token-alist)) |
| 1001 | (error "Concatenating \"%s\" and \"%s\" does not give a valid \ | 1460 | (hif-stringify i))))) |
| 1002 | preprocessing token" | 1461 | ;; Check if it's a number, if yes, return the number instead of a symbol. |
| 1003 | (or ra (symbol-name a)) | 1462 | ;; 'hif-value and 'hif-space properties are trimmed off by `hif-stringify' |
| 1004 | (or rb (symbol-name b))))) | 1463 | (hif-strtok str t))) |
| 1005 | (intern-safe (concat (hif-stringify a) | ||
| 1006 | (hif-stringify b))))) | ||
| 1007 | 1464 | ||
| 1008 | (defun hif-mathify (val) | 1465 | (defun hif-mathify (val) |
| 1009 | "Treat VAL as a number: if it's t or nil, use 1 or 0." | 1466 | "Treat VAL as a hideif number: if it's t or nil, use 1 or 0." |
| 1010 | (cond ((eq val t) 1) | 1467 | (cond |
| 1011 | ((null val) 0) | 1468 | ((stringp val) |
| 1012 | (t val))) | 1469 | (or (get-text-property 0 'hif-value val) |
| 1470 | val)) | ||
| 1471 | ((eq val t) 1) | ||
| 1472 | ((null val) 0) | ||
| 1473 | (t val))) | ||
| 1013 | 1474 | ||
| 1014 | (defun hif-conditional (a b c) | 1475 | (defun hif-conditional (a b c) |
| 1015 | (if (not (zerop (hif-mathify a))) (hif-mathify b) (hif-mathify c))) | 1476 | (if (not (zerop (hif-mathify a))) (hif-mathify b) (hif-mathify c))) |
| @@ -1053,49 +1514,108 @@ preprocessing token" | |||
| 1053 | (defalias 'hif-logxor (hif-mathify-binop logxor)) | 1514 | (defalias 'hif-logxor (hif-mathify-binop logxor)) |
| 1054 | (defalias 'hif-logand (hif-mathify-binop logand)) | 1515 | (defalias 'hif-logand (hif-mathify-binop logand)) |
| 1055 | 1516 | ||
| 1517 | (defun hif-__LINE__ () | ||
| 1518 | (line-number-at-pos)) | ||
| 1519 | |||
| 1520 | (defun hif-__FILE__ () | ||
| 1521 | (file-name-nondirectory (buffer-file-name))) | ||
| 1522 | |||
| 1523 | (defvar hif-__COUNTER__ 0) | ||
| 1524 | (defun hif-__COUNTER__ () | ||
| 1525 | (prog1 hif-__COUNTER__ (cl-incf hif-__COUNTER__))) | ||
| 1526 | |||
| 1527 | (defun hif-__cplusplus () | ||
| 1528 | (and (string-match | ||
| 1529 | "\\.c\\(c\\|xx\\|pp\\|\\+\\+\\)\\'" | ||
| 1530 | (buffer-file-name)) | ||
| 1531 | (memq major-mode '(c++-mode cc-mode cpp-mode)) | ||
| 1532 | 201710)) | ||
| 1533 | |||
| 1534 | (defun hif-__DATE__ () | ||
| 1535 | (format-time-string "%Y/%m/%d")) | ||
| 1536 | |||
| 1537 | (defun hif-__TIME__ () | ||
| 1538 | (format-time-string "%H:%M:%S")) | ||
| 1539 | |||
| 1540 | (defun hif-__STDC__ () 1) | ||
| 1541 | (defun hif-__STDC_VERSION__ () 201710) | ||
| 1542 | (defun hif-__STDC_HOST__ () 1) | ||
| 1056 | 1543 | ||
| 1057 | (defun hif-comma (&rest expr) | 1544 | (defun hif-comma (&rest expr) |
| 1058 | "Evaluate a list of EXPR, return the result of the last item." | 1545 | "Evaluate a list of EXPR, return the result of the last item." |
| 1059 | (let ((result nil)) | 1546 | (let ((result nil)) |
| 1060 | (dolist (e expr) | 1547 | (dolist (e expr result) |
| 1061 | (ignore-errors | 1548 | (ignore-errors |
| 1062 | (setq result (funcall hide-ifdef-evaluator e)))) | 1549 | (setq result (funcall hide-ifdef-evaluator e)))))) |
| 1063 | result)) | ||
| 1064 | 1550 | ||
| 1065 | (defun hif-token-stringification (l) | 1551 | (defun hif-token-stringification (l) |
| 1066 | "Scan token list for `hif-stringify' ('#') token and stringify the next token." | 1552 | "Scan token list for `hif-stringify' (`#') token and stringify the next token." |
| 1067 | (let (result) | 1553 | (if (memq 'hif-stringify l) |
| 1068 | (while l | 1554 | (let (result) |
| 1069 | (push (if (eq (car l) 'hif-stringify) | 1555 | (while l |
| 1070 | (prog1 | 1556 | (push (if (eq (car l) 'hif-stringify) |
| 1071 | (if (cadr l) | 1557 | (prog1 |
| 1072 | (hif-stringify (cadr l)) | 1558 | (if (cadr l) |
| 1073 | (error "No token to stringify")) | 1559 | (hif-stringify (cadr l)) |
| 1074 | (setq l (cdr l))) | 1560 | (error "No token to stringify")) |
| 1075 | (car l)) | 1561 | (setq l (cdr l))) |
| 1076 | result) | 1562 | (car l)) |
| 1077 | (setq l (cdr l))) | 1563 | result) |
| 1078 | (nreverse result))) | 1564 | (setq l (cdr l))) |
| 1565 | (nreverse result)) | ||
| 1566 | ;; no `#' presents | ||
| 1567 | l)) | ||
| 1079 | 1568 | ||
| 1080 | (defun hif-token-concatenation (l) | 1569 | (defun hif-token-concatenation (l) |
| 1081 | "Scan token list for `hif-token-concat' ('##') token and concatenate two tokens." | 1570 | "Scan token list for `hif-token-concat' ('##') token and concatenate tokens." |
| 1082 | (let ((prev nil) | 1571 | (if (memq 'hif-token-concat l) |
| 1083 | result) | 1572 | ;; Notice that after some substitutions, there could be more than |
| 1084 | (while l | 1573 | ;; one `hif-space' in a list. |
| 1085 | (while (eq (car l) 'hif-token-concat) | 1574 | (let ((items nil) |
| 1086 | (unless prev | 1575 | (tk nil) |
| 1087 | (error "No token before ## to concatenate")) | 1576 | (count 0) ; count of `##' |
| 1088 | (unless (cdr l) | 1577 | result) |
| 1089 | (error "No token after ## to concatenate")) | 1578 | (setq l (hif-keep-single l 'hif-space)) |
| 1090 | (setq prev (hif-token-concat prev (cadr l))) | 1579 | (while (setq tk (car l)) |
| 1091 | (setq l (cddr l))) | 1580 | (if (not (eq tk 'hif-token-concat)) |
| 1092 | (if prev | 1581 | ;; In reverse order so that we don't have to use `last' or |
| 1093 | (setq result (append result (list prev)))) | 1582 | ;; `butlast' |
| 1094 | (setq prev (car l) | 1583 | (progn |
| 1095 | l (cdr l))) | 1584 | (push tk result) |
| 1096 | (if prev | 1585 | (setq l (cdr l))) |
| 1097 | (append result (list prev)) | 1586 | ;; First `##' met, start `##' sequence |
| 1098 | result))) | 1587 | ;; We only drop `hif-space' when doing token concatenation |
| 1588 | (setq items nil | ||
| 1589 | count 0) | ||
| 1590 | (setq tk (pop result)) | ||
| 1591 | (if (or (null tk) | ||
| 1592 | (and (eq tk 'hif-space) | ||
| 1593 | (null (setq tk (pop result))))) | ||
| 1594 | (error "No token before `##' to concatenate") | ||
| 1595 | (push tk items) ; first item, in reverse order | ||
| 1596 | (setq tk 'hif-token-concat)) | ||
| 1597 | (while (eq tk 'hif-token-concat) | ||
| 1598 | (cl-incf count) | ||
| 1599 | ;; 2+ item | ||
| 1600 | (setq l (cdr l) | ||
| 1601 | tk (car l)) | ||
| 1602 | ;; only one 'hif-space could appear here | ||
| 1603 | (if (eq tk 'hif-space) ; ignore it | ||
| 1604 | (setq l (cdr l) | ||
| 1605 | tk (car l))) | ||
| 1606 | (if (or (null tk) | ||
| 1607 | (eq tk 'hif-token-concat)) | ||
| 1608 | (error | ||
| 1609 | "No token after the %d-th `##' to concatenate at line %d" | ||
| 1610 | count (line-number-at-pos)) | ||
| 1611 | (push tk items) | ||
| 1612 | (setq l (cdr l) | ||
| 1613 | tk (car l)))) | ||
| 1614 | ;; `##' sequence ended, concat them, then push into result | ||
| 1615 | (push (hif-token-concat (nreverse items)) result))) | ||
| 1616 | (nreverse result)) | ||
| 1617 | ;; no need to reassemble the list if no `##' presents | ||
| 1618 | l)) | ||
| 1099 | 1619 | ||
| 1100 | (defun hif-delimit (lis atom) | 1620 | (defun hif-delimit (lis atom) |
| 1101 | (nconc (mapcan (lambda (l) (list l atom)) | 1621 | (nconc (mapcan (lambda (l) (list l atom)) |
| @@ -1105,7 +1625,7 @@ preprocessing token" | |||
| 1105 | ;; Perform token replacement: | 1625 | ;; Perform token replacement: |
| 1106 | (defun hif-macro-supply-arguments (macro-name actual-parms) | 1626 | (defun hif-macro-supply-arguments (macro-name actual-parms) |
| 1107 | "Expand a macro call, replace ACTUAL-PARMS in the macro body." | 1627 | "Expand a macro call, replace ACTUAL-PARMS in the macro body." |
| 1108 | (let* ((SA (assoc macro-name hide-ifdef-env)) | 1628 | (let* ((SA (assq macro-name hide-ifdef-env)) |
| 1109 | (macro (and SA | 1629 | (macro (and SA |
| 1110 | (cdr SA) | 1630 | (cdr SA) |
| 1111 | (eq (cadr SA) 'hif-define-macro) | 1631 | (eq (cadr SA) 'hif-define-macro) |
| @@ -1156,11 +1676,14 @@ preprocessing token" | |||
| 1156 | formal macro-body)) | 1676 | formal macro-body)) |
| 1157 | (setq actual-parms (cdr actual-parms))) | 1677 | (setq actual-parms (cdr actual-parms))) |
| 1158 | 1678 | ||
| 1159 | ;; Replacement completed, flatten the whole token list | 1679 | ;; Replacement completed, stringifiy and concatenate the token list. |
| 1160 | (setq macro-body (flatten-tree macro-body)) | 1680 | ;; Stringification happens must take place before flattening, otherwise |
| 1681 | ;; only the first token will be stringified. | ||
| 1682 | (setq macro-body | ||
| 1683 | (flatten-tree (hif-token-stringification macro-body))) | ||
| 1161 | 1684 | ||
| 1162 | ;; Stringification and token concatenation happens here | 1685 | ;; Token concatenation happens here, keep single 'hif-space |
| 1163 | (hif-token-concatenation (hif-token-stringification macro-body))))) | 1686 | (hif-keep-single (hif-token-concatenation macro-body) 'hif-space)))) |
| 1164 | 1687 | ||
| 1165 | (defun hif-invoke (macro-name actual-parms) | 1688 | (defun hif-invoke (macro-name actual-parms) |
| 1166 | "Invoke a macro by expanding it, reparse macro-body and finally invoke it." | 1689 | "Invoke a macro by expanding it, reparse macro-body and finally invoke it." |
| @@ -1432,7 +1955,7 @@ Point is left unchanged." | |||
| 1432 | ;; A bit slimy. | 1955 | ;; A bit slimy. |
| 1433 | 1956 | ||
| 1434 | (defun hif-hide-line (point) | 1957 | (defun hif-hide-line (point) |
| 1435 | "Hide the line containing point. | 1958 | "Hide the line containing POINT. |
| 1436 | Does nothing if `hide-ifdef-lines' is nil." | 1959 | Does nothing if `hide-ifdef-lines' is nil." |
| 1437 | (when hide-ifdef-lines | 1960 | (when hide-ifdef-lines |
| 1438 | (save-excursion | 1961 | (save-excursion |
| @@ -1441,7 +1964,7 @@ Does nothing if `hide-ifdef-lines' is nil." | |||
| 1441 | (line-beginning-position) (progn (hif-end-of-line) (point)))))) | 1964 | (line-beginning-position) (progn (hif-end-of-line) (point)))))) |
| 1442 | 1965 | ||
| 1443 | 1966 | ||
| 1444 | ;; Hif-Possibly-Hide | 1967 | ;; hif-Possibly-Hide |
| 1445 | ;; There are four cases. The #ifX expression is "taken" if it | 1968 | ;; There are four cases. The #ifX expression is "taken" if it |
| 1446 | ;; the hide-ifdef-evaluator returns T. Presumably, this means the code | 1969 | ;; the hide-ifdef-evaluator returns T. Presumably, this means the code |
| 1447 | ;; inside the #ifdef would be included when the program was | 1970 | ;; inside the #ifdef would be included when the program was |
| @@ -1484,7 +2007,7 @@ Does nothing if `hide-ifdef-lines' is nil." | |||
| 1484 | "Called at #ifX expression, this hides those parts that should be hidden. | 2007 | "Called at #ifX expression, this hides those parts that should be hidden. |
| 1485 | It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag | 2008 | It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag |
| 1486 | indicating that we should expand the #ifdef even if it should be hidden. | 2009 | indicating that we should expand the #ifdef even if it should be hidden. |
| 1487 | Refer to `hide-ifdef-expand-reinclusion-protection' for more details." | 2010 | Refer to `hide-ifdef-expand-reinclusion-guard' for more details." |
| 1488 | ;; (message "hif-possibly-hide") (sit-for 1) | 2011 | ;; (message "hif-possibly-hide") (sit-for 1) |
| 1489 | (let* ((case-fold-search nil) | 2012 | (let* ((case-fold-search nil) |
| 1490 | (test (hif-canonicalize hif-ifx-regexp)) | 2013 | (test (hif-canonicalize hif-ifx-regexp)) |
| @@ -1564,23 +2087,83 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for more details." | |||
| 1564 | (result (funcall hide-ifdef-evaluator expr))) | 2087 | (result (funcall hide-ifdef-evaluator expr))) |
| 1565 | result)) | 2088 | result)) |
| 1566 | 2089 | ||
| 2090 | (defun hif-display-macro (name def &optional result) | ||
| 2091 | (if (and def | ||
| 2092 | (listp def) | ||
| 2093 | (eq (car def) 'hif-define-macro)) | ||
| 2094 | (let ((cdef (concat "#define " name)) | ||
| 2095 | (parmlist (cadr def)) | ||
| 2096 | s) | ||
| 2097 | (setq def (caddr def)) | ||
| 2098 | ;; parmlist | ||
| 2099 | (when parmlist | ||
| 2100 | (setq cdef (concat cdef "(")) | ||
| 2101 | (while (car parmlist) | ||
| 2102 | (setq cdef (concat cdef (symbol-name (car parmlist)) | ||
| 2103 | (if (cdr parmlist) ",")) | ||
| 2104 | parmlist (cdr parmlist))) | ||
| 2105 | (setq cdef (concat cdef ")"))) | ||
| 2106 | (setq cdef (concat cdef " ")) | ||
| 2107 | ;; body | ||
| 2108 | (while def | ||
| 2109 | (if (listp def) | ||
| 2110 | (setq s (car def) | ||
| 2111 | def (cdr def)) | ||
| 2112 | (setq s def | ||
| 2113 | def nil)) | ||
| 2114 | (setq cdef | ||
| 2115 | (concat cdef | ||
| 2116 | (cond | ||
| 2117 | ;;((setq tok (car (rassoc s hif-token-alist))) | ||
| 2118 | ;; (concat tok (if (eq s 'hif-comma) " "))) | ||
| 2119 | ((symbolp s) | ||
| 2120 | (concat (hif-stringify s) | ||
| 2121 | (if (eq s 'hif-comma) " "))) | ||
| 2122 | ((stringp s) | ||
| 2123 | (hif-stringify s)) | ||
| 2124 | (t ;; (numberp s) | ||
| 2125 | (format "%S" s)))))) | ||
| 2126 | (if (and result | ||
| 2127 | ;; eg: "#define RECURSIVE_SYMBOL RECURSIVE_SYMBOL" | ||
| 2128 | (not (and (listp result) | ||
| 2129 | (eq (car result) 'hif-define-macro)))) | ||
| 2130 | (setq cdef (concat cdef | ||
| 2131 | (if (integerp result) | ||
| 2132 | (format "\n=> %S (%#x)" result result) | ||
| 2133 | (format "\n=> %S" result))))) | ||
| 2134 | (message "%s" cdef)) | ||
| 2135 | (message "%S <= `%s'" def name))) | ||
| 2136 | |||
| 1567 | (defun hif-evaluate-macro (rstart rend) | 2137 | (defun hif-evaluate-macro (rstart rend) |
| 1568 | "Evaluate the macro expansion result for the active region. | 2138 | "Evaluate the macro expansion result for the active region. |
| 1569 | If no region active, find the current #ifdefs and evaluate the result. | 2139 | If no region is currently active, find the current #ifdef/#define and evaluate |
| 2140 | the result; otherwise it looks for current word at point. | ||
| 1570 | Currently it supports only math calculations, strings or argumented macros can | 2141 | Currently it supports only math calculations, strings or argumented macros can |
| 1571 | not be expanded." | 2142 | not be expanded. |
| 2143 | This function by default ignores parsing error and return `false' on evaluating | ||
| 2144 | runtime C(++) statements or tokens that normal C(++) preprocessor can't perform; | ||
| 2145 | however, when this command is prefixed, it will display the error instead." | ||
| 1572 | (interactive | 2146 | (interactive |
| 1573 | (if (use-region-p) | 2147 | (if (not (use-region-p)) |
| 1574 | (list (region-beginning) (region-end)) | 2148 | '(nil nil) |
| 1575 | '(nil nil))) | 2149 | (list (region-beginning) (region-end)))) |
| 1576 | (let ((case-fold-search nil)) | 2150 | (run-hooks 'hide-ifdef-evalulate-enter-hook) |
| 2151 | (let ((case-fold-search nil) | ||
| 2152 | (currpnt (point)) | ||
| 2153 | bounds) | ||
| 1577 | (save-excursion | 2154 | (save-excursion |
| 1578 | (unless (use-region-p) | 2155 | (unless (use-region-p) |
| 1579 | (setq rstart nil rend nil) | 2156 | (setq rstart nil rend nil) |
| 1580 | (beginning-of-line) | 2157 | (beginning-of-line) |
| 1581 | (when (and (re-search-forward hif-macro-expr-prefix-regexp nil t) | 2158 | (if (and (re-search-forward hif-macro-expr-prefix-regexp nil t) |
| 1582 | (string= "define" (match-string 2))) | 2159 | (= (line-number-at-pos currpnt) (line-number-at-pos))) |
| 1583 | (re-search-forward hif-macroref-regexp nil t))) | 2160 | (if (string= "define" (match-string 2)) |
| 2161 | (re-search-forward hif-macroref-regexp nil t)) | ||
| 2162 | (goto-char currpnt) | ||
| 2163 | (setq bounds (bounds-of-thing-at-point 'word) | ||
| 2164 | ;; TODO: BOUNDS need a C++ syntax word boundary finder | ||
| 2165 | rstart (car bounds) | ||
| 2166 | rend (cdr bounds)))) | ||
| 1584 | (let* ((start (or rstart (point))) | 2167 | (let* ((start (or rstart (point))) |
| 1585 | (end (or rend (progn (hif-end-of-line) (point)))) | 2168 | (end (or rend (progn (hif-end-of-line) (point)))) |
| 1586 | (defined nil) | 2169 | (defined nil) |
| @@ -1588,34 +2171,61 @@ not be expanded." | |||
| 1588 | (tokens (ignore-errors ; Prevent C statement things like | 2171 | (tokens (ignore-errors ; Prevent C statement things like |
| 1589 | ; 'do { ... } while (0)' | 2172 | ; 'do { ... } while (0)' |
| 1590 | (hif-tokenize start end))) | 2173 | (hif-tokenize start end))) |
| 2174 | ;; Note that on evaluating we can't simply define the symbol | ||
| 2175 | ;; even if we are currently at a #define line, as this #define | ||
| 2176 | ;; might actually be wrapped up in a #if 0 block. We can only | ||
| 2177 | ;; define that explicitly with `hide-ifdef-define'. | ||
| 1591 | (expr (or (and (<= (length tokens) 1) ; Simple token | 2178 | (expr (or (and (<= (length tokens) 1) ; Simple token |
| 1592 | (setq defined (assoc (car tokens) hide-ifdef-env)) | 2179 | (setq defined |
| 2180 | (or (assq (car tokens) hide-ifdef-env) | ||
| 2181 | (assq (car tokens) hif-predefine-alist))) | ||
| 1593 | (setq simple (atom (hif-lookup (car tokens)))) | 2182 | (setq simple (atom (hif-lookup (car tokens)))) |
| 1594 | (hif-lookup (car tokens))) | 2183 | (hif-lookup (car tokens))) |
| 1595 | (and tokens | 2184 | (and tokens |
| 1596 | (condition-case nil | 2185 | (condition-case err |
| 1597 | (hif-parse-exp tokens) | 2186 | (hif-parse-exp tokens) |
| 1598 | (error | 2187 | (error |
| 1599 | nil))))) | 2188 | ;; when prefixed, pass the error on for later |
| 1600 | (result (funcall hide-ifdef-evaluator expr)) | 2189 | ;; `hide-ifdef-evaluator' |
| 1601 | (exprstring (replace-regexp-in-string | 2190 | (if current-prefix-arg err)))))) |
| 1602 | ;; Trim off leading/trailing whites | 2191 | (exprstring (hif-stringify tokens)) |
| 1603 | "^[ \t]*\\|[ \t]*$" "" | 2192 | (result (condition-case err |
| 1604 | (replace-regexp-in-string | 2193 | (funcall hide-ifdef-evaluator expr) |
| 1605 | "\\(//.*\\)" "" ; Trim off end-of-line comments | 2194 | ;; in case of arithmetic error or others |
| 1606 | (buffer-substring-no-properties start end))))) | 2195 | (error (error "Error: line %d %S when evaluating `%s'" |
| 1607 | (cond | 2196 | (line-number-at-pos) err exprstring))))) |
| 1608 | ((and (<= (length tokens) 1) simple) ; Simple token | 2197 | (setq |
| 1609 | (if defined | 2198 | result |
| 1610 | (message "%S <= `%s'" result exprstring) | 2199 | (cond |
| 1611 | (message "`%s' is not defined" exprstring))) | 2200 | ((= (length tokens) 0) |
| 1612 | ((integerp result) | 2201 | (message "`%s'" exprstring)) |
| 1613 | (if (or (= 0 result) (= 1 result)) | 2202 | ((= (length tokens) 1) ; Simple token |
| 1614 | (message "%S <= `%s'" result exprstring) | 2203 | (if simple |
| 1615 | (message "%S (%#x) <= `%s'" result result exprstring))) | 2204 | (if defined |
| 1616 | ((null result) (message "%S <= `%s'" 'false exprstring)) | 2205 | (hif-display-macro exprstring result) |
| 1617 | ((eq t result) (message "%S <= `%s'" 'true exprstring)) | 2206 | (if (and (hif-is-number exprstring) |
| 1618 | (t (message "%S <= `%s'" result exprstring))) | 2207 | result (numberp result)) |
| 2208 | (message "%S (%#x)" result result) | ||
| 2209 | (if (and (hif-is-float exprstring) | ||
| 2210 | result (numberp result)) | ||
| 2211 | (message "%S (%s)" result exprstring) | ||
| 2212 | (if (string-match hif-string-literal-regexp exprstring) | ||
| 2213 | (message "%s" exprstring) | ||
| 2214 | (message "`%s' is not defined" exprstring))))) | ||
| 2215 | (if defined | ||
| 2216 | (hif-display-macro exprstring (cdr defined) result) | ||
| 2217 | (message "`%s' is not defined" exprstring)))) | ||
| 2218 | ((integerp result) | ||
| 2219 | (if (or (= 0 result) (= 1 result)) | ||
| 2220 | (message "%S <= `%s'" result exprstring) | ||
| 2221 | (message "%S (%#x) <= `%s'" result result exprstring))) | ||
| 2222 | ((null result) | ||
| 2223 | (message "%S <= `%s'" 'false exprstring)) | ||
| 2224 | ((eq t result) | ||
| 2225 | (message "%S <= `%s'" 'true exprstring)) | ||
| 2226 | (t | ||
| 2227 | (message "%S <= `%s'" result exprstring)))) | ||
| 2228 | (run-hooks 'hide-ifdef-evalulate-leave-hook) | ||
| 1619 | result)))) | 2229 | result)))) |
| 1620 | 2230 | ||
| 1621 | (defun hif-parse-macro-arglist (str) | 2231 | (defun hif-parse-macro-arglist (str) |
| @@ -1667,6 +2277,8 @@ first arg will be `hif-etc'." | |||
| 1667 | ;; the performance I use this `hif-simple-token-only' to notify my code and | 2277 | ;; the performance I use this `hif-simple-token-only' to notify my code and |
| 1668 | ;; save the final [value] into symbol database. [lukelee] | 2278 | ;; save the final [value] into symbol database. [lukelee] |
| 1669 | 2279 | ||
| 2280 | (defvar hif-verbose-define-count 0) | ||
| 2281 | |||
| 1670 | (defun hif-find-define (&optional min max) | 2282 | (defun hif-find-define (&optional min max) |
| 1671 | "Parse texts and retrieve all defines within the region MIN and MAX." | 2283 | "Parse texts and retrieve all defines within the region MIN and MAX." |
| 1672 | (interactive) | 2284 | (interactive) |
| @@ -1676,8 +2288,11 @@ first arg will be `hif-etc'." | |||
| 1676 | (let* ((defining (string= "define" (match-string 2))) | 2288 | (let* ((defining (string= "define" (match-string 2))) |
| 1677 | (name (and (re-search-forward hif-macroref-regexp max t) | 2289 | (name (and (re-search-forward hif-macroref-regexp max t) |
| 1678 | (match-string 1))) | 2290 | (match-string 1))) |
| 1679 | (parmlist (and (match-string 3) ; First arg id found | 2291 | (parmlist (or (and (match-string 3) ; First arg id found |
| 1680 | (hif-parse-macro-arglist (match-string 2))))) | 2292 | (delq 'hif-space |
| 2293 | (hif-parse-macro-arglist (match-string 2)))) | ||
| 2294 | (and (match-string 2) ; empty arglist | ||
| 2295 | (list nil))))) | ||
| 1681 | (if defining | 2296 | (if defining |
| 1682 | ;; Ignore name (still need to return 't), or define the name | 2297 | ;; Ignore name (still need to return 't), or define the name |
| 1683 | (or (and hide-ifdef-exclude-define-regexp | 2298 | (or (and hide-ifdef-exclude-define-regexp |
| @@ -1689,6 +2304,14 @@ first arg will be `hif-etc'." | |||
| 1689 | (hif-simple-token-only nil) ; Dynamic binding | 2304 | (hif-simple-token-only nil) ; Dynamic binding |
| 1690 | (tokens | 2305 | (tokens |
| 1691 | (and name | 2306 | (and name |
| 2307 | (prog1 t | ||
| 2308 | (cl-incf hif-verbose-define-count) | ||
| 2309 | ;; only show 1/50 to not slow down to much | ||
| 2310 | (if (and hide-ifdef-verbose | ||
| 2311 | (= (% hif-verbose-define-count 50) 1)) | ||
| 2312 | (message "[Line %d] defining %S" | ||
| 2313 | (line-number-at-pos (point)) | ||
| 2314 | (substring-no-properties name)))) | ||
| 1692 | ;; `hif-simple-token-only' is set/clear | 2315 | ;; `hif-simple-token-only' is set/clear |
| 1693 | ;; only in this block | 2316 | ;; only in this block |
| 1694 | (condition-case nil | 2317 | (condition-case nil |
| @@ -1700,8 +2323,10 @@ first arg will be `hif-etc'." | |||
| 1700 | ;; this will stop hideif from searching | 2323 | ;; this will stop hideif from searching |
| 1701 | ;; for more #defines. | 2324 | ;; for more #defines. |
| 1702 | (setq hif-simple-token-only t) | 2325 | (setq hif-simple-token-only t) |
| 1703 | (buffer-substring-no-properties | 2326 | (replace-regexp-in-string |
| 1704 | start end))))) | 2327 | "^[ \t]*\\|[ \t]*$" "" |
| 2328 | (buffer-substring-no-properties | ||
| 2329 | start end)))))) | ||
| 1705 | ;; For simple tokens we save only the parsed result; | 2330 | ;; For simple tokens we save only the parsed result; |
| 1706 | ;; otherwise we save the tokens and parse it after | 2331 | ;; otherwise we save the tokens and parse it after |
| 1707 | ;; parameter replacement | 2332 | ;; parameter replacement |
| @@ -1715,17 +2340,19 @@ first arg will be `hif-etc'." | |||
| 1715 | `(hif-define-macro ,parmlist | 2340 | `(hif-define-macro ,parmlist |
| 1716 | ,tokens)))) | 2341 | ,tokens)))) |
| 1717 | (SA (and name | 2342 | (SA (and name |
| 1718 | (assoc (intern name) hide-ifdef-env)))) | 2343 | (assq (intern name) hide-ifdef-env)))) |
| 1719 | (and name | 2344 | (and name |
| 1720 | (if SA | 2345 | (if SA |
| 1721 | (or (setcdr SA expr) t) | 2346 | (or (setcdr SA expr) t) |
| 1722 | ;; Lazy evaluation, eval only if hif-lookup find it. | 2347 | ;; Lazy evaluation, eval only if `hif-lookup' find it. |
| 1723 | ;; Define it anyway, even if nil it's still in list | 2348 | ;; Define it anyway, even if nil it's still in list |
| 1724 | ;; and therefore considered defined. | 2349 | ;; and therefore considered defined. |
| 1725 | (push (cons (intern name) expr) hide-ifdef-env))))) | 2350 | (push (cons (intern name) expr) hide-ifdef-env))))) |
| 1726 | ;; #undef | 2351 | ;; #undef |
| 1727 | (and name | 2352 | (and name |
| 1728 | (hif-undefine-symbol (intern name)))))) | 2353 | (intern-soft name) |
| 2354 | (hif-undefine-symbol (intern name))) | ||
| 2355 | t))) | ||
| 1729 | t)) | 2356 | t)) |
| 1730 | 2357 | ||
| 1731 | 2358 | ||
| @@ -1735,7 +2362,10 @@ first arg will be `hif-etc'." | |||
| 1735 | (save-excursion | 2362 | (save-excursion |
| 1736 | (save-restriction | 2363 | (save-restriction |
| 1737 | ;; (mark-region min max) ;; for debugging | 2364 | ;; (mark-region min max) ;; for debugging |
| 2365 | (setq hif-verbose-define-count 0) | ||
| 2366 | (forward-comment (point-max)) | ||
| 1738 | (while (hif-find-define min max) | 2367 | (while (hif-find-define min max) |
| 2368 | (forward-comment (point-max)) | ||
| 1739 | (setf min (point))) | 2369 | (setf min (point))) |
| 1740 | (if max (goto-char max) | 2370 | (if max (goto-char max) |
| 1741 | (goto-char (point-max)))))) | 2371 | (goto-char (point-max)))))) |
| @@ -1745,22 +2375,31 @@ first arg will be `hif-etc'." | |||
| 1745 | It does not do the work that's pointless to redo on a recursive entry." | 2375 | It does not do the work that's pointless to redo on a recursive entry." |
| 1746 | (save-excursion | 2376 | (save-excursion |
| 1747 | (let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp' | 2377 | (let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp' |
| 1748 | (expand-header (and hide-ifdef-expand-reinclusion-protection | 2378 | (expand-header (and hide-ifdef-expand-reinclusion-guard |
| 1749 | (buffer-file-name) | 2379 | (buffer-file-name) |
| 1750 | (string-match hide-ifdef-header-regexp | 2380 | (string-match hide-ifdef-header-regexp |
| 1751 | (buffer-file-name)) | 2381 | (buffer-file-name)) |
| 1752 | (zerop hif-recurse-level))) | 2382 | (zerop hif-recurse-level))) |
| 1753 | (case-fold-search nil) | 2383 | (case-fold-search nil) |
| 1754 | min max) | 2384 | min max) |
| 2385 | (setq hif-__COUNTER__ 0) | ||
| 1755 | (goto-char (point-min)) | 2386 | (goto-char (point-min)) |
| 1756 | (setf min (point)) | 2387 | (setf min (point)) |
| 1757 | (cl-loop do | 2388 | ;; Without this `condition-case' it would be easier to see which |
| 1758 | (setf max (hif-find-any-ifX)) | 2389 | ;; operation went wrong thru the backtrace `iff' user realize |
| 1759 | (hif-add-new-defines min max) | 2390 | ;; the underlying meaning of all hif-* operation; for example, |
| 1760 | (if max | 2391 | ;; `hif-shiftleft' refers to C(++) '<<' operator and floating |
| 1761 | (hif-possibly-hide expand-header)) | 2392 | ;; operation arguments would be invalid. |
| 1762 | (setf min (point)) | 2393 | (condition-case err |
| 1763 | while max)))) | 2394 | (cl-loop do |
| 2395 | (setf max (hif-find-any-ifX)) | ||
| 2396 | (hif-add-new-defines min max) | ||
| 2397 | (if max | ||
| 2398 | (hif-possibly-hide expand-header)) | ||
| 2399 | (setf min (point)) | ||
| 2400 | while max) | ||
| 2401 | (error (error "Error: failed at line %d %S" | ||
| 2402 | (line-number-at-pos) err)))))) | ||
| 1764 | 2403 | ||
| 1765 | ;;===%%SF%% hide-ifdef-hiding (End) === | 2404 | ;;===%%SF%% hide-ifdef-hiding (End) === |
| 1766 | 2405 | ||
| @@ -1821,13 +2460,17 @@ This allows #ifdef VAR to be hidden." | |||
| 1821 | nil nil t nil "1"))) | 2460 | nil nil t nil "1"))) |
| 1822 | (list var val))) | 2461 | (list var val))) |
| 1823 | (hif-set-var var (or val 1)) | 2462 | (hif-set-var var (or val 1)) |
| 1824 | (message "%s set to %s" var (or val 1)) | 2463 | (if hide-ifdef-hiding (hide-ifdefs)) |
| 1825 | (sleep-for 1) | 2464 | (message "%s set to %s" var (or val 1))) |
| 1826 | (if hide-ifdef-hiding (hide-ifdefs))) | ||
| 1827 | 2465 | ||
| 1828 | (defun hif-undefine-symbol (var) | 2466 | (defun hif-undefine-symbol (var) |
| 1829 | (setq hide-ifdef-env | 2467 | (when (assq var hide-ifdef-env) |
| 1830 | (delete (assoc var hide-ifdef-env) hide-ifdef-env))) | 2468 | (setq hide-ifdef-env |
| 2469 | (delete (assq var hide-ifdef-env) hide-ifdef-env)) | ||
| 2470 | ;; We can override things in `hif-predefine-alist' so keep them | ||
| 2471 | (unless (assq var hif-predefine-alist) | ||
| 2472 | (unintern (symbol-name var) nil)) | ||
| 2473 | t)) | ||
| 1831 | 2474 | ||
| 1832 | (defun hide-ifdef-undef (start end) | 2475 | (defun hide-ifdef-undef (start end) |
| 1833 | "Undefine a VAR so that #ifdef VAR would not be included." | 2476 | "Undefine a VAR so that #ifdef VAR would not be included." |
| @@ -1848,35 +2491,54 @@ This allows #ifdef VAR to be hidden." | |||
| 1848 | (if hide-ifdef-hiding (hide-ifdefs)) | 2491 | (if hide-ifdef-hiding (hide-ifdefs)) |
| 1849 | (message "`%S' undefined" sym)))) | 2492 | (message "`%S' undefined" sym)))) |
| 1850 | 2493 | ||
| 1851 | (defun hide-ifdefs (&optional nomsg) | 2494 | (defun hide-ifdefs (&optional start end nomsg) |
| 1852 | "Hide the contents of some #ifdefs. | 2495 | "Hide the contents of some #ifdefs. |
| 1853 | Assume that defined symbols have been added to `hide-ifdef-env'. | 2496 | Assume that defined symbols have been added to `hide-ifdef-env'. |
| 1854 | The text hidden is the text that would not be included by the C | 2497 | The text hidden is the text that would not be included by the C |
| 1855 | preprocessor if it were given the file with those symbols defined. | 2498 | preprocessor if it were given the file with those symbols defined. |
| 1856 | With prefix command presents it will also hide the #ifdefs themselves. | 2499 | With prefix command presents it will also hide the #ifdefs themselves. |
| 1857 | 2500 | ||
| 2501 | Hiding will only be performed within the marked region if there is one. | ||
| 2502 | |||
| 1858 | Turn off hiding by calling `show-ifdefs'." | 2503 | Turn off hiding by calling `show-ifdefs'." |
| 1859 | 2504 | ||
| 1860 | (interactive) | 2505 | (interactive |
| 1861 | (let ((hide-ifdef-lines current-prefix-arg)) | 2506 | (if (use-region-p) |
| 1862 | (or nomsg | 2507 | (list (region-beginning) (region-end)) |
| 1863 | (message "Hiding...")) | 2508 | (list (point-min) (point-max)))) |
| 1864 | (setq hif-outside-read-only buffer-read-only) | 2509 | |
| 1865 | (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode | 2510 | (setq current-prefix-arg (or hide-ifdef-lines current-prefix-arg)) |
| 1866 | (if hide-ifdef-hiding | 2511 | (save-restriction |
| 1867 | (show-ifdefs)) ; Otherwise, deep confusion. | 2512 | (let* ((hide-ifdef-lines current-prefix-arg) |
| 1868 | (setq hide-ifdef-hiding t) | 2513 | (outer-hide-ifdef-verbose hide-ifdef-verbose) |
| 1869 | (hide-ifdef-guts) | 2514 | (hide-ifdef-verbose (and outer-hide-ifdef-verbose |
| 1870 | (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)) | 2515 | (not (or nomsg (use-region-p))))) |
| 1871 | (or nomsg | 2516 | (hide-start-time (current-time))) |
| 1872 | (message "Hiding done")))) | 2517 | (and hide-ifdef-verbose |
| 1873 | 2518 | (message "Hiding...")) | |
| 1874 | 2519 | (setq hif-outside-read-only buffer-read-only) | |
| 1875 | (defun show-ifdefs () | 2520 | (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode |
| 2521 | (if hide-ifdef-hiding | ||
| 2522 | (show-ifdefs)) ; Otherwise, deep confusion. | ||
| 2523 | (setq hide-ifdef-hiding t) | ||
| 2524 | (narrow-to-region (or start (point-min)) (or end (point-max))) | ||
| 2525 | (hide-ifdef-guts) | ||
| 2526 | (setq buffer-read-only | ||
| 2527 | (or hide-ifdef-read-only hif-outside-read-only)) | ||
| 2528 | (and hide-ifdef-verbose | ||
| 2529 | (message "Hiding done, %.1f seconds elapsed" | ||
| 2530 | (float-time (time-subtract (current-time) | ||
| 2531 | hide-start-time))))))) | ||
| 2532 | |||
| 2533 | |||
| 2534 | (defun show-ifdefs (&optional start end) | ||
| 1876 | "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs." | 2535 | "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs." |
| 1877 | (interactive) | 2536 | (interactive |
| 2537 | (if (use-region-p) | ||
| 2538 | (list (region-beginning) (region-end)) | ||
| 2539 | (list (point-min) (point-max)))) | ||
| 1878 | (setq buffer-read-only hif-outside-read-only) | 2540 | (setq buffer-read-only hif-outside-read-only) |
| 1879 | (hif-show-all) | 2541 | (hif-show-all (or start (point-min)) (or end (point-max))) |
| 1880 | (setq hide-ifdef-hiding nil)) | 2542 | (setq hide-ifdef-hiding nil)) |
| 1881 | 2543 | ||
| 1882 | 2544 | ||
| @@ -1960,21 +2622,17 @@ With optional prefix argument ARG, also hide the #ifdefs themselves." | |||
| 1960 | 2622 | ||
| 1961 | 2623 | ||
| 1962 | ;;; definition alist support | 2624 | ;;; definition alist support |
| 2625 | ;; The old implementation that match symbol only to 't is now considered | ||
| 2626 | ;; obsolete. | ||
| 1963 | 2627 | ||
| 1964 | (defvar hide-ifdef-define-alist nil | 2628 | (defvar hide-ifdef-define-alist nil |
| 1965 | "A global assoc list of pre-defined symbol lists.") | 2629 | "A global assoc list of pre-defined symbol lists.") |
| 1966 | 2630 | ||
| 1967 | (defun hif-compress-define-list (env) | ||
| 1968 | "Compress the define list ENV into a list of defined symbols only." | ||
| 1969 | (let ((new-defs nil)) | ||
| 1970 | (dolist (def env new-defs) | ||
| 1971 | (if (hif-lookup (car def)) (push (car def) new-defs))))) | ||
| 1972 | |||
| 1973 | (defun hide-ifdef-set-define-alist (name) | 2631 | (defun hide-ifdef-set-define-alist (name) |
| 1974 | "Set the association for NAME to `hide-ifdef-env'." | 2632 | "Set the association for NAME to `hide-ifdef-env'." |
| 1975 | (interactive "SSet define list: ") | 2633 | (interactive "SSet define list: ") |
| 1976 | (push (cons name (hif-compress-define-list hide-ifdef-env)) | 2634 | (push (cons name hide-ifdef-env) |
| 1977 | hide-ifdef-define-alist)) | 2635 | hide-ifdef-define-alist)) |
| 1978 | 2636 | ||
| 1979 | (defun hide-ifdef-use-define-alist (name) | 2637 | (defun hide-ifdef-use-define-alist (name) |
| 1980 | "Set `hide-ifdef-env' to the define list specified by NAME." | 2638 | "Set `hide-ifdef-env' to the define list specified by NAME." |
| @@ -1986,9 +2644,8 @@ With optional prefix argument ARG, also hide the #ifdefs themselves." | |||
| 1986 | (if (stringp name) (setq name (intern name))) | 2644 | (if (stringp name) (setq name (intern name))) |
| 1987 | (let ((define-list (assoc name hide-ifdef-define-alist))) | 2645 | (let ((define-list (assoc name hide-ifdef-define-alist))) |
| 1988 | (if define-list | 2646 | (if define-list |
| 1989 | (setq hide-ifdef-env | 2647 | (setq hide-ifdef-env |
| 1990 | (mapcar (lambda (arg) (cons arg t)) | 2648 | (cdr define-list)) |
| 1991 | (cdr define-list))) | ||
| 1992 | (error "No define list for %s" name)) | 2649 | (error "No define list for %s" name)) |
| 1993 | (if hide-ifdef-hiding (hide-ifdefs)))) | 2650 | (if hide-ifdef-hiding (hide-ifdefs)))) |
| 1994 | 2651 | ||
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 5d877fc6ba3..aff3066c698 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el | |||
| @@ -461,7 +461,7 @@ Non-nil means always go to the next Octave code line after sending." | |||
| 461 | ;; For (invalid) code between switch and case. | 461 | ;; For (invalid) code between switch and case. |
| 462 | ;; (if (smie-rule-parent-p "switch") 4) | 462 | ;; (if (smie-rule-parent-p "switch") 4) |
| 463 | nil)) | 463 | nil)) |
| 464 | ('(:after . "=") octave-block-offset))) | 464 | ('(:after . "=") (smie-rule-parent octave-block-offset)))) |
| 465 | 465 | ||
| 466 | (defun octave-indent-comment () | 466 | (defun octave-indent-comment () |
| 467 | "A function for `smie-indent-functions' (which see)." | 467 | "A function for `smie-indent-functions' (which see)." |
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index fd23683bc0a..f49ee4cb2b5 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el | |||
| @@ -285,7 +285,7 @@ | |||
| 285 | (put-text-property (match-beginning 2) (match-end 2) | 285 | (put-text-property (match-beginning 2) (match-end 2) |
| 286 | 'syntax-table (string-to-syntax "\"")) | 286 | 'syntax-table (string-to-syntax "\"")) |
| 287 | (perl-syntax-propertize-special-constructs end))))) | 287 | (perl-syntax-propertize-special-constructs end))))) |
| 288 | ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" | 288 | ("\\(^\\|[?:.,;=|&!~({[ \t]\\|=>\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\(?:\\s-\\|\n\\)*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" |
| 289 | ;; Nasty cases: | 289 | ;; Nasty cases: |
| 290 | ;; /foo/m $a->m $#m $m @m %m | 290 | ;; /foo/m $a->m $#m $m @m %m |
| 291 | ;; \s (appears often in regexps). | 291 | ;; \s (appears often in regexps). |
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index d307c31df8b..b7a926f82e0 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -1464,7 +1464,7 @@ IGNORES is a list of glob patterns for files to ignore." | |||
| 1464 | ;; do that reliably enough, without creating false negatives? | 1464 | ;; do that reliably enough, without creating false negatives? |
| 1465 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) | 1465 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) |
| 1466 | files | 1466 | files |
| 1467 | (file-name-as-directory | 1467 | (directory-file-name |
| 1468 | (file-name-unquote | 1468 | (file-name-unquote |
| 1469 | (file-local-name (expand-file-name dir)))) | 1469 | (file-local-name (expand-file-name dir)))) |
| 1470 | ignores)) | 1470 | ignores)) |
diff --git a/lisp/server.el b/lisp/server.el index 55af2786463..5cb5452efe9 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -1608,7 +1608,9 @@ prevent a backup for it.) The variable `server-temp-file-regexp' controls | |||
| 1608 | which filenames are considered temporary. | 1608 | which filenames are considered temporary. |
| 1609 | 1609 | ||
| 1610 | If invoked with a prefix argument, or if there is no server process running, | 1610 | If invoked with a prefix argument, or if there is no server process running, |
| 1611 | starts server process and that is all. Invoked by \\[server-edit]." | 1611 | starts server process and that is all. Invoked by \\[server-edit]. |
| 1612 | |||
| 1613 | To abort an edit instead of saying \"Done\", use \\[server-edit-abort]." | ||
| 1612 | (interactive "P") | 1614 | (interactive "P") |
| 1613 | (cond | 1615 | (cond |
| 1614 | ((or arg | 1616 | ((or arg |
| @@ -1618,6 +1620,17 @@ starts server process and that is all. Invoked by \\[server-edit]." | |||
| 1618 | (server-clients (apply #'server-switch-buffer (server-done))) | 1620 | (server-clients (apply #'server-switch-buffer (server-done))) |
| 1619 | (t (message "No server editing buffers exist")))) | 1621 | (t (message "No server editing buffers exist")))) |
| 1620 | 1622 | ||
| 1623 | (defun server-edit-abort () | ||
| 1624 | "Abort editing the current client buffer." | ||
| 1625 | (interactive) | ||
| 1626 | (if server-clients | ||
| 1627 | (mapc (lambda (proc) | ||
| 1628 | (server-send-string | ||
| 1629 | proc (concat "-error " | ||
| 1630 | (server-quote-arg "Aborted by the user")))) | ||
| 1631 | server-clients) | ||
| 1632 | (message "This buffer has no clients"))) | ||
| 1633 | |||
| 1621 | (defun server-switch-buffer (&optional next-buffer killed-one filepos | 1634 | (defun server-switch-buffer (&optional next-buffer killed-one filepos |
| 1622 | this-frame-only) | 1635 | this-frame-only) |
| 1623 | "Switch to another buffer, preferably one that has a client. | 1636 | "Switch to another buffer, preferably one that has a client. |
diff --git a/lisp/shell.el b/lisp/shell.el index 3098d3a14da..62de5be8172 100644 --- a/lisp/shell.el +++ b/lisp/shell.el | |||
| @@ -321,6 +321,15 @@ Thus, this does not include the shell's current directory.") | |||
| 321 | (defvar shell-dirstack-query nil | 321 | (defvar shell-dirstack-query nil |
| 322 | "Command used by `shell-resync-dirs' to query the shell.") | 322 | "Command used by `shell-resync-dirs' to query the shell.") |
| 323 | 323 | ||
| 324 | (defcustom shell-has-auto-cd nil | ||
| 325 | "If non-nil, `shell-mode' handles implicit \"cd\" commands. | ||
| 326 | Implicit \"cd\" is changing the directory if the command is a directory. | ||
| 327 | You can make this variable buffer-local to change it, per shell-mode instance. | ||
| 328 | Useful for shells like zsh that has this feature." | ||
| 329 | :type 'boolean | ||
| 330 | :group 'shell-directories | ||
| 331 | :version "28.1") | ||
| 332 | |||
| 324 | (defvar shell-mode-map | 333 | (defvar shell-mode-map |
| 325 | (let ((map (make-sparse-keymap))) | 334 | (let ((map (make-sparse-keymap))) |
| 326 | (define-key map "\C-c\C-f" 'shell-forward-command) | 335 | (define-key map "\C-c\C-f" 'shell-forward-command) |
| @@ -836,13 +845,15 @@ Environment variables are expanded, see function `substitute-in-file-name'." | |||
| 836 | str) ; skip whitespace | 845 | str) ; skip whitespace |
| 837 | (match-end 0))) | 846 | (match-end 0))) |
| 838 | (case-fold-search) | 847 | (case-fold-search) |
| 839 | end cmd arg1) | 848 | end cmd arg1 cmd-subst-fn) |
| 840 | (while (string-match shell-command-regexp str start) | 849 | (while (string-match shell-command-regexp str start) |
| 841 | (setq end (match-end 0) | 850 | (setq end (match-end 0) |
| 842 | cmd (comint-arguments (substring str start end) 0 0) | 851 | cmd (comint-arguments (substring str start end) 0 0) |
| 843 | arg1 (comint-arguments (substring str start end) 1 1)) | 852 | arg1 (comint-arguments (substring str start end) 1 1)) |
| 844 | (if arg1 | 853 | (if arg1 |
| 845 | (setq arg1 (shell-unquote-argument arg1))) | 854 | (setq arg1 (shell-unquote-argument arg1))) |
| 855 | (if shell-has-auto-cd | ||
| 856 | (setq cmd-subst-fn (comint-substitute-in-file-name cmd))) | ||
| 846 | (cond ((string-match (concat "\\`\\(" shell-popd-regexp | 857 | (cond ((string-match (concat "\\`\\(" shell-popd-regexp |
| 847 | "\\)\\($\\|[ \t]\\)") | 858 | "\\)\\($\\|[ \t]\\)") |
| 848 | cmd) | 859 | cmd) |
| @@ -859,7 +870,9 @@ Environment variables are expanded, see function `substitute-in-file-name'." | |||
| 859 | (string-match (concat "\\`\\(" shell-chdrive-regexp | 870 | (string-match (concat "\\`\\(" shell-chdrive-regexp |
| 860 | "\\)\\($\\|[ \t]\\)") | 871 | "\\)\\($\\|[ \t]\\)") |
| 861 | cmd)) | 872 | cmd)) |
| 862 | (shell-process-cd (comint-substitute-in-file-name cmd)))) | 873 | (shell-process-cd (comint-substitute-in-file-name cmd))) |
| 874 | ((and shell-has-auto-cd (file-directory-p cmd-subst-fn)) | ||
| 875 | (shell-process-cd cmd-subst-fn))) | ||
| 863 | (setq start (progn (string-match shell-command-separator-regexp | 876 | (setq start (progn (string-match shell-command-separator-regexp |
| 864 | str end) | 877 | str end) |
| 865 | ;; skip again | 878 | ;; skip again |
diff --git a/lisp/simple.el b/lisp/simple.el index 4695a6a7771..b00918e9188 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -4217,12 +4217,22 @@ impose the use of a shell (with its need to quote arguments)." | |||
| 4217 | (shell-command-on-region (point) (point) command | 4217 | (shell-command-on-region (point) (point) command |
| 4218 | output-buffer nil error-buffer))))))) | 4218 | output-buffer nil error-buffer))))))) |
| 4219 | 4219 | ||
| 4220 | (defun max-mini-window-lines (&optional frame) | ||
| 4221 | "Compute maximum number of lines for echo area in FRAME. | ||
| 4222 | As defined by `max-mini-window-height'. FRAME defaults to the | ||
| 4223 | selected frame. Result may be a floating-point number, | ||
| 4224 | i.e. include a fractional number of lines." | ||
| 4225 | (cond ((floatp max-mini-window-height) (* (frame-height frame) | ||
| 4226 | max-mini-window-height)) | ||
| 4227 | ((integerp max-mini-window-height) max-mini-window-height) | ||
| 4228 | (t 1))) | ||
| 4229 | |||
| 4220 | (defun display-message-or-buffer (message &optional buffer-name action frame) | 4230 | (defun display-message-or-buffer (message &optional buffer-name action frame) |
| 4221 | "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer. | 4231 | "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer. |
| 4222 | MESSAGE may be either a string or a buffer. | 4232 | MESSAGE may be either a string or a buffer. |
| 4223 | 4233 | ||
| 4224 | A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long | 4234 | A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long |
| 4225 | for maximum height of the echo area, as defined by `max-mini-window-height' | 4235 | for maximum height of the echo area, as defined by `max-mini-window-lines' |
| 4226 | if `resize-mini-windows' is non-nil. | 4236 | if `resize-mini-windows' is non-nil. |
| 4227 | 4237 | ||
| 4228 | Returns either the string shown in the echo area, or when a pop-up | 4238 | Returns either the string shown in the echo area, or when a pop-up |
| @@ -4261,14 +4271,7 @@ and are used only if a pop-up buffer is displayed." | |||
| 4261 | (cond ((= lines 0)) | 4271 | (cond ((= lines 0)) |
| 4262 | ((and (or (<= lines 1) | 4272 | ((and (or (<= lines 1) |
| 4263 | (<= lines | 4273 | (<= lines |
| 4264 | (if resize-mini-windows | 4274 | (if resize-mini-windows (max-mini-window-lines) |
| 4265 | (cond ((floatp max-mini-window-height) | ||
| 4266 | (* (frame-height) | ||
| 4267 | max-mini-window-height)) | ||
| 4268 | ((integerp max-mini-window-height) | ||
| 4269 | max-mini-window-height) | ||
| 4270 | (t | ||
| 4271 | 1)) | ||
| 4272 | 1))) | 4275 | 1))) |
| 4273 | ;; Don't use the echo area if the output buffer is | 4276 | ;; Don't use the echo area if the output buffer is |
| 4274 | ;; already displayed in the selected frame. | 4277 | ;; already displayed in the selected frame. |
| @@ -4334,7 +4337,7 @@ current buffer after START. | |||
| 4334 | 4337 | ||
| 4335 | Optional fifth arg REPLACE, if non-nil, means to insert the | 4338 | Optional fifth arg REPLACE, if non-nil, means to insert the |
| 4336 | output in place of text from START to END, putting point and mark | 4339 | output in place of text from START to END, putting point and mark |
| 4337 | around it. | 4340 | around it. If REPLACE is the symbol `no-mark', don't set the mark. |
| 4338 | 4341 | ||
| 4339 | Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer | 4342 | Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer |
| 4340 | or buffer name to which to direct the command's standard error | 4343 | or buffer name to which to direct the command's standard error |
| @@ -4409,7 +4412,9 @@ characters." | |||
| 4409 | (let ((swap (and replace (< start end)))) | 4412 | (let ((swap (and replace (< start end)))) |
| 4410 | ;; Don't muck with mark unless REPLACE says we should. | 4413 | ;; Don't muck with mark unless REPLACE says we should. |
| 4411 | (goto-char start) | 4414 | (goto-char start) |
| 4412 | (and replace (push-mark (point) 'nomsg)) | 4415 | (when (and replace |
| 4416 | (not (eq replace 'no-mark))) | ||
| 4417 | (push-mark (point) 'nomsg)) | ||
| 4413 | (setq exit-status | 4418 | (setq exit-status |
| 4414 | (call-shell-region start end command replace | 4419 | (call-shell-region start end command replace |
| 4415 | (if error-file | 4420 | (if error-file |
| @@ -4420,7 +4425,9 @@ characters." | |||
| 4420 | ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) | 4425 | ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) |
| 4421 | ;; (kill-buffer shell-buffer))) | 4426 | ;; (kill-buffer shell-buffer))) |
| 4422 | ;; Don't muck with mark unless REPLACE says we should. | 4427 | ;; Don't muck with mark unless REPLACE says we should. |
| 4423 | (and replace swap (exchange-point-and-mark))) | 4428 | (when (and replace swap |
| 4429 | (not (eq replace 'no-mark))) | ||
| 4430 | (exchange-point-and-mark))) | ||
| 4424 | ;; No prefix argument: put the output in a temp buffer, | 4431 | ;; No prefix argument: put the output in a temp buffer, |
| 4425 | ;; replacing its entire contents. | 4432 | ;; replacing its entire contents. |
| 4426 | (let ((buffer (get-buffer-create | 4433 | (let ((buffer (get-buffer-create |
| @@ -5735,7 +5742,8 @@ PROMPT is a string to prompt with." | |||
| 5735 | (complete-with-action action completions string pred))) | 5742 | (complete-with-action action completions string pred))) |
| 5736 | nil nil nil | 5743 | nil nil nil |
| 5737 | (if history-pos | 5744 | (if history-pos |
| 5738 | (cons 'read-from-kill-ring-history (1+ history-pos)) | 5745 | (cons 'read-from-kill-ring-history |
| 5746 | (if (zerop history-pos) history-pos (1+ history-pos))) | ||
| 5739 | 'read-from-kill-ring-history))))) | 5747 | 'read-from-kill-ring-history))))) |
| 5740 | 5748 | ||
| 5741 | (defcustom yank-from-kill-ring-rotate t | 5749 | (defcustom yank-from-kill-ring-rotate t |
| @@ -5773,8 +5781,9 @@ When called from Lisp, insert STRING like `insert-for-yank' does." | |||
| 5773 | (insert-for-yank string) | 5781 | (insert-for-yank string) |
| 5774 | (when yank-from-kill-ring-rotate | 5782 | (when yank-from-kill-ring-rotate |
| 5775 | (let ((pos (seq-position kill-ring string))) | 5783 | (let ((pos (seq-position kill-ring string))) |
| 5776 | (when pos | 5784 | (if pos |
| 5777 | (setq kill-ring-yank-pointer (nthcdr pos kill-ring))))) | 5785 | (setq kill-ring-yank-pointer (nthcdr pos kill-ring)) |
| 5786 | (kill-new string)))) | ||
| 5778 | (if (consp arg) | 5787 | (if (consp arg) |
| 5779 | ;; Swap point and mark like in `yank' and `yank-pop'. | 5788 | ;; Swap point and mark like in `yank' and `yank-pop'. |
| 5780 | (goto-char (prog1 (mark t) | 5789 | (goto-char (prog1 (mark t) |
diff --git a/lisp/so-long.el b/lisp/so-long.el index f916b61b60f..d765d3449ca 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el | |||
| @@ -1648,7 +1648,8 @@ invoking the new action." | |||
| 1648 | (when so-long--active | 1648 | (when so-long--active |
| 1649 | (so-long-revert)) | 1649 | (so-long-revert)) |
| 1650 | ;; Invoke the new action. | 1650 | ;; Invoke the new action. |
| 1651 | (let ((so-long--calling t)) | 1651 | (let ((so-long--calling t) |
| 1652 | (view-mode-active view-mode)) | ||
| 1652 | (so-long--ensure-enabled) | 1653 | (so-long--ensure-enabled) |
| 1653 | ;; ACTION takes precedence if supplied. | 1654 | ;; ACTION takes precedence if supplied. |
| 1654 | (when action | 1655 | (when action |
| @@ -1677,7 +1678,10 @@ invoking the new action." | |||
| 1677 | ;; functions need to modify the buffer. We use `inhibit-read-only' to | 1678 | ;; functions need to modify the buffer. We use `inhibit-read-only' to |
| 1678 | ;; side-step the issue (and likewise in `so-long-revert'). | 1679 | ;; side-step the issue (and likewise in `so-long-revert'). |
| 1679 | (let ((inhibit-read-only t)) | 1680 | (let ((inhibit-read-only t)) |
| 1680 | (run-hooks 'so-long-hook))))) | 1681 | (run-hooks 'so-long-hook)) |
| 1682 | ;; Restore `view-mode'. | ||
| 1683 | (when view-mode-active | ||
| 1684 | (view-mode))))) | ||
| 1681 | 1685 | ||
| 1682 | (defun so-long-revert () | 1686 | (defun so-long-revert () |
| 1683 | "Revert the active `so-long-action' and run `so-long-revert-hook'. | 1687 | "Revert the active `so-long-action' and run `so-long-revert-hook'. |
diff --git a/lisp/subr.el b/lisp/subr.el index 78507a552c1..e49c2773357 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -195,6 +195,14 @@ buffer-local wherever it is set." | |||
| 195 | (list 'progn (list 'defvar var val docstring) | 195 | (list 'progn (list 'defvar var val docstring) |
| 196 | (list 'make-variable-buffer-local (list 'quote var)))) | 196 | (list 'make-variable-buffer-local (list 'quote var)))) |
| 197 | 197 | ||
| 198 | (defun buffer-local-boundp (symbol buffer) | ||
| 199 | "Return non-nil if SYMBOL is bound in BUFFER. | ||
| 200 | Also see `local-variable-p'." | ||
| 201 | (condition-case nil | ||
| 202 | (buffer-local-value symbol buffer) | ||
| 203 | (:success t) | ||
| 204 | (void-variable nil))) | ||
| 205 | |||
| 198 | (defmacro push (newelt place) | 206 | (defmacro push (newelt place) |
| 199 | "Add NEWELT to the list stored in the generalized variable PLACE. | 207 | "Add NEWELT to the list stored in the generalized variable PLACE. |
| 200 | This is morally equivalent to (setf PLACE (cons NEWELT PLACE)), | 208 | This is morally equivalent to (setf PLACE (cons NEWELT PLACE)), |
| @@ -2476,7 +2484,11 @@ file name without extension. | |||
| 2476 | If TYPE is nil, then any kind of definition is acceptable. If | 2484 | If TYPE is nil, then any kind of definition is acceptable. If |
| 2477 | TYPE is `defun', `defvar', or `defface', that specifies function | 2485 | TYPE is `defun', `defvar', or `defface', that specifies function |
| 2478 | definition, variable definition, or face definition only. | 2486 | definition, variable definition, or face definition only. |
| 2479 | Otherwise TYPE is assumed to be a symbol property." | 2487 | Otherwise TYPE is assumed to be a symbol property. |
| 2488 | |||
| 2489 | This function only works for symbols defined in Lisp files. For | ||
| 2490 | symbols that are defined in C files, use `help-C-file-name' | ||
| 2491 | instead." | ||
| 2480 | (if (and (or (null type) (eq type 'defun)) | 2492 | (if (and (or (null type) (eq type 'defun)) |
| 2481 | (symbolp symbol) | 2493 | (symbolp symbol) |
| 2482 | (autoloadp (symbol-function symbol))) | 2494 | (autoloadp (symbol-function symbol))) |
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index e4521ff1876..8c6c75e7e22 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el | |||
| @@ -1355,7 +1355,7 @@ This returns an error if any Emacs frames are X frames." | |||
| 1355 | (declare-function x-get-selection-internal "xselect.c" | 1355 | (declare-function x-get-selection-internal "xselect.c" |
| 1356 | (selection-symbol target-type &optional time-stamp terminal)) | 1356 | (selection-symbol target-type &optional time-stamp terminal)) |
| 1357 | 1357 | ||
| 1358 | (add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x)) | 1358 | (add-to-list 'display-format-alist '("\\`.*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x)) |
| 1359 | (cl-defmethod handle-args-function (args &context (window-system x)) | 1359 | (cl-defmethod handle-args-function (args &context (window-system x)) |
| 1360 | (x-handle-args args)) | 1360 | (x-handle-args args)) |
| 1361 | 1361 | ||
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 8d2715f611c..ba48e5de21a 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el | |||
| @@ -1263,14 +1263,27 @@ spell-check." | |||
| 1263 | (t | 1263 | (t |
| 1264 | (setq flyspell-word-cache-result nil) | 1264 | (setq flyspell-word-cache-result nil) |
| 1265 | ;; Highlight the location as incorrect, | 1265 | ;; Highlight the location as incorrect, |
| 1266 | ;; including offset specified in POSS. | 1266 | ;; including offset specified in POSS |
| 1267 | ;; and only for the length of the | ||
| 1268 | ;; misspelled word specified by POSS. | ||
| 1267 | (if flyspell-highlight-flag | 1269 | (if flyspell-highlight-flag |
| 1268 | (flyspell-highlight-incorrect-region | 1270 | (let ((hstart start) |
| 1269 | (if (and (consp poss) | 1271 | (hend end) |
| 1270 | (integerp (nth 1 poss))) | 1272 | offset misspelled) |
| 1271 | (+ start (nth 1 poss) -1) | 1273 | (when (consp poss) |
| 1272 | start) | 1274 | (setq misspelled (car poss) |
| 1273 | end poss) | 1275 | offset (nth 1 poss)) |
| 1276 | (if (integerp offset) | ||
| 1277 | (setq hstart (+ start offset -1))) | ||
| 1278 | ;; POSS includes the misspelled | ||
| 1279 | ;; word; use that to figure out | ||
| 1280 | ;; how many characters to highlight. | ||
| 1281 | (if (stringp misspelled) | ||
| 1282 | (setq hend | ||
| 1283 | (+ hstart | ||
| 1284 | (length misspelled))))) | ||
| 1285 | (flyspell-highlight-incorrect-region | ||
| 1286 | hstart hend poss)) | ||
| 1274 | (flyspell-notify-misspell word poss)) | 1287 | (flyspell-notify-misspell word poss)) |
| 1275 | nil)))) | 1288 | nil)))) |
| 1276 | ;; return to original location | 1289 | ;; return to original location |
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8d7f459190b..a805c8952fd 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el | |||
| @@ -599,11 +599,13 @@ An alternative value is \" . \", if you use a font with a narrow period." | |||
| 599 | ;; Citation args. | 599 | ;; Citation args. |
| 600 | (list (concat slash citations opt arg) 3 'font-lock-constant-face) | 600 | (list (concat slash citations opt arg) 3 'font-lock-constant-face) |
| 601 | ;; | 601 | ;; |
| 602 | ;; Text between `` quotes ''. | 602 | ;; Text between `` quotes ''. |
| 603 | (cons (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) | 603 | (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) |
| 604 | "[^'\">{]+" ;a bit pessimistic | 604 | "\\(\\(.\\|\n\\)+?\\)" |
| 605 | (regexp-opt '("''" "\">" "\"'" ">>" "»") t)) | 605 | (regexp-opt `("''" "\">" "\"'" ">>" "»") t)) |
| 606 | 'font-lock-string-face) | 606 | '(1 font-lock-keyword-face) |
| 607 | '(2 font-lock-string-face) | ||
| 608 | '(4 font-lock-keyword-face)) | ||
| 607 | ;; | 609 | ;; |
| 608 | ;; Command names, special and general. | 610 | ;; Command names, special and general. |
| 609 | (cons (concat slash specials-1) 'font-lock-warning-face) | 611 | (cons (concat slash specials-1) 'font-lock-warning-face) |
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index b9eab95b232..0cc566f0d8c 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el | |||
| @@ -462,195 +462,203 @@ and all `time-stamp-format' compatibility." | |||
| 462 | (let ((fmt-len (length format)) | 462 | (let ((fmt-len (length format)) |
| 463 | (ind 0) | 463 | (ind 0) |
| 464 | cur-char | 464 | cur-char |
| 465 | (prev-char nil) | 465 | (result "")) |
| 466 | (result "") | ||
| 467 | field-width | ||
| 468 | field-result | ||
| 469 | alt-form change-case upcase | ||
| 470 | (paren-level 0)) | ||
| 471 | (while (< ind fmt-len) | 466 | (while (< ind fmt-len) |
| 472 | (setq cur-char (aref format ind)) | 467 | (setq cur-char (aref format ind)) |
| 473 | (setq | 468 | (setq |
| 474 | result | 469 | result |
| 475 | (concat result | 470 | (concat |
| 476 | (cond | 471 | result |
| 477 | ((eq cur-char ?%) | 472 | (cond |
| 478 | ;; eat any additional args to allow for future expansion | 473 | ((eq cur-char ?%) |
| 479 | (setq alt-form 0 change-case nil upcase nil field-width "") | 474 | (let ((prev-char nil) |
| 480 | (while (progn | 475 | (field-width "") |
| 481 | (setq ind (1+ ind)) | 476 | field-result |
| 482 | (setq cur-char (if (< ind fmt-len) | 477 | (alt-form 0) |
| 483 | (aref format ind) | 478 | (change-case nil) |
| 484 | ?\0)) | 479 | (upcase nil) |
| 485 | (or (eq ?. cur-char) | 480 | (paren-level 0)) |
| 486 | (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char) | 481 | ;; eat any additional args to allow for future expansion |
| 487 | (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char) | 482 | (while (progn |
| 488 | (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char) | 483 | (setq ind (1+ ind)) |
| 489 | (and (eq ?\( cur-char) | 484 | (setq cur-char (if (< ind fmt-len) |
| 490 | (not (eq prev-char ?\\)) | 485 | (aref format ind) |
| 491 | (setq paren-level (1+ paren-level))) | 486 | ?\0)) |
| 492 | (if (and (eq ?\) cur-char) | 487 | (or (eq ?. cur-char) |
| 488 | (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char) | ||
| 489 | (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char) | ||
| 490 | (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char) | ||
| 491 | (and (eq ?\( cur-char) | ||
| 493 | (not (eq prev-char ?\\)) | 492 | (not (eq prev-char ?\\)) |
| 494 | (> paren-level 0)) | 493 | (setq paren-level (1+ paren-level))) |
| 495 | (setq paren-level (1- paren-level)) | 494 | (if (and (eq ?\) cur-char) |
| 496 | (and (> paren-level 0) | 495 | (not (eq prev-char ?\\)) |
| 497 | (< ind fmt-len))) | 496 | (> paren-level 0)) |
| 498 | (if (and (<= ?0 cur-char) (>= ?9 cur-char)) | 497 | (setq paren-level (1- paren-level)) |
| 499 | ;; get format width | 498 | (and (> paren-level 0) |
| 500 | (let ((field-index ind)) | 499 | (< ind fmt-len))) |
| 501 | (while (progn | 500 | (if (and (<= ?0 cur-char) (>= ?9 cur-char)) |
| 502 | (setq ind (1+ ind)) | 501 | ;; get format width |
| 503 | (setq cur-char (if (< ind fmt-len) | 502 | (let ((field-index ind) |
| 504 | (aref format ind) | 503 | (first-digit cur-char)) |
| 505 | ?\0)) | 504 | (while (progn |
| 506 | (and (<= ?0 cur-char) (>= ?9 cur-char)))) | 505 | (setq ind (1+ ind)) |
| 507 | (setq field-width (substring format field-index ind)) | 506 | (setq cur-char (if (< ind fmt-len) |
| 508 | (setq ind (1- ind)) | 507 | (aref format ind) |
| 509 | t)))) | 508 | ?\0)) |
| 510 | (setq prev-char cur-char) | 509 | (and (<= ?0 cur-char) |
| 511 | ;; some characters we actually use | 510 | (>= ?9 cur-char)))) |
| 512 | (cond ((eq cur-char ?:) | 511 | (setq field-width |
| 513 | (setq alt-form (1+ alt-form))) | 512 | (substring format field-index ind)) |
| 514 | ((eq cur-char ?#) | 513 | (setq ind (1- ind)) |
| 515 | (setq change-case t)) | 514 | (setq cur-char first-digit) |
| 516 | ((eq cur-char ?^) | 515 | t)))) |
| 517 | (setq upcase t)) | 516 | (setq prev-char cur-char) |
| 518 | ((eq cur-char ?-) | 517 | ;; some characters we actually use |
| 519 | (setq field-width "1")) | 518 | (cond ((eq cur-char ?:) |
| 520 | ((eq cur-char ?_) | 519 | (setq alt-form (1+ alt-form))) |
| 521 | (setq field-width "2")))) | 520 | ((eq cur-char ?#) |
| 522 | (setq field-result | 521 | (setq change-case t)) |
| 523 | (cond | 522 | ((eq cur-char ?^) |
| 524 | ((eq cur-char ?%) | 523 | (setq upcase t)) |
| 525 | "%") | 524 | ((eq cur-char ?-) |
| 526 | ((eq cur-char ?a) ;day of week | 525 | (setq field-width "1")) |
| 527 | (if (> alt-form 0) | 526 | ((eq cur-char ?_) |
| 528 | (if (string-equal field-width "") | 527 | (setq field-width "2")))) |
| 529 | (time-stamp--format "%A" time) | 528 | (setq field-result |
| 530 | "") ;discourage "%:3a" | 529 | (cond |
| 531 | (if (or change-case upcase) | 530 | ((eq cur-char ?%) |
| 532 | (time-stamp--format "%#a" time) | 531 | "%") |
| 533 | (time-stamp--format "%a" time)))) | 532 | ((eq cur-char ?a) ;day of week |
| 534 | ((eq cur-char ?A) | 533 | (if (> alt-form 0) |
| 535 | (if (or change-case upcase (not (string-equal field-width ""))) | 534 | (if (string-equal field-width "") |
| 536 | (time-stamp--format "%#A" time) | 535 | (time-stamp--format "%A" time) |
| 537 | (time-stamp--format "%A" time))) | 536 | "") ;discourage "%:3a" |
| 538 | ((eq cur-char ?b) ;month name | 537 | (if (or change-case upcase) |
| 539 | (if (> alt-form 0) | 538 | (time-stamp--format "%#a" time) |
| 540 | (if (string-equal field-width "") | 539 | (time-stamp--format "%a" time)))) |
| 541 | (time-stamp--format "%B" time) | 540 | ((eq cur-char ?A) |
| 542 | "") ;discourage "%:3b" | 541 | (if (or change-case upcase (not (string-equal field-width |
| 543 | (if (or change-case upcase) | 542 | ""))) |
| 544 | (time-stamp--format "%#b" time) | 543 | (time-stamp--format "%#A" time) |
| 545 | (time-stamp--format "%b" time)))) | 544 | (time-stamp--format "%A" time))) |
| 546 | ((eq cur-char ?B) | 545 | ((eq cur-char ?b) ;month name |
| 547 | (if (or change-case upcase (not (string-equal field-width ""))) | 546 | (if (> alt-form 0) |
| 548 | (time-stamp--format "%#B" time) | 547 | (if (string-equal field-width "") |
| 549 | (time-stamp--format "%B" time))) | 548 | (time-stamp--format "%B" time) |
| 550 | ((eq cur-char ?d) ;day of month, 1-31 | 549 | "") ;discourage "%:3b" |
| 551 | (time-stamp-do-number cur-char alt-form field-width time)) | 550 | (if (or change-case upcase) |
| 552 | ((eq cur-char ?H) ;hour, 0-23 | 551 | (time-stamp--format "%#b" time) |
| 553 | (time-stamp-do-number cur-char alt-form field-width time)) | 552 | (time-stamp--format "%b" time)))) |
| 554 | ((eq cur-char ?I) ;hour, 1-12 | 553 | ((eq cur-char ?B) |
| 555 | (time-stamp-do-number cur-char alt-form field-width time)) | 554 | (if (or change-case upcase (not (string-equal field-width |
| 556 | ((eq cur-char ?m) ;month number, 1-12 | 555 | ""))) |
| 557 | (time-stamp-do-number cur-char alt-form field-width time)) | 556 | (time-stamp--format "%#B" time) |
| 558 | ((eq cur-char ?M) ;minute, 0-59 | 557 | (time-stamp--format "%B" time))) |
| 559 | (time-stamp-do-number cur-char alt-form field-width time)) | 558 | ((eq cur-char ?d) ;day of month, 1-31 |
| 560 | ((eq cur-char ?p) ;am or pm | 559 | (time-stamp-do-number cur-char alt-form field-width time)) |
| 561 | (if change-case | 560 | ((eq cur-char ?H) ;hour, 0-23 |
| 562 | (time-stamp--format "%#p" time) | 561 | (time-stamp-do-number cur-char alt-form field-width time)) |
| 563 | (time-stamp--format "%p" time))) | 562 | ((eq cur-char ?I) ;hour, 1-12 |
| 564 | ((eq cur-char ?P) ;AM or PM | 563 | (time-stamp-do-number cur-char alt-form field-width time)) |
| 565 | (time-stamp--format "%p" time)) | 564 | ((eq cur-char ?m) ;month number, 1-12 |
| 566 | ((eq cur-char ?S) ;seconds, 00-60 | 565 | (time-stamp-do-number cur-char alt-form field-width time)) |
| 567 | (time-stamp-do-number cur-char alt-form field-width time)) | 566 | ((eq cur-char ?M) ;minute, 0-59 |
| 568 | ((eq cur-char ?w) ;weekday number, Sunday is 0 | 567 | (time-stamp-do-number cur-char alt-form field-width time)) |
| 569 | (time-stamp--format "%w" time)) | 568 | ((eq cur-char ?p) ;am or pm |
| 570 | ((eq cur-char ?y) ;year | 569 | (if change-case |
| 571 | (if (> alt-form 0) | 570 | (time-stamp--format "%#p" time) |
| 572 | (string-to-number (time-stamp--format "%Y" time)) | 571 | (time-stamp--format "%p" time))) |
| 573 | (if (or (string-equal field-width "") | 572 | ((eq cur-char ?P) ;AM or PM |
| 574 | (<= (string-to-number field-width) 2)) | 573 | (time-stamp--format "%p" time)) |
| 575 | (string-to-number (time-stamp--format "%y" time)) | 574 | ((eq cur-char ?S) ;seconds, 00-60 |
| 576 | (time-stamp-conv-warn (format "%%%sy" field-width) "%Y") | 575 | (time-stamp-do-number cur-char alt-form field-width time)) |
| 577 | (string-to-number (time-stamp--format "%Y" time))))) | 576 | ((eq cur-char ?w) ;weekday number, Sunday is 0 |
| 578 | ((eq cur-char ?Y) ;4-digit year | 577 | (time-stamp--format "%w" time)) |
| 579 | (string-to-number (time-stamp--format "%Y" time))) | 578 | ((eq cur-char ?y) ;year |
| 580 | ((eq cur-char ?z) ;time zone offset | 579 | (if (> alt-form 0) |
| 581 | (if change-case | 580 | (string-to-number (time-stamp--format "%Y" time)) |
| 582 | "" ;discourage %z variations | 581 | (if (or (string-equal field-width "") |
| 583 | (cond ((= alt-form 0) | 582 | (<= (string-to-number field-width) 2)) |
| 584 | (if (string-equal field-width "") | 583 | (string-to-number (time-stamp--format "%y" time)) |
| 585 | (progn | 584 | (time-stamp-conv-warn (format "%%%sy" field-width) "%Y") |
| 586 | (time-stamp-conv-warn "%z" "%#Z") | 585 | (string-to-number (time-stamp--format "%Y" time))))) |
| 587 | (time-stamp--format "%#Z" time)) | 586 | ((eq cur-char ?Y) ;4-digit year |
| 588 | (cond ((string-equal field-width "1") | 587 | (string-to-number (time-stamp--format "%Y" time))) |
| 589 | (setq field-width "3")) ;%-z -> "+00" | 588 | ((eq cur-char ?z) ;time zone offset |
| 590 | ((string-equal field-width "2") | 589 | (if change-case |
| 591 | (setq field-width "5")) ;%_z -> "+0000" | 590 | "" ;discourage %z variations |
| 592 | ((string-equal field-width "4") | 591 | (cond ((= alt-form 0) |
| 593 | (setq field-width "0"))) ;discourage %4z | 592 | (if (string-equal field-width "") |
| 594 | (time-stamp--format "%z" time))) | 593 | (progn |
| 595 | ((= alt-form 1) | 594 | (time-stamp-conv-warn "%z" "%#Z") |
| 596 | (time-stamp--format "%:z" time)) | 595 | (time-stamp--format "%#Z" time)) |
| 597 | ((= alt-form 2) | 596 | (cond ((string-equal field-width "1") |
| 598 | (time-stamp--format "%::z" time)) | 597 | (setq field-width "3")) ;%-z -> "+00" |
| 599 | ((= alt-form 3) | 598 | ((string-equal field-width "2") |
| 600 | (time-stamp--format "%:::z" time))))) | 599 | (setq field-width "5")) ;%_z -> "+0000" |
| 601 | ((eq cur-char ?Z) ;time zone name | 600 | ((string-equal field-width "4") |
| 602 | (if change-case | 601 | (setq field-width "0"))) ;discourage %4z |
| 603 | (time-stamp--format "%#Z" time) | 602 | (time-stamp--format "%z" time))) |
| 604 | (time-stamp--format "%Z" time))) | 603 | ((= alt-form 1) |
| 605 | ((eq cur-char ?f) ;buffer-file-name, base name only | 604 | (time-stamp--format "%:z" time)) |
| 606 | (if buffer-file-name | 605 | ((= alt-form 2) |
| 607 | (file-name-nondirectory buffer-file-name) | 606 | (time-stamp--format "%::z" time)) |
| 608 | time-stamp-no-file)) | 607 | ((= alt-form 3) |
| 609 | ((eq cur-char ?F) ;buffer-file-name, full path | 608 | (time-stamp--format "%:::z" time))))) |
| 610 | (or buffer-file-name | 609 | ((eq cur-char ?Z) ;time zone name |
| 611 | time-stamp-no-file)) | 610 | (if change-case |
| 612 | ((eq cur-char ?s) ;system name, legacy | 611 | (time-stamp--format "%#Z" time) |
| 613 | (system-name)) | 612 | (time-stamp--format "%Z" time))) |
| 614 | ((eq cur-char ?u) ;user name, legacy | 613 | ((eq cur-char ?f) ;buffer-file-name, base name only |
| 615 | (user-login-name)) | 614 | (if buffer-file-name |
| 616 | ((eq cur-char ?U) ;user full name, legacy | 615 | (file-name-nondirectory buffer-file-name) |
| 617 | (user-full-name)) | 616 | time-stamp-no-file)) |
| 618 | ((eq cur-char ?l) ;login name | 617 | ((eq cur-char ?F) ;buffer-file-name, full path |
| 619 | (user-login-name)) | 618 | (or buffer-file-name |
| 620 | ((eq cur-char ?L) ;full name of logged-in user | 619 | time-stamp-no-file)) |
| 621 | (user-full-name)) | 620 | ((eq cur-char ?s) ;system name, legacy |
| 622 | ((eq cur-char ?h) ;mail host name | 621 | (system-name)) |
| 623 | (or mail-host-address (system-name))) | 622 | ((eq cur-char ?u) ;user name, legacy |
| 624 | ((eq cur-char ?q) ;unqualified host name | 623 | (user-login-name)) |
| 625 | (let ((qualname (system-name))) | 624 | ((eq cur-char ?U) ;user full name, legacy |
| 626 | (if (string-match "\\." qualname) | 625 | (user-full-name)) |
| 627 | (substring qualname 0 (match-beginning 0)) | 626 | ((eq cur-char ?l) ;login name |
| 628 | qualname))) | 627 | (user-login-name)) |
| 629 | ((eq cur-char ?Q) ;fully-qualified host name | 628 | ((eq cur-char ?L) ;full name of logged-in user |
| 630 | (system-name)) | 629 | (user-full-name)) |
| 631 | )) | 630 | ((eq cur-char ?h) ;mail host name |
| 632 | (and (numberp field-result) | 631 | (or mail-host-address (system-name))) |
| 633 | (= alt-form 0) | 632 | ((eq cur-char ?q) ;unqualified host name |
| 634 | (string-equal field-width "") | 633 | (let ((qualname (system-name))) |
| 635 | ;; no width provided; set width for default | 634 | (if (string-match "\\." qualname) |
| 636 | (setq field-width "02")) | 635 | (substring qualname 0 (match-beginning 0)) |
| 637 | (let ((padded-result | 636 | qualname))) |
| 638 | (format (format "%%%s%c" | 637 | ((eq cur-char ?Q) ;fully-qualified host name |
| 639 | field-width | 638 | (system-name)) |
| 640 | (if (numberp field-result) ?d ?s)) | 639 | )) |
| 641 | (or field-result "")))) | 640 | (and (numberp field-result) |
| 642 | (let* ((initial-length (length padded-result)) | 641 | (= alt-form 0) |
| 643 | (desired-length (if (string-equal field-width "") | 642 | (string-equal field-width "") |
| 644 | initial-length | 643 | ;; no width provided; set width for default |
| 645 | (string-to-number field-width)))) | 644 | (setq field-width "02")) |
| 646 | (if (> initial-length desired-length) | 645 | (let ((padded-result |
| 647 | ;; truncate strings on right | 646 | (format (format "%%%s%c" |
| 648 | (if (stringp field-result) | 647 | field-width |
| 649 | (substring padded-result 0 desired-length) | 648 | (if (numberp field-result) ?d ?s)) |
| 650 | padded-result) ;numbers don't truncate | 649 | (or field-result "")))) |
| 651 | padded-result)))) | 650 | (let* ((initial-length (length padded-result)) |
| 652 | (t | 651 | (desired-length (if (string-equal field-width "") |
| 653 | (char-to-string cur-char))))) | 652 | initial-length |
| 653 | (string-to-number field-width)))) | ||
| 654 | (if (> initial-length desired-length) | ||
| 655 | ;; truncate strings on right | ||
| 656 | (if (stringp field-result) | ||
| 657 | (substring padded-result 0 desired-length) | ||
| 658 | padded-result) ;numbers don't truncate | ||
| 659 | padded-result))))) | ||
| 660 | (t | ||
| 661 | (char-to-string cur-char))))) | ||
| 654 | (setq ind (1+ ind))) | 662 | (setq ind (1+ ind))) |
| 655 | result)) | 663 | result)) |
| 656 | 664 | ||
diff --git a/lisp/transient.el b/lisp/transient.el index 93a643c78e6..6153b502f7a 100644 --- a/lisp/transient.el +++ b/lisp/transient.el | |||
| @@ -932,7 +932,7 @@ example, sets a variable use `transient-define-infix' instead. | |||
| 932 | (if (eq k :class) | 932 | (if (eq k :class) |
| 933 | (setq class pop) | 933 | (setq class pop) |
| 934 | (setq args (plist-put args k pop))))) | 934 | (setq args (plist-put args k pop))))) |
| 935 | (vector (or level (oref-default 'transient-child level)) | 935 | (vector (or level 1) |
| 936 | (or class | 936 | (or class |
| 937 | (if (vectorp car) | 937 | (if (vectorp car) |
| 938 | 'transient-columns | 938 | 'transient-columns |
| @@ -1003,7 +1003,7 @@ example, sets a variable use `transient-define-infix' instead. | |||
| 1003 | (unless (plist-get args :key) | 1003 | (unless (plist-get args :key) |
| 1004 | (when-let ((shortarg (plist-get args :shortarg))) | 1004 | (when-let ((shortarg (plist-get args :shortarg))) |
| 1005 | (setq args (plist-put args :key shortarg)))) | 1005 | (setq args (plist-put args :key shortarg)))) |
| 1006 | (list (or level (oref-default 'transient-child level)) | 1006 | (list (or level 1) |
| 1007 | (or class 'transient-suffix) | 1007 | (or class 'transient-suffix) |
| 1008 | args))) | 1008 | args))) |
| 1009 | 1009 | ||
| @@ -3583,9 +3583,9 @@ we stop there." | |||
| 3583 | ;;;; `transient-lisp-variable' | 3583 | ;;;; `transient-lisp-variable' |
| 3584 | 3584 | ||
| 3585 | (defclass transient-lisp-variable (transient-variable) | 3585 | (defclass transient-lisp-variable (transient-variable) |
| 3586 | ((reader :initform transient-lisp-variable--reader) | 3586 | ((reader :initform #'transient-lisp-variable--reader) |
| 3587 | (always-read :initform t) | 3587 | (always-read :initform t) |
| 3588 | (set-value :initarg :set-value :initform set)) | 3588 | (set-value :initarg :set-value :initform #'set)) |
| 3589 | "[Experimental] Class used for Lisp variables.") | 3589 | "[Experimental] Class used for Lisp variables.") |
| 3590 | 3590 | ||
| 3591 | (cl-defmethod transient-init-value ((obj transient-lisp-variable)) | 3591 | (cl-defmethod transient-init-value ((obj transient-lisp-variable)) |
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index 270c99ef1fa..0965e888f06 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el | |||
| @@ -231,10 +231,7 @@ one optional arguments, diff-number to refine.") | |||
| 231 | (sit-for 2) | 231 | (sit-for 2) |
| 232 | ;; 1 is an error exit code | 232 | ;; 1 is an error exit code |
| 233 | 1) | 233 | 1) |
| 234 | (t (message "Computing differences between %s and %s ..." | 234 | (t ;; this erases the diff buffer automatically |
| 235 | (file-name-nondirectory file1) | ||
| 236 | (file-name-nondirectory file2)) | ||
| 237 | ;; this erases the diff buffer automatically | ||
| 238 | (ediff-exec-process ediff-diff-program | 235 | (ediff-exec-process ediff-diff-program |
| 239 | diff-buffer | 236 | diff-buffer |
| 240 | 'synchronize | 237 | 'synchronize |
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e37c09df7c2..89f9800a1b5 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el | |||
| @@ -127,6 +127,13 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches." | |||
| 127 | (repeat :tag "Argument List" :value ("") string)) | 127 | (repeat :tag "Argument List" :value ("") string)) |
| 128 | :version "25.1") | 128 | :version "25.1") |
| 129 | 129 | ||
| 130 | (defcustom vc-git-log-switches nil | ||
| 131 | "String or list of strings specifying switches for Git log under VC." | ||
| 132 | :type '(choice (const :tag "None" nil) | ||
| 133 | (string :tag "Argument String") | ||
| 134 | (repeat :tag "Argument List" :value ("") string)) | ||
| 135 | :version "28.1") | ||
| 136 | |||
| 130 | (defcustom vc-git-resolve-conflicts t | 137 | (defcustom vc-git-resolve-conflicts t |
| 131 | "When non-nil, mark conflicted file as resolved upon saving. | 138 | "When non-nil, mark conflicted file as resolved upon saving. |
| 132 | That is performed after all conflict markers in it have been | 139 | That is performed after all conflict markers in it have been |
| @@ -1131,6 +1138,8 @@ This prompts for a branch to merge from." | |||
| 1131 | :type 'boolean | 1138 | :type 'boolean |
| 1132 | :version "26.1") | 1139 | :version "26.1") |
| 1133 | 1140 | ||
| 1141 | (autoload 'vc-switches "vc") | ||
| 1142 | |||
| 1134 | (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) | 1143 | (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) |
| 1135 | "Print commit log associated with FILES into specified BUFFER. | 1144 | "Print commit log associated with FILES into specified BUFFER. |
| 1136 | If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. | 1145 | If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. |
| @@ -1162,9 +1171,10 @@ If LIMIT is a revision string, use it as an end-revision." | |||
| 1162 | (when shortlog | 1171 | (when shortlog |
| 1163 | `("--graph" "--decorate" "--date=short" | 1172 | `("--graph" "--decorate" "--date=short" |
| 1164 | ,(format "--pretty=tformat:%s" | 1173 | ,(format "--pretty=tformat:%s" |
| 1165 | (car vc-git-root-log-format)) | 1174 | (car vc-git-root-log-format)) |
| 1166 | "--abbrev-commit")) | 1175 | "--abbrev-commit")) |
| 1167 | (when (numberp limit) | 1176 | vc-git-log-switches |
| 1177 | (when (numberp limit) | ||
| 1168 | (list "-n" (format "%s" limit))) | 1178 | (list "-n" (format "%s" limit))) |
| 1169 | (when start-revision | 1179 | (when start-revision |
| 1170 | (if (and limit (not (numberp limit))) | 1180 | (if (and limit (not (numberp limit))) |
| @@ -1385,8 +1395,6 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." | |||
| 1385 | samp coding-system-for-read t))) | 1395 | samp coding-system-for-read t))) |
| 1386 | (setq coding-system-for-read 'undecided))) | 1396 | (setq coding-system-for-read 'undecided))) |
| 1387 | 1397 | ||
| 1388 | (autoload 'vc-switches "vc") | ||
| 1389 | |||
| 1390 | (defun vc-git-diff (files &optional rev1 rev2 buffer _async) | 1398 | (defun vc-git-diff (files &optional rev1 rev2 buffer _async) |
| 1391 | "Get a difference report using Git between two revisions of FILES." | 1399 | "Get a difference report using Git between two revisions of FILES." |
| 1392 | (let (process-file-side-effects | 1400 | (let (process-file-side-effects |
diff --git a/lisp/wdired.el b/lisp/wdired.el index 35211bcf86b..22c1cebe13c 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el | |||
| @@ -351,13 +351,32 @@ or \\[wdired-abort-changes] to abort changes"))) | |||
| 351 | ;; This code is a copy of some dired-get-filename lines. | 351 | ;; This code is a copy of some dired-get-filename lines. |
| 352 | (defsubst wdired-normalize-filename (file unquotep) | 352 | (defsubst wdired-normalize-filename (file unquotep) |
| 353 | (when unquotep | 353 | (when unquotep |
| 354 | (setq file | 354 | ;; Unquote names quoted by ls or by dired-insert-directory. |
| 355 | ;; FIXME: shouldn't we check for a `b' argument or somesuch before | 355 | ;; This code was written using `read' to unquote, because |
| 356 | ;; doing such unquoting? --Stef | 356 | ;; it's faster than substituting \007 (4 chars) -> ^G (1 |
| 357 | (read (concat | 357 | ;; char) etc. in a lisp loop. Unfortunately, this decision |
| 358 | "\"" (replace-regexp-in-string | 358 | ;; has necessitated hacks such as dealing with filenames |
| 359 | "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file) | 359 | ;; with quotation marks in their names. |
| 360 | "\"")))) | 360 | (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file) |
| 361 | (setq file (replace-match "\\\"" nil t file 1))) | ||
| 362 | ;; Unescape any spaces escaped by ls -b (bug#10469). | ||
| 363 | ;; Other -b quotes, eg \t, \n, work transparently. | ||
| 364 | (if (dired-switches-escape-p dired-actual-switches) | ||
| 365 | (let ((start 0) | ||
| 366 | (rep "") | ||
| 367 | (shift -1)) | ||
| 368 | (while (string-match "\\(\\\\\\) " file start) | ||
| 369 | (setq file (replace-match rep nil t file 1) | ||
| 370 | start (+ shift (match-end 0)))))) | ||
| 371 | (when (eq system-type 'windows-nt) | ||
| 372 | (save-match-data | ||
| 373 | (let ((start 0)) | ||
| 374 | (while (string-match "\\\\" file start) | ||
| 375 | (aset file (match-beginning 0) ?/) | ||
| 376 | (setq start (match-end 0)))))) | ||
| 377 | |||
| 378 | ;; Hence we don't need to worry about converting `\\' back to `\'. | ||
| 379 | (setq file (read (concat "\"" file "\"")))) | ||
| 361 | (and file buffer-file-coding-system | 380 | (and file buffer-file-coding-system |
| 362 | (not file-name-coding-system) | 381 | (not file-name-coding-system) |
| 363 | (not default-file-name-coding-system) | 382 | (not default-file-name-coding-system) |
diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 22bfae06975..aaa56835cdd 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el | |||
| @@ -1039,6 +1039,9 @@ See also `whitespace-newline' and `whitespace-display-mappings'." | |||
| 1039 | 1 -1)) | 1039 | 1 -1)) |
| 1040 | ;; sync states (running a batch job) | 1040 | ;; sync states (running a batch job) |
| 1041 | (setq global-whitespace-newline-mode global-whitespace-mode))) | 1041 | (setq global-whitespace-newline-mode global-whitespace-mode))) |
| 1042 | (make-obsolete 'global-whitespace-newline-mode | ||
| 1043 | "use `global-whitespace-mode' with `whitespace-style' set to `(newline-mark newline)' instead." | ||
| 1044 | "28.1") | ||
| 1042 | 1045 | ||
| 1043 | 1046 | ||
| 1044 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1047 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 49baab69199..9a34dc8d438 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -4011,7 +4011,10 @@ is inline." | |||
| 4011 | 4011 | ||
| 4012 | (defun widget-boolean-prompt-value (_widget prompt _value _unbound) | 4012 | (defun widget-boolean-prompt-value (_widget prompt _value _unbound) |
| 4013 | ;; Toggle a boolean. | 4013 | ;; Toggle a boolean. |
| 4014 | (y-or-n-p prompt)) | 4014 | ;; Say what "y" means. A la |
| 4015 | ;; "Set customized value for bar to true: (y or n)" | ||
| 4016 | (y-or-n-p (concat (replace-regexp-in-string ": ?\\'" "" prompt) | ||
| 4017 | " true: "))) | ||
| 4015 | 4018 | ||
| 4016 | ;;; The `color' Widget. | 4019 | ;;; The `color' Widget. |
| 4017 | 4020 | ||
diff --git a/lisp/windmove.el b/lisp/windmove.el index e4ea8e0f693..f5589036812 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el | |||
| @@ -426,19 +426,53 @@ unless `windmove-create-window' is non-nil and a new window is created." | |||
| 426 | ;; I don't think these bindings will work on non-X terminals; you | 426 | ;; I don't think these bindings will work on non-X terminals; you |
| 427 | ;; probably want to use different bindings in that case. | 427 | ;; probably want to use different bindings in that case. |
| 428 | 428 | ||
| 429 | (defvar windmove-mode-map (make-sparse-keymap) | ||
| 430 | "Map used by `windmove-install-defaults'.") | ||
| 431 | |||
| 432 | (define-minor-mode windmove-mode | ||
| 433 | "Global minor mode for default windmove commands." | ||
| 434 | :keymap windmove-mode-map | ||
| 435 | :init-value t | ||
| 436 | :global t) | ||
| 437 | |||
| 438 | (defun windmove-install-defaults (prefix modifiers alist &optional uninstall) | ||
| 439 | "Install keys as specified by ALIST. | ||
| 440 | Every element of ALIST has the form (FN KEY), where KEY is | ||
| 441 | appended to MODIFIERS, adding PREFIX to the beginning, before | ||
| 442 | installing the key. Previous bindings of FN are unbound. | ||
| 443 | If UNINSTALL is non-nil, just remove the keys from ALIST." | ||
| 444 | (dolist (bind alist) | ||
| 445 | (dolist (old (where-is-internal (car bind) windmove-mode-map)) | ||
| 446 | (define-key windmove-mode-map old nil)) | ||
| 447 | (unless uninstall | ||
| 448 | (let ((key (vconcat (if (or (equal prefix [ignore]) | ||
| 449 | (eq prefix 'none)) | ||
| 450 | nil prefix) | ||
| 451 | (list (append modifiers (cdr bind)))))) | ||
| 452 | (when (eq (key-binding key) #'self-insert-command) | ||
| 453 | (warn "Command %S is shadowing self-insert-key" (car bind))) | ||
| 454 | (let ((old-fn (lookup-key windmove-mode-map key))) | ||
| 455 | (when (functionp old-fn) | ||
| 456 | (warn "Overriding %S with %S" old-fn (car bind)))) | ||
| 457 | (define-key windmove-mode-map key (car bind)))))) | ||
| 458 | |||
| 429 | ;;;###autoload | 459 | ;;;###autoload |
| 430 | (defun windmove-default-keybindings (&optional modifiers) | 460 | (defun windmove-default-keybindings (&optional modifiers) |
| 431 | "Set up keybindings for `windmove'. | 461 | "Set up keybindings for `windmove'. |
| 432 | Keybindings are of the form MODIFIERS-{left,right,up,down}, | 462 | Keybindings are of the form MODIFIERS-{left,right,up,down}, |
| 433 | where MODIFIERS is either a list of modifiers or a single modifier. | 463 | where MODIFIERS is either a list of modifiers or a single modifier. |
| 464 | If MODIFIERS is `none', the keybindings will be directly bound to | ||
| 465 | the arrow keys. | ||
| 434 | Default value of MODIFIERS is `shift'." | 466 | Default value of MODIFIERS is `shift'." |
| 435 | (interactive) | 467 | (interactive) |
| 436 | (unless modifiers (setq modifiers 'shift)) | 468 | (unless modifiers (setq modifiers 'shift)) |
| 469 | (when (eq modifiers 'none) (setq modifiers nil)) | ||
| 437 | (unless (listp modifiers) (setq modifiers (list modifiers))) | 470 | (unless (listp modifiers) (setq modifiers (list modifiers))) |
| 438 | (global-set-key (vector (append modifiers '(left))) 'windmove-left) | 471 | (windmove-install-defaults nil modifiers |
| 439 | (global-set-key (vector (append modifiers '(right))) 'windmove-right) | 472 | '((windmove-left left) |
| 440 | (global-set-key (vector (append modifiers '(up))) 'windmove-up) | 473 | (windmove-right right) |
| 441 | (global-set-key (vector (append modifiers '(down))) 'windmove-down)) | 474 | (windmove-up up) |
| 475 | (windmove-down down)))) | ||
| 442 | 476 | ||
| 443 | 477 | ||
| 444 | ;;; Directional window display and selection | 478 | ;;; Directional window display and selection |
| @@ -546,17 +580,21 @@ See the logic of the prefix ARG in `windmove-display-in-direction'." | |||
| 546 | Keys are bound to commands that display the next buffer in the specified | 580 | Keys are bound to commands that display the next buffer in the specified |
| 547 | direction. Keybindings are of the form MODIFIERS-{left,right,up,down}, | 581 | direction. Keybindings are of the form MODIFIERS-{left,right,up,down}, |
| 548 | where MODIFIERS is either a list of modifiers or a single modifier. | 582 | where MODIFIERS is either a list of modifiers or a single modifier. |
| 583 | If MODIFIERS is `none', the keybindings will be directly bound to | ||
| 584 | the arrow keys. | ||
| 549 | Default value of MODIFIERS is `shift-meta'." | 585 | Default value of MODIFIERS is `shift-meta'." |
| 550 | (interactive) | 586 | (interactive) |
| 551 | (unless modifiers (setq modifiers '(shift meta))) | 587 | (unless modifiers (setq modifiers '(shift meta))) |
| 588 | (when (eq modifiers 'none) (setq modifiers nil)) | ||
| 552 | (unless (listp modifiers) (setq modifiers (list modifiers))) | 589 | (unless (listp modifiers) (setq modifiers (list modifiers))) |
| 553 | (global-set-key (vector (append modifiers '(left))) 'windmove-display-left) | 590 | (windmove-install-defaults nil modifiers |
| 554 | (global-set-key (vector (append modifiers '(right))) 'windmove-display-right) | 591 | '((windmove-display-left left) |
| 555 | (global-set-key (vector (append modifiers '(up))) 'windmove-display-up) | 592 | (windmove-display-right right) |
| 556 | (global-set-key (vector (append modifiers '(down))) 'windmove-display-down) | 593 | (windmove-display-up up) |
| 557 | (global-set-key (vector (append modifiers '(?0))) 'windmove-display-same-window) | 594 | (windmove-display-down down) |
| 558 | (global-set-key (vector (append modifiers '(?f))) 'windmove-display-new-frame) | 595 | (windmove-display-same-window ?0) |
| 559 | (global-set-key (vector (append modifiers '(?t))) 'windmove-display-new-tab)) | 596 | (windmove-display-new-frame ?f) |
| 597 | (windmove-display-new-tab ?t)))) | ||
| 560 | 598 | ||
| 561 | 599 | ||
| 562 | ;;; Directional window deletion | 600 | ;;; Directional window deletion |
| @@ -618,16 +656,22 @@ select the window that was below the current one." | |||
| 618 | Keys are bound to commands that delete windows in the specified | 656 | Keys are bound to commands that delete windows in the specified |
| 619 | direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down}, | 657 | direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down}, |
| 620 | where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or | 658 | where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or |
| 621 | a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'." | 659 | a single modifier. |
| 660 | If PREFIX is `none', no prefix is used. If MODIFIERS is `none', the keybindings | ||
| 661 | are directly bound to the arrow keys. | ||
| 662 | Default value of PREFIX is `C-x' and MODIFIERS is `shift'." | ||
| 622 | (interactive) | 663 | (interactive) |
| 623 | (unless prefix (setq prefix '(?\C-x))) | 664 | (unless prefix (setq prefix '(?\C-x))) |
| 665 | (when (eq prefix 'none) (setq prefix nil)) | ||
| 624 | (unless (listp prefix) (setq prefix (list prefix))) | 666 | (unless (listp prefix) (setq prefix (list prefix))) |
| 625 | (unless modifiers (setq modifiers '(shift))) | 667 | (unless modifiers (setq modifiers '(shift))) |
| 668 | (when (eq modifiers 'none) (setq modifiers nil)) | ||
| 626 | (unless (listp modifiers) (setq modifiers (list modifiers))) | 669 | (unless (listp modifiers) (setq modifiers (list modifiers))) |
| 627 | (global-set-key (vector prefix (append modifiers '(left))) 'windmove-delete-left) | 670 | (windmove-install-defaults prefix modifiers |
| 628 | (global-set-key (vector prefix (append modifiers '(right))) 'windmove-delete-right) | 671 | '((windmove-delete-left left) |
| 629 | (global-set-key (vector prefix (append modifiers '(up))) 'windmove-delete-up) | 672 | (windmove-delete-right right) |
| 630 | (global-set-key (vector prefix (append modifiers '(down))) 'windmove-delete-down)) | 673 | (windmove-delete-up up) |
| 674 | (windmove-delete-down down)))) | ||
| 631 | 675 | ||
| 632 | 676 | ||
| 633 | ;;; Directional window swap states | 677 | ;;; Directional window swap states |
| @@ -673,14 +717,103 @@ from the opposite side of the frame." | |||
| 673 | Keys are bound to commands that swap the states of the selected window | 717 | Keys are bound to commands that swap the states of the selected window |
| 674 | with the window in the specified direction. Keybindings are of the form | 718 | with the window in the specified direction. Keybindings are of the form |
| 675 | MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers | 719 | MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers |
| 676 | or a single modifier. Default value of MODIFIERS is `shift-super'." | 720 | or a single modifier. |
| 721 | If MODIFIERS is `none', the keybindings will be directly bound to the | ||
| 722 | arrow keys. | ||
| 723 | Default value of MODIFIERS is `shift-super'." | ||
| 677 | (interactive) | 724 | (interactive) |
| 678 | (unless modifiers (setq modifiers '(shift super))) | 725 | (unless modifiers (setq modifiers '(shift super))) |
| 726 | (when (eq modifiers 'none) (setq modifiers nil)) | ||
| 679 | (unless (listp modifiers) (setq modifiers (list modifiers))) | 727 | (unless (listp modifiers) (setq modifiers (list modifiers))) |
| 680 | (global-set-key (vector (append modifiers '(left))) 'windmove-swap-states-left) | 728 | (windmove-install-defaults nil modifiers |
| 681 | (global-set-key (vector (append modifiers '(right))) 'windmove-swap-states-right) | 729 | '((windmove-swap-states-left left) |
| 682 | (global-set-key (vector (append modifiers '(up))) 'windmove-swap-states-up) | 730 | (windmove-swap-states-right right) |
| 683 | (global-set-key (vector (append modifiers '(down))) 'windmove-swap-states-down)) | 731 | (windmove-swap-states-up up) |
| 732 | (windmove-swap-states-down down)))) | ||
| 733 | |||
| 734 | |||
| 735 | |||
| 736 | (defconst windmove--default-keybindings-type | ||
| 737 | `(choice (const :tag "Don't bind" nil) | ||
| 738 | (cons :tag "Bind using" | ||
| 739 | (key-sequence :tag "Prefix") | ||
| 740 | (set :tag "Modifier" | ||
| 741 | :greedy t | ||
| 742 | ;; See `(elisp) Keyboard Events' | ||
| 743 | (const :tag "Meta" meta) | ||
| 744 | (const :tag "Control" control) | ||
| 745 | (const :tag "Shift" shift) | ||
| 746 | (const :tag "Hyper" hyper) | ||
| 747 | (const :tag "Super" super) | ||
| 748 | (const :tag "Alt" alt)))) | ||
| 749 | "Customisation type for windmove modifiers.") | ||
| 750 | |||
| 751 | (defcustom windmove-default-keybindings nil | ||
| 752 | "Default keybindings for regular windmove commands. | ||
| 753 | See `windmove-default-keybindings' for more detail." | ||
| 754 | :set (lambda (sym val) | ||
| 755 | (windmove-install-defaults | ||
| 756 | (car val) (cdr val) | ||
| 757 | '((windmove-left left) | ||
| 758 | (windmove-right right) | ||
| 759 | (windmove-up up) | ||
| 760 | (windmove-down down)) | ||
| 761 | (null val)) | ||
| 762 | (set-default sym val)) | ||
| 763 | :type windmove--default-keybindings-type | ||
| 764 | :version "28.1" | ||
| 765 | :group 'windmove) | ||
| 766 | |||
| 767 | (defcustom windmove-display-default-keybindings nil | ||
| 768 | "Default keybindings for windmove directional buffer display commands. | ||
| 769 | See `windmove-display-default-keybindings' for more detail." | ||
| 770 | :set (lambda (sym val) | ||
| 771 | (windmove-install-defaults | ||
| 772 | (car val) (cdr val) | ||
| 773 | '((windmove-display-left left) | ||
| 774 | (windmove-display-right right) | ||
| 775 | (windmove-display-up up) | ||
| 776 | (windmove-display-down down) | ||
| 777 | (windmove-display-same-window ?0) | ||
| 778 | (windmove-display-new-frame ?f) | ||
| 779 | (windmove-display-new-tab ?t)) | ||
| 780 | (null val)) | ||
| 781 | (set-default sym val)) | ||
| 782 | :type windmove--default-keybindings-type | ||
| 783 | :version "28.1" | ||
| 784 | :group 'windmove) | ||
| 785 | |||
| 786 | (defcustom windmove-delete-default-keybindings nil | ||
| 787 | "Default keybindings for windmove directional window deletion commands. | ||
| 788 | See `windmove-delete-default-keybindings' for more detail." | ||
| 789 | :set (lambda (sym val) | ||
| 790 | (windmove-install-defaults | ||
| 791 | (car val) (cdr val) | ||
| 792 | '((windmove-delete-left left) | ||
| 793 | (windmove-delete-right right) | ||
| 794 | (windmove-delete-up up) | ||
| 795 | (windmove-delete-down down)) | ||
| 796 | (null val)) | ||
| 797 | (set-default sym val)) | ||
| 798 | :type windmove--default-keybindings-type | ||
| 799 | :version "28.1" | ||
| 800 | :group 'windmove) | ||
| 801 | |||
| 802 | (defcustom windmove-swap-states-default-keybindings nil | ||
| 803 | "Default keybindings for windmove's directional window swap-state commands. | ||
| 804 | See `windmove-swap-states-default-keybindings' for more detail." | ||
| 805 | :set (lambda (sym val) | ||
| 806 | (windmove-install-defaults | ||
| 807 | (car val) (cdr val) | ||
| 808 | '((windmove-swap-states-left left) | ||
| 809 | (windmove-swap-states-right right) | ||
| 810 | (windmove-swap-states-up up) | ||
| 811 | (windmove-swap-states-down down)) | ||
| 812 | (null val)) | ||
| 813 | (set-default sym val)) | ||
| 814 | :type windmove--default-keybindings-type | ||
| 815 | :version "28.1" | ||
| 816 | :group 'windmove) | ||
| 684 | 817 | ||
| 685 | 818 | ||
| 686 | (provide 'windmove) | 819 | (provide 'windmove) |
diff --git a/lisp/window.el b/lisp/window.el index fd1c617d6be..ff4a39a2a0a 100644 --- a/lisp/window.el +++ b/lisp/window.el | |||
| @@ -2499,14 +2499,16 @@ and no others." | |||
| 2499 | 2499 | ||
| 2500 | (defalias 'some-window 'get-window-with-predicate) | 2500 | (defalias 'some-window 'get-window-with-predicate) |
| 2501 | 2501 | ||
| 2502 | (defun get-lru-window (&optional all-frames dedicated not-selected) | 2502 | (defun get-lru-window (&optional all-frames dedicated not-selected no-other) |
| 2503 | "Return the least recently used window on frames specified by ALL-FRAMES. | 2503 | "Return the least recently used window on frames specified by ALL-FRAMES. |
| 2504 | Return a full-width window if possible. A minibuffer window is | 2504 | Return a full-width window if possible. A minibuffer window is |
| 2505 | never a candidate. A dedicated window is never a candidate | 2505 | never a candidate. A dedicated window is never a candidate |
| 2506 | unless DEDICATED is non-nil, so if all windows are dedicated, the | 2506 | unless DEDICATED is non-nil, so if all windows are dedicated, the |
| 2507 | value is nil. Avoid returning the selected window if possible. | 2507 | value is nil. Avoid returning the selected window if possible. |
| 2508 | Optional argument NOT-SELECTED non-nil means never return the | 2508 | Optional argument NOT-SELECTED non-nil means never return the |
| 2509 | selected window. | 2509 | selected window. Optional argument NO-OTHER non-nil means to |
| 2510 | never return a window whose 'no-other-window' parameter is | ||
| 2511 | non-nil. | ||
| 2510 | 2512 | ||
| 2511 | The following non-nil values of the optional argument ALL-FRAMES | 2513 | The following non-nil values of the optional argument ALL-FRAMES |
| 2512 | have special meanings: | 2514 | have special meanings: |
| @@ -2526,7 +2528,9 @@ selected frame and no others." | |||
| 2526 | (let (best-window best-time second-best-window second-best-time time) | 2528 | (let (best-window best-time second-best-window second-best-time time) |
| 2527 | (dolist (window (window-list-1 nil 'nomini all-frames)) | 2529 | (dolist (window (window-list-1 nil 'nomini all-frames)) |
| 2528 | (when (and (or dedicated (not (window-dedicated-p window))) | 2530 | (when (and (or dedicated (not (window-dedicated-p window))) |
| 2529 | (or (not not-selected) (not (eq window (selected-window))))) | 2531 | (or (not not-selected) (not (eq window (selected-window)))) |
| 2532 | (or (not no-other) | ||
| 2533 | (not (window-parameter window 'no-other-window)))) | ||
| 2530 | (setq time (window-use-time window)) | 2534 | (setq time (window-use-time window)) |
| 2531 | (if (or (eq window (selected-window)) | 2535 | (if (or (eq window (selected-window)) |
| 2532 | (not (window-full-width-p window))) | 2536 | (not (window-full-width-p window))) |
| @@ -2538,12 +2542,14 @@ selected frame and no others." | |||
| 2538 | (setq best-window window))))) | 2542 | (setq best-window window))))) |
| 2539 | (or best-window second-best-window))) | 2543 | (or best-window second-best-window))) |
| 2540 | 2544 | ||
| 2541 | (defun get-mru-window (&optional all-frames dedicated not-selected) | 2545 | (defun get-mru-window (&optional all-frames dedicated not-selected no-other) |
| 2542 | "Return the most recently used window on frames specified by ALL-FRAMES. | 2546 | "Return the most recently used window on frames specified by ALL-FRAMES. |
| 2543 | A minibuffer window is never a candidate. A dedicated window is | 2547 | A minibuffer window is never a candidate. A dedicated window is |
| 2544 | never a candidate unless DEDICATED is non-nil, so if all windows | 2548 | never a candidate unless DEDICATED is non-nil, so if all windows |
| 2545 | are dedicated, the value is nil. Optional argument NOT-SELECTED | 2549 | are dedicated, the value is nil. Optional argument NOT-SELECTED |
| 2546 | non-nil means never return the selected window. | 2550 | non-nil means never return the selected window. Optional |
| 2551 | argument NO-OTHER non-nil means to never return a window whose | ||
| 2552 | 'no-other-window' parameter is non-nil. | ||
| 2547 | 2553 | ||
| 2548 | The following non-nil values of the optional argument ALL-FRAMES | 2554 | The following non-nil values of the optional argument ALL-FRAMES |
| 2549 | have special meanings: | 2555 | have special meanings: |
| @@ -2565,17 +2571,21 @@ selected frame and no others." | |||
| 2565 | (setq time (window-use-time window)) | 2571 | (setq time (window-use-time window)) |
| 2566 | (when (and (or dedicated (not (window-dedicated-p window))) | 2572 | (when (and (or dedicated (not (window-dedicated-p window))) |
| 2567 | (or (not not-selected) (not (eq window (selected-window)))) | 2573 | (or (not not-selected) (not (eq window (selected-window)))) |
| 2568 | (or (not best-time) (> time best-time))) | 2574 | (or (not no-other) |
| 2575 | (not (window-parameter window 'no-other-window))) | ||
| 2576 | (or (not best-time) (> time best-time))) | ||
| 2569 | (setq best-time time) | 2577 | (setq best-time time) |
| 2570 | (setq best-window window))) | 2578 | (setq best-window window))) |
| 2571 | best-window)) | 2579 | best-window)) |
| 2572 | 2580 | ||
| 2573 | (defun get-largest-window (&optional all-frames dedicated not-selected) | 2581 | (defun get-largest-window (&optional all-frames dedicated not-selected no-other) |
| 2574 | "Return the largest window on frames specified by ALL-FRAMES. | 2582 | "Return the largest window on frames specified by ALL-FRAMES. |
| 2575 | A minibuffer window is never a candidate. A dedicated window is | 2583 | A minibuffer window is never a candidate. A dedicated window is |
| 2576 | never a candidate unless DEDICATED is non-nil, so if all windows | 2584 | never a candidate unless DEDICATED is non-nil, so if all windows |
| 2577 | are dedicated, the value is nil. Optional argument NOT-SELECTED | 2585 | are dedicated, the value is nil. Optional argument NOT-SELECTED |
| 2578 | non-nil means never return the selected window. | 2586 | non-nil means never return the selected window. Optional |
| 2587 | argument NO-OTHER non-nil means to never return a window whose | ||
| 2588 | 'no-other-window' parameter is non-nil. | ||
| 2579 | 2589 | ||
| 2580 | The following non-nil values of the optional argument ALL-FRAMES | 2590 | The following non-nil values of the optional argument ALL-FRAMES |
| 2581 | have special meanings: | 2591 | have special meanings: |
| @@ -2596,7 +2606,9 @@ selected frame and no others." | |||
| 2596 | best-window size) | 2606 | best-window size) |
| 2597 | (dolist (window (window-list-1 nil 'nomini all-frames)) | 2607 | (dolist (window (window-list-1 nil 'nomini all-frames)) |
| 2598 | (when (and (or dedicated (not (window-dedicated-p window))) | 2608 | (when (and (or dedicated (not (window-dedicated-p window))) |
| 2599 | (or (not not-selected) (not (eq window (selected-window))))) | 2609 | (or (not not-selected) (not (eq window (selected-window)))) |
| 2610 | (or (not no-other) | ||
| 2611 | (not (window-parameter window 'no-other-window)))) | ||
| 2600 | (setq size (* (window-pixel-height window) | 2612 | (setq size (* (window-pixel-height window) |
| 2601 | (window-pixel-width window))) | 2613 | (window-pixel-width window))) |
| 2602 | (when (> size best-size) | 2614 | (when (> size best-size) |
| @@ -4130,18 +4142,56 @@ frame can be safely deleted." | |||
| 4130 | ;; of its frame. | 4142 | ;; of its frame. |
| 4131 | t)))) | 4143 | t)))) |
| 4132 | 4144 | ||
| 4133 | (defun window--in-subtree-p (window root) | 4145 | (defun window-at-x-y (x y &optional frame no-other) |
| 4134 | "Return t if WINDOW is either ROOT or a member of ROOT's subtree." | 4146 | "Return live window at coordinates X, Y on specified FRAME. |
| 4135 | (or (eq window root) | 4147 | X and Y are FRAME-relative pixel coordinates. A coordinate on an |
| 4136 | (let ((parent (window-parent window))) | 4148 | edge shared by two windows is attributed to the window on the |
| 4137 | (catch 'done | 4149 | right (or below). Return nil if no such window can be found. |
| 4138 | (while parent | 4150 | |
| 4139 | (if (eq parent root) | 4151 | Optional argument FRAME must specify a live frame and defaults to |
| 4140 | (throw 'done t) | 4152 | the selected one. Optional argument NO-OTHER non-nil means to |
| 4141 | (setq parent (window-parent parent)))))))) | 4153 | return nil if the window located at the specified coordinates has |
| 4154 | a non-nil `no-other-window' parameter." | ||
| 4155 | (setq frame (window-normalize-frame frame)) | ||
| 4156 | (let* ((root-edges (window-edges (frame-root-window frame) nil nil t)) | ||
| 4157 | (root-left (nth 2 root-edges)) | ||
| 4158 | (root-bottom (nth 3 root-edges))) | ||
| 4159 | (catch 'window | ||
| 4160 | (walk-window-tree | ||
| 4161 | (lambda (window) | ||
| 4162 | (let ((edges (window-edges window nil nil t))) | ||
| 4163 | (when (and (>= x (nth 0 edges)) | ||
| 4164 | (or (< x (nth 2 edges)) (= x root-left)) | ||
| 4165 | (>= y (nth 1 edges)) | ||
| 4166 | (or (< y (nth 3 edges)) (= y root-bottom))) | ||
| 4167 | (if (and no-other (window-parameter window 'no-other-window)) | ||
| 4168 | (throw 'window nil) | ||
| 4169 | (throw 'window window))))) | ||
| 4170 | frame)))) | ||
| 4171 | |||
| 4172 | (defcustom delete-window-choose-selected 'mru | ||
| 4173 | "How to choose a frame's selected window after window deletion. | ||
| 4174 | When a frame's selected window gets deleted, Emacs has to choose | ||
| 4175 | another live window on that frame to serve as its selected | ||
| 4176 | window. This option allows to control which window gets selected | ||
| 4177 | instead. | ||
| 4178 | |||
| 4179 | The possible choices are 'mru' (the default) to select the most | ||
| 4180 | recently used window on that frame, and 'pos' to choose the | ||
| 4181 | window at the frame coordinates of point of the previously | ||
| 4182 | selected window. If this is nil, choose the frame's first window | ||
| 4183 | instead. A window with a non-nil `no-other-window' parameter is | ||
| 4184 | chosen only if all windows on that frame have that parameter set | ||
| 4185 | to a non-nil value." | ||
| 4186 | :type '(choice (const :tag "Most recently used" mru) | ||
| 4187 | (const :tag "At position of deleted" pos) | ||
| 4188 | (const :tag "Frame's first " nil)) | ||
| 4189 | :group 'windows | ||
| 4190 | :group 'frames | ||
| 4191 | :version "28.1") | ||
| 4142 | 4192 | ||
| 4143 | (defun delete-window (&optional window) | 4193 | (defun delete-window (&optional window) |
| 4144 | "Delete WINDOW. | 4194 | "Delete specified WINDOW. |
| 4145 | WINDOW must be a valid window and defaults to the selected one. | 4195 | WINDOW must be a valid window and defaults to the selected one. |
| 4146 | Return nil. | 4196 | Return nil. |
| 4147 | 4197 | ||
| @@ -4156,7 +4206,11 @@ Otherwise, if WINDOW is part of an atomic window, call | |||
| 4156 | `delete-window' with the root of the atomic window as its | 4206 | `delete-window' with the root of the atomic window as its |
| 4157 | argument. Signal an error if WINDOW is either the only window on | 4207 | argument. Signal an error if WINDOW is either the only window on |
| 4158 | its frame, the last non-side window, or part of an atomic window | 4208 | its frame, the last non-side window, or part of an atomic window |
| 4159 | that is its frame's root window." | 4209 | that is its frame's root window. |
| 4210 | |||
| 4211 | If WINDOW is the selected window on its frame, choose some other | ||
| 4212 | window as that frame's selected window according to the value of | ||
| 4213 | the option `delete-window-choose-selected'." | ||
| 4160 | (interactive) | 4214 | (interactive) |
| 4161 | (setq window (window-normalize-window window)) | 4215 | (setq window (window-normalize-window window)) |
| 4162 | (let* ((frame (window-frame window)) | 4216 | (let* ((frame (window-frame window)) |
| @@ -4191,11 +4245,11 @@ that is its frame's root window." | |||
| 4191 | (window-combination-resize | 4245 | (window-combination-resize |
| 4192 | (or window-combination-resize | 4246 | (or window-combination-resize |
| 4193 | (window-parameter parent 'window-side))) | 4247 | (window-parameter parent 'window-side))) |
| 4194 | (frame-selected | 4248 | (frame-selected-window (frame-selected-window frame)) |
| 4195 | (window--in-subtree-p (frame-selected-window frame) window)) | ||
| 4196 | ;; Emacs 23 preferably gives WINDOW's space to its left | 4249 | ;; Emacs 23 preferably gives WINDOW's space to its left |
| 4197 | ;; sibling. | 4250 | ;; sibling. |
| 4198 | (sibling (or (window-left window) (window-right window)))) | 4251 | (sibling (or (window-left window) (window-right window))) |
| 4252 | frame-selected-window-edges frame-selected-window-pos) | ||
| 4199 | (window--resize-reset frame horizontal) | 4253 | (window--resize-reset frame horizontal) |
| 4200 | (cond | 4254 | (cond |
| 4201 | ((and (not (eq window-combination-resize t)) | 4255 | ((and (not (eq window-combination-resize t)) |
| @@ -4211,15 +4265,63 @@ that is its frame's root window." | |||
| 4211 | (t | 4265 | (t |
| 4212 | ;; Can't do without resizing fixed-size windows. | 4266 | ;; Can't do without resizing fixed-size windows. |
| 4213 | (window--resize-siblings window (- size) horizontal t))) | 4267 | (window--resize-siblings window (- size) horizontal t))) |
| 4268 | |||
| 4269 | (when (eq delete-window-choose-selected 'pos) | ||
| 4270 | ;; Remember edges and position of point of the selected window | ||
| 4271 | ;; of WINDOW'S frame. | ||
| 4272 | (setq frame-selected-window-edges | ||
| 4273 | (window-edges frame-selected-window nil nil t)) | ||
| 4274 | (setq frame-selected-window-pos | ||
| 4275 | (nth 2 (posn-at-point nil frame-selected-window)))) | ||
| 4276 | |||
| 4214 | ;; Actually delete WINDOW. | 4277 | ;; Actually delete WINDOW. |
| 4215 | (delete-window-internal window) | 4278 | (delete-window-internal window) |
| 4216 | (window--pixel-to-total frame horizontal) | 4279 | (window--pixel-to-total frame horizontal) |
| 4217 | (when (and frame-selected | 4280 | |
| 4218 | (window-parameter | 4281 | ;; If we deleted the selected window of WINDOW's frame, choose |
| 4219 | (frame-selected-window frame) 'no-other-window)) | 4282 | ;; another one based on `delete-window-choose-selected'. Note |
| 4220 | ;; `delete-window-internal' has selected a window that should | 4283 | ;; that both `window-at-x-y' and `get-mru-window' may fail to |
| 4221 | ;; not be selected, fix this here. | 4284 | ;; produce a suitable window in which case we will fall back on |
| 4222 | (other-window -1 frame)) | 4285 | ;; its frame's first window, chosen by `delete-window-internal'. |
| 4286 | (cond | ||
| 4287 | ((window-live-p frame-selected-window)) | ||
| 4288 | ((and frame-selected-window-pos | ||
| 4289 | ;; We have a recorded position of point of the previously | ||
| 4290 | ;; selected window. Try to find the window that is now | ||
| 4291 | ;; at that position. | ||
| 4292 | (let ((new-frame-selected-window | ||
| 4293 | (window-at-x-y | ||
| 4294 | (+ (nth 0 frame-selected-window-edges) | ||
| 4295 | (car frame-selected-window-pos)) | ||
| 4296 | (+ (nth 1 frame-selected-window-edges) | ||
| 4297 | (cdr frame-selected-window-pos)) | ||
| 4298 | frame t))) | ||
| 4299 | (and new-frame-selected-window | ||
| 4300 | ;; Select window at WINDOW's position at point. | ||
| 4301 | (set-frame-selected-window | ||
| 4302 | frame new-frame-selected-window))))) | ||
| 4303 | ((and (eq delete-window-choose-selected 'mru) | ||
| 4304 | ;; Try to use the most recently used window. | ||
| 4305 | (let ((mru-window (get-mru-window frame nil nil t))) | ||
| 4306 | (and mru-window | ||
| 4307 | (set-frame-selected-window frame mru-window))))) | ||
| 4308 | ((and (window-parameter | ||
| 4309 | (frame-selected-window frame) 'no-other-window) | ||
| 4310 | ;; If `delete-window-internal' selected a window with a | ||
| 4311 | ;; non-nil 'no-other-window' parameter as its frame's | ||
| 4312 | ;; selected window, try to choose another one. | ||
| 4313 | (catch 'found | ||
| 4314 | (walk-window-tree | ||
| 4315 | (lambda (other) | ||
| 4316 | (unless (window-parameter other 'no-other-window) | ||
| 4317 | (set-frame-selected-window frame other) | ||
| 4318 | (throw 'found t))) | ||
| 4319 | frame)))) | ||
| 4320 | (t | ||
| 4321 | ;; Record the window chosen by `delete-window-internal'. | ||
| 4322 | (set-frame-selected-window | ||
| 4323 | frame (frame-selected-window frame)))) | ||
| 4324 | |||
| 4223 | (window--check frame) | 4325 | (window--check frame) |
| 4224 | ;; Always return nil. | 4326 | ;; Always return nil. |
| 4225 | nil)))) | 4327 | nil)))) |
diff --git a/lisp/xdg.el b/lisp/xdg.el index 11039499ea9..0bdfd114c48 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el | |||
| @@ -231,7 +231,7 @@ admin config, and finally system cached associations." | |||
| 231 | (desktop (getenv "XDG_CURRENT_DESKTOP")) | 231 | (desktop (getenv "XDG_CURRENT_DESKTOP")) |
| 232 | res) | 232 | res) |
| 233 | (when desktop | 233 | (when desktop |
| 234 | (setq desktop (format "%s-mimeapps.list" desktop))) | 234 | (setq desktop (list (format "%s-mimeapps.list" desktop)))) |
| 235 | (dolist (name (cons "mimeapps.list" desktop)) | 235 | (dolist (name (cons "mimeapps.list" desktop)) |
| 236 | (push (expand-file-name name (xdg-config-home)) res) | 236 | (push (expand-file-name name (xdg-config-home)) res) |
| 237 | (push (expand-file-name (format "applications/%s" name) (xdg-data-home)) | 237 | (push (expand-file-name (format "applications/%s" name) (xdg-data-home)) |
diff --git a/src/character.c b/src/character.c index e874cf5e53c..38a81d36b09 100644 --- a/src/character.c +++ b/src/character.c | |||
| @@ -328,12 +328,14 @@ strwidth (const char *str, ptrdiff_t len) | |||
| 328 | compositions. If PRECISION > 0, return the width of longest | 328 | compositions. If PRECISION > 0, return the width of longest |
| 329 | substring that doesn't exceed PRECISION, and set number of | 329 | substring that doesn't exceed PRECISION, and set number of |
| 330 | characters and bytes of the substring in *NCHARS and *NBYTES | 330 | characters and bytes of the substring in *NCHARS and *NBYTES |
| 331 | respectively. FROM and TO are zero-based character indices | 331 | respectively. FROM and TO are zero-based character indices that |
| 332 | that define the substring of STRING to consider. */ | 332 | define the substring of STRING to consider. If AUTO_COMP is |
| 333 | non-zero, account for automatic compositions in STRING. */ | ||
| 333 | 334 | ||
| 334 | ptrdiff_t | 335 | ptrdiff_t |
| 335 | lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to, | 336 | lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to, |
| 336 | ptrdiff_t precision, ptrdiff_t *nchars, ptrdiff_t *nbytes) | 337 | ptrdiff_t precision, ptrdiff_t *nchars, ptrdiff_t *nbytes, |
| 338 | bool auto_comp) | ||
| 337 | { | 339 | { |
| 338 | /* This set multibyte to 0 even if STRING is multibyte when it | 340 | /* This set multibyte to 0 even if STRING is multibyte when it |
| 339 | contains only ascii and eight-bit-graphic, but that's | 341 | contains only ascii and eight-bit-graphic, but that's |
| @@ -370,9 +372,11 @@ lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to, | |||
| 370 | bytes = string_char_to_byte (string, end) - i_byte; | 372 | bytes = string_char_to_byte (string, end) - i_byte; |
| 371 | } | 373 | } |
| 372 | #ifdef HAVE_WINDOW_SYSTEM | 374 | #ifdef HAVE_WINDOW_SYSTEM |
| 373 | else if (f && FRAME_WINDOW_P (f) | 375 | else if (auto_comp |
| 376 | && f && FRAME_WINDOW_P (f) | ||
| 374 | && multibyte | 377 | && multibyte |
| 375 | && find_automatic_composition (i, -1, &ignore, &end, &val, string) | 378 | && find_automatic_composition (i, -1, i, &ignore, |
| 379 | &end, &val, string) | ||
| 376 | && end > i) | 380 | && end > i) |
| 377 | { | 381 | { |
| 378 | int j; | 382 | int j; |
| @@ -471,7 +475,7 @@ usage: (string-width STRING &optional FROM TO) */) | |||
| 471 | 475 | ||
| 472 | CHECK_STRING (str); | 476 | CHECK_STRING (str); |
| 473 | validate_subarray (str, from, to, SCHARS (str), &ifrom, &ito); | 477 | validate_subarray (str, from, to, SCHARS (str), &ifrom, &ito); |
| 474 | XSETFASTINT (val, lisp_string_width (str, ifrom, ito, -1, NULL, NULL)); | 478 | XSETFASTINT (val, lisp_string_width (str, ifrom, ito, -1, NULL, NULL, true)); |
| 475 | return val; | 479 | return val; |
| 476 | } | 480 | } |
| 477 | 481 | ||
diff --git a/src/character.h b/src/character.h index 75351cd1edf..1a745484daa 100644 --- a/src/character.h +++ b/src/character.h | |||
| @@ -573,7 +573,7 @@ extern ptrdiff_t strwidth (const char *, ptrdiff_t); | |||
| 573 | extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int, | 573 | extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int, |
| 574 | ptrdiff_t *, ptrdiff_t *); | 574 | ptrdiff_t *, ptrdiff_t *); |
| 575 | extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, ptrdiff_t, | 575 | extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, ptrdiff_t, |
| 576 | ptrdiff_t, ptrdiff_t *, ptrdiff_t *); | 576 | ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool); |
| 577 | 577 | ||
| 578 | extern Lisp_Object Vchar_unify_table; | 578 | extern Lisp_Object Vchar_unify_table; |
| 579 | extern Lisp_Object string_escape_byte8 (Lisp_Object); | 579 | extern Lisp_Object string_escape_byte8 (Lisp_Object); |
diff --git a/src/composite.c b/src/composite.c index 17d5914e634..129e9d6bb25 100644 --- a/src/composite.c +++ b/src/composite.c | |||
| @@ -1473,14 +1473,60 @@ struct position_record | |||
| 1473 | (POSITION).pos--; \ | 1473 | (POSITION).pos--; \ |
| 1474 | } while (0) | 1474 | } while (0) |
| 1475 | 1475 | ||
| 1476 | /* This is like find_composition, but find an automatic composition | 1476 | /* Similar to find_composition, but find an automatic composition instead. |
| 1477 | instead. It is assured that POS is not within a static | 1477 | |
| 1478 | composition. If found, set *GSTRING to the glyph-string | 1478 | This function looks for automatic composition at or near position |
| 1479 | representing the composition, and return true. Otherwise, *GSTRING to | 1479 | POS of OBJECT (a buffer or a string). OBJECT defaults to the |
| 1480 | Qnil, and return false. */ | 1480 | current buffer. It must be assured that POS is not within a static |
| 1481 | composition. Also, the current buffer must be displayed in some | ||
| 1482 | window, otherwise the function will return FALSE. | ||
| 1483 | |||
| 1484 | If LIMIT is negative, and there's no composition that includes POS | ||
| 1485 | (i.e. starts at or before POS and ends at or after POS), return | ||
| 1486 | FALSE. In this case, the function is allowed to look from POS as | ||
| 1487 | far back as BACKLIM, and as far forward as POS+1 plus | ||
| 1488 | MAX_AUTO_COMPOSITION_LOOKBACK, the maximum number of look-back for | ||
| 1489 | automatic compositions (3) -- this is a limitation imposed by | ||
| 1490 | composition rules in composition-function-table, which see. If | ||
| 1491 | BACKLIM is negative, it stands for the beginning of OBJECT: BEGV | ||
| 1492 | for a buffer or position zero for a string. | ||
| 1493 | |||
| 1494 | If LIMIT is positive, search for a composition forward (LIMIT > | ||
| 1495 | POS) or backward (LIMIT < POS). In this case, LIMIT bounds the | ||
| 1496 | search for the first character of a composed sequence. | ||
| 1497 | (LIMIT == POS is the same as LIMIT < 0.) If LIMIT > POS, the | ||
| 1498 | function can find a composition that starts after POS. | ||
| 1499 | |||
| 1500 | BACKLIM limits how far back is the function allowed to look in | ||
| 1501 | OBJECT while trying to find a position where it is safe to start | ||
| 1502 | searching forward for compositions. Such a safe place is generally | ||
| 1503 | the position after a character that can never be composed. | ||
| 1504 | |||
| 1505 | If BACKLIM is negative, that means the first character position of | ||
| 1506 | OBJECT; this is useful when calling the function for the first time | ||
| 1507 | for a given buffer or string, since it is possible that a | ||
| 1508 | composition begins before POS. However, if POS is very far from | ||
| 1509 | the beginning of OBJECT, a negative value of BACKLIM could make the | ||
| 1510 | function slow. Also, in this case the function may return START | ||
| 1511 | and END that do not include POS, something that is not necessarily | ||
| 1512 | wanted, and needs to be explicitly checked by the caller. | ||
| 1513 | |||
| 1514 | When calling the function in a loop for the same buffer/string, the | ||
| 1515 | caller should generally set BACKLIM equal to POS, to avoid costly | ||
| 1516 | repeated searches backward. This is because if the previous | ||
| 1517 | positions were already checked for compositions, there should be no | ||
| 1518 | reason to re-check them. | ||
| 1519 | |||
| 1520 | If BACKLIM is positive, it must be less or equal to LIMIT. | ||
| 1521 | |||
| 1522 | If an automatic composition satisfying the above conditions is | ||
| 1523 | found, set *GSTRING to the Lispy glyph-string representing the | ||
| 1524 | composition, set *START and *END to the start and end of the | ||
| 1525 | composed sequence, and return TRUE. Otherwise, set *GSTRING to | ||
| 1526 | nil, and return FALSE. */ | ||
| 1481 | 1527 | ||
| 1482 | bool | 1528 | bool |
| 1483 | find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, | 1529 | find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim, |
| 1484 | ptrdiff_t *start, ptrdiff_t *end, | 1530 | ptrdiff_t *start, ptrdiff_t *end, |
| 1485 | Lisp_Object *gstring, Lisp_Object string) | 1531 | Lisp_Object *gstring, Lisp_Object string) |
| 1486 | { | 1532 | { |
| @@ -1502,13 +1548,13 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, | |||
| 1502 | cur.pos = pos; | 1548 | cur.pos = pos; |
| 1503 | if (NILP (string)) | 1549 | if (NILP (string)) |
| 1504 | { | 1550 | { |
| 1505 | head = BEGV, tail = ZV, stop = GPT; | 1551 | head = backlim < 0 ? BEGV : backlim, tail = ZV, stop = GPT; |
| 1506 | cur.pos_byte = CHAR_TO_BYTE (cur.pos); | 1552 | cur.pos_byte = CHAR_TO_BYTE (cur.pos); |
| 1507 | cur.p = BYTE_POS_ADDR (cur.pos_byte); | 1553 | cur.p = BYTE_POS_ADDR (cur.pos_byte); |
| 1508 | } | 1554 | } |
| 1509 | else | 1555 | else |
| 1510 | { | 1556 | { |
| 1511 | head = 0, tail = SCHARS (string), stop = -1; | 1557 | head = backlim < 0 ? 0 : backlim, tail = SCHARS (string), stop = -1; |
| 1512 | cur.pos_byte = string_char_to_byte (string, cur.pos); | 1558 | cur.pos_byte = string_char_to_byte (string, cur.pos); |
| 1513 | cur.p = SDATA (string) + cur.pos_byte; | 1559 | cur.p = SDATA (string) + cur.pos_byte; |
| 1514 | } | 1560 | } |
| @@ -1516,6 +1562,9 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, | |||
| 1516 | /* Finding a composition covering the character after POS is the | 1562 | /* Finding a composition covering the character after POS is the |
| 1517 | same as setting LIMIT to POS. */ | 1563 | same as setting LIMIT to POS. */ |
| 1518 | limit = pos; | 1564 | limit = pos; |
| 1565 | |||
| 1566 | eassert (backlim < 0 || backlim <= limit); | ||
| 1567 | |||
| 1519 | if (limit <= pos) | 1568 | if (limit <= pos) |
| 1520 | fore_check_limit = min (tail, pos + 1 + MAX_AUTO_COMPOSITION_LOOKBACK); | 1569 | fore_check_limit = min (tail, pos + 1 + MAX_AUTO_COMPOSITION_LOOKBACK); |
| 1521 | else | 1570 | else |
| @@ -1696,8 +1745,8 @@ composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt) | |||
| 1696 | return new_pt; | 1745 | return new_pt; |
| 1697 | 1746 | ||
| 1698 | /* Next check the automatic composition. */ | 1747 | /* Next check the automatic composition. */ |
| 1699 | if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, &beg, &end, &val, | 1748 | if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, (ptrdiff_t) -1, |
| 1700 | Qnil) | 1749 | &beg, &end, &val, Qnil) |
| 1701 | || beg == new_pt) | 1750 | || beg == new_pt) |
| 1702 | return new_pt; | 1751 | return new_pt; |
| 1703 | for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++) | 1752 | for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++) |
| @@ -1893,8 +1942,8 @@ See `find-composition' for more details. */) | |||
| 1893 | { | 1942 | { |
| 1894 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) | 1943 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 1895 | && ! NILP (Vauto_composition_mode) | 1944 | && ! NILP (Vauto_composition_mode) |
| 1896 | && find_automatic_composition (from, to, &start, &end, &gstring, | 1945 | && find_automatic_composition (from, to, (ptrdiff_t) -1, |
| 1897 | string)) | 1946 | &start, &end, &gstring, string)) |
| 1898 | return list3 (make_fixnum (start), make_fixnum (end), gstring); | 1947 | return list3 (make_fixnum (start), make_fixnum (end), gstring); |
| 1899 | return Qnil; | 1948 | return Qnil; |
| 1900 | } | 1949 | } |
| @@ -1902,7 +1951,8 @@ See `find-composition' for more details. */) | |||
| 1902 | { | 1951 | { |
| 1903 | ptrdiff_t s, e; | 1952 | ptrdiff_t s, e; |
| 1904 | 1953 | ||
| 1905 | if (find_automatic_composition (from, to, &s, &e, &gstring, string) | 1954 | if (find_automatic_composition (from, to, (ptrdiff_t) -1, |
| 1955 | &s, &e, &gstring, string) | ||
| 1906 | && (e <= fixed_pos ? e > end : s < start)) | 1956 | && (e <= fixed_pos ? e > end : s < start)) |
| 1907 | return list3 (make_fixnum (s), make_fixnum (e), gstring); | 1957 | return list3 (make_fixnum (s), make_fixnum (e), gstring); |
| 1908 | } | 1958 | } |
diff --git a/src/composite.h b/src/composite.h index 75e5f9b9ecb..67e87201bf2 100644 --- a/src/composite.h +++ b/src/composite.h | |||
| @@ -246,6 +246,11 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop) | |||
| 246 | /* Macros for lispy glyph-string. This is completely different from | 246 | /* Macros for lispy glyph-string. This is completely different from |
| 247 | struct glyph_string. */ | 247 | struct glyph_string. */ |
| 248 | 248 | ||
| 249 | /* LGSTRING is a string of font glyphs, LGLYPHs. It is represented as | ||
| 250 | a Lisp vector, with components shown below. Once LGSTRING was | ||
| 251 | processed by a shaping engine, it holds font glyphs for one or more | ||
| 252 | grapheme clusters. */ | ||
| 253 | |||
| 249 | #define LGSTRING_HEADER(lgs) AREF (lgs, 0) | 254 | #define LGSTRING_HEADER(lgs) AREF (lgs, 0) |
| 250 | #define LGSTRING_SET_HEADER(lgs, header) ASET (lgs, 0, header) | 255 | #define LGSTRING_SET_HEADER(lgs, header) ASET (lgs, 0, header) |
| 251 | 256 | ||
| @@ -259,6 +264,10 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop) | |||
| 259 | #define LGSTRING_ID(lgs) AREF (lgs, 1) | 264 | #define LGSTRING_ID(lgs) AREF (lgs, 1) |
| 260 | #define LGSTRING_SET_ID(lgs, id) ASET (lgs, 1, id) | 265 | #define LGSTRING_SET_ID(lgs, id) ASET (lgs, 1, id) |
| 261 | 266 | ||
| 267 | /* LGSTRING_GLYPH_LEN is the maximum number of LGLYPHs that the | ||
| 268 | LGSTRING can hold. This is NOT the actual number of valid LGLYPHs; | ||
| 269 | to find the latter, walk the glyphs returned by LGSTRING_GLYPH | ||
| 270 | until the first one that is nil. */ | ||
| 262 | #define LGSTRING_GLYPH_LEN(lgs) (ASIZE ((lgs)) - 2) | 271 | #define LGSTRING_GLYPH_LEN(lgs) (ASIZE ((lgs)) - 2) |
| 263 | #define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 2) | 272 | #define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 2) |
| 264 | #define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 2, (val)) | 273 | #define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 2, (val)) |
| @@ -278,6 +287,14 @@ enum lglyph_indices | |||
| 278 | LGLYPH_SIZE | 287 | LGLYPH_SIZE |
| 279 | }; | 288 | }; |
| 280 | 289 | ||
| 290 | /* Each LGLYPH is a single font glyph, whose font code is in | ||
| 291 | LGLYPH_CODE. | ||
| 292 | LGLYPH_FROM and LGLYPH_TO are indices into LGSTRING; all the | ||
| 293 | LGLYPHs that share the same values of LGLYPH_FROM and LGLYPH_TO | ||
| 294 | belong to the same grapheme cluster. | ||
| 295 | LGLYPH_CHAR is one of the characters, usually the first one, that | ||
| 296 | contributed to the glyph (since there isn't a 1:1 correspondence | ||
| 297 | between composed characters and the font glyphs). */ | ||
| 281 | #define LGLYPH_NEW() make_nil_vector (LGLYPH_SIZE) | 298 | #define LGLYPH_NEW() make_nil_vector (LGLYPH_SIZE) |
| 282 | #define LGLYPH_FROM(g) XFIXNUM (AREF ((g), LGLYPH_IX_FROM)) | 299 | #define LGLYPH_FROM(g) XFIXNUM (AREF ((g), LGLYPH_IX_FROM)) |
| 283 | #define LGLYPH_TO(g) XFIXNUM (AREF ((g), LGLYPH_IX_TO)) | 300 | #define LGLYPH_TO(g) XFIXNUM (AREF ((g), LGLYPH_IX_TO)) |
| @@ -320,9 +337,9 @@ extern bool composition_gstring_p (Lisp_Object); | |||
| 320 | extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t, | 337 | extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t, |
| 321 | struct font_metrics *); | 338 | struct font_metrics *); |
| 322 | 339 | ||
| 323 | extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t *, | 340 | extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t, |
| 324 | ptrdiff_t *, Lisp_Object *, | 341 | ptrdiff_t *, ptrdiff_t *, |
| 325 | Lisp_Object); | 342 | Lisp_Object *, Lisp_Object); |
| 326 | 343 | ||
| 327 | extern void composition_compute_stop_pos (struct composition_it *, | 344 | extern void composition_compute_stop_pos (struct composition_it *, |
| 328 | ptrdiff_t, ptrdiff_t, ptrdiff_t, | 345 | ptrdiff_t, ptrdiff_t, ptrdiff_t, |
diff --git a/src/data.c b/src/data.c index d547f5da5e0..059f31e514b 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -2200,7 +2200,9 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) | |||
| 2200 | DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p, | 2200 | DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p, |
| 2201 | 1, 2, 0, | 2201 | 1, 2, 0, |
| 2202 | doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER. | 2202 | doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER. |
| 2203 | BUFFER defaults to the current buffer. */) | 2203 | BUFFER defaults to the current buffer. |
| 2204 | |||
| 2205 | Also see `buffer-local-boundp'.*/) | ||
| 2204 | (Lisp_Object variable, Lisp_Object buffer) | 2206 | (Lisp_Object variable, Lisp_Object buffer) |
| 2205 | { | 2207 | { |
| 2206 | struct buffer *buf = decode_buffer (buffer); | 2208 | struct buffer *buf = decode_buffer (buffer); |
diff --git a/src/editfns.c b/src/editfns.c index 182d3ba6f2b..aa0f46fea04 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -3390,7 +3390,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) | |||
| 3390 | ptrdiff_t nch, nby; | 3390 | ptrdiff_t nch, nby; |
| 3391 | nchars_string = SCHARS (arg); | 3391 | nchars_string = SCHARS (arg); |
| 3392 | width = lisp_string_width (arg, 0, nchars_string, prec, | 3392 | width = lisp_string_width (arg, 0, nchars_string, prec, |
| 3393 | &nch, &nby); | 3393 | &nch, &nby, false); |
| 3394 | if (prec < 0) | 3394 | if (prec < 0) |
| 3395 | nbytes = SBYTES (arg); | 3395 | nbytes = SBYTES (arg); |
| 3396 | else | 3396 | else |
diff --git a/src/frame.c b/src/frame.c index f8479f63f1d..3c7c4078cb0 100644 --- a/src/frame.c +++ b/src/frame.c | |||
| @@ -985,6 +985,7 @@ make_frame (bool mini_p) | |||
| 985 | f->ns_transparent_titlebar = false; | 985 | f->ns_transparent_titlebar = false; |
| 986 | #endif | 986 | #endif |
| 987 | #endif | 987 | #endif |
| 988 | f->select_mini_window_flag = false; | ||
| 988 | /* This one should never be zero. */ | 989 | /* This one should never be zero. */ |
| 989 | f->change_stamp = 1; | 990 | f->change_stamp = 1; |
| 990 | root_window = make_window (); | 991 | root_window = make_window (); |
| @@ -1545,7 +1546,17 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor | |||
| 1545 | tty->top_frame = frame; | 1546 | tty->top_frame = frame; |
| 1546 | } | 1547 | } |
| 1547 | 1548 | ||
| 1549 | sf->select_mini_window_flag = MINI_WINDOW_P (XWINDOW (sf->selected_window)); | ||
| 1550 | |||
| 1548 | selected_frame = frame; | 1551 | selected_frame = frame; |
| 1552 | |||
| 1553 | move_minibuffers_onto_frame (sf, for_deletion); | ||
| 1554 | |||
| 1555 | if (f->select_mini_window_flag | ||
| 1556 | && !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt))) | ||
| 1557 | f->selected_window = f->minibuffer_window; | ||
| 1558 | f->select_mini_window_flag = false; | ||
| 1559 | |||
| 1549 | if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame))) | 1560 | if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame))) |
| 1550 | last_nonminibuf_frame = XFRAME (selected_frame); | 1561 | last_nonminibuf_frame = XFRAME (selected_frame); |
| 1551 | 1562 | ||
| @@ -1562,7 +1573,6 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor | |||
| 1562 | #endif | 1573 | #endif |
| 1563 | internal_last_event_frame = Qnil; | 1574 | internal_last_event_frame = Qnil; |
| 1564 | 1575 | ||
| 1565 | move_minibuffers_onto_frame (sf, for_deletion); | ||
| 1566 | return frame; | 1576 | return frame; |
| 1567 | } | 1577 | } |
| 1568 | 1578 | ||
diff --git a/src/frame.h b/src/frame.h index b1ad525779c..d3ae548ed3b 100644 --- a/src/frame.h +++ b/src/frame.h | |||
| @@ -462,6 +462,11 @@ struct frame | |||
| 462 | in X builds only. */ | 462 | in X builds only. */ |
| 463 | bool_bf was_invisible : 1; | 463 | bool_bf was_invisible : 1; |
| 464 | 464 | ||
| 465 | /* True when the frame isn't selected, and selecting it in the | ||
| 466 | future should select the mini-window rather than the currently | ||
| 467 | selected window in the frame, assuming there is still an active | ||
| 468 | minibuffer in that mini-window. */ | ||
| 469 | bool_bf select_mini_window_flag : 1; | ||
| 465 | /* Bitfield area ends here. */ | 470 | /* Bitfield area ends here. */ |
| 466 | 471 | ||
| 467 | /* This frame's change stamp, set the last time window change | 472 | /* This frame's change stamp, set the last time window change |
diff --git a/src/image.c b/src/image.c index 9b8b7d97bda..916edd502da 100644 --- a/src/image.c +++ b/src/image.c | |||
| @@ -3276,19 +3276,16 @@ image_find_image_fd (Lisp_Object file, int *pfd) | |||
| 3276 | /* Try to find FILE in data-directory/images, then x-bitmap-file-path. */ | 3276 | /* Try to find FILE in data-directory/images, then x-bitmap-file-path. */ |
| 3277 | fd = openp (search_path, file, Qnil, &file_found, | 3277 | fd = openp (search_path, file, Qnil, &file_found, |
| 3278 | pfd ? Qt : make_fixnum (R_OK), false, false); | 3278 | pfd ? Qt : make_fixnum (R_OK), false, false); |
| 3279 | if (fd >= 0 || fd == -2) | 3279 | if (fd == -2) |
| 3280 | { | 3280 | { |
| 3281 | file_found = ENCODE_FILE (file_found); | 3281 | /* The file exists locally, but has a file name handler. |
| 3282 | if (fd == -2) | 3282 | (This happens, e.g., under Auto Image File Mode.) |
| 3283 | { | 3283 | 'openp' didn't open the file, so we should, because the |
| 3284 | /* The file exists locally, but has a file name handler. | 3284 | caller expects that. */ |
| 3285 | (This happens, e.g., under Auto Image File Mode.) | 3285 | Lisp_Object encoded_name = ENCODE_FILE (file_found); |
| 3286 | 'openp' didn't open the file, so we should, because the | 3286 | fd = emacs_open (SSDATA (encoded_name), O_RDONLY, 0); |
| 3287 | caller expects that. */ | ||
| 3288 | fd = emacs_open (SSDATA (file_found), O_RDONLY, 0); | ||
| 3289 | } | ||
| 3290 | } | 3287 | } |
| 3291 | else /* fd < 0, but not -2 */ | 3288 | else if (fd < 0) |
| 3292 | return Qnil; | 3289 | return Qnil; |
| 3293 | if (pfd) | 3290 | if (pfd) |
| 3294 | *pfd = fd; | 3291 | *pfd = fd; |
| @@ -3296,8 +3293,8 @@ image_find_image_fd (Lisp_Object file, int *pfd) | |||
| 3296 | } | 3293 | } |
| 3297 | 3294 | ||
| 3298 | /* Find image file FILE. Look in data-directory/images, then | 3295 | /* Find image file FILE. Look in data-directory/images, then |
| 3299 | x-bitmap-file-path. Value is the encoded full name of the file | 3296 | x-bitmap-file-path. Value is the full name of the file found, or |
| 3300 | found, or nil if not found. */ | 3297 | nil if not found. */ |
| 3301 | 3298 | ||
| 3302 | Lisp_Object | 3299 | Lisp_Object |
| 3303 | image_find_image_file (Lisp_Object file) | 3300 | image_find_image_file (Lisp_Object file) |
diff --git a/src/keyboard.c b/src/keyboard.c index b2aabdda325..87a9512a45b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -2254,8 +2254,17 @@ read_decoded_event_from_main_queue (struct timespec *end_time, | |||
| 2254 | { | 2254 | { |
| 2255 | int i; | 2255 | int i; |
| 2256 | if (meta_key != 2) | 2256 | if (meta_key != 2) |
| 2257 | for (i = 0; i < n; i++) | 2257 | { |
| 2258 | events[i] = make_fixnum (XFIXNUM (events[i]) & ~0x80); | 2258 | for (i = 0; i < n; i++) |
| 2259 | { | ||
| 2260 | int c = XFIXNUM (events[i]); | ||
| 2261 | int modifier = | ||
| 2262 | (meta_key == 3 && c < 0x100 && (c & 0x80)) | ||
| 2263 | ? meta_modifier | ||
| 2264 | : 0; | ||
| 2265 | events[i] = make_fixnum ((c & ~0x80) | modifier); | ||
| 2266 | } | ||
| 2267 | } | ||
| 2259 | } | 2268 | } |
| 2260 | else | 2269 | else |
| 2261 | { | 2270 | { |
| @@ -2264,7 +2273,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, | |||
| 2264 | int i; | 2273 | int i; |
| 2265 | for (i = 0; i < n; i++) | 2274 | for (i = 0; i < n; i++) |
| 2266 | src[i] = XFIXNUM (events[i]); | 2275 | src[i] = XFIXNUM (events[i]); |
| 2267 | if (meta_key != 2) | 2276 | if (meta_key < 2) /* input-meta-mode is t or nil */ |
| 2268 | for (i = 0; i < n; i++) | 2277 | for (i = 0; i < n; i++) |
| 2269 | src[i] &= ~0x80; | 2278 | src[i] &= ~0x80; |
| 2270 | coding->destination = dest; | 2279 | coding->destination = dest; |
| @@ -2282,7 +2291,18 @@ read_decoded_event_from_main_queue (struct timespec *end_time, | |||
| 2282 | eassert (coding->carryover_bytes == 0); | 2291 | eassert (coding->carryover_bytes == 0); |
| 2283 | n = 0; | 2292 | n = 0; |
| 2284 | while (n < coding->produced_char) | 2293 | while (n < coding->produced_char) |
| 2285 | events[n++] = make_fixnum (string_char_advance (&p)); | 2294 | { |
| 2295 | int c = string_char_advance (&p); | ||
| 2296 | if (meta_key == 3) | ||
| 2297 | { | ||
| 2298 | int modifier | ||
| 2299 | = (c < 0x100 && (c & 0x80) | ||
| 2300 | ? meta_modifier | ||
| 2301 | : 0); | ||
| 2302 | c = (c & ~0x80) | modifier; | ||
| 2303 | } | ||
| 2304 | events[n++] = make_fixnum (c); | ||
| 2305 | } | ||
| 2286 | } | 2306 | } |
| 2287 | } | 2307 | } |
| 2288 | } | 2308 | } |
| @@ -5021,6 +5041,10 @@ static short const internal_border_parts[] = { | |||
| 5021 | 5041 | ||
| 5022 | static Lisp_Object button_down_location; | 5042 | static Lisp_Object button_down_location; |
| 5023 | 5043 | ||
| 5044 | /* A cons recording the original frame-relative x and y coordinates of | ||
| 5045 | the down mouse event. */ | ||
| 5046 | static Lisp_Object frame_relative_event_pos; | ||
| 5047 | |||
| 5024 | /* Information about the most recent up-going button event: Which | 5048 | /* Information about the most recent up-going button event: Which |
| 5025 | button, what location, and what time. */ | 5049 | button, what location, and what time. */ |
| 5026 | 5050 | ||
| @@ -5672,6 +5696,7 @@ make_lispy_event (struct input_event *event) | |||
| 5672 | double_click_count = 1; | 5696 | double_click_count = 1; |
| 5673 | button_down_time = event->timestamp; | 5697 | button_down_time = event->timestamp; |
| 5674 | *start_pos_ptr = Fcopy_alist (position); | 5698 | *start_pos_ptr = Fcopy_alist (position); |
| 5699 | frame_relative_event_pos = Fcons (event->x, event->y); | ||
| 5675 | ignore_mouse_drag_p = false; | 5700 | ignore_mouse_drag_p = false; |
| 5676 | } | 5701 | } |
| 5677 | 5702 | ||
| @@ -5694,20 +5719,12 @@ make_lispy_event (struct input_event *event) | |||
| 5694 | ignore_mouse_drag_p = false; | 5719 | ignore_mouse_drag_p = false; |
| 5695 | else | 5720 | else |
| 5696 | { | 5721 | { |
| 5697 | Lisp_Object new_down, down; | ||
| 5698 | intmax_t xdiff = double_click_fuzz, ydiff = double_click_fuzz; | 5722 | intmax_t xdiff = double_click_fuzz, ydiff = double_click_fuzz; |
| 5699 | 5723 | ||
| 5700 | /* The third element of every position | 5724 | xdiff = XFIXNUM (event->x) |
| 5701 | should be the (x,y) pair. */ | 5725 | - XFIXNUM (XCAR (frame_relative_event_pos)); |
| 5702 | down = Fcar (Fcdr (Fcdr (start_pos))); | 5726 | ydiff = XFIXNUM (event->y) |
| 5703 | new_down = Fcar (Fcdr (Fcdr (position))); | 5727 | - XFIXNUM (XCDR (frame_relative_event_pos)); |
| 5704 | |||
| 5705 | if (CONSP (down) | ||
| 5706 | && FIXNUMP (XCAR (down)) && FIXNUMP (XCDR (down))) | ||
| 5707 | { | ||
| 5708 | xdiff = XFIXNUM (XCAR (new_down)) - XFIXNUM (XCAR (down)); | ||
| 5709 | ydiff = XFIXNUM (XCDR (new_down)) - XFIXNUM (XCDR (down)); | ||
| 5710 | } | ||
| 5711 | 5728 | ||
| 5712 | if (! (0 < double_click_fuzz | 5729 | if (! (0 < double_click_fuzz |
| 5713 | && - double_click_fuzz < xdiff | 5730 | && - double_click_fuzz < xdiff |
| @@ -5724,12 +5741,51 @@ make_lispy_event (struct input_event *event) | |||
| 5724 | a click. But mouse-drag-region completely ignores | 5741 | a click. But mouse-drag-region completely ignores |
| 5725 | this case and it hasn't caused any real problem, so | 5742 | this case and it hasn't caused any real problem, so |
| 5726 | it's probably OK to ignore it as well. */ | 5743 | it's probably OK to ignore it as well. */ |
| 5727 | && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))) | 5744 | && (EQ (Fcar (Fcdr (start_pos)), |
| 5745 | Fcar (Fcdr (position))) /* Same buffer pos */ | ||
| 5746 | || !EQ (Fcar (start_pos), | ||
| 5747 | Fcar (position))))) /* Different window */ | ||
| 5728 | { | 5748 | { |
| 5729 | /* Mouse has moved enough. */ | 5749 | /* Mouse has moved enough. */ |
| 5730 | button_down_time = 0; | 5750 | button_down_time = 0; |
| 5731 | click_or_drag_modifier = drag_modifier; | 5751 | click_or_drag_modifier = drag_modifier; |
| 5732 | } | 5752 | } |
| 5753 | else if (((!EQ (Fcar (start_pos), Fcar (position))) | ||
| 5754 | || (!EQ (Fcar (Fcdr (start_pos)), | ||
| 5755 | Fcar (Fcdr (position))))) | ||
| 5756 | /* Was the down event in a window body? */ | ||
| 5757 | && FIXNUMP (Fcar (Fcdr (start_pos))) | ||
| 5758 | && WINDOW_LIVE_P (Fcar (start_pos)) | ||
| 5759 | && !NILP (Ffboundp (Qwindow_edges))) | ||
| 5760 | /* If the window (etc.) at the mouse position has | ||
| 5761 | changed between the down event and the up event, | ||
| 5762 | we assume there's been a redisplay between the | ||
| 5763 | two events, and we pretend the mouse is still in | ||
| 5764 | the old window to prevent a spurious drag event | ||
| 5765 | being generated. */ | ||
| 5766 | { | ||
| 5767 | Lisp_Object edges | ||
| 5768 | = call4 (Qwindow_edges, Fcar (start_pos), Qt, Qnil, Qt); | ||
| 5769 | int new_x = XFIXNUM (Fcar (frame_relative_event_pos)); | ||
| 5770 | int new_y = XFIXNUM (Fcdr (frame_relative_event_pos)); | ||
| 5771 | |||
| 5772 | /* If the up-event is outside the down-event's | ||
| 5773 | window, use coordinates that are within it. */ | ||
| 5774 | if (new_x < XFIXNUM (Fcar (edges))) | ||
| 5775 | new_x = XFIXNUM (Fcar (edges)); | ||
| 5776 | else if (new_x >= XFIXNUM (Fcar (Fcdr (Fcdr (edges))))) | ||
| 5777 | new_x = XFIXNUM (Fcar (Fcdr (Fcdr (edges)))) - 1; | ||
| 5778 | if (new_y < XFIXNUM (Fcar (Fcdr (edges)))) | ||
| 5779 | new_y = XFIXNUM (Fcar (Fcdr (edges))); | ||
| 5780 | else if (new_y | ||
| 5781 | >= XFIXNUM (Fcar (Fcdr (Fcdr (Fcdr (edges)))))) | ||
| 5782 | new_y = XFIXNUM (Fcar (Fcdr (Fcdr (Fcdr (edges))))) - 1; | ||
| 5783 | |||
| 5784 | position = make_lispy_position | ||
| 5785 | (XFRAME (event->frame_or_window), | ||
| 5786 | make_fixnum (new_x), make_fixnum (new_y), | ||
| 5787 | event->timestamp); | ||
| 5788 | } | ||
| 5733 | } | 5789 | } |
| 5734 | 5790 | ||
| 5735 | /* Don't check is_double; treat this as multiple if the | 5791 | /* Don't check is_double; treat this as multiple if the |
| @@ -7040,7 +7096,7 @@ tty_read_avail_input (struct terminal *terminal, | |||
| 7040 | buf.modifiers = 0; | 7096 | buf.modifiers = 0; |
| 7041 | if (tty->meta_key == 1 && (cbuf[i] & 0x80)) | 7097 | if (tty->meta_key == 1 && (cbuf[i] & 0x80)) |
| 7042 | buf.modifiers = meta_modifier; | 7098 | buf.modifiers = meta_modifier; |
| 7043 | if (tty->meta_key != 2) | 7099 | if (tty->meta_key < 2) |
| 7044 | cbuf[i] &= ~0x80; | 7100 | cbuf[i] &= ~0x80; |
| 7045 | 7101 | ||
| 7046 | buf.code = cbuf[i]; | 7102 | buf.code = cbuf[i]; |
| @@ -11047,7 +11103,10 @@ See also `current-input-mode'. */) | |||
| 11047 | DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0, | 11103 | DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0, |
| 11048 | doc: /* Enable or disable 8-bit input on TERMINAL. | 11104 | doc: /* Enable or disable 8-bit input on TERMINAL. |
| 11049 | If META is t, Emacs will accept 8-bit input, and interpret the 8th | 11105 | If META is t, Emacs will accept 8-bit input, and interpret the 8th |
| 11050 | bit as the Meta modifier. | 11106 | bit as the Meta modifier before it decodes the characters. |
| 11107 | |||
| 11108 | If META is `encoded', Emacs will interpret the 8th bit of single-byte | ||
| 11109 | characters after decoding the characters. | ||
| 11051 | 11110 | ||
| 11052 | If META is nil, Emacs will ignore the top bit, on the assumption it is | 11111 | If META is nil, Emacs will ignore the top bit, on the assumption it is |
| 11053 | parity. | 11112 | parity. |
| @@ -11076,6 +11135,8 @@ See also `current-input-mode'. */) | |||
| 11076 | new_meta = 0; | 11135 | new_meta = 0; |
| 11077 | else if (EQ (meta, Qt)) | 11136 | else if (EQ (meta, Qt)) |
| 11078 | new_meta = 1; | 11137 | new_meta = 1; |
| 11138 | else if (EQ (meta, Qencoded)) | ||
| 11139 | new_meta = 3; | ||
| 11079 | else | 11140 | else |
| 11080 | new_meta = 2; | 11141 | new_meta = 2; |
| 11081 | 11142 | ||
| @@ -11138,6 +11199,8 @@ Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal | |||
| 11138 | (no effect except in CBREAK mode). | 11199 | (no effect except in CBREAK mode). |
| 11139 | Third arg META t means accept 8-bit input (for a Meta key). | 11200 | Third arg META t means accept 8-bit input (for a Meta key). |
| 11140 | META nil means ignore the top bit, on the assumption it is parity. | 11201 | META nil means ignore the top bit, on the assumption it is parity. |
| 11202 | META `encoded' means accept 8-bit input and interpret Meta after | ||
| 11203 | decoding the input characters. | ||
| 11141 | Otherwise, accept 8-bit input and don't use the top bit for Meta. | 11204 | Otherwise, accept 8-bit input and don't use the top bit for Meta. |
| 11142 | Optional fourth arg QUIT if non-nil specifies character to use for quitting. | 11205 | Optional fourth arg QUIT if non-nil specifies character to use for quitting. |
| 11143 | See also `current-input-mode'. */) | 11206 | See also `current-input-mode'. */) |
| @@ -11158,9 +11221,12 @@ The value is a list of the form (INTERRUPT FLOW META QUIT), where | |||
| 11158 | nil, Emacs is using CBREAK mode. | 11221 | nil, Emacs is using CBREAK mode. |
| 11159 | FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the | 11222 | FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the |
| 11160 | terminal; this does not apply if Emacs uses interrupt-driven input. | 11223 | terminal; this does not apply if Emacs uses interrupt-driven input. |
| 11161 | META is t if accepting 8-bit input with 8th bit as Meta flag. | 11224 | META is t if accepting 8-bit unencoded input with 8th bit as Meta flag. |
| 11162 | META nil means ignoring the top bit, on the assumption it is parity. | 11225 | META is `encoded' if accepting 8-bit encoded input with 8th bit as |
| 11163 | META is neither t nor nil if accepting 8-bit input and using | 11226 | Meta flag which has to be interpreted after decoding the input. |
| 11227 | META is nil if ignoring the top bit of input, on the assumption that | ||
| 11228 | it is a parity bit. | ||
| 11229 | META is neither t nor nil if accepting 8-bit input and using | ||
| 11164 | all 8 bits as the character code. | 11230 | all 8 bits as the character code. |
| 11165 | QUIT is the character Emacs currently uses to quit. | 11231 | QUIT is the character Emacs currently uses to quit. |
| 11166 | The elements of this list correspond to the arguments of | 11232 | The elements of this list correspond to the arguments of |
| @@ -11176,7 +11242,9 @@ The elements of this list correspond to the arguments of | |||
| 11176 | flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil; | 11242 | flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil; |
| 11177 | meta = (FRAME_TTY (sf)->meta_key == 2 | 11243 | meta = (FRAME_TTY (sf)->meta_key == 2 |
| 11178 | ? make_fixnum (0) | 11244 | ? make_fixnum (0) |
| 11179 | : (CURTTY ()->meta_key == 1 ? Qt : Qnil)); | 11245 | : (CURTTY ()->meta_key == 1 |
| 11246 | ? Qt | ||
| 11247 | : (CURTTY ()->meta_key == 3 ? Qencoded : Qnil))); | ||
| 11180 | } | 11248 | } |
| 11181 | else | 11249 | else |
| 11182 | { | 11250 | { |
| @@ -11653,6 +11721,7 @@ syms_of_keyboard (void) | |||
| 11653 | DEFSYM (Qmake_frame_visible, "make-frame-visible"); | 11721 | DEFSYM (Qmake_frame_visible, "make-frame-visible"); |
| 11654 | DEFSYM (Qselect_window, "select-window"); | 11722 | DEFSYM (Qselect_window, "select-window"); |
| 11655 | DEFSYM (Qselection_request, "selection-request"); | 11723 | DEFSYM (Qselection_request, "selection-request"); |
| 11724 | DEFSYM (Qwindow_edges, "window-edges"); | ||
| 11656 | { | 11725 | { |
| 11657 | int i; | 11726 | int i; |
| 11658 | 11727 | ||
| @@ -11666,9 +11735,11 @@ syms_of_keyboard (void) | |||
| 11666 | } | 11735 | } |
| 11667 | } | 11736 | } |
| 11668 | DEFSYM (Qno_record, "no-record"); | 11737 | DEFSYM (Qno_record, "no-record"); |
| 11738 | DEFSYM (Qencoded, "encoded"); | ||
| 11669 | 11739 | ||
| 11670 | button_down_location = make_nil_vector (5); | 11740 | button_down_location = make_nil_vector (5); |
| 11671 | staticpro (&button_down_location); | 11741 | staticpro (&button_down_location); |
| 11742 | staticpro (&frame_relative_event_pos); | ||
| 11672 | mouse_syms = make_nil_vector (5); | 11743 | mouse_syms = make_nil_vector (5); |
| 11673 | staticpro (&mouse_syms); | 11744 | staticpro (&mouse_syms); |
| 11674 | wheel_syms = make_nil_vector (ARRAYELTS (lispy_wheel_names)); | 11745 | wheel_syms = make_nil_vector (ARRAYELTS (lispy_wheel_names)); |
| @@ -12273,7 +12344,10 @@ Called with three arguments: | |||
| 12273 | - the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA) | 12344 | - the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA) |
| 12274 | such as what `condition-case' would bind its variable to, | 12345 | such as what `condition-case' would bind its variable to, |
| 12275 | - the context (a string which normally goes at the start of the message), | 12346 | - the context (a string which normally goes at the start of the message), |
| 12276 | - the Lisp function within which the error was signaled. */); | 12347 | - the Lisp function within which the error was signaled. |
| 12348 | |||
| 12349 | Also see `set-message-function' (which controls how non-error messages | ||
| 12350 | are displayed). */); | ||
| 12277 | Vcommand_error_function = intern ("command-error-default-function"); | 12351 | Vcommand_error_function = intern ("command-error-default-function"); |
| 12278 | 12352 | ||
| 12279 | DEFVAR_LISP ("enable-disabled-menus-and-buttons", | 12353 | DEFVAR_LISP ("enable-disabled-menus-and-buttons", |
diff --git a/src/minibuf.c b/src/minibuf.c index cffb7fe787c..00069eabbe5 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -2385,7 +2385,7 @@ default top level value is used. */); | |||
| 2385 | Vminibuffer_setup_hook = Qnil; | 2385 | Vminibuffer_setup_hook = Qnil; |
| 2386 | 2386 | ||
| 2387 | DEFVAR_LISP ("minibuffer-exit-hook", Vminibuffer_exit_hook, | 2387 | DEFVAR_LISP ("minibuffer-exit-hook", Vminibuffer_exit_hook, |
| 2388 | doc: /* Normal hook run just after exit from minibuffer. */); | 2388 | doc: /* Normal hook run whenever a minibuffer is exited. */); |
| 2389 | Vminibuffer_exit_hook = Qnil; | 2389 | Vminibuffer_exit_hook = Qnil; |
| 2390 | 2390 | ||
| 2391 | DEFVAR_LISP ("history-length", Vhistory_length, | 2391 | DEFVAR_LISP ("history-length", Vhistory_length, |
diff --git a/src/nsfns.m b/src/nsfns.m index d14f7b51eaf..454a6fdab62 100644 --- a/src/nsfns.m +++ b/src/nsfns.m | |||
| @@ -1953,8 +1953,11 @@ DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs, | |||
| 1953 | doc: /* If ON is non-nil, the entire Emacs application is hidden. | 1953 | doc: /* If ON is non-nil, the entire Emacs application is hidden. |
| 1954 | Otherwise if Emacs is hidden, it is unhidden. | 1954 | Otherwise if Emacs is hidden, it is unhidden. |
| 1955 | If ON is equal to `activate', Emacs is unhidden and becomes | 1955 | If ON is equal to `activate', Emacs is unhidden and becomes |
| 1956 | the active application. */) | 1956 | the active application. |
| 1957 | (Lisp_Object on) | 1957 | If ON is equal to `activate-front', Emacs is unhidden and |
| 1958 | becomes the active application, but only the selected frame | ||
| 1959 | is layered in front of the windows of other applications. */) | ||
| 1960 | (Lisp_Object on) | ||
| 1958 | { | 1961 | { |
| 1959 | check_window_system (NULL); | 1962 | check_window_system (NULL); |
| 1960 | if (EQ (on, intern ("activate"))) | 1963 | if (EQ (on, intern ("activate"))) |
| @@ -1962,6 +1965,12 @@ the active application. */) | |||
| 1962 | [NSApp unhide: NSApp]; | 1965 | [NSApp unhide: NSApp]; |
| 1963 | [NSApp activateIgnoringOtherApps: YES]; | 1966 | [NSApp activateIgnoringOtherApps: YES]; |
| 1964 | } | 1967 | } |
| 1968 | else if (EQ (on, intern ("activate-front"))) | ||
| 1969 | { | ||
| 1970 | [NSApp unhide: NSApp]; | ||
| 1971 | [[NSRunningApplication currentApplication] | ||
| 1972 | activateWithOptions: NSApplicationActivateIgnoringOtherApps]; | ||
| 1973 | } | ||
| 1965 | else if (NILP (on)) | 1974 | else if (NILP (on)) |
| 1966 | [NSApp unhide: NSApp]; | 1975 | [NSApp unhide: NSApp]; |
| 1967 | else | 1976 | else |
| @@ -3024,7 +3033,8 @@ all_nonzero_ascii (unsigned char *str, ptrdiff_t n) | |||
| 3024 | } | 3033 | } |
| 3025 | 3034 | ||
| 3026 | @implementation NSString (EmacsString) | 3035 | @implementation NSString (EmacsString) |
| 3027 | /* Make an NSString from a Lisp string. */ | 3036 | /* Make an NSString from a Lisp string. STRING must not be in an |
| 3037 | encoded form (e.g. UTF-8). */ | ||
| 3028 | + (NSString *)stringWithLispString:(Lisp_Object)string | 3038 | + (NSString *)stringWithLispString:(Lisp_Object)string |
| 3029 | { | 3039 | { |
| 3030 | /* Shortcut for the common case. */ | 3040 | /* Shortcut for the common case. */ |
diff --git a/src/nsimage.m b/src/nsimage.m index fa81a41a519..3c16cd371e6 100644 --- a/src/nsimage.m +++ b/src/nsimage.m | |||
| @@ -254,15 +254,15 @@ ns_image_size_in_bytes (void *img) | |||
| 254 | NSImageRep *imgRep; | 254 | NSImageRep *imgRep; |
| 255 | Lisp_Object found; | 255 | Lisp_Object found; |
| 256 | EmacsImage *image; | 256 | EmacsImage *image; |
| 257 | NSString *filename; | ||
| 257 | 258 | ||
| 258 | /* Search bitmap-file-path for the file, if appropriate. */ | 259 | /* Search bitmap-file-path for the file, if appropriate. */ |
| 259 | found = image_find_image_file (file); | 260 | found = image_find_image_file (file); |
| 260 | if (!STRINGP (found)) | 261 | if (!STRINGP (found)) |
| 261 | return nil; | 262 | return nil; |
| 262 | found = ENCODE_FILE (found); | 263 | filename = [NSString stringWithLispString:found]; |
| 263 | 264 | ||
| 264 | image = [[EmacsImage alloc] initByReferencingFile: | 265 | image = [[EmacsImage alloc] initByReferencingFile:filename]; |
| 265 | [NSString stringWithLispString: found]]; | ||
| 266 | 266 | ||
| 267 | image->bmRep = nil; | 267 | image->bmRep = nil; |
| 268 | #ifdef NS_IMPL_COCOA | 268 | #ifdef NS_IMPL_COCOA |
| @@ -277,8 +277,7 @@ ns_image_size_in_bytes (void *img) | |||
| 277 | } | 277 | } |
| 278 | 278 | ||
| 279 | [image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])]; | 279 | [image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])]; |
| 280 | 280 | [image setName:filename]; | |
| 281 | [image setName: [NSString stringWithLispString: file]]; | ||
| 282 | 281 | ||
| 283 | return image; | 282 | return image; |
| 284 | } | 283 | } |
diff --git a/src/nsterm.h b/src/nsterm.h index 017c2394ef1..e7ea907569e 100644 --- a/src/nsterm.h +++ b/src/nsterm.h | |||
| @@ -443,7 +443,6 @@ typedef id instancetype; | |||
| 443 | int maximized_width, maximized_height; | 443 | int maximized_width, maximized_height; |
| 444 | NSWindow *nonfs_window; | 444 | NSWindow *nonfs_window; |
| 445 | BOOL fs_is_native; | 445 | BOOL fs_is_native; |
| 446 | BOOL in_fullscreen_transition; | ||
| 447 | #ifdef NS_DRAW_TO_BUFFER | 446 | #ifdef NS_DRAW_TO_BUFFER |
| 448 | EmacsSurface *surface; | 447 | EmacsSurface *surface; |
| 449 | #endif | 448 | #endif |
| @@ -475,8 +474,6 @@ typedef id instancetype; | |||
| 475 | - (void) toggleFullScreen: (id) sender; | 474 | - (void) toggleFullScreen: (id) sender; |
| 476 | - (BOOL) fsIsNative; | 475 | - (BOOL) fsIsNative; |
| 477 | - (BOOL) isFullscreen; | 476 | - (BOOL) isFullscreen; |
| 478 | - (BOOL) inFullScreenTransition; | ||
| 479 | - (void) waitFullScreenTransition; | ||
| 480 | #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 | 477 | #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 |
| 481 | - (void) updateCollectionBehavior; | 478 | - (void) updateCollectionBehavior; |
| 482 | #endif | 479 | #endif |
| @@ -724,8 +721,9 @@ typedef id instancetype; | |||
| 724 | IOSurfaceRef currentSurface; | 721 | IOSurfaceRef currentSurface; |
| 725 | IOSurfaceRef lastSurface; | 722 | IOSurfaceRef lastSurface; |
| 726 | CGContextRef context; | 723 | CGContextRef context; |
| 724 | CGFloat scale; | ||
| 727 | } | 725 | } |
| 728 | - (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs; | 726 | - (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs Scale: (CGFloat)scale; |
| 729 | - (void) dealloc; | 727 | - (void) dealloc; |
| 730 | - (NSSize) getSize; | 728 | - (NSSize) getSize; |
| 731 | - (CGContextRef) getContext; | 729 | - (CGContextRef) getContext; |
diff --git a/src/nsterm.m b/src/nsterm.m index bb20886ab1d..838c14d5abb 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -1640,8 +1640,6 @@ ns_make_frame_visible (struct frame *f) | |||
| 1640 | fullscreen also. So skip handleFS as this will print an error. */ | 1640 | fullscreen also. So skip handleFS as this will print an error. */ |
| 1641 | if ([view fsIsNative] && [view isFullscreen]) | 1641 | if ([view fsIsNative] && [view isFullscreen]) |
| 1642 | { | 1642 | { |
| 1643 | // maybe it is not necessary to wait | ||
| 1644 | [view waitFullScreenTransition]; | ||
| 1645 | return; | 1643 | return; |
| 1646 | } | 1644 | } |
| 1647 | 1645 | ||
| @@ -2057,11 +2055,7 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val | |||
| 2057 | #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 | 2055 | #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 |
| 2058 | // child frame must not be in fullscreen | 2056 | // child frame must not be in fullscreen |
| 2059 | if ([view fsIsNative] && [view isFullscreen]) | 2057 | if ([view fsIsNative] && [view isFullscreen]) |
| 2060 | { | 2058 | [view toggleFullScreen:child]; |
| 2061 | // in case child is going fullscreen | ||
| 2062 | [view waitFullScreenTransition]; | ||
| 2063 | [view toggleFullScreen:child]; | ||
| 2064 | } | ||
| 2065 | NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary"); | 2059 | NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary"); |
| 2066 | [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary]; | 2060 | [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary]; |
| 2067 | #endif | 2061 | #endif |
| @@ -7489,7 +7483,6 @@ not_in_argv (NSString *arg) | |||
| 7489 | #endif | 7483 | #endif |
| 7490 | fs_is_native = ns_use_native_fullscreen; | 7484 | fs_is_native = ns_use_native_fullscreen; |
| 7491 | #endif | 7485 | #endif |
| 7492 | in_fullscreen_transition = NO; | ||
| 7493 | 7486 | ||
| 7494 | maximized_width = maximized_height = -1; | 7487 | maximized_width = maximized_height = -1; |
| 7495 | nonfs_window = nil; | 7488 | nonfs_window = nil; |
| @@ -7862,7 +7855,6 @@ not_in_argv (NSString *arg) | |||
| 7862 | - (void)windowWillEnterFullScreen:(NSNotification *)notification | 7855 | - (void)windowWillEnterFullScreen:(NSNotification *)notification |
| 7863 | { | 7856 | { |
| 7864 | NSTRACE ("[EmacsView windowWillEnterFullScreen:]"); | 7857 | NSTRACE ("[EmacsView windowWillEnterFullScreen:]"); |
| 7865 | in_fullscreen_transition = YES; | ||
| 7866 | [self windowWillEnterFullScreen]; | 7858 | [self windowWillEnterFullScreen]; |
| 7867 | } | 7859 | } |
| 7868 | - (void)windowWillEnterFullScreen /* provided for direct calls */ | 7860 | - (void)windowWillEnterFullScreen /* provided for direct calls */ |
| @@ -7875,7 +7867,6 @@ not_in_argv (NSString *arg) | |||
| 7875 | { | 7867 | { |
| 7876 | NSTRACE ("[EmacsView windowDidEnterFullScreen:]"); | 7868 | NSTRACE ("[EmacsView windowDidEnterFullScreen:]"); |
| 7877 | [self windowDidEnterFullScreen]; | 7869 | [self windowDidEnterFullScreen]; |
| 7878 | in_fullscreen_transition = NO; | ||
| 7879 | } | 7870 | } |
| 7880 | 7871 | ||
| 7881 | - (void)windowDidEnterFullScreen /* provided for direct calls */ | 7872 | - (void)windowDidEnterFullScreen /* provided for direct calls */ |
| @@ -7914,7 +7905,6 @@ not_in_argv (NSString *arg) | |||
| 7914 | - (void)windowWillExitFullScreen:(NSNotification *)notification | 7905 | - (void)windowWillExitFullScreen:(NSNotification *)notification |
| 7915 | { | 7906 | { |
| 7916 | NSTRACE ("[EmacsView windowWillExitFullScreen:]"); | 7907 | NSTRACE ("[EmacsView windowWillExitFullScreen:]"); |
| 7917 | in_fullscreen_transition = YES; | ||
| 7918 | [self windowWillExitFullScreen]; | 7908 | [self windowWillExitFullScreen]; |
| 7919 | } | 7909 | } |
| 7920 | 7910 | ||
| @@ -7934,7 +7924,6 @@ not_in_argv (NSString *arg) | |||
| 7934 | { | 7924 | { |
| 7935 | NSTRACE ("[EmacsView windowDidExitFullScreen:]"); | 7925 | NSTRACE ("[EmacsView windowDidExitFullScreen:]"); |
| 7936 | [self windowDidExitFullScreen]; | 7926 | [self windowDidExitFullScreen]; |
| 7937 | in_fullscreen_transition = NO; | ||
| 7938 | } | 7927 | } |
| 7939 | 7928 | ||
| 7940 | - (void)windowDidExitFullScreen /* provided for direct calls */ | 7929 | - (void)windowDidExitFullScreen /* provided for direct calls */ |
| @@ -7963,22 +7952,6 @@ not_in_argv (NSString *arg) | |||
| 7963 | [[self window] performZoom:self]; | 7952 | [[self window] performZoom:self]; |
| 7964 | } | 7953 | } |
| 7965 | 7954 | ||
| 7966 | - (BOOL)inFullScreenTransition | ||
| 7967 | { | ||
| 7968 | return in_fullscreen_transition; | ||
| 7969 | } | ||
| 7970 | |||
| 7971 | - (void)waitFullScreenTransition | ||
| 7972 | { | ||
| 7973 | #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 | ||
| 7974 | while ([self inFullScreenTransition]) | ||
| 7975 | { | ||
| 7976 | NSTRACE ("wait for fullscreen"); | ||
| 7977 | wait_reading_process_output (0, 300000000, 0, 1, Qnil, NULL, 0); | ||
| 7978 | } | ||
| 7979 | #endif | ||
| 7980 | } | ||
| 7981 | |||
| 7982 | - (BOOL)fsIsNative | 7955 | - (BOOL)fsIsNative |
| 7983 | { | 7956 | { |
| 7984 | return fs_is_native; | 7957 | return fs_is_native; |
| @@ -8058,14 +8031,8 @@ not_in_argv (NSString *arg) | |||
| 8058 | #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 | 8031 | #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 |
| 8059 | #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 | 8032 | #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 |
| 8060 | if ([[self window] respondsToSelector: @selector(toggleFullScreen:)]) | 8033 | if ([[self window] respondsToSelector: @selector(toggleFullScreen:)]) |
| 8061 | { | ||
| 8062 | #endif | ||
| 8063 | [[self window] toggleFullScreen:sender]; | ||
| 8064 | // wait for fullscreen animation complete (bug#28496) | ||
| 8065 | [self waitFullScreenTransition]; | ||
| 8066 | #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 | ||
| 8067 | } | ||
| 8068 | #endif | 8034 | #endif |
| 8035 | [[self window] toggleFullScreen:sender]; | ||
| 8069 | #endif | 8036 | #endif |
| 8070 | return; | 8037 | return; |
| 8071 | } | 8038 | } |
| @@ -8353,19 +8320,17 @@ not_in_argv (NSString *arg) | |||
| 8353 | 8320 | ||
| 8354 | surface = [[EmacsSurface alloc] initWithSize:s | 8321 | surface = [[EmacsSurface alloc] initWithSize:s |
| 8355 | ColorSpace:[[[self window] colorSpace] | 8322 | ColorSpace:[[[self window] colorSpace] |
| 8356 | CGColorSpace]]; | 8323 | CGColorSpace] |
| 8324 | Scale:scale]; | ||
| 8357 | 8325 | ||
| 8358 | /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay | 8326 | /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay |
| 8359 | the layer's scale factor is not set automatically, so do it | 8327 | the layer's scale factor is not set automatically, so do it |
| 8360 | now. */ | 8328 | now. */ |
| 8361 | [[self layer] setContentsScale:[[self window] backingScaleFactor]]; | 8329 | [[self layer] setContentsScale:scale]; |
| 8362 | } | 8330 | } |
| 8363 | 8331 | ||
| 8364 | CGContextRef context = [surface getContext]; | 8332 | CGContextRef context = [surface getContext]; |
| 8365 | 8333 | ||
| 8366 | CGContextTranslateCTM(context, 0, [surface getSize].height); | ||
| 8367 | CGContextScaleCTM(context, scale, -scale); | ||
| 8368 | |||
| 8369 | [NSGraphicsContext | 8334 | [NSGraphicsContext |
| 8370 | setCurrentContext:[NSGraphicsContext | 8335 | setCurrentContext:[NSGraphicsContext |
| 8371 | graphicsContextWithCGContext:context | 8336 | graphicsContextWithCGContext:context |
| @@ -8378,7 +8343,6 @@ not_in_argv (NSString *arg) | |||
| 8378 | NSTRACE ("[EmacsView unfocusDrawingBuffer]"); | 8343 | NSTRACE ("[EmacsView unfocusDrawingBuffer]"); |
| 8379 | 8344 | ||
| 8380 | [NSGraphicsContext setCurrentContext:nil]; | 8345 | [NSGraphicsContext setCurrentContext:nil]; |
| 8381 | [surface releaseContext]; | ||
| 8382 | [self setNeedsDisplay:YES]; | 8346 | [self setNeedsDisplay:YES]; |
| 8383 | } | 8347 | } |
| 8384 | 8348 | ||
| @@ -8516,7 +8480,11 @@ not_in_argv (NSString *arg) | |||
| 8516 | There's a private method, -[CALayer setContentsChanged], that we | 8480 | There's a private method, -[CALayer setContentsChanged], that we |
| 8517 | could use to force it, but we shouldn't often get the same | 8481 | could use to force it, but we shouldn't often get the same |
| 8518 | surface twice in a row. */ | 8482 | surface twice in a row. */ |
| 8483 | [surface releaseContext]; | ||
| 8519 | [[self layer] setContents:(id)[surface getSurface]]; | 8484 | [[self layer] setContents:(id)[surface getSurface]]; |
| 8485 | [surface performSelectorOnMainThread:@selector (getContext) | ||
| 8486 | withObject:nil | ||
| 8487 | waitUntilDone:NO]; | ||
| 8520 | } | 8488 | } |
| 8521 | #endif | 8489 | #endif |
| 8522 | 8490 | ||
| @@ -9717,17 +9685,20 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) | |||
| 9717 | probably be some sort of pruning job that removes excess | 9685 | probably be some sort of pruning job that removes excess |
| 9718 | surfaces. */ | 9686 | surfaces. */ |
| 9719 | 9687 | ||
| 9688 | #define CACHE_MAX_SIZE 2 | ||
| 9720 | 9689 | ||
| 9721 | - (id) initWithSize: (NSSize)s | 9690 | - (id) initWithSize: (NSSize)s |
| 9722 | ColorSpace: (CGColorSpaceRef)cs | 9691 | ColorSpace: (CGColorSpaceRef)cs |
| 9692 | Scale: (CGFloat)scl | ||
| 9723 | { | 9693 | { |
| 9724 | NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]"); | 9694 | NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]"); |
| 9725 | 9695 | ||
| 9726 | [super init]; | 9696 | [super init]; |
| 9727 | 9697 | ||
| 9728 | cache = [[NSMutableArray arrayWithCapacity:3] retain]; | 9698 | cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain]; |
| 9729 | size = s; | 9699 | size = s; |
| 9730 | colorSpace = cs; | 9700 | colorSpace = cs; |
| 9701 | scale = scl; | ||
| 9731 | 9702 | ||
| 9732 | return self; | 9703 | return self; |
| 9733 | } | 9704 | } |
| @@ -9740,8 +9711,6 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) | |||
| 9740 | 9711 | ||
| 9741 | if (currentSurface) | 9712 | if (currentSurface) |
| 9742 | CFRelease (currentSurface); | 9713 | CFRelease (currentSurface); |
| 9743 | if (lastSurface) | ||
| 9744 | CFRelease (lastSurface); | ||
| 9745 | 9714 | ||
| 9746 | for (id object in cache) | 9715 | for (id object in cache) |
| 9747 | CFRelease ((IOSurfaceRef)object); | 9716 | CFRelease ((IOSurfaceRef)object); |
| @@ -9764,50 +9733,66 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) | |||
| 9764 | calls cannot be nested. */ | 9733 | calls cannot be nested. */ |
| 9765 | - (CGContextRef) getContext | 9734 | - (CGContextRef) getContext |
| 9766 | { | 9735 | { |
| 9767 | IOSurfaceRef surface = NULL; | 9736 | NSTRACE ("[EmacsSurface getContext]"); |
| 9768 | |||
| 9769 | NSTRACE ("[EmacsSurface getContextWithSize:]"); | ||
| 9770 | NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (lastSurface ? 1 : 0)); | ||
| 9771 | 9737 | ||
| 9772 | for (id object in cache) | 9738 | if (!context) |
| 9773 | { | 9739 | { |
| 9774 | if (!IOSurfaceIsInUse ((IOSurfaceRef)object)) | 9740 | IOSurfaceRef surface = NULL; |
| 9775 | { | ||
| 9776 | surface = (IOSurfaceRef)object; | ||
| 9777 | [cache removeObject:object]; | ||
| 9778 | break; | ||
| 9779 | } | ||
| 9780 | } | ||
| 9781 | 9741 | ||
| 9782 | if (!surface) | 9742 | NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (lastSurface ? 1 : 0)); |
| 9783 | { | ||
| 9784 | int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow, | ||
| 9785 | size.width * 4); | ||
| 9786 | 9743 | ||
| 9787 | surface = IOSurfaceCreate | 9744 | for (id object in cache) |
| 9788 | ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:size.width], | 9745 | { |
| 9789 | (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height], | 9746 | if (!IOSurfaceIsInUse ((IOSurfaceRef)object)) |
| 9790 | (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow], | 9747 | { |
| 9791 | (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4], | 9748 | surface = (IOSurfaceRef)object; |
| 9792 | (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']}); | 9749 | [cache removeObject:object]; |
| 9793 | } | 9750 | break; |
| 9751 | } | ||
| 9752 | } | ||
| 9794 | 9753 | ||
| 9795 | IOReturn lockStatus = IOSurfaceLock (surface, 0, nil); | 9754 | if (!surface && [cache count] >= CACHE_MAX_SIZE) |
| 9796 | if (lockStatus != kIOReturnSuccess) | 9755 | { |
| 9797 | NSLog (@"Failed to lock surface: %x", lockStatus); | 9756 | /* Just grab the first one off the cache. This may result |
| 9757 | in tearing effects. The alternative is to wait for one | ||
| 9758 | of the surfaces to become free. */ | ||
| 9759 | surface = (IOSurfaceRef)[cache firstObject]; | ||
| 9760 | [cache removeObject:(id)surface]; | ||
| 9761 | } | ||
| 9762 | else if (!surface) | ||
| 9763 | { | ||
| 9764 | int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow, | ||
| 9765 | size.width * 4); | ||
| 9766 | |||
| 9767 | surface = IOSurfaceCreate | ||
| 9768 | ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:size.width], | ||
| 9769 | (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height], | ||
| 9770 | (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow], | ||
| 9771 | (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4], | ||
| 9772 | (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']}); | ||
| 9773 | } | ||
| 9774 | |||
| 9775 | IOReturn lockStatus = IOSurfaceLock (surface, 0, nil); | ||
| 9776 | if (lockStatus != kIOReturnSuccess) | ||
| 9777 | NSLog (@"Failed to lock surface: %x", lockStatus); | ||
| 9798 | 9778 | ||
| 9799 | [self copyContentsTo:surface]; | 9779 | [self copyContentsTo:surface]; |
| 9800 | 9780 | ||
| 9801 | currentSurface = surface; | 9781 | currentSurface = surface; |
| 9782 | |||
| 9783 | context = CGBitmapContextCreate (IOSurfaceGetBaseAddress (currentSurface), | ||
| 9784 | IOSurfaceGetWidth (currentSurface), | ||
| 9785 | IOSurfaceGetHeight (currentSurface), | ||
| 9786 | 8, | ||
| 9787 | IOSurfaceGetBytesPerRow (currentSurface), | ||
| 9788 | colorSpace, | ||
| 9789 | (kCGImageAlphaPremultipliedFirst | ||
| 9790 | | kCGBitmapByteOrder32Host)); | ||
| 9791 | |||
| 9792 | CGContextTranslateCTM(context, 0, size.height); | ||
| 9793 | CGContextScaleCTM(context, scale, -scale); | ||
| 9794 | } | ||
| 9802 | 9795 | ||
| 9803 | context = CGBitmapContextCreate (IOSurfaceGetBaseAddress (currentSurface), | ||
| 9804 | IOSurfaceGetWidth (currentSurface), | ||
| 9805 | IOSurfaceGetHeight (currentSurface), | ||
| 9806 | 8, | ||
| 9807 | IOSurfaceGetBytesPerRow (currentSurface), | ||
| 9808 | colorSpace, | ||
| 9809 | (kCGImageAlphaPremultipliedFirst | ||
| 9810 | | kCGBitmapByteOrder32Host)); | ||
| 9811 | return context; | 9796 | return context; |
| 9812 | } | 9797 | } |
| 9813 | 9798 | ||
| @@ -9818,6 +9803,9 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) | |||
| 9818 | { | 9803 | { |
| 9819 | NSTRACE ("[EmacsSurface releaseContextAndGetSurface]"); | 9804 | NSTRACE ("[EmacsSurface releaseContextAndGetSurface]"); |
| 9820 | 9805 | ||
| 9806 | if (!context) | ||
| 9807 | return; | ||
| 9808 | |||
| 9821 | CGContextRelease (context); | 9809 | CGContextRelease (context); |
| 9822 | context = NULL; | 9810 | context = NULL; |
| 9823 | 9811 | ||
| @@ -9825,11 +9813,8 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) | |||
| 9825 | if (lockStatus != kIOReturnSuccess) | 9813 | if (lockStatus != kIOReturnSuccess) |
| 9826 | NSLog (@"Failed to unlock surface: %x", lockStatus); | 9814 | NSLog (@"Failed to unlock surface: %x", lockStatus); |
| 9827 | 9815 | ||
| 9828 | /* Put lastSurface back on the end of the cache. It may not have | 9816 | /* Put currentSurface back on the end of the cache. */ |
| 9829 | been displayed on the screen yet, but we probably want the new | 9817 | [cache addObject:(id)currentSurface]; |
| 9830 | data and not some stale data anyway. */ | ||
| 9831 | if (lastSurface) | ||
| 9832 | [cache addObject:(id)lastSurface]; | ||
| 9833 | lastSurface = currentSurface; | 9818 | lastSurface = currentSurface; |
| 9834 | currentSurface = NULL; | 9819 | currentSurface = NULL; |
| 9835 | } | 9820 | } |
| @@ -9854,7 +9839,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) | |||
| 9854 | 9839 | ||
| 9855 | NSTRACE ("[EmacsSurface copyContentsTo:]"); | 9840 | NSTRACE ("[EmacsSurface copyContentsTo:]"); |
| 9856 | 9841 | ||
| 9857 | if (! lastSurface) | 9842 | if (!lastSurface || lastSurface == destination) |
| 9858 | return; | 9843 | return; |
| 9859 | 9844 | ||
| 9860 | lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil); | 9845 | lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil); |
| @@ -9874,6 +9859,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) | |||
| 9874 | NSLog (@"Failed to unlock source surface: %x", lockStatus); | 9859 | NSLog (@"Failed to unlock source surface: %x", lockStatus); |
| 9875 | } | 9860 | } |
| 9876 | 9861 | ||
| 9862 | #undef CACHE_MAX_SIZE | ||
| 9877 | 9863 | ||
| 9878 | @end /* EmacsSurface */ | 9864 | @end /* EmacsSurface */ |
| 9879 | 9865 | ||
diff --git a/src/window.c b/src/window.c index 9961c54161d..db324effcce 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -468,6 +468,7 @@ Return WINDOW. */) | |||
| 468 | else | 468 | else |
| 469 | { | 469 | { |
| 470 | fset_selected_window (XFRAME (frame), window); | 470 | fset_selected_window (XFRAME (frame), window); |
| 471 | /* Don't clear FRAME's select_mini_window_flag here. */ | ||
| 471 | return window; | 472 | return window; |
| 472 | } | 473 | } |
| 473 | } | 474 | } |
| @@ -517,6 +518,9 @@ select_window (Lisp_Object window, Lisp_Object norecord, | |||
| 517 | /* Do not select a tooltip window (Bug#47207). */ | 518 | /* Do not select a tooltip window (Bug#47207). */ |
| 518 | error ("Cannot select a tooltip window"); | 519 | error ("Cannot select a tooltip window"); |
| 519 | 520 | ||
| 521 | /* We deinitely want to select WINDOW, not the mini-window. */ | ||
| 522 | f->select_mini_window_flag = false; | ||
| 523 | |||
| 520 | /* Make the selected window's buffer current. */ | 524 | /* Make the selected window's buffer current. */ |
| 521 | Fset_buffer (w->contents); | 525 | Fset_buffer (w->contents); |
| 522 | 526 | ||
| @@ -3242,6 +3246,9 @@ window-start value is reasonable when this function is called. */) | |||
| 3242 | if (EQ (selected_frame, w->frame)) | 3246 | if (EQ (selected_frame, w->frame)) |
| 3243 | Fselect_window (window, Qnil); | 3247 | Fselect_window (window, Qnil); |
| 3244 | else | 3248 | else |
| 3249 | /* Do not clear f->select_mini_window_flag here. If the | ||
| 3250 | last selected window on F was an active minibuffer, we | ||
| 3251 | want to return to it on a later Fselect_frame. */ | ||
| 3245 | fset_selected_window (f, window); | 3252 | fset_selected_window (f, window); |
| 3246 | } | 3253 | } |
| 3247 | } | 3254 | } |
| @@ -5141,37 +5148,23 @@ Signal an error when WINDOW is the only window on its frame. */) | |||
| 5141 | adjust_frame_glyphs (f); | 5148 | adjust_frame_glyphs (f); |
| 5142 | 5149 | ||
| 5143 | if (!WINDOW_LIVE_P (FRAME_SELECTED_WINDOW (f))) | 5150 | if (!WINDOW_LIVE_P (FRAME_SELECTED_WINDOW (f))) |
| 5144 | /* We deleted the frame's selected window. */ | 5151 | /* We apparently deleted the frame's selected window; use the |
| 5152 | frame's first window as substitute but don't record it yet. | ||
| 5153 | `delete-window' may have something better up its sleeves. */ | ||
| 5145 | { | 5154 | { |
| 5146 | /* Use the frame's first window as fallback ... */ | 5155 | /* Use the frame's first window as fallback ... */ |
| 5147 | Lisp_Object new_selected_window = Fframe_first_window (frame); | 5156 | Lisp_Object new_selected_window = Fframe_first_window (frame); |
| 5148 | /* ... but preferably use its most recently used window. */ | ||
| 5149 | Lisp_Object mru_window; | ||
| 5150 | 5157 | ||
| 5151 | /* `get-mru-window' might fail for some reason so play it safe | ||
| 5152 | - promote the first window _without recording it_ first. */ | ||
| 5153 | if (EQ (FRAME_SELECTED_WINDOW (f), selected_window)) | 5158 | if (EQ (FRAME_SELECTED_WINDOW (f), selected_window)) |
| 5154 | Fselect_window (new_selected_window, Qt); | 5159 | Fselect_window (new_selected_window, Qt); |
| 5155 | else | 5160 | else |
| 5156 | fset_selected_window (f, new_selected_window); | 5161 | /* Do not clear f->select_mini_window_flag here. If the |
| 5157 | 5162 | last selected window on F was an active minibuffer, we | |
| 5158 | unblock_input (); | 5163 | want to return to it on a later Fselect_frame. */ |
| 5159 | |||
| 5160 | /* Now look whether `get-mru-window' gets us something. */ | ||
| 5161 | mru_window = call1 (Qget_mru_window, frame); | ||
| 5162 | if (WINDOW_LIVE_P (mru_window) | ||
| 5163 | && EQ (XWINDOW (mru_window)->frame, frame)) | ||
| 5164 | new_selected_window = mru_window; | ||
| 5165 | |||
| 5166 | /* If all ended up well, we now promote the mru window. */ | ||
| 5167 | if (EQ (FRAME_SELECTED_WINDOW (f), selected_window)) | ||
| 5168 | Fselect_window (new_selected_window, Qnil); | ||
| 5169 | else | ||
| 5170 | fset_selected_window (f, new_selected_window); | 5164 | fset_selected_window (f, new_selected_window); |
| 5171 | } | 5165 | } |
| 5172 | else | ||
| 5173 | unblock_input (); | ||
| 5174 | 5166 | ||
| 5167 | unblock_input (); | ||
| 5175 | FRAME_WINDOW_CHANGE (f) = true; | 5168 | FRAME_WINDOW_CHANGE (f) = true; |
| 5176 | } | 5169 | } |
| 5177 | else | 5170 | else |
diff --git a/src/xdisp.c b/src/xdisp.c index 74fa0a57e44..e95e64a24cd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -10795,6 +10795,9 @@ include the height of both, if present, in the return value. */) | |||
| 10795 | it.max_descent = max (it.max_descent, it.descent); | 10795 | it.max_descent = max (it.max_descent, it.descent); |
| 10796 | } | 10796 | } |
| 10797 | } | 10797 | } |
| 10798 | else | ||
| 10799 | bidi_unshelve_cache (it2data, true); | ||
| 10800 | |||
| 10798 | if (!NILP (x_limit)) | 10801 | if (!NILP (x_limit)) |
| 10799 | { | 10802 | { |
| 10800 | /* Don't return more than X-LIMIT. */ | 10803 | /* Don't return more than X-LIMIT. */ |
| @@ -22386,15 +22389,23 @@ extend_face_to_end_of_line (struct it *it) | |||
| 22386 | it->face_id = (it->glyph_row->ends_at_zv_p ? | 22389 | it->face_id = (it->glyph_row->ends_at_zv_p ? |
| 22387 | default_face->id : face->id); | 22390 | default_face->id : face->id); |
| 22388 | 22391 | ||
| 22389 | /* Display fill-column indicator if needed. */ | ||
| 22390 | const int indicator_column = fill_column_indicator_column (it, 1); | ||
| 22391 | |||
| 22392 | /* Make sure our idea of current_x is in sync with the glyphs | 22392 | /* Make sure our idea of current_x is in sync with the glyphs |
| 22393 | actually in the glyph row. They might differ because | 22393 | actually in the glyph row. They might differ because |
| 22394 | append_space_for_newline can insert one glyph without | 22394 | append_space_for_newline can insert one glyph without |
| 22395 | updating current_x. */ | 22395 | updating current_x. */ |
| 22396 | it->current_x = it->glyph_row->used[TEXT_AREA]; | 22396 | it->current_x = it->glyph_row->used[TEXT_AREA]; |
| 22397 | 22397 | ||
| 22398 | /* The above assignment causes the code below to use a | ||
| 22399 | non-standard semantics of it->current_x: it is measured | ||
| 22400 | relative to the beginning of the text-area, thus disregarding | ||
| 22401 | the window's hscroll. That is why we need to correct the | ||
| 22402 | indicator column for the hscroll, otherwise the indicator | ||
| 22403 | will not move together with the text as result of horizontal | ||
| 22404 | scrolling. */ | ||
| 22405 | const int indicator_column = | ||
| 22406 | fill_column_indicator_column (it, 1) - it->first_visible_x; | ||
| 22407 | |||
| 22408 | /* Display fill-column indicator if needed. */ | ||
| 22398 | while (it->current_x <= it->last_visible_x) | 22409 | while (it->current_x <= it->last_visible_x) |
| 22399 | { | 22410 | { |
| 22400 | if (it->current_x != indicator_column) | 22411 | if (it->current_x != indicator_column) |
| @@ -30305,7 +30316,7 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym) | |||
| 30305 | 30316 | ||
| 30306 | /* +4 is for vertical bars of a box plus 1-pixel spaces at both side. */ | 30317 | /* +4 is for vertical bars of a box plus 1-pixel spaces at both side. */ |
| 30307 | width = max (metrics_upper.width, metrics_lower.width) + 4; | 30318 | width = max (metrics_upper.width, metrics_lower.width) + 4; |
| 30308 | upper_xoff = upper_yoff = 2; /* the typical case */ | 30319 | upper_xoff = lower_xoff = 2; /* the typical case */ |
| 30309 | if (base_width >= width) | 30320 | if (base_width >= width) |
| 30310 | { | 30321 | { |
| 30311 | /* Align the upper to the left, the lower to the right. */ | 30322 | /* Align the upper to the left, the lower to the right. */ |
| @@ -30319,13 +30330,7 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym) | |||
| 30319 | if (metrics_upper.width >= metrics_lower.width) | 30330 | if (metrics_upper.width >= metrics_lower.width) |
| 30320 | lower_xoff = (width - metrics_lower.width) / 2; | 30331 | lower_xoff = (width - metrics_lower.width) / 2; |
| 30321 | else | 30332 | else |
| 30322 | { | 30333 | upper_xoff = (width - metrics_upper.width) / 2; |
| 30323 | /* FIXME: This code doesn't look right. It formerly was | ||
| 30324 | missing the "lower_xoff = 0;", which couldn't have | ||
| 30325 | been right since it left lower_xoff uninitialized. */ | ||
| 30326 | lower_xoff = 0; | ||
| 30327 | upper_xoff = (width - metrics_upper.width) / 2; | ||
| 30328 | } | ||
| 30329 | } | 30334 | } |
| 30330 | 30335 | ||
| 30331 | /* +5 is for horizontal bars of a box plus 1-pixel spaces at | 30336 | /* +5 is for horizontal bars of a box plus 1-pixel spaces at |
| @@ -35660,8 +35665,10 @@ as usual. If the function returns a string, the returned string is | |||
| 35660 | displayed in the echo area. If this function returns any other non-nil | 35665 | displayed in the echo area. If this function returns any other non-nil |
| 35661 | value, this means that the message was already handled, and the original | 35666 | value, this means that the message was already handled, and the original |
| 35662 | message text will not be displayed in the echo area. | 35667 | message text will not be displayed in the echo area. |
| 35663 | See also `clear-message-function' that can be used to clear the | 35668 | |
| 35664 | message displayed by this function. */); | 35669 | Also see `clear-message-function' (which can be used to clear the |
| 35670 | message displayed by this function), and `command-error-function' | ||
| 35671 | (which controls how error messages are displayed). */); | ||
| 35665 | Vset_message_function = Qnil; | 35672 | Vset_message_function = Qnil; |
| 35666 | 35673 | ||
| 35667 | DEFVAR_LISP ("clear-message-function", Vclear_message_function, | 35674 | DEFVAR_LISP ("clear-message-function", Vclear_message_function, |
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl new file mode 100644 index 00000000000..f54d55241df --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl | |||
| @@ -0,0 +1,14 @@ | |||
| 1 | # The source file contains non-ASCII characters, supposed to be saved | ||
| 2 | # in UTF-8 encoding. Tell Perl about that, just in case. | ||
| 3 | use utf8; | ||
| 4 | |||
| 5 | # Following code is the example from the report Bug#22355 which needed | ||
| 6 | # attention in perl-mode. | ||
| 7 | |||
| 8 | printf qq | ||
| 9 | {<?xml version="1.0" encoding="UTF-8"?> | ||
| 10 | <kml xmlns="http://www.opengis.net/kml/2.2"> | ||
| 11 | <Document> | ||
| 12 | <Folder><name>台灣 %s 廣播電台</name> | ||
| 13 | <description><![CDATA[http://radioscanningtw.wikia.com/wiki/台描:地圖 %d-%02d-%02d]]></description> | ||
| 14 | }, uc( substr( $ARGV[0], 0, 2 ) ), $year + 1900, $mon + 1, $mday; | ||
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl new file mode 100644 index 00000000000..1db639c6aa2 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl | |||
| @@ -0,0 +1,10 @@ | |||
| 1 | # Test file for Bug#23992 | ||
| 2 | # | ||
| 3 | # The "||" case is directly from the report, | ||
| 4 | # the "&&" case has been added for symmetry. | ||
| 5 | |||
| 6 | s/LEFT/L/g || s/RIGHT/R/g || s/aVALUE\D+//g; | ||
| 7 | s/LEFT/L/g||s/RIGHT/R/g||s/aVALUE\D+//g; | ||
| 8 | |||
| 9 | s/LEFT/L/g && s/RIGHT/R/g && s/aVALUE\D+//g; | ||
| 10 | s/LEFT/L/g&&s/RIGHT/R/g&&s/aVALUE\D+//g; | ||
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl new file mode 100644 index 00000000000..0987b4e02c0 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl | |||
| @@ -0,0 +1,21 @@ | |||
| 1 | # Code from the bug report Bug#25098 | ||
| 2 | |||
| 3 | my $good = XML::LibXML->load_xml( string => q{<div class="clearfix">}); | ||
| 4 | my $bad = XML::LibXML->load_xml( string =>q{<div class="clearfix">}); | ||
| 5 | |||
| 6 | # Related: Method calls are no quotelike operators. That's why you | ||
| 7 | # can't just add '>' to the character class. | ||
| 8 | |||
| 9 | my $method_call = $object->q(argument); | ||
| 10 | |||
| 11 | # Also related, still not fontified correctly: | ||
| 12 | # | ||
| 13 | # my $method_call = $object -> q (argument); | ||
| 14 | # | ||
| 15 | # perl-mode interprets the method call as a quotelike op (because it | ||
| 16 | # is preceded by a space). | ||
| 17 | # cperl-mode gets the argument right, but marks q as a quotelike op. | ||
| 18 | # | ||
| 19 | # my $greater = 2>q/1/; | ||
| 20 | # | ||
| 21 | # perl-mode doesn't identify this as a quotelike op. | ||
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 7cdfa45d6f7..4d2bac6ee47 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el | |||
| @@ -37,7 +37,7 @@ | |||
| 37 | ;;; Utilities | 37 | ;;; Utilities |
| 38 | 38 | ||
| 39 | (defun cperl-test-ppss (text regexp) | 39 | (defun cperl-test-ppss (text regexp) |
| 40 | "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT." | 40 | "Return the `syntax-ppss' after the last character matched by REGEXP in TEXT." |
| 41 | (interactive) | 41 | (interactive) |
| 42 | (with-temp-buffer | 42 | (with-temp-buffer |
| 43 | (insert text) | 43 | (insert text) |
| @@ -377,6 +377,55 @@ documentation it does the right thing anyway." | |||
| 377 | (cperl-indent-command) | 377 | (cperl-indent-command) |
| 378 | (forward-line 1)))) | 378 | (forward-line 1)))) |
| 379 | 379 | ||
| 380 | (ert-deftest cperl-test-bug-22355 () | ||
| 381 | "Verify that substitutions are fontified directly after \"|&\". | ||
| 382 | Regular expressions are strings in both perl-mode and cperl-mode." | ||
| 383 | (with-temp-buffer | ||
| 384 | (insert-file-contents (ert-resource-file "cperl-bug-22355.pl")) | ||
| 385 | (funcall cperl-test-mode) | ||
| 386 | (goto-char (point-min)) | ||
| 387 | ;; Just check for the start of the string | ||
| 388 | (search-forward "{") | ||
| 389 | (should (nth 3 (syntax-ppss))))) | ||
| 390 | |||
| 391 | (ert-deftest cperl-test-bug-23992 () | ||
| 392 | "Verify that substitutions are fontified directly after \"|&\". | ||
| 393 | Regular expressions are strings in both perl-mode and cperl-mode." | ||
| 394 | (with-temp-buffer | ||
| 395 | (insert-file-contents (ert-resource-file "cperl-bug-23992.pl")) | ||
| 396 | (funcall cperl-test-mode) | ||
| 397 | (goto-char (point-min)) | ||
| 398 | ;; "or" operator, with spaces | ||
| 399 | (search-forward "RIGHT") | ||
| 400 | (should (nth 3 (syntax-ppss))) | ||
| 401 | ;; "or" operator, without spaces | ||
| 402 | (search-forward "RIGHT") | ||
| 403 | (should (nth 3 (syntax-ppss))) | ||
| 404 | ;; "and" operator, with spaces | ||
| 405 | (search-forward "RIGHT") | ||
| 406 | (should (nth 3 (syntax-ppss))) | ||
| 407 | ;; "and" operator, without spaces | ||
| 408 | (search-forward "RIGHT") | ||
| 409 | (should (nth 3 (syntax-ppss))))) | ||
| 410 | |||
| 411 | (ert-deftest cperl-test-bug-25098 () | ||
| 412 | "Verify that a quotelike operator is recognized after a fat comma \"=>\". | ||
| 413 | Related, check that calling a method named q is not mistaken as a | ||
| 414 | quotelike operator." | ||
| 415 | (with-temp-buffer | ||
| 416 | (insert-file-contents (ert-resource-file "cperl-bug-25098.pl")) | ||
| 417 | (funcall cperl-test-mode) | ||
| 418 | (goto-char (point-min)) | ||
| 419 | ;; good example from the bug report, with a space | ||
| 420 | (search-forward "q{") | ||
| 421 | (should (nth 3 (syntax-ppss))) | ||
| 422 | ;; bad (but now fixed) example from the bug report, without space | ||
| 423 | (search-forward "q{") | ||
| 424 | (should (nth 3 (syntax-ppss))) | ||
| 425 | ;; calling a method "q" (parens instead of braces to make it valid) | ||
| 426 | (search-forward "q(") | ||
| 427 | (should-not (nth 3 (syntax-ppss))))) | ||
| 428 | |||
| 380 | (ert-deftest cperl-test-bug-28650 () | 429 | (ert-deftest cperl-test-bug-28650 () |
| 381 | "Verify that regular expressions are recognized after 'return'. | 430 | "Verify that regular expressions are recognized after 'return'. |
| 382 | The test uses the syntax property \"inside a string\" for the | 431 | The test uses the syntax property \"inside a string\" for the |
| @@ -448,14 +497,14 @@ If seen as regular expression, then the slash is displayed using | |||
| 448 | font-lock-constant-face. If seen as a division, then it doesn't | 497 | font-lock-constant-face. If seen as a division, then it doesn't |
| 449 | have a face property." | 498 | have a face property." |
| 450 | :tags '(:fontification) | 499 | :tags '(:fontification) |
| 451 | ;; The next two Perl expressions have divisions. Perl "punctuation" | 500 | ;; The next two Perl expressions have divisions. The slash does not |
| 452 | ;; operators don't get a face. | 501 | ;; start a string. |
| 453 | (let ((code "{ $a++ / $b }")) | 502 | (let ((code "{ $a++ / $b }")) |
| 454 | (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) | 503 | (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) |
| 455 | (let ((code "{ $a-- / $b }")) | 504 | (let ((code "{ $a-- / $b }")) |
| 456 | (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) | 505 | (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) |
| 457 | ;; The next two Perl expressions have regular expressions. The | 506 | ;; The next two Perl expressions have regular expressions. The slash |
| 458 | ;; delimiter of a RE is fontified with font-lock-constant-face. | 507 | ;; starts a string. |
| 459 | (let ((code "{ $a+ / $b } # /")) | 508 | (let ((code "{ $a+ / $b } # /")) |
| 460 | (should (equal (nth 8 (cperl-test-ppss code "/")) 7))) | 509 | (should (equal (nth 8 (cperl-test-ppss code "/")) 7))) |
| 461 | (let ((code "{ $a- / $b } # /")) | 510 | (let ((code "{ $a- / $b } # /")) |
diff --git a/test/lisp/progmodes/octave-tests.el b/test/lisp/progmodes/octave-tests.el new file mode 100644 index 00000000000..e28fe73b836 --- /dev/null +++ b/test/lisp/progmodes/octave-tests.el | |||
| @@ -0,0 +1,49 @@ | |||
| 1 | ;;; octave-tests.el --- Test suite for octave.el -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2021 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | (require 'octave) | ||
| 26 | |||
| 27 | (defun octave-test--indent (string) | ||
| 28 | (with-temp-buffer | ||
| 29 | (octave-mode) | ||
| 30 | (insert string) | ||
| 31 | (indent-region (point-min) (point-max)) | ||
| 32 | (buffer-string))) | ||
| 33 | |||
| 34 | (ert-deftest octave-tests--continuation-indentation () | ||
| 35 | (should | ||
| 36 | (equal (octave-test--indent "a = b + a * \\ | ||
| 37 | c; | ||
| 38 | ") | ||
| 39 | "a = b + a * \\ | ||
| 40 | c; | ||
| 41 | ")) | ||
| 42 | (should (equal (octave-test--indent "a = \\ | ||
| 43 | b; | ||
| 44 | ") | ||
| 45 | "a = \\ | ||
| 46 | b; | ||
| 47 | "))) | ||
| 48 | |||
| 49 | ;;; octave-tests.el ends here | ||
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index 66099dc110c..d29452243b2 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el | |||
| @@ -117,18 +117,14 @@ | |||
| 117 | (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) | 117 | (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) |
| 118 | 118 | ||
| 119 | (ert-deftest xref--xref-file-name-display-is-abs () | 119 | (ert-deftest xref--xref-file-name-display-is-abs () |
| 120 | (let* ((xref-file-name-display 'abs) | 120 | (let ((xref-file-name-display 'abs)) |
| 121 | ;; Some older BSD find versions can produce '//' in the output. | 121 | (should (equal |
| 122 | (expected (list | 122 | (delete-dups |
| 123 | (concat xref-tests--data-dir "/?file1.txt") | 123 | (mapcar 'xref-location-group |
| 124 | (concat xref-tests--data-dir "/?file2.txt"))) | 124 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) |
| 125 | (actual (delete-dups | 125 | (list |
| 126 | (mapcar 'xref-location-group | 126 | (concat xref-tests--data-dir "file1.txt") |
| 127 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))))) | 127 | (concat xref-tests--data-dir "file2.txt")))))) |
| 128 | (should (= (length expected) (length actual))) | ||
| 129 | (should (cl-every (lambda (e1 e2) | ||
| 130 | (string-match-p e1 e2)) | ||
| 131 | expected actual)))) | ||
| 132 | 128 | ||
| 133 | (ert-deftest xref--xref-file-name-display-is-nondirectory () | 129 | (ert-deftest xref--xref-file-name-display-is-nondirectory () |
| 134 | (let ((xref-file-name-display 'nondirectory)) | 130 | (let ((xref-file-name-display 'nondirectory)) |
| @@ -144,17 +140,13 @@ | |||
| 144 | (file-name-directory (directory-file-name xref-tests--data-dir))) | 140 | (file-name-directory (directory-file-name xref-tests--data-dir))) |
| 145 | (project-find-functions | 141 | (project-find-functions |
| 146 | (lambda (_) (cons 'transient data-parent-dir))) | 142 | (lambda (_) (cons 'transient data-parent-dir))) |
| 147 | (xref-file-name-display 'project-relative) | 143 | (xref-file-name-display 'project-relative)) |
| 148 | ;; Some older BSD find versions can produce '//' in the output. | 144 | (should (equal |
| 149 | (expected (list | 145 | (delete-dups |
| 150 | "xref-resources//?file1.txt" | 146 | (mapcar 'xref-location-group |
| 151 | "xref-resources//?file2.txt")) | 147 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) |
| 152 | (actual (delete-dups | 148 | (list |
| 153 | (mapcar 'xref-location-group | 149 | "xref-resources/file1.txt" |
| 154 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))))) | 150 | "xref-resources/file2.txt"))))) |
| 155 | (should (and (= (length expected) (length actual)) | ||
| 156 | (cl-every (lambda (e1 e2) | ||
| 157 | (string-match-p e1 e2)) | ||
| 158 | expected actual))))) | ||
| 159 | 151 | ||
| 160 | ;;; xref-tests.el ends here | 152 | ;;; xref-tests.el ends here |
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 1e146732163..375251cffc5 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el | |||
| @@ -684,5 +684,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." | |||
| 684 | (should (>= (length (apropos-internal "^help" #'commandp)) 15)) | 684 | (should (>= (length (apropos-internal "^help" #'commandp)) 15)) |
| 685 | (should-not (apropos-internal "^next-line$" #'keymapp))) | 685 | (should-not (apropos-internal "^next-line$" #'keymapp))) |
| 686 | 686 | ||
| 687 | |||
| 688 | (ert-deftest test-buffer-local-boundp () | ||
| 689 | (let ((buf (generate-new-buffer "boundp"))) | ||
| 690 | (with-current-buffer buf | ||
| 691 | (setq-local test-boundp t)) | ||
| 692 | (setq test-global-boundp t) | ||
| 693 | (should (buffer-local-boundp 'test-boundp buf)) | ||
| 694 | (should-not (buffer-local-boundp 'test-not-boundp buf)) | ||
| 695 | (should (buffer-local-boundp 'test-global-boundp buf)))) | ||
| 696 | |||
| 687 | (provide 'subr-tests) | 697 | (provide 'subr-tests) |
| 688 | ;;; subr-tests.el ends here | 698 | ;;; subr-tests.el ends here |
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index 4ae3c1917dd..b42271e4e51 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el | |||
| @@ -486,7 +486,10 @@ | |||
| 486 | "Test time-stamp format %Y." | 486 | "Test time-stamp format %Y." |
| 487 | (with-time-stamp-test-env | 487 | (with-time-stamp-test-env |
| 488 | ;; implemented since 1997, documented since 2019 | 488 | ;; implemented since 1997, documented since 2019 |
| 489 | (should (equal (time-stamp-string "%Y" ref-time1) "2006")))) | 489 | (should (equal (time-stamp-string "%Y" ref-time1) "2006")) |
| 490 | ;; numbers do not truncate | ||
| 491 | (should (equal (time-stamp-string "%2Y" ref-time1) "2006")) | ||
| 492 | (should (equal (time-stamp-string "%02Y" ref-time1) "2006")))) | ||
| 490 | 493 | ||
| 491 | (ert-deftest time-stamp-format-am-pm () | 494 | (ert-deftest time-stamp-format-am-pm () |
| 492 | "Test time-stamp formats for AM and PM strings." | 495 | "Test time-stamp formats for AM and PM strings." |
| @@ -522,7 +525,7 @@ | |||
| 522 | (should (equal (time-stamp-string "%#Z" ref-time1) utc-abbr))))) | 525 | (should (equal (time-stamp-string "%#Z" ref-time1) utc-abbr))))) |
| 523 | 526 | ||
| 524 | (ert-deftest time-stamp-format-time-zone-offset () | 527 | (ert-deftest time-stamp-format-time-zone-offset () |
| 525 | "Test time-stamp format %z." | 528 | "Tests time-stamp legacy format %z and new offset format %5z." |
| 526 | (with-time-stamp-test-env | 529 | (with-time-stamp-test-env |
| 527 | (let ((utc-abbr (format-time-string "%#Z" ref-time1 t))) | 530 | (let ((utc-abbr (format-time-string "%#Z" ref-time1 t))) |
| 528 | ;; documented 1995-2019, warned since 2019, will change | 531 | ;; documented 1995-2019, warned since 2019, will change |
| @@ -541,6 +544,7 @@ | |||
| 541 | (should (equal (time-stamp-string "%_z" ref-time1) "+0000")) | 544 | (should (equal (time-stamp-string "%_z" ref-time1) "+0000")) |
| 542 | (should (equal (time-stamp-string "%:z" ref-time1) "+00:00")) | 545 | (should (equal (time-stamp-string "%:z" ref-time1) "+00:00")) |
| 543 | (should (equal (time-stamp-string "%::z" ref-time1) "+00:00:00")) | 546 | (should (equal (time-stamp-string "%::z" ref-time1) "+00:00:00")) |
| 547 | (should (equal (time-stamp-string "%9::z" ref-time1) "+00:00:00")) | ||
| 544 | (should (equal (time-stamp-string "%:::z" ref-time1) "+00")))) | 548 | (should (equal (time-stamp-string "%:::z" ref-time1) "+00")))) |
| 545 | 549 | ||
| 546 | (ert-deftest time-stamp-format-non-date-conversions () | 550 | (ert-deftest time-stamp-format-non-date-conversions () |
| @@ -586,6 +590,9 @@ | |||
| 586 | (should (equal (time-stamp-string "%(st(u)ff)B" ref-time3) May)) | 590 | (should (equal (time-stamp-string "%(st(u)ff)B" ref-time3) May)) |
| 587 | ;; escaped parens do not change the nesting level | 591 | ;; escaped parens do not change the nesting level |
| 588 | (should (equal (time-stamp-string "%(st\\)u\\(ff)B" ref-time3) May)) | 592 | (should (equal (time-stamp-string "%(st\\)u\\(ff)B" ref-time3) May)) |
| 593 | ;; incorrectly nested parens do not crash us | ||
| 594 | (should-not (equal (time-stamp-string "%(stuffB" ref-time3) May)) | ||
| 595 | (should-not (equal (time-stamp-string "%)B" ref-time3) May)) | ||
| 589 | ;; not all punctuation is allowed | 596 | ;; not all punctuation is allowed |
| 590 | (should-not (equal (time-stamp-string "%&B" ref-time3) May))))) | 597 | (should-not (equal (time-stamp-string "%&B" ref-time3) May))))) |
| 591 | 598 | ||
| @@ -594,6 +601,33 @@ | |||
| 594 | (with-time-stamp-test-env | 601 | (with-time-stamp-test-env |
| 595 | (should (equal (time-stamp-string "No percent" ref-time1) "No percent")))) | 602 | (should (equal (time-stamp-string "No percent" ref-time1) "No percent")))) |
| 596 | 603 | ||
| 604 | (ert-deftest time-stamp-format-multiple-conversions () | ||
| 605 | "Tests that multiple %-conversions are independent." | ||
| 606 | (with-time-stamp-test-env | ||
| 607 | (let ((Mon (format-time-string "%a" ref-time1 t)) | ||
| 608 | (MON (format-time-string "%^a" ref-time1 t)) | ||
| 609 | (Monday (format-time-string "%A" ref-time1 t))) | ||
| 610 | ;; change-case flag is independent | ||
| 611 | (should (equal (time-stamp-string "%a.%#a.%a" ref-time1) | ||
| 612 | (concat Mon "." MON "." Mon))) | ||
| 613 | ;; up-case flag is independent | ||
| 614 | (should (equal (time-stamp-string "%a.%^a.%a" ref-time1) | ||
| 615 | (concat Mon "." MON "." Mon))) | ||
| 616 | ;; underscore flag is independent | ||
| 617 | (should (equal (time-stamp-string "%_d.%d.%_d" ref-time1) " 2.02. 2")) | ||
| 618 | ;; minus flag is independendent | ||
| 619 | (should (equal (time-stamp-string "%d.%-d.%d" ref-time1) "02.2.02")) | ||
| 620 | ;; 0 flag is independendent | ||
| 621 | (should (equal (time-stamp-string "%2d.%02d.%2d" ref-time1) " 2.02. 2")) | ||
| 622 | ;; field width is independent | ||
| 623 | (should (equal | ||
| 624 | (time-stamp-string "%6Y.%Y.%6Y" ref-time1) " 2006.2006. 2006")) | ||
| 625 | ;; colon modifier is independent | ||
| 626 | (should (equal (time-stamp-string "%a.%:a.%a" ref-time1) | ||
| 627 | (concat Mon "." Monday "." Mon))) | ||
| 628 | ;; format letter is independent | ||
| 629 | (should (equal (time-stamp-string "%H:%M" ref-time1) "15:04"))))) | ||
| 630 | |||
| 597 | (ert-deftest time-stamp-format-string-width () | 631 | (ert-deftest time-stamp-format-string-width () |
| 598 | "Test time-stamp string width modifiers." | 632 | "Test time-stamp string width modifiers." |
| 599 | (with-time-stamp-test-env | 633 | (with-time-stamp-test-env |
diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good index 3cffd6d25ef..e265836fd2b 100644 --- a/test/manual/etags/CTAGS.good +++ b/test/manual/etags/CTAGS.good | |||
| @@ -2461,8 +2461,47 @@ abs/f ada-src/etags-test-for.ada /^ function "abs" (Right : Complex) return | |||
| 2461 | absolute_dirname c-src/etags.c /^absolute_dirname (char *file, char *dir)$/ | 2461 | absolute_dirname c-src/etags.c /^absolute_dirname (char *file, char *dir)$/ |
| 2462 | absolute_filename c-src/etags.c /^absolute_filename (char *file, char *dir)$/ | 2462 | absolute_filename c-src/etags.c /^absolute_filename (char *file, char *dir)$/ |
| 2463 | abt cp-src/c.C 55 | 2463 | abt cp-src/c.C 55 |
| 2464 | acc_pred_info merc-src/accumulator.m /^:- pred acc_pred_info(list(mer_type)::in, list(pro/ | ||
| 2465 | acc_proc_info merc-src/accumulator.m /^:- pred acc_proc_info(list(prog_var)::in, prog_var/ | ||
| 2466 | acc_unification merc-src/accumulator.m /^:- pred acc_unification(pair(prog_var)::in, hlds_g/ | ||
| 2467 | acc_var_subst_init merc-src/accumulator.m /^:- pred acc_var_subst_init(list(prog_var)::in,$/ | ||
| 2464 | accent_key_syms c-src/emacs/src/keyboard.c 4625 | 2468 | accent_key_syms c-src/emacs/src/keyboard.c 4625 |
| 2465 | access_keymap_keyremap c-src/emacs/src/keyboard.c /^access_keymap_keyremap (Lisp_Object map, Lisp_Obje/ | 2469 | access_keymap_keyremap c-src/emacs/src/keyboard.c /^access_keymap_keyremap (Lisp_Object map, Lisp_Obje/ |
| 2470 | accu_assoc merc-src/accumulator.m /^:- pred accu_assoc(module_info::in, vartypes::in, / | ||
| 2471 | accu_assoc merc-src/accumulator.m /^:- type accu_assoc$/ | ||
| 2472 | accu_base merc-src/accumulator.m /^:- type accu_base$/ | ||
| 2473 | accu_before merc-src/accumulator.m /^:- pred accu_before(module_info::in, vartypes::in,/ | ||
| 2474 | accu_case merc-src/accumulator.m /^:- type accu_case$/ | ||
| 2475 | accu_construct merc-src/accumulator.m /^:- pred accu_construct(module_info::in, vartypes::/ | ||
| 2476 | accu_construct_assoc merc-src/accumulator.m /^:- pred accu_construct_assoc(module_info::in, vart/ | ||
| 2477 | accu_create_goal merc-src/accumulator.m /^:- pred accu_create_goal(accu_goal_id::in, list(pr/ | ||
| 2478 | accu_divide_base_case merc-src/accumulator.m /^:- pred accu_divide_base_case(module_info::in, var/ | ||
| 2479 | accu_goal_id merc-src/accumulator.m /^:- type accu_goal_id$/ | ||
| 2480 | accu_goal_list merc-src/accumulator.m /^:- func accu_goal_list(list(accu_goal_id), accu_go/ | ||
| 2481 | accu_goal_store merc-src/accumulator.m /^:- type accu_goal_store == goal_store(accu_goal_id/ | ||
| 2482 | accu_has_heuristic merc-src/accumulator.m /^:- pred accu_has_heuristic(module_name::in, string/ | ||
| 2483 | accu_heuristic merc-src/accumulator.m /^:- pred accu_heuristic(module_name::in, string::in/ | ||
| 2484 | accu_is_associative merc-src/accumulator.m /^:- pred accu_is_associative(module_info::in, pred_/ | ||
| 2485 | accu_is_update merc-src/accumulator.m /^:- pred accu_is_update(module_info::in, pred_id::i/ | ||
| 2486 | accu_process_assoc_set merc-src/accumulator.m /^:- pred accu_process_assoc_set(module_info::in, ac/ | ||
| 2487 | accu_process_update_set merc-src/accumulator.m /^:- pred accu_process_update_set(module_info::in, a/ | ||
| 2488 | accu_related merc-src/accumulator.m /^:- pred accu_related(module_info::in, vartypes::in/ | ||
| 2489 | accu_rename merc-src/accumulator.m /^:- func accu_rename(list(accu_goal_id), accu_subst/ | ||
| 2490 | accu_sets merc-src/accumulator.m /^:- type accu_sets$/ | ||
| 2491 | accu_sets_init merc-src/accumulator.m /^:- pred accu_sets_init(accu_sets::out) is det.$/ | ||
| 2492 | accu_stage1 merc-src/accumulator.m /^:- pred accu_stage1(module_info::in, vartypes::in,/ | ||
| 2493 | accu_stage1_2 merc-src/accumulator.m /^:- pred accu_stage1_2(module_info::in, vartypes::i/ | ||
| 2494 | accu_stage2 merc-src/accumulator.m /^:- pred accu_stage2(module_info::in, proc_info::in/ | ||
| 2495 | accu_stage3 merc-src/accumulator.m /^:- pred accu_stage3(accu_goal_id::in, list(prog_va/ | ||
| 2496 | accu_standardize merc-src/accumulator.m /^:- pred accu_standardize(hlds_goal::in, hlds_goal:/ | ||
| 2497 | accu_store merc-src/accumulator.m /^:- pred accu_store(accu_case::in, hlds_goal::in,$/ | ||
| 2498 | accu_subst merc-src/accumulator.m /^:- type accu_subst == map(prog_var, prog_var).$/ | ||
| 2499 | accu_substs merc-src/accumulator.m /^:- type accu_substs$/ | ||
| 2500 | accu_substs_init merc-src/accumulator.m /^:- pred accu_substs_init(list(prog_var)::in, prog_/ | ||
| 2501 | accu_top_level merc-src/accumulator.m /^:- pred accu_top_level(top_level::in, hlds_goal::i/ | ||
| 2502 | accu_transform_proc merc-src/accumulator.m /^:- pred accu_transform_proc(pred_proc_id::in, pred/ | ||
| 2503 | accu_update merc-src/accumulator.m /^:- pred accu_update(module_info::in, vartypes::in,/ | ||
| 2504 | accu_warning merc-src/accumulator.m /^:- type accu_warning$/ | ||
| 2466 | act prol-src/natded.prolog /^act(OutForm,OutSyn,Ws):-$/ | 2505 | act prol-src/natded.prolog /^act(OutForm,OutSyn,Ws):-$/ |
| 2467 | action prol-src/natded.prolog /^action(KeyVals):-$/ | 2506 | action prol-src/natded.prolog /^action(KeyVals):-$/ |
| 2468 | active_maps c-src/emacs/src/keyboard.c /^active_maps (Lisp_Object first_event)$/ | 2507 | active_maps c-src/emacs/src/keyboard.c /^active_maps (Lisp_Object first_event)$/ |
| @@ -2534,6 +2573,8 @@ assemby-code-word forth-src/test-forth.fth /^code assemby-code-word ( dunno what | |||
| 2534 | assert c-src/etags.c 135 | 2573 | assert c-src/etags.c 135 |
| 2535 | assert c-src/etags.c /^# define assert(x) ((void) 0)$/ | 2574 | assert c-src/etags.c /^# define assert(x) ((void) 0)$/ |
| 2536 | assign_neighbor cp-src/clheir.hpp /^ void assign_neighbor(int direction, location */ | 2575 | assign_neighbor cp-src/clheir.hpp /^ void assign_neighbor(int direction, location */ |
| 2576 | assoc_list merc-src/accumulator.m /^:- import_module assoc_list.$/ | ||
| 2577 | associativity_assertion merc-src/accumulator.m /^:- pred associativity_assertion(module_info::in, l/ | ||
| 2537 | at_end c-src/etags.c 249 | 2578 | at_end c-src/etags.c 249 |
| 2538 | at_filename c-src/etags.c 247 | 2579 | at_filename c-src/etags.c 247 |
| 2539 | at_language c-src/etags.c 245 | 2580 | at_language c-src/etags.c 245 |
| @@ -2567,6 +2608,8 @@ bas_syn prol-src/natded.prolog /^bas_syn(n(_)).$/ | |||
| 2567 | base c-src/emacs/src/lisp.h 2188 | 2608 | base c-src/emacs/src/lisp.h 2188 |
| 2568 | base cp-src/c.C /^double base (void) const { return rng_base; }$/ | 2609 | base cp-src/c.C /^double base (void) const { return rng_base; }$/ |
| 2569 | base cp-src/Range.h /^ double base (void) const { return rng_base; }$/ | 2610 | base cp-src/Range.h /^ double base (void) const { return rng_base; }$/ |
| 2611 | base_case_ids merc-src/accumulator.m /^:- func base_case_ids(accu_goal_store) = list(accu/ | ||
| 2612 | base_case_ids_set merc-src/accumulator.m /^:- func base_case_ids_set(accu_goal_store) = set(a/ | ||
| 2570 | baz= ruby-src/test1.ru /^ :baz,$/ | 2613 | baz= ruby-src/test1.ru /^ :baz,$/ |
| 2571 | bb c.c 275 | 2614 | bb c.c 275 |
| 2572 | bbb c.c 251 | 2615 | bbb c.c 251 |
| @@ -2604,6 +2647,7 @@ bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/ | |||
| 2604 | bodyindent tex-src/texinfo.tex /^\\advance\\leftskip by \\defbodyindent \\advance \\righ/ | 2647 | bodyindent tex-src/texinfo.tex /^\\advance\\leftskip by \\defbodyindent \\advance \\righ/ |
| 2605 | bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/ | 2648 | bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/ |
| 2606 | bool c.c 222 | 2649 | bool c.c 222 |
| 2650 | bool merc-src/accumulator.m /^:- import_module bool.$/ | ||
| 2607 | bool_header_size c-src/emacs/src/lisp.h 1472 | 2651 | bool_header_size c-src/emacs/src/lisp.h 1472 |
| 2608 | bool_vector_bitref c-src/emacs/src/lisp.h /^bool_vector_bitref (Lisp_Object a, EMACS_INT i)$/ | 2652 | bool_vector_bitref c-src/emacs/src/lisp.h /^bool_vector_bitref (Lisp_Object a, EMACS_INT i)$/ |
| 2609 | bool_vector_bytes c-src/emacs/src/lisp.h /^bool_vector_bytes (EMACS_INT size)$/ | 2653 | bool_vector_bytes c-src/emacs/src/lisp.h /^bool_vector_bytes (EMACS_INT size)$/ |
| @@ -2645,6 +2689,7 @@ c_ext c-src/etags.c 2271 | |||
| 2645 | caccacacca c.c /^caccacacca (a,b,c,d,e,f,g)$/ | 2689 | caccacacca c.c /^caccacacca (a,b,c,d,e,f,g)$/ |
| 2646 | cacheLRUEntry_s c.c 172 | 2690 | cacheLRUEntry_s c.c 172 |
| 2647 | cacheLRUEntry_t c.c 177 | 2691 | cacheLRUEntry_t c.c 177 |
| 2692 | calculate_goal_info merc-src/accumulator.m /^:- pred calculate_goal_info(hlds_goal_expr::in, hl/ | ||
| 2648 | calloc c-src/emacs/src/gmalloc.c 66 | 2693 | calloc c-src/emacs/src/gmalloc.c 66 |
| 2649 | calloc c-src/emacs/src/gmalloc.c 70 | 2694 | calloc c-src/emacs/src/gmalloc.c 70 |
| 2650 | calloc c-src/emacs/src/gmalloc.c /^calloc (size_t nmemb, size_t size)$/ | 2695 | calloc c-src/emacs/src/gmalloc.c /^calloc (size_t nmemb, size_t size)$/ |
| @@ -2665,6 +2710,8 @@ cgrep html-src/software.html /^cgrep$/ | |||
| 2665 | chain c-src/emacs/src/lisp.h 1162 | 2710 | chain c-src/emacs/src/lisp.h 1162 |
| 2666 | chain c-src/emacs/src/lisp.h 2206 | 2711 | chain c-src/emacs/src/lisp.h 2206 |
| 2667 | chain c-src/emacs/src/lisp.h 2396 | 2712 | chain c-src/emacs/src/lisp.h 2396 |
| 2713 | chain_subst merc-src/accumulator.m /^:- func chain_subst(accu_subst, accu_subst) = accu/ | ||
| 2714 | chain_subst_2 merc-src/accumulator.m /^:- pred chain_subst_2(list(A)::in, map(A, B)::in, / | ||
| 2668 | char_bits c-src/emacs/src/lisp.h 2443 | 2715 | char_bits c-src/emacs/src/lisp.h 2443 |
| 2669 | char_table_specials c-src/emacs/src/lisp.h 1692 | 2716 | char_table_specials c-src/emacs/src/lisp.h 1692 |
| 2670 | charpos c-src/emacs/src/lisp.h 2011 | 2717 | charpos c-src/emacs/src/lisp.h 2011 |
| @@ -2707,6 +2754,7 @@ command_loop_1 c-src/emacs/src/keyboard.c /^command_loop_1 (void)$/ | |||
| 2707 | command_loop_2 c-src/emacs/src/keyboard.c /^command_loop_2 (Lisp_Object ignore)$/ | 2754 | command_loop_2 c-src/emacs/src/keyboard.c /^command_loop_2 (Lisp_Object ignore)$/ |
| 2708 | command_loop_level c-src/emacs/src/keyboard.c 195 | 2755 | command_loop_level c-src/emacs/src/keyboard.c 195 |
| 2709 | comment php-src/lce_functions.php /^ function comment($line, $class)$/ | 2756 | comment php-src/lce_functions.php /^ function comment($line, $class)$/ |
| 2757 | commutativity_assertion merc-src/accumulator.m /^:- pred commutativity_assertion(module_info::in,li/ | ||
| 2710 | compile_empty prol-src/natded.prolog /^compile_empty:-$/ | 2758 | compile_empty prol-src/natded.prolog /^compile_empty:-$/ |
| 2711 | compile_lex prol-src/natded.prolog /^compile_lex(File):-$/ | 2759 | compile_lex prol-src/natded.prolog /^compile_lex(File):-$/ |
| 2712 | complete prol-src/natded.prolog /^complete(Cat):-$/ | 2760 | complete prol-src/natded.prolog /^complete(Cat):-$/ |
| @@ -2740,6 +2788,13 @@ create-bar forth-src/test-forth.fth /^: create-bar foo ;$/ | |||
| 2740 | createPOEntries php-src/lce_functions.php /^ function createPOEntries()$/ | 2788 | createPOEntries php-src/lce_functions.php /^ function createPOEntries()$/ |
| 2741 | createWidgets pyt-src/server.py /^ def createWidgets(self, host):$/ | 2789 | createWidgets pyt-src/server.py /^ def createWidgets(self, host):$/ |
| 2742 | createWidgets pyt-src/server.py /^ def createWidgets(self):$/ | 2790 | createWidgets pyt-src/server.py /^ def createWidgets(self):$/ |
| 2791 | create_acc_call merc-src/accumulator.m /^:- func create_acc_call(hlds_goal::in(goal_plain_c/ | ||
| 2792 | create_acc_goal merc-src/accumulator.m /^:- pred create_acc_goal(hlds_goal::in, accu_substs/ | ||
| 2793 | create_new_base_goals merc-src/accumulator.m /^:- func create_new_base_goals(set(accu_goal_id), a/ | ||
| 2794 | create_new_orig_recursive_goals merc-src/accumulator.m /^:- func create_new_orig_recursive_goals(set(accu_g/ | ||
| 2795 | create_new_recursive_goals merc-src/accumulator.m /^:- func create_new_recursive_goals(set(accu_goal_i/ | ||
| 2796 | create_new_var merc-src/accumulator.m /^:- pred create_new_var(prog_var::in, string::in, p/ | ||
| 2797 | create_orig_goal merc-src/accumulator.m /^:- pred create_orig_goal(hlds_goal::in, accu_subst/ | ||
| 2743 | cscInitTime cp-src/c.C 7 | 2798 | cscInitTime cp-src/c.C 7 |
| 2744 | cscSegmentationTime cp-src/c.C 8 | 2799 | cscSegmentationTime cp-src/c.C 8 |
| 2745 | cstack c-src/etags.c 2523 | 2800 | cstack c-src/etags.c 2523 |
| @@ -3104,6 +3159,8 @@ gcpro c-src/emacs/src/lisp.h 3042 | |||
| 3104 | gcpro c-src/emacs/src/lisp.h 3132 | 3159 | gcpro c-src/emacs/src/lisp.h 3132 |
| 3105 | gen_help_event c-src/emacs/src/keyboard.c /^gen_help_event (Lisp_Object help, Lisp_Object fram/ | 3160 | gen_help_event c-src/emacs/src/keyboard.c /^gen_help_event (Lisp_Object help, Lisp_Object fram/ |
| 3106 | genalgorithm html-src/algrthms.html /^Generating the Data<\/font><\/i><\/b>$/ | 3161 | genalgorithm html-src/algrthms.html /^Generating the Data<\/font><\/i><\/b>$/ |
| 3162 | generate_warning merc-src/accumulator.m /^:- pred generate_warning(module_info::in, prog_var/ | ||
| 3163 | generate_warnings merc-src/accumulator.m /^:- pred generate_warnings(module_info::in, prog_va/ | ||
| 3107 | generic_object cp-src/clheir.cpp /^generic_object::generic_object(void)$/ | 3164 | generic_object cp-src/clheir.cpp /^generic_object::generic_object(void)$/ |
| 3108 | generic_object cp-src/clheir.hpp 13 | 3165 | generic_object cp-src/clheir.hpp 13 |
| 3109 | getArchs objc-src/PackInsp.m /^-(void)getArchs$/ | 3166 | getArchs objc-src/PackInsp.m /^-(void)getArchs$/ |
| @@ -3172,6 +3229,21 @@ help_char_p c-src/emacs/src/keyboard.c /^help_char_p (Lisp_Object c)$/ | |||
| 3172 | help_form_saved_window_configs c-src/emacs/src/keyboard.c 2156 | 3229 | help_form_saved_window_configs c-src/emacs/src/keyboard.c 2156 |
| 3173 | helpwin pyt-src/server.py /^def helpwin(helpdict):$/ | 3230 | helpwin pyt-src/server.py /^def helpwin(helpdict):$/ |
| 3174 | hide_cursor cp-src/screen.cpp /^void hide_cursor(void)$/ | 3231 | hide_cursor cp-src/screen.cpp /^void hide_cursor(void)$/ |
| 3232 | hlds merc-src/accumulator.m /^:- import_module hlds.$/ | ||
| 3233 | hlds.assertion merc-src/accumulator.m /^:- import_module hlds.assertion.$/ | ||
| 3234 | hlds.goal_util merc-src/accumulator.m /^:- import_module hlds.goal_util.$/ | ||
| 3235 | hlds.hlds_error_util merc-src/accumulator.m /^:- import_module hlds.hlds_error_util.$/ | ||
| 3236 | hlds.hlds_goal merc-src/accumulator.m /^:- import_module hlds.hlds_goal.$/ | ||
| 3237 | hlds.hlds_module merc-src/accumulator.m /^:- import_module hlds.hlds_module.$/ | ||
| 3238 | hlds.hlds_out merc-src/accumulator.m /^:- import_module hlds.hlds_out.$/ | ||
| 3239 | hlds.hlds_out.hlds_out_util merc-src/accumulator.m /^:- import_module hlds.hlds_out.hlds_out_util.$/ | ||
| 3240 | hlds.hlds_pred merc-src/accumulator.m /^:- import_module hlds.hlds_pred.$/ | ||
| 3241 | hlds.hlds_promise merc-src/accumulator.m /^:- import_module hlds.hlds_promise.$/ | ||
| 3242 | hlds.instmap merc-src/accumulator.m /^:- import_module hlds.instmap.$/ | ||
| 3243 | hlds.pred_table merc-src/accumulator.m /^:- import_module hlds.pred_table.$/ | ||
| 3244 | hlds.quantification merc-src/accumulator.m /^:- import_module hlds.quantification.$/ | ||
| 3245 | hlds.status merc-src/accumulator.m /^:- import_module hlds.status.$/ | ||
| 3246 | hlds.vartypes merc-src/accumulator.m /^:- import_module hlds.vartypes.$/ | ||
| 3175 | htmltreelist prol-src/natded.prolog /^htmltreelist([]).$/ | 3247 | htmltreelist prol-src/natded.prolog /^htmltreelist([]).$/ |
| 3176 | hybrid_aligned_alloc c-src/emacs/src/gmalloc.c /^hybrid_aligned_alloc (size_t alignment, size_t siz/ | 3248 | hybrid_aligned_alloc c-src/emacs/src/gmalloc.c /^hybrid_aligned_alloc (size_t alignment, size_t siz/ |
| 3177 | hybrid_calloc c-src/emacs/src/gmalloc.c /^hybrid_calloc (size_t nmemb, size_t size)$/ | 3249 | hybrid_calloc c-src/emacs/src/gmalloc.c /^hybrid_calloc (size_t nmemb, size_t size)$/ |
| @@ -3191,6 +3263,9 @@ ialpage tex-src/texinfo.tex /^ \\dimen@=\\pageheight \\advance\\dimen@ by-\\ht\ | |||
| 3191 | ialpage tex-src/texinfo.tex /^ \\availdimen@=\\pageheight \\advance\\availdimen@ by/ | 3263 | ialpage tex-src/texinfo.tex /^ \\availdimen@=\\pageheight \\advance\\availdimen@ by/ |
| 3192 | ialpage tex-src/texinfo.tex /^ \\dimen@=\\pageheight \\advance\\dimen@ by-\\ht\\pa/ | 3264 | ialpage tex-src/texinfo.tex /^ \\dimen@=\\pageheight \\advance\\dimen@ by-\\ht\\pa/ |
| 3193 | ialpage= tex-src/texinfo.tex /^ \\output={\\global\\setbox\\partialpage=$/ | 3265 | ialpage= tex-src/texinfo.tex /^ \\output={\\global\\setbox\\partialpage=$/ |
| 3266 | identify_goal_type merc-src/accumulator.m /^:- pred identify_goal_type(pred_id::in, proc_id::i/ | ||
| 3267 | identify_out_and_out_prime merc-src/accumulator.m /^:- pred identify_out_and_out_prime(module_info::in/ | ||
| 3268 | identify_recursive_calls merc-src/accumulator.m /^:- pred identify_recursive_calls(pred_id::in, proc/ | ||
| 3194 | idx c-src/emacs/src/lisp.h 3150 | 3269 | idx c-src/emacs/src/lisp.h 3150 |
| 3195 | ignore_case c-src/etags.c 266 | 3270 | ignore_case c-src/etags.c 266 |
| 3196 | ignore_mouse_drag_p c-src/emacs/src/keyboard.c 1256 | 3271 | ignore_mouse_drag_p c-src/emacs/src/keyboard.c 1256 |
| @@ -3220,6 +3295,7 @@ inita c.c /^static void inita () {}$/ | |||
| 3220 | initb c.c /^static void initb () {}$/ | 3295 | initb c.c /^static void initb () {}$/ |
| 3221 | initial_kboard c-src/emacs/src/keyboard.c 84 | 3296 | initial_kboard c-src/emacs/src/keyboard.c 84 |
| 3222 | initialize-new-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun initialize-new-tags-table ()$/ | 3297 | initialize-new-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun initialize-new-tags-table ()$/ |
| 3298 | initialize_goal_store merc-src/accumulator.m /^:- func initialize_goal_store(list(hlds_goal), ins/ | ||
| 3223 | initialize_random_junk y-src/cccp.y /^initialize_random_junk ()$/ | 3299 | initialize_random_junk y-src/cccp.y /^initialize_random_junk ()$/ |
| 3224 | input-pending-p c-src/emacs/src/keyboard.c /^DEFUN ("input-pending-p", Finput_pending_p, Sinput/ | 3300 | input-pending-p c-src/emacs/src/keyboard.c /^DEFUN ("input-pending-p", Finput_pending_p, Sinput/ |
| 3225 | input_available_clear_time c-src/emacs/src/keyboard.c 324 | 3301 | input_available_clear_time c-src/emacs/src/keyboard.c 324 |
| @@ -3235,6 +3311,7 @@ instance_method_exclamation! ruby-src/test.rb /^ def instance_method_excl | |||
| 3235 | instance_method_question? ruby-src/test.rb /^ def instance_method_question?$/ | 3311 | instance_method_question? ruby-src/test.rb /^ def instance_method_question?$/ |
| 3236 | instr y-src/parse.y 81 | 3312 | instr y-src/parse.y 81 |
| 3237 | instruct c-src/etags.c 2527 | 3313 | instruct c-src/etags.c 2527 |
| 3314 | int merc-src/accumulator.m /^:- import_module int.$/ | ||
| 3238 | intNumber go-src/test1.go 13 | 3315 | intNumber go-src/test1.go 13 |
| 3239 | integer c-src/emacs/src/lisp.h 2127 | 3316 | integer c-src/emacs/src/lisp.h 2127 |
| 3240 | integer y-src/cccp.y 112 | 3317 | integer y-src/cccp.y 112 |
| @@ -3257,6 +3334,7 @@ intoken c-src/etags.c /^#define intoken(c) (_itk[CHAR (c)]) \/* c can be in/ | |||
| 3257 | intspec c-src/emacs/src/lisp.h 1688 | 3334 | intspec c-src/emacs/src/lisp.h 1688 |
| 3258 | intvar c-src/emacs/src/lisp.h 2277 | 3335 | intvar c-src/emacs/src/lisp.h 2277 |
| 3259 | invalidate_nodes c-src/etags.c /^invalidate_nodes (fdesc *badfdp, node **npp)$/ | 3336 | invalidate_nodes c-src/etags.c /^invalidate_nodes (fdesc *badfdp, node **npp)$/ |
| 3337 | io merc-src/accumulator.m /^:- import_module io.$/ | ||
| 3260 | ipc3dCSC19 cp-src/c.C 6 | 3338 | ipc3dCSC19 cp-src/c.C 6 |
| 3261 | ipc3dChannelType cp-src/c.C 1 | 3339 | ipc3dChannelType cp-src/c.C 1 |
| 3262 | ipc3dIslandHierarchy cp-src/c.C 1 | 3340 | ipc3dIslandHierarchy cp-src/c.C 1 |
| @@ -3266,6 +3344,7 @@ irregular_location cp-src/clheir.hpp /^ irregular_location(double xi, double | |||
| 3266 | isComment php-src/lce_functions.php /^ function isComment($class)$/ | 3344 | isComment php-src/lce_functions.php /^ function isComment($class)$/ |
| 3267 | isHoliday cp-src/functions.cpp /^bool isHoliday ( Date d ){$/ | 3345 | isHoliday cp-src/functions.cpp /^bool isHoliday ( Date d ){$/ |
| 3268 | isLeap cp-src/functions.cpp /^bool isLeap ( int year ){$/ | 3346 | isLeap cp-src/functions.cpp /^bool isLeap ( int year ){$/ |
| 3347 | is_associative_construction merc-src/accumulator.m /^:- pred is_associative_construction(module_info::i/ | ||
| 3269 | is_curly_brace_form c-src/h.h 54 | 3348 | is_curly_brace_form c-src/h.h 54 |
| 3270 | is_explicit c-src/h.h 49 | 3349 | is_explicit c-src/h.h 49 |
| 3271 | is_func c-src/etags.c 221 | 3350 | is_func c-src/etags.c 221 |
| @@ -3274,6 +3353,7 @@ is_idchar y-src/cccp.y 948 | |||
| 3274 | is_idstart y-src/cccp.y 950 | 3353 | is_idstart y-src/cccp.y 950 |
| 3275 | is_muldiv_operation cp-src/c.C /^is_muldiv_operation(pc)$/ | 3354 | is_muldiv_operation cp-src/c.C /^is_muldiv_operation(pc)$/ |
| 3276 | is_ordset prol-src/ordsets.prolog /^is_ordset(X) :- var(X), !, fail.$/ | 3355 | is_ordset prol-src/ordsets.prolog /^is_ordset(X) :- var(X), !, fail.$/ |
| 3356 | is_recursive_case merc-src/accumulator.m /^:- pred is_recursive_case(list(hlds_goal)::in, pre/ | ||
| 3277 | iso_lispy_function_keys c-src/emacs/src/keyboard.c 5151 | 3357 | iso_lispy_function_keys c-src/emacs/src/keyboard.c 5151 |
| 3278 | isoperator prol-src/natded.prolog /^isoperator(Char):-$/ | 3358 | isoperator prol-src/natded.prolog /^isoperator(Char):-$/ |
| 3279 | isoptab prol-src/natded.prolog /^isoptab('%').$/ | 3359 | isoptab prol-src/natded.prolog /^isoptab('%').$/ |
| @@ -3370,6 +3450,10 @@ letter: tex-src/texinfo.tex /^\\xdef\\thischapter{Appendix \\appendixletter: \\n | |||
| 3370 | level c-src/emacs/src/lisp.h 3153 | 3450 | level c-src/emacs/src/lisp.h 3153 |
| 3371 | lex prol-src/natded.prolog /^lex(W,SynOut,Sem):-$/ | 3451 | lex prol-src/natded.prolog /^lex(W,SynOut,Sem):-$/ |
| 3372 | lexptr y-src/cccp.y 332 | 3452 | lexptr y-src/cccp.y 332 |
| 3453 | libs merc-src/accumulator.m /^:- import_module libs.$/ | ||
| 3454 | libs.globals merc-src/accumulator.m /^:- import_module libs.globals.$/ | ||
| 3455 | libs.optimization_options merc-src/accumulator.m /^:- import_module libs.optimization_options.$/ | ||
| 3456 | libs.options merc-src/accumulator.m /^:- import_module libs.options.$/ | ||
| 3373 | licenze html-src/softwarelibero.html /^Licenze d'uso di un programma$/ | 3457 | licenze html-src/softwarelibero.html /^Licenze d'uso di un programma$/ |
| 3374 | limit cp-src/Range.h /^ double limit (void) const { return rng_limit; }$/ | 3458 | limit cp-src/Range.h /^ double limit (void) const { return rng_limit; }$/ |
| 3375 | line c-src/etags.c 2493 | 3459 | line c-src/etags.c 2493 |
| @@ -3427,6 +3511,7 @@ lispy_modifier_list c-src/emacs/src/keyboard.c /^lispy_modifier_list (int modifi | |||
| 3427 | lispy_multimedia_keys c-src/emacs/src/keyboard.c 4962 | 3511 | lispy_multimedia_keys c-src/emacs/src/keyboard.c 4962 |
| 3428 | lispy_wheel_names c-src/emacs/src/keyboard.c 5174 | 3512 | lispy_wheel_names c-src/emacs/src/keyboard.c 5174 |
| 3429 | list c-src/emacs/src/gmalloc.c 186 | 3513 | list c-src/emacs/src/gmalloc.c 186 |
| 3514 | list merc-src/accumulator.m /^:- import_module list.$/ | ||
| 3430 | list-tags el-src/emacs/lisp/progmodes/etags.el /^(defun list-tags (file &optional _next-match)$/ | 3515 | list-tags el-src/emacs/lisp/progmodes/etags.el /^(defun list-tags (file &optional _next-match)$/ |
| 3431 | list-tags-function el-src/emacs/lisp/progmodes/etags.el /^(defvar list-tags-function nil$/ | 3516 | list-tags-function el-src/emacs/lisp/progmodes/etags.el /^(defvar list-tags-function nil$/ |
| 3432 | list2i c-src/emacs/src/lisp.h /^list2i (EMACS_INT x, EMACS_INT y)$/ | 3517 | list2i c-src/emacs/src/lisp.h /^list2i (EMACS_INT x, EMACS_INT y)$/ |
| @@ -3443,6 +3528,7 @@ local_if_set c-src/emacs/src/lisp.h 2338 | |||
| 3443 | location cp-src/clheir.hpp 33 | 3528 | location cp-src/clheir.hpp 33 |
| 3444 | location cp-src/clheir.hpp /^ location() { }$/ | 3529 | location cp-src/clheir.hpp /^ location() { }$/ |
| 3445 | lookup y-src/cccp.y /^lookup (name, len, hash)$/ | 3530 | lookup y-src/cccp.y /^lookup (name, len, hash)$/ |
| 3531 | lookup_call merc-src/accumulator.m /^:- pred lookup_call(accu_goal_store::in, accu_goal/ | ||
| 3446 | lowcase c-src/etags.c /^#define lowcase(c) tolower (CHAR (c))$/ | 3532 | lowcase c-src/etags.c /^#define lowcase(c) tolower (CHAR (c))$/ |
| 3447 | lucid_event_type_list_p c-src/emacs/src/keyboard.c /^lucid_event_type_list_p (Lisp_Object object)$/ | 3533 | lucid_event_type_list_p c-src/emacs/src/keyboard.c /^lucid_event_type_list_p (Lisp_Object object)$/ |
| 3448 | mabort c-src/emacs/src/gmalloc.c /^mabort (enum mcheck_status status)$/ | 3534 | mabort c-src/emacs/src/gmalloc.c /^mabort (enum mcheck_status status)$/ |
| @@ -3488,6 +3574,7 @@ mallochook c-src/emacs/src/gmalloc.c /^mallochook (size_t size)$/ | |||
| 3488 | man manpage make-src/Makefile /^man manpage: etags.1.man$/ | 3574 | man manpage make-src/Makefile /^man manpage: etags.1.man$/ |
| 3489 | mao c-src/h.h 101 | 3575 | mao c-src/h.h 101 |
| 3490 | map c-src/emacs/src/keyboard.c 8748 | 3576 | map c-src/emacs/src/keyboard.c 8748 |
| 3577 | map merc-src/accumulator.m /^:- import_module map.$/ | ||
| 3491 | map_word prol-src/natded.prolog /^map_word([[_]|Ws],Exp):-$/ | 3578 | map_word prol-src/natded.prolog /^map_word([[_]|Ws],Exp):-$/ |
| 3492 | mapping html-src/algrthms.html /^Mapping the Channel Symbols$/ | 3579 | mapping html-src/algrthms.html /^Mapping the Channel Symbols$/ |
| 3493 | mapsyn prol-src/natded.prolog /^mapsyn(A\/B,AM\/BM):-$/ | 3580 | mapsyn prol-src/natded.prolog /^mapsyn(A\/B,AM\/BM):-$/ |
| @@ -3501,15 +3588,19 @@ max_args c-src/emacs/src/lisp.h 1686 | |||
| 3501 | max_num_directions cp-src/clheir.hpp 31 | 3588 | max_num_directions cp-src/clheir.hpp 31 |
| 3502 | max_num_generic_objects cp-src/clheir.cpp 9 | 3589 | max_num_generic_objects cp-src/clheir.cpp 9 |
| 3503 | maxargs c-src/emacs/src/lisp.h 2831 | 3590 | maxargs c-src/emacs/src/lisp.h 2831 |
| 3591 | maybe merc-src/accumulator.m /^:- import_module maybe.$/ | ||
| 3504 | maybe_gc c-src/emacs/src/lisp.h /^maybe_gc (void)$/ | 3592 | maybe_gc c-src/emacs/src/lisp.h /^maybe_gc (void)$/ |
| 3505 | mcCSC cp-src/c.C 6 | 3593 | mcCSC cp-src/c.C 6 |
| 3506 | mcheck c-src/emacs/src/gmalloc.c /^mcheck (void (*func) (enum mcheck_status))$/ | 3594 | mcheck c-src/emacs/src/gmalloc.c /^mcheck (void (*func) (enum mcheck_status))$/ |
| 3507 | mcheck_status c-src/emacs/src/gmalloc.c 283 | 3595 | mcheck_status c-src/emacs/src/gmalloc.c 283 |
| 3508 | mcheck_used c-src/emacs/src/gmalloc.c 2012 | 3596 | mcheck_used c-src/emacs/src/gmalloc.c 2012 |
| 3597 | mdbcomp merc-src/accumulator.m /^:- import_module mdbcomp.$/ | ||
| 3598 | mdbcomp.sym_name merc-src/accumulator.m /^:- import_module mdbcomp.sym_name.$/ | ||
| 3509 | me22b lua-src/test.lua /^ local function test.me22b (one)$/ | 3599 | me22b lua-src/test.lua /^ local function test.me22b (one)$/ |
| 3510 | me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/ | 3600 | me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/ |
| 3511 | memalign c-src/emacs/src/gmalloc.c /^memalign (size_t alignment, size_t size)$/ | 3601 | memalign c-src/emacs/src/gmalloc.c /^memalign (size_t alignment, size_t size)$/ |
| 3512 | member prol-src/natded.prolog /^member(X,[X|_]).$/ | 3602 | member prol-src/natded.prolog /^member(X,[X|_]).$/ |
| 3603 | member_lessthan_goalid merc-src/accumulator.m /^:- pred member_lessthan_goalid(accu_goal_store::in/ | ||
| 3513 | memclear c-src/emacs/src/lisp.h /^memclear (void *p, ptrdiff_t nbytes)$/ | 3604 | memclear c-src/emacs/src/lisp.h /^memclear (void *p, ptrdiff_t nbytes)$/ |
| 3514 | menu_bar_item c-src/emacs/src/keyboard.c /^menu_bar_item (Lisp_Object key, Lisp_Object item, / | 3605 | menu_bar_item c-src/emacs/src/keyboard.c /^menu_bar_item (Lisp_Object key, Lisp_Object item, / |
| 3515 | menu_bar_items c-src/emacs/src/keyboard.c /^menu_bar_items (Lisp_Object old)$/ | 3606 | menu_bar_items c-src/emacs/src/keyboard.c /^menu_bar_items (Lisp_Object old)$/ |
| @@ -3780,6 +3871,7 @@ pMu c-src/emacs/src/lisp.h 151 | |||
| 3780 | pMu c-src/emacs/src/lisp.h 156 | 3871 | pMu c-src/emacs/src/lisp.h 156 |
| 3781 | p_next c-src/etags.c 258 | 3872 | p_next c-src/etags.c 258 |
| 3782 | pagesize c-src/emacs/src/gmalloc.c 1703 | 3873 | pagesize c-src/emacs/src/gmalloc.c 1703 |
| 3874 | pair merc-src/accumulator.m /^:- import_module pair.$/ | ||
| 3783 | parent c-src/emacs/src/keyboard.c 8745 | 3875 | parent c-src/emacs/src/keyboard.c 8745 |
| 3784 | parent c-src/emacs/src/lisp.h 1590 | 3876 | parent c-src/emacs/src/lisp.h 1590 |
| 3785 | parse prol-src/natded.prolog /^parse(Ws,Cat):-$/ | 3877 | parse prol-src/natded.prolog /^parse(Ws,Cat):-$/ |
| @@ -3797,6 +3889,12 @@ parse_return y-src/parse.y 74 | |||
| 3797 | parse_return_error y-src/cccp.y 70 | 3889 | parse_return_error y-src/cccp.y 70 |
| 3798 | parse_solitary_modifier c-src/emacs/src/keyboard.c /^parse_solitary_modifier (Lisp_Object symbol)$/ | 3890 | parse_solitary_modifier c-src/emacs/src/keyboard.c /^parse_solitary_modifier (Lisp_Object symbol)$/ |
| 3799 | parse_tool_bar_item c-src/emacs/src/keyboard.c /^parse_tool_bar_item (Lisp_Object key, Lisp_Object / | 3891 | parse_tool_bar_item c-src/emacs/src/keyboard.c /^parse_tool_bar_item (Lisp_Object key, Lisp_Object / |
| 3892 | parse_tree merc-src/accumulator.m /^:- import_module parse_tree.$/ | ||
| 3893 | parse_tree.error_util merc-src/accumulator.m /^:- import_module parse_tree.error_util.$/ | ||
| 3894 | parse_tree.prog_data merc-src/accumulator.m /^:- import_module parse_tree.prog_data.$/ | ||
| 3895 | parse_tree.prog_mode merc-src/accumulator.m /^:- import_module parse_tree.prog_mode.$/ | ||
| 3896 | parse_tree.prog_util merc-src/accumulator.m /^:- import_module parse_tree.prog_util.$/ | ||
| 3897 | parse_tree.set_of_var merc-src/accumulator.m /^:- import_module parse_tree.set_of_var.$/ | ||
| 3800 | pat c-src/etags.c 262 | 3898 | pat c-src/etags.c 262 |
| 3801 | pattern c-src/etags.c 260 | 3899 | pattern c-src/etags.c 260 |
| 3802 | pdlcount c-src/emacs/src/lisp.h 3046 | 3900 | pdlcount c-src/emacs/src/lisp.h 3046 |
| @@ -3989,6 +4087,7 @@ removeexp prol-src/natded.prolog /^removeexp(E,E,'NIL'):-!.$/ | |||
| 3989 | reorder_modifiers c-src/emacs/src/keyboard.c /^reorder_modifiers (Lisp_Object symbol)$/ | 4087 | reorder_modifiers c-src/emacs/src/keyboard.c /^reorder_modifiers (Lisp_Object symbol)$/ |
| 3990 | request c.c /^request request (a, b)$/ | 4088 | request c.c /^request request (a, b)$/ |
| 3991 | requeued_events_pending_p c-src/emacs/src/keyboard.c /^requeued_events_pending_p (void)$/ | 4089 | requeued_events_pending_p c-src/emacs/src/keyboard.c /^requeued_events_pending_p (void)$/ |
| 4090 | require merc-src/accumulator.m /^:- import_module require.$/ | ||
| 3992 | required_argument c-src/getopt.h 90 | 4091 | required_argument c-src/getopt.h 90 |
| 3993 | reset-this-command-lengths c-src/emacs/src/keyboard.c /^DEFUN ("reset-this-command-lengths", Freset_this_c/ | 4092 | reset-this-command-lengths c-src/emacs/src/keyboard.c /^DEFUN ("reset-this-command-lengths", Freset_this_c/ |
| 3994 | restore_getcjmp c-src/emacs/src/keyboard.c /^restore_getcjmp (sys_jmp_buf temp)$/ | 4093 | restore_getcjmp c-src/emacs/src/keyboard.c /^restore_getcjmp (sys_jmp_buf temp)$/ |
| @@ -4061,6 +4160,7 @@ separator_names c-src/emacs/src/keyboard.c 7372 | |||
| 4061 | serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/ | 4160 | serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/ |
| 4062 | serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/ | 4161 | serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/ |
| 4063 | set cp-src/conway.hpp /^ void set(void) { alive = 1; }$/ | 4162 | set cp-src/conway.hpp /^ void set(void) { alive = 1; }$/ |
| 4163 | set merc-src/accumulator.m /^:- import_module set.$/ | ||
| 4064 | set-input-interrupt-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-interrupt-mode", Fset_input_inte/ | 4164 | set-input-interrupt-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-interrupt-mode", Fset_input_inte/ |
| 4065 | set-input-meta-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-meta-mode", Fset_input_meta_mode/ | 4165 | set-input-meta-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-meta-mode", Fset_input_meta_mode/ |
| 4066 | set-input-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-mode", Fset_input_mode, Sset_inp/ | 4166 | set-input-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-mode", Fset_input_mode, Sset_inp/ |
| @@ -4088,11 +4188,14 @@ set_sub_char_table_contents c-src/emacs/src/lisp.h /^set_sub_char_table_contents | |||
| 4088 | set_symbol_function c-src/emacs/src/lisp.h /^set_symbol_function (Lisp_Object sym, Lisp_Object / | 4188 | set_symbol_function c-src/emacs/src/lisp.h /^set_symbol_function (Lisp_Object sym, Lisp_Object / |
| 4089 | set_symbol_next c-src/emacs/src/lisp.h /^set_symbol_next (Lisp_Object sym, struct Lisp_Symb/ | 4189 | set_symbol_next c-src/emacs/src/lisp.h /^set_symbol_next (Lisp_Object sym, struct Lisp_Symb/ |
| 4090 | set_symbol_plist c-src/emacs/src/lisp.h /^set_symbol_plist (Lisp_Object sym, Lisp_Object pli/ | 4190 | set_symbol_plist c-src/emacs/src/lisp.h /^set_symbol_plist (Lisp_Object sym, Lisp_Object pli/ |
| 4191 | set_upto merc-src/accumulator.m /^:- func set_upto(accu_case, int) = set(accu_goal_i/ | ||
| 4091 | set_waiting_for_input c-src/emacs/src/keyboard.c /^set_waiting_for_input (struct timespec *time_to_cl/ | 4192 | set_waiting_for_input c-src/emacs/src/keyboard.c /^set_waiting_for_input (struct timespec *time_to_cl/ |
| 4092 | setref tex-src/texinfo.tex /^\\expandafter\\expandafter\\expandafter\\appendixsetre/ | 4193 | setref tex-src/texinfo.tex /^\\expandafter\\expandafter\\expandafter\\appendixsetre/ |
| 4093 | setup cp-src/c.C 5 | 4194 | setup cp-src/c.C 5 |
| 4094 | shift cp-src/functions.cpp /^void Date::shift ( void ){\/\/Shift this date to pre/ | 4195 | shift cp-src/functions.cpp /^void Date::shift ( void ){\/\/Shift this date to pre/ |
| 4095 | shouldLoad objc-src/PackInsp.m /^-(BOOL)shouldLoad$/ | 4196 | shouldLoad objc-src/PackInsp.m /^-(BOOL)shouldLoad$/ |
| 4197 | should_attempt_accu_transform merc-src/accumulator.m /^:- pred should_attempt_accu_transform(module_info:/ | ||
| 4198 | should_attempt_accu_transform_2 merc-src/accumulator.m /^:- pred should_attempt_accu_transform_2(module_inf/ | ||
| 4096 | should_see_this_array_type cp-src/c.C 156 | 4199 | should_see_this_array_type cp-src/c.C 156 |
| 4097 | should_see_this_function_pointer cp-src/c.C 153 | 4200 | should_see_this_function_pointer cp-src/c.C 153 |
| 4098 | should_see_this_one_enclosed_in_extern_C cp-src/c.C 149 | 4201 | should_see_this_one_enclosed_in_extern_C cp-src/c.C 149 |
| @@ -4122,6 +4225,7 @@ skip_non_spaces c-src/etags.c /^skip_non_spaces (char *cp)$/ | |||
| 4122 | skip_spaces c-src/etags.c /^skip_spaces (char *cp)$/ | 4225 | skip_spaces c-src/etags.c /^skip_spaces (char *cp)$/ |
| 4123 | snarf-tag-function el-src/emacs/lisp/progmodes/etags.el /^(defvar snarf-tag-function nil$/ | 4226 | snarf-tag-function el-src/emacs/lisp/progmodes/etags.el /^(defvar snarf-tag-function nil$/ |
| 4124 | snone c-src/etags.c 2443 | 4227 | snone c-src/etags.c 2443 |
| 4228 | solutions merc-src/accumulator.m /^:- import_module solutions.$/ | ||
| 4125 | some_mouse_moved c-src/emacs/src/keyboard.c /^some_mouse_moved (void)$/ | 4229 | some_mouse_moved c-src/emacs/src/keyboard.c /^some_mouse_moved (void)$/ |
| 4126 | space tex-src/texinfo.tex /^ {#2\\labelspace #1}\\dotfill\\doshortpageno{#3}}%/ | 4230 | space tex-src/texinfo.tex /^ {#2\\labelspace #1}\\dotfill\\doshortpageno{#3}}%/ |
| 4127 | space tex-src/texinfo.tex /^ \\dosubsubsecentry{#2.#3.#4.#5\\labelspace#1}{#6}}/ | 4231 | space tex-src/texinfo.tex /^ \\dosubsubsecentry{#2.#3.#4.#5\\labelspace#1}{#6}}/ |
| @@ -4171,10 +4275,12 @@ step cp-src/conway.hpp /^ void step(void) { alive = next_alive; }$/ | |||
| 4171 | step cp-src/clheir.hpp /^ virtual void step(void) { }$/ | 4275 | step cp-src/clheir.hpp /^ virtual void step(void) { }$/ |
| 4172 | step_everybody cp-src/clheir.cpp /^void step_everybody(void)$/ | 4276 | step_everybody cp-src/clheir.cpp /^void step_everybody(void)$/ |
| 4173 | stop_polling c-src/emacs/src/keyboard.c /^stop_polling (void)$/ | 4277 | stop_polling c-src/emacs/src/keyboard.c /^stop_polling (void)$/ |
| 4278 | store_info merc-src/accumulator.m /^:- type store_info$/ | ||
| 4174 | store_user_signal_events c-src/emacs/src/keyboard.c /^store_user_signal_events (void)$/ | 4279 | store_user_signal_events c-src/emacs/src/keyboard.c /^store_user_signal_events (void)$/ |
| 4175 | str go-src/test1.go 9 | 4280 | str go-src/test1.go 9 |
| 4176 | strcaseeq c-src/etags.c /^#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=/ | 4281 | strcaseeq c-src/etags.c /^#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=/ |
| 4177 | streq c-src/etags.c /^#define streq(s,t) (assert ((s)!=NULL || (t)!=NULL/ | 4282 | streq c-src/etags.c /^#define streq(s,t) (assert ((s)!=NULL || (t)!=NULL/ |
| 4283 | string merc-src/accumulator.m /^:- import_module string.$/ | ||
| 4178 | string_intervals c-src/emacs/src/lisp.h /^string_intervals (Lisp_Object s)$/ | 4284 | string_intervals c-src/emacs/src/lisp.h /^string_intervals (Lisp_Object s)$/ |
| 4179 | stripLine php-src/lce_functions.php /^ function stripLine($line, $class)$/ | 4285 | stripLine php-src/lce_functions.php /^ function stripLine($line, $class)$/ |
| 4180 | stripname pas-src/common.pas /^function stripname; (* ($/ | 4286 | stripname pas-src/common.pas /^function stripname; (* ($/ |
| @@ -4314,6 +4420,7 @@ tee ruby-src/test1.ru /^ attr_accessor :tee$/ | |||
| 4314 | tee= ruby-src/test1.ru /^ attr_accessor :tee$/ | 4420 | tee= ruby-src/test1.ru /^ attr_accessor :tee$/ |
| 4315 | temporarily_switch_to_single_kboard c-src/emacs/src/keyboard.c /^temporarily_switch_to_single_kboard (struct frame / | 4421 | temporarily_switch_to_single_kboard c-src/emacs/src/keyboard.c /^temporarily_switch_to_single_kboard (struct frame / |
| 4316 | tend c-src/etags.c 2432 | 4422 | tend c-src/etags.c 2432 |
| 4423 | term merc-src/accumulator.m /^:- import_module term.$/ | ||
| 4317 | terminate objc-src/Subprocess.m /^- terminate:sender$/ | 4424 | terminate objc-src/Subprocess.m /^- terminate:sender$/ |
| 4318 | terminateInput objc-src/Subprocess.m /^- terminateInput$/ | 4425 | terminateInput objc-src/Subprocess.m /^- terminateInput$/ |
| 4319 | test c-src/emacs/src/lisp.h 1871 | 4426 | test c-src/emacs/src/lisp.h 1871 |
| @@ -4365,6 +4472,7 @@ tool_bar_items c-src/emacs/src/keyboard.c /^tool_bar_items (Lisp_Object reuse, i | |||
| 4365 | tool_bar_items_vector c-src/emacs/src/keyboard.c 7965 | 4472 | tool_bar_items_vector c-src/emacs/src/keyboard.c 7965 |
| 4366 | toolkit_menubar_in_use c-src/emacs/src/keyboard.c /^toolkit_menubar_in_use (struct frame *f)$/ | 4473 | toolkit_menubar_in_use c-src/emacs/src/keyboard.c /^toolkit_menubar_in_use (struct frame *f)$/ |
| 4367 | top-level c-src/emacs/src/keyboard.c /^DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, / | 4474 | top-level c-src/emacs/src/keyboard.c /^DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, / |
| 4475 | top_level merc-src/accumulator.m /^:- type top_level$/ | ||
| 4368 | top_level_1 c-src/emacs/src/keyboard.c /^top_level_1 (Lisp_Object ignore)$/ | 4476 | top_level_1 c-src/emacs/src/keyboard.c /^top_level_1 (Lisp_Object ignore)$/ |
| 4369 | top_level_2 c-src/emacs/src/keyboard.c /^top_level_2 (void)$/ | 4477 | top_level_2 c-src/emacs/src/keyboard.c /^top_level_2 (void)$/ |
| 4370 | total_keys c-src/emacs/src/keyboard.c 97 | 4478 | total_keys c-src/emacs/src/keyboard.c 97 |
| @@ -4376,6 +4484,9 @@ tpcmd c-src/h.h 15 | |||
| 4376 | track-mouse c-src/emacs/src/keyboard.c /^DEFUN ("internal--track-mouse", Ftrack_mouse, Stra/ | 4484 | track-mouse c-src/emacs/src/keyboard.c /^DEFUN ("internal--track-mouse", Ftrack_mouse, Stra/ |
| 4377 | tracking_off c-src/emacs/src/keyboard.c /^tracking_off (Lisp_Object old_value)$/ | 4485 | tracking_off c-src/emacs/src/keyboard.c /^tracking_off (Lisp_Object old_value)$/ |
| 4378 | traffic_light cp-src/conway.cpp /^void traffic_light(int x, int y)$/ | 4486 | traffic_light cp-src/conway.cpp /^void traffic_light(int x, int y)$/ |
| 4487 | transform_hlds.accumulator merc-src/accumulator.m /^:- module transform_hlds.accumulator.$/ | ||
| 4488 | transform_hlds.accumulator merc-src/accumulator.m /^:- end_module transform_hlds.accumulator.$/ | ||
| 4489 | transform_hlds.goal_store merc-src/accumulator.m /^:- import_module transform_hlds.goal_store.$/ | ||
| 4379 | translate c-src/emacs/src/regex.h 361 | 4490 | translate c-src/emacs/src/regex.h 361 |
| 4380 | treats cp-src/c.C 131 | 4491 | treats cp-src/c.C 131 |
| 4381 | tt prol-src/natded.prolog /^tt:-$/ | 4492 | tt prol-src/natded.prolog /^tt:-$/ |
| @@ -4421,12 +4532,14 @@ unblock_input c-src/emacs/src/keyboard.c /^unblock_input (void)$/ | |||
| 4421 | unblock_input_to c-src/emacs/src/keyboard.c /^unblock_input_to (int level)$/ | 4532 | unblock_input_to c-src/emacs/src/keyboard.c /^unblock_input_to (int level)$/ |
| 4422 | unchar c-src/h.h 99 | 4533 | unchar c-src/h.h 99 |
| 4423 | unexpand-abbrev c-src/abbrev.c /^DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexp/ | 4534 | unexpand-abbrev c-src/abbrev.c /^DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexp/ |
| 4535 | univ merc-src/accumulator.m /^:- import_module univ.$/ | ||
| 4424 | unread_switch_frame c-src/emacs/src/keyboard.c 204 | 4536 | unread_switch_frame c-src/emacs/src/keyboard.c 204 |
| 4425 | unsignedp y-src/cccp.y 112 | 4537 | unsignedp y-src/cccp.y 112 |
| 4426 | unwind c-src/emacs/src/lisp.h 2962 | 4538 | unwind c-src/emacs/src/lisp.h 2962 |
| 4427 | unwind_int c-src/emacs/src/lisp.h 2972 | 4539 | unwind_int c-src/emacs/src/lisp.h 2972 |
| 4428 | unwind_ptr c-src/emacs/src/lisp.h 2967 | 4540 | unwind_ptr c-src/emacs/src/lisp.h 2967 |
| 4429 | unwind_void c-src/emacs/src/lisp.h 2976 | 4541 | unwind_void c-src/emacs/src/lisp.h 2976 |
| 4542 | update_accumulator_pred merc-src/accumulator.m /^:- pred update_accumulator_pred(pred_id::in, proc_/ | ||
| 4430 | uprintmax_t c-src/emacs/src/lisp.h 149 | 4543 | uprintmax_t c-src/emacs/src/lisp.h 149 |
| 4431 | uprintmax_t c-src/emacs/src/lisp.h 154 | 4544 | uprintmax_t c-src/emacs/src/lisp.h 154 |
| 4432 | usage perl-src/yagrip.pl /^sub usage {$/ | 4545 | usage perl-src/yagrip.pl /^sub usage {$/ |
| @@ -4458,6 +4571,7 @@ varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/ | |||
| 4458 | varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/ | 4571 | varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/ |
| 4459 | varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/ | 4572 | varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/ |
| 4460 | varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/ | 4573 | varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/ |
| 4574 | varset merc-src/accumulator.m /^:- import_module varset.$/ | ||
| 4461 | vcopy c-src/emacs/src/lisp.h /^vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Objec/ | 4575 | vcopy c-src/emacs/src/lisp.h /^vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Objec/ |
| 4462 | vectorlike_header c-src/emacs/src/lisp.h 1343 | 4576 | vectorlike_header c-src/emacs/src/lisp.h 1343 |
| 4463 | verde cp-src/c.C 40 | 4577 | verde cp-src/c.C 40 |
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1 index a8470ea1393..e05b8f2aafe 100644 --- a/test/manual/etags/ETAGS.good_1 +++ b/test/manual/etags/ETAGS.good_1 | |||
| @@ -3881,6 +3881,122 @@ Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % | |||
| 3881 | \global\def={=3307,107500 | 3881 | \global\def={=3307,107500 |
| 3882 | \def\normalbackslash{\normalbackslash3321,107882 | 3882 | \def\normalbackslash{\normalbackslash3321,107882 |
| 3883 | 3883 | ||
| 3884 | merc-src/accumulator.m,4275 | ||
| 3885 | :- module transform_hlds.accumulator145,5333 | ||
| 3886 | :- import_module hlds148,5386 | ||
| 3887 | :- import_module hlds.hlds_module149,5409 | ||
| 3888 | :- import_module hlds.hlds_pred150,5444 | ||
| 3889 | :- import_module univ152,5478 | ||
| 3890 | :- pred accu_transform_proc(159,5793 | ||
| 3891 | :- import_module hlds.assertion168,6135 | ||
| 3892 | :- import_module hlds.goal_util169,6168 | ||
| 3893 | :- import_module hlds.hlds_error_util170,6201 | ||
| 3894 | :- import_module hlds.hlds_goal171,6240 | ||
| 3895 | :- import_module hlds.hlds_out172,6273 | ||
| 3896 | :- import_module hlds.hlds_out.hlds_out_util173,6305 | ||
| 3897 | :- import_module hlds.hlds_promise174,6351 | ||
| 3898 | :- import_module hlds.instmap175,6387 | ||
| 3899 | :- import_module hlds.pred_table176,6418 | ||
| 3900 | :- import_module hlds.quantification177,6452 | ||
| 3901 | :- import_module hlds.status178,6490 | ||
| 3902 | :- import_module hlds.vartypes179,6520 | ||
| 3903 | :- import_module libs180,6552 | ||
| 3904 | :- import_module libs.globals181,6575 | ||
| 3905 | :- import_module libs.optimization_options182,6606 | ||
| 3906 | :- import_module libs.options183,6650 | ||
| 3907 | :- import_module mdbcomp184,6681 | ||
| 3908 | :- import_module mdbcomp.sym_name185,6707 | ||
| 3909 | :- import_module parse_tree186,6742 | ||
| 3910 | :- import_module parse_tree.error_util187,6771 | ||
| 3911 | :- import_module parse_tree.prog_data188,6811 | ||
| 3912 | :- import_module parse_tree.prog_mode189,6850 | ||
| 3913 | :- import_module parse_tree.prog_util190,6889 | ||
| 3914 | :- import_module parse_tree.set_of_var191,6928 | ||
| 3915 | :- import_module transform_hlds.goal_store192,6968 | ||
| 3916 | :- import_module assoc_list194,7013 | ||
| 3917 | :- import_module bool195,7042 | ||
| 3918 | :- import_module int196,7065 | ||
| 3919 | :- import_module io197,7087 | ||
| 3920 | :- import_module list198,7108 | ||
| 3921 | :- import_module map199,7131 | ||
| 3922 | :- import_module maybe200,7153 | ||
| 3923 | :- import_module pair201,7177 | ||
| 3924 | :- import_module require202,7200 | ||
| 3925 | :- import_module set203,7226 | ||
| 3926 | :- import_module solutions204,7248 | ||
| 3927 | :- import_module string205,7276 | ||
| 3928 | :- import_module term206,7301 | ||
| 3929 | :- import_module varset207,7324 | ||
| 3930 | :- type top_level213,7499 | ||
| 3931 | :- type accu_goal_id225,7900 | ||
| 3932 | :- type accu_case228,7964 | ||
| 3933 | :- type accu_goal_store234,8091 | ||
| 3934 | :- type accu_subst238,8216 | ||
| 3935 | :- type accu_warning240,8264 | ||
| 3936 | :- pred generate_warnings(334,12550 | ||
| 3937 | :- pred generate_warning(342,12895 | ||
| 3938 | :- pred should_attempt_accu_transform(365,13886 | ||
| 3939 | :- pred should_attempt_accu_transform_2(398,15406 | ||
| 3940 | :- pred accu_standardize(440,17390 | ||
| 3941 | :- pred identify_goal_type(465,18169 | ||
| 3942 | :- pred is_recursive_case(549,21175 | ||
| 3943 | :- type store_info560,21713 | ||
| 3944 | :- func initialize_goal_store(570,22060 | ||
| 3945 | :- pred accu_store(580,22421 | ||
| 3946 | :- pred identify_recursive_calls(601,23288 | ||
| 3947 | :- pred identify_out_and_out_prime(626,24396 | ||
| 3948 | :- type accu_sets676,26425 | ||
| 3949 | :- pred accu_stage1(689,26977 | ||
| 3950 | :- pred accu_stage1_2(727,28347 | ||
| 3951 | :- pred accu_sets_init(781,30557 | ||
| 3952 | :- func set_upto(796,30984 | ||
| 3953 | :- pred accu_before(812,31498 | ||
| 3954 | :- pred accu_assoc(835,32477 | ||
| 3955 | :- pred accu_construct(862,33712 | ||
| 3956 | :- pred accu_construct_assoc(896,35307 | ||
| 3957 | :- pred accu_update(938,37069 | ||
| 3958 | :- pred member_lessthan_goalid(964,38219 | ||
| 3959 | :- type accu_assoc975,38652 | ||
| 3960 | :- pred accu_is_associative(986,39138 | ||
| 3961 | :- pred associativity_assertion(1014,40263 | ||
| 3962 | :- pred commutativity_assertion(1037,41242 | ||
| 3963 | :- pred accu_is_update(1057,41952 | ||
| 3964 | :- pred is_associative_construction(1078,42802 | ||
| 3965 | :- type accu_substs1095,43480 | ||
| 3966 | :- type accu_base1103,43744 | ||
| 3967 | :- pred accu_stage2(1124,44605 | ||
| 3968 | :- pred accu_substs_init(1179,46957 | ||
| 3969 | :- pred acc_var_subst_init(1194,47573 | ||
| 3970 | :- pred create_new_var(1207,48147 | ||
| 3971 | :- pred accu_process_assoc_set(1223,48862 | ||
| 3972 | :- pred accu_has_heuristic(1297,52081 | ||
| 3973 | :- pred accu_heuristic(1304,52336 | ||
| 3974 | :- pred accu_process_update_set(1318,52906 | ||
| 3975 | :- pred accu_divide_base_case(1380,55844 | ||
| 3976 | :- pred accu_related(1412,57146 | ||
| 3977 | :- pred lookup_call(1449,58601 | ||
| 3978 | :- pred accu_stage3(1470,59432 | ||
| 3979 | :- pred acc_proc_info(1508,61326 | ||
| 3980 | :- pred acc_pred_info(1556,63449 | ||
| 3981 | :- pred accu_create_goal(1600,65285 | ||
| 3982 | :- func create_acc_call(1621,66400 | ||
| 3983 | :- pred create_orig_goal(1634,66987 | ||
| 3984 | :- pred create_acc_goal(1662,68157 | ||
| 3985 | :- func create_new_orig_recursive_goals(1709,70225 | ||
| 3986 | :- func create_new_recursive_goals(1723,70918 | ||
| 3987 | :- func create_new_base_goals(1738,71717 | ||
| 3988 | :- pred acc_unification(1749,72156 | ||
| 3989 | :- pred accu_top_level(1766,72896 | ||
| 3990 | :- pred update_accumulator_pred(1856,76290 | ||
| 3991 | :- func accu_rename(1876,77253 | ||
| 3992 | :- func base_case_ids(1889,77784 | ||
| 3993 | :- func base_case_ids_set(1898,78048 | ||
| 3994 | :- func accu_goal_list(1905,78269 | ||
| 3995 | :- pred calculate_goal_info(1916,78680 | ||
| 3996 | :- func chain_subst(1932,79319 | ||
| 3997 | :- pred chain_subst_2(1938,79482 | ||
| 3998 | :- end_module transform_hlds.accumulator1953,79939 | ||
| 3999 | |||
| 3884 | c-src/c.c,76 | 4000 | c-src/c.c,76 |
| 3885 | T f(1,0 | 4001 | T f(1,0 |
| 3886 | }T i;2,14 | 4002 | }T i;2,14 |
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2 index 1c2568376f2..c3d2726ece1 100644 --- a/test/manual/etags/ETAGS.good_2 +++ b/test/manual/etags/ETAGS.good_2 | |||
| @@ -4454,6 +4454,180 @@ Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % | |||
| 4454 | \global\def={=3307,107500 | 4454 | \global\def={=3307,107500 |
| 4455 | \def\normalbackslash{\normalbackslash3321,107882 | 4455 | \def\normalbackslash{\normalbackslash3321,107882 |
| 4456 | 4456 | ||
| 4457 | merc-src/accumulator.m,5996 | ||
| 4458 | :- module transform_hlds.accumulator145,5333 | ||
| 4459 | :- import_module hlds148,5386 | ||
| 4460 | :- import_module hlds.hlds_module149,5409 | ||
| 4461 | :- import_module hlds.hlds_pred150,5444 | ||
| 4462 | :- import_module univ152,5478 | ||
| 4463 | :- pred accu_transform_proc(159,5793 | ||
| 4464 | :- import_module hlds.assertion168,6135 | ||
| 4465 | :- import_module hlds.goal_util169,6168 | ||
| 4466 | :- import_module hlds.hlds_error_util170,6201 | ||
| 4467 | :- import_module hlds.hlds_goal171,6240 | ||
| 4468 | :- import_module hlds.hlds_out172,6273 | ||
| 4469 | :- import_module hlds.hlds_out.hlds_out_util173,6305 | ||
| 4470 | :- import_module hlds.hlds_promise174,6351 | ||
| 4471 | :- import_module hlds.instmap175,6387 | ||
| 4472 | :- import_module hlds.pred_table176,6418 | ||
| 4473 | :- import_module hlds.quantification177,6452 | ||
| 4474 | :- import_module hlds.status178,6490 | ||
| 4475 | :- import_module hlds.vartypes179,6520 | ||
| 4476 | :- import_module libs180,6552 | ||
| 4477 | :- import_module libs.globals181,6575 | ||
| 4478 | :- import_module libs.optimization_options182,6606 | ||
| 4479 | :- import_module libs.options183,6650 | ||
| 4480 | :- import_module mdbcomp184,6681 | ||
| 4481 | :- import_module mdbcomp.sym_name185,6707 | ||
| 4482 | :- import_module parse_tree186,6742 | ||
| 4483 | :- import_module parse_tree.error_util187,6771 | ||
| 4484 | :- import_module parse_tree.prog_data188,6811 | ||
| 4485 | :- import_module parse_tree.prog_mode189,6850 | ||
| 4486 | :- import_module parse_tree.prog_util190,6889 | ||
| 4487 | :- import_module parse_tree.set_of_var191,6928 | ||
| 4488 | :- import_module transform_hlds.goal_store192,6968 | ||
| 4489 | :- import_module assoc_list194,7013 | ||
| 4490 | :- import_module bool195,7042 | ||
| 4491 | :- import_module int196,7065 | ||
| 4492 | :- import_module io197,7087 | ||
| 4493 | :- import_module list198,7108 | ||
| 4494 | :- import_module map199,7131 | ||
| 4495 | :- import_module maybe200,7153 | ||
| 4496 | :- import_module pair201,7177 | ||
| 4497 | :- import_module require202,7200 | ||
| 4498 | :- import_module set203,7226 | ||
| 4499 | :- import_module solutions204,7248 | ||
| 4500 | :- import_module string205,7276 | ||
| 4501 | :- import_module term206,7301 | ||
| 4502 | :- import_module varset207,7324 | ||
| 4503 | :- type top_level213,7499 | ||
| 4504 | :- type accu_goal_id225,7900 | ||
| 4505 | :- type accu_case228,7964 | ||
| 4506 | :- type accu_goal_store234,8091 | ||
| 4507 | :- type accu_subst238,8216 | ||
| 4508 | :- type accu_warning240,8264 | ||
| 4509 | accu_transform_proc(247,8578 | ||
| 4510 | :- pred generate_warnings(334,12550 | ||
| 4511 | generate_warnings(337,12669 | ||
| 4512 | :- pred generate_warning(342,12895 | ||
| 4513 | generate_warning(345,13001 | ||
| 4514 | :- pred should_attempt_accu_transform(365,13886 | ||
| 4515 | should_attempt_accu_transform(370,14123 | ||
| 4516 | :- pred should_attempt_accu_transform_2(398,15406 | ||
| 4517 | should_attempt_accu_transform_2(405,15763 | ||
| 4518 | :- pred accu_standardize(440,17390 | ||
| 4519 | accu_standardize(442,17455 | ||
| 4520 | :- pred identify_goal_type(465,18169 | ||
| 4521 | identify_goal_type(469,18359 | ||
| 4522 | :- pred is_recursive_case(549,21175 | ||
| 4523 | is_recursive_case(551,21253 | ||
| 4524 | :- type store_info560,21713 | ||
| 4525 | :- func initialize_goal_store(570,22060 | ||
| 4526 | initialize_goal_store(573,22166 | ||
| 4527 | :- pred accu_store(580,22421 | ||
| 4528 | accu_store(584,22576 | ||
| 4529 | :- pred identify_recursive_calls(601,23288 | ||
| 4530 | identify_recursive_calls(604,23406 | ||
| 4531 | :- pred identify_out_and_out_prime(626,24396 | ||
| 4532 | identify_out_and_out_prime(631,24631 | ||
| 4533 | :- type accu_sets676,26425 | ||
| 4534 | :- pred accu_stage1(689,26977 | ||
| 4535 | accu_stage1(693,27155 | ||
| 4536 | :- pred accu_stage1_2(727,28347 | ||
| 4537 | accu_stage1_2(731,28515 | ||
| 4538 | :- pred accu_sets_init(781,30557 | ||
| 4539 | accu_sets_init(783,30605 | ||
| 4540 | :- func set_upto(796,30984 | ||
| 4541 | set_upto(798,31039 | ||
| 4542 | :- pred accu_before(812,31498 | ||
| 4543 | accu_before(815,31639 | ||
| 4544 | :- pred accu_assoc(835,32477 | ||
| 4545 | accu_assoc(838,32617 | ||
| 4546 | :- pred accu_construct(862,33712 | ||
| 4547 | accu_construct(865,33856 | ||
| 4548 | :- pred accu_construct_assoc(896,35307 | ||
| 4549 | accu_construct_assoc(899,35457 | ||
| 4550 | :- pred accu_update(938,37069 | ||
| 4551 | accu_update(941,37210 | ||
| 4552 | :- pred member_lessthan_goalid(964,38219 | ||
| 4553 | member_lessthan_goalid(967,38342 | ||
| 4554 | :- type accu_assoc975,38652 | ||
| 4555 | :- pred accu_is_associative(986,39138 | ||
| 4556 | accu_is_associative(989,39250 | ||
| 4557 | :- pred associativity_assertion(1014,40263 | ||
| 4558 | associativity_assertion(1017,40404 | ||
| 4559 | :- pred commutativity_assertion(1037,41242 | ||
| 4560 | commutativity_assertion(1040,41369 | ||
| 4561 | :- pred accu_is_update(1057,41952 | ||
| 4562 | accu_is_update(1060,42066 | ||
| 4563 | :- pred is_associative_construction(1078,42802 | ||
| 4564 | is_associative_construction(1081,42898 | ||
| 4565 | :- type accu_substs1095,43480 | ||
| 4566 | :- type accu_base1103,43744 | ||
| 4567 | :- pred accu_stage2(1124,44605 | ||
| 4568 | accu_stage2(1131,44946 | ||
| 4569 | :- pred accu_substs_init(1179,46957 | ||
| 4570 | accu_substs_init(1182,47097 | ||
| 4571 | :- pred acc_var_subst_init(1194,47573 | ||
| 4572 | acc_var_subst_init(1198,47718 | ||
| 4573 | :- pred create_new_var(1207,48147 | ||
| 4574 | create_new_var(1210,48288 | ||
| 4575 | :- pred accu_process_assoc_set(1223,48862 | ||
| 4576 | accu_process_assoc_set(1229,49150 | ||
| 4577 | :- pred accu_has_heuristic(1297,52081 | ||
| 4578 | accu_has_heuristic(1299,52161 | ||
| 4579 | :- pred accu_heuristic(1304,52336 | ||
| 4580 | accu_heuristic(1307,52457 | ||
| 4581 | :- pred accu_process_update_set(1318,52906 | ||
| 4582 | accu_process_update_set(1325,53221 | ||
| 4583 | :- pred accu_divide_base_case(1380,55844 | ||
| 4584 | accu_divide_base_case(1385,56059 | ||
| 4585 | :- pred accu_related(1412,57146 | ||
| 4586 | accu_related(1415,57270 | ||
| 4587 | :- pred lookup_call(1449,58601 | ||
| 4588 | lookup_call(1452,58715 | ||
| 4589 | :- pred accu_stage3(1470,59432 | ||
| 4590 | accu_stage3(1477,59826 | ||
| 4591 | :- pred acc_proc_info(1508,61326 | ||
| 4592 | acc_proc_info(1512,61485 | ||
| 4593 | :- pred acc_pred_info(1556,63449 | ||
| 4594 | acc_pred_info(1559,63597 | ||
| 4595 | :- pred accu_create_goal(1600,65285 | ||
| 4596 | accu_create_goal(1607,65628 | ||
| 4597 | :- func create_acc_call(1621,66400 | ||
| 4598 | create_acc_call(1625,66569 | ||
| 4599 | :- pred create_orig_goal(1634,66987 | ||
| 4600 | create_orig_goal(1638,67176 | ||
| 4601 | :- pred create_acc_goal(1662,68157 | ||
| 4602 | create_acc_goal(1667,68380 | ||
| 4603 | :- func create_new_orig_recursive_goals(1709,70225 | ||
| 4604 | create_new_orig_recursive_goals(1712,70368 | ||
| 4605 | :- func create_new_recursive_goals(1723,70918 | ||
| 4606 | create_new_recursive_goals(1727,71108 | ||
| 4607 | :- func create_new_base_goals(1738,71717 | ||
| 4608 | create_new_base_goals(1741,71831 | ||
| 4609 | :- pred acc_unification(1749,72156 | ||
| 4610 | acc_unification(1751,72225 | ||
| 4611 | :- pred accu_top_level(1766,72896 | ||
| 4612 | accu_top_level(1770,73058 | ||
| 4613 | :- pred update_accumulator_pred(1856,76290 | ||
| 4614 | update_accumulator_pred(1859,76411 | ||
| 4615 | :- func accu_rename(1876,77253 | ||
| 4616 | accu_rename(1879,77363 | ||
| 4617 | :- func base_case_ids(1889,77784 | ||
| 4618 | base_case_ids(1891,77846 | ||
| 4619 | :- func base_case_ids_set(1898,78048 | ||
| 4620 | base_case_ids_set(1900,78113 | ||
| 4621 | :- func accu_goal_list(1905,78269 | ||
| 4622 | accu_goal_list(1907,78349 | ||
| 4623 | :- pred calculate_goal_info(1916,78680 | ||
| 4624 | calculate_goal_info(1918,78753 | ||
| 4625 | :- func chain_subst(1932,79319 | ||
| 4626 | chain_subst(1934,79378 | ||
| 4627 | :- pred chain_subst_2(1938,79482 | ||
| 4628 | chain_subst_2(1941,79576 | ||
| 4629 | :- end_module transform_hlds.accumulator1953,79939 | ||
| 4630 | |||
| 4457 | c-src/c.c,76 | 4631 | c-src/c.c,76 |
| 4458 | T f(1,0 | 4632 | T f(1,0 |
| 4459 | }T i;2,14 | 4633 | }T i;2,14 |
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3 index 5b558189ebc..85897febbf6 100644 --- a/test/manual/etags/ETAGS.good_3 +++ b/test/manual/etags/ETAGS.good_3 | |||
| @@ -4288,6 +4288,122 @@ Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % | |||
| 4288 | \global\def={=3307,107500 | 4288 | \global\def={=3307,107500 |
| 4289 | \def\normalbackslash{\normalbackslash3321,107882 | 4289 | \def\normalbackslash{\normalbackslash3321,107882 |
| 4290 | 4290 | ||
| 4291 | merc-src/accumulator.m,4275 | ||
| 4292 | :- module transform_hlds.accumulator145,5333 | ||
| 4293 | :- import_module hlds148,5386 | ||
| 4294 | :- import_module hlds.hlds_module149,5409 | ||
| 4295 | :- import_module hlds.hlds_pred150,5444 | ||
| 4296 | :- import_module univ152,5478 | ||
| 4297 | :- pred accu_transform_proc(159,5793 | ||
| 4298 | :- import_module hlds.assertion168,6135 | ||
| 4299 | :- import_module hlds.goal_util169,6168 | ||
| 4300 | :- import_module hlds.hlds_error_util170,6201 | ||
| 4301 | :- import_module hlds.hlds_goal171,6240 | ||
| 4302 | :- import_module hlds.hlds_out172,6273 | ||
| 4303 | :- import_module hlds.hlds_out.hlds_out_util173,6305 | ||
| 4304 | :- import_module hlds.hlds_promise174,6351 | ||
| 4305 | :- import_module hlds.instmap175,6387 | ||
| 4306 | :- import_module hlds.pred_table176,6418 | ||
| 4307 | :- import_module hlds.quantification177,6452 | ||
| 4308 | :- import_module hlds.status178,6490 | ||
| 4309 | :- import_module hlds.vartypes179,6520 | ||
| 4310 | :- import_module libs180,6552 | ||
| 4311 | :- import_module libs.globals181,6575 | ||
| 4312 | :- import_module libs.optimization_options182,6606 | ||
| 4313 | :- import_module libs.options183,6650 | ||
| 4314 | :- import_module mdbcomp184,6681 | ||
| 4315 | :- import_module mdbcomp.sym_name185,6707 | ||
| 4316 | :- import_module parse_tree186,6742 | ||
| 4317 | :- import_module parse_tree.error_util187,6771 | ||
| 4318 | :- import_module parse_tree.prog_data188,6811 | ||
| 4319 | :- import_module parse_tree.prog_mode189,6850 | ||
| 4320 | :- import_module parse_tree.prog_util190,6889 | ||
| 4321 | :- import_module parse_tree.set_of_var191,6928 | ||
| 4322 | :- import_module transform_hlds.goal_store192,6968 | ||
| 4323 | :- import_module assoc_list194,7013 | ||
| 4324 | :- import_module bool195,7042 | ||
| 4325 | :- import_module int196,7065 | ||
| 4326 | :- import_module io197,7087 | ||
| 4327 | :- import_module list198,7108 | ||
| 4328 | :- import_module map199,7131 | ||
| 4329 | :- import_module maybe200,7153 | ||
| 4330 | :- import_module pair201,7177 | ||
| 4331 | :- import_module require202,7200 | ||
| 4332 | :- import_module set203,7226 | ||
| 4333 | :- import_module solutions204,7248 | ||
| 4334 | :- import_module string205,7276 | ||
| 4335 | :- import_module term206,7301 | ||
| 4336 | :- import_module varset207,7324 | ||
| 4337 | :- type top_level213,7499 | ||
| 4338 | :- type accu_goal_id225,7900 | ||
| 4339 | :- type accu_case228,7964 | ||
| 4340 | :- type accu_goal_store234,8091 | ||
| 4341 | :- type accu_subst238,8216 | ||
| 4342 | :- type accu_warning240,8264 | ||
| 4343 | :- pred generate_warnings(334,12550 | ||
| 4344 | :- pred generate_warning(342,12895 | ||
| 4345 | :- pred should_attempt_accu_transform(365,13886 | ||
| 4346 | :- pred should_attempt_accu_transform_2(398,15406 | ||
| 4347 | :- pred accu_standardize(440,17390 | ||
| 4348 | :- pred identify_goal_type(465,18169 | ||
| 4349 | :- pred is_recursive_case(549,21175 | ||
| 4350 | :- type store_info560,21713 | ||
| 4351 | :- func initialize_goal_store(570,22060 | ||
| 4352 | :- pred accu_store(580,22421 | ||
| 4353 | :- pred identify_recursive_calls(601,23288 | ||
| 4354 | :- pred identify_out_and_out_prime(626,24396 | ||
| 4355 | :- type accu_sets676,26425 | ||
| 4356 | :- pred accu_stage1(689,26977 | ||
| 4357 | :- pred accu_stage1_2(727,28347 | ||
| 4358 | :- pred accu_sets_init(781,30557 | ||
| 4359 | :- func set_upto(796,30984 | ||
| 4360 | :- pred accu_before(812,31498 | ||
| 4361 | :- pred accu_assoc(835,32477 | ||
| 4362 | :- pred accu_construct(862,33712 | ||
| 4363 | :- pred accu_construct_assoc(896,35307 | ||
| 4364 | :- pred accu_update(938,37069 | ||
| 4365 | :- pred member_lessthan_goalid(964,38219 | ||
| 4366 | :- type accu_assoc975,38652 | ||
| 4367 | :- pred accu_is_associative(986,39138 | ||
| 4368 | :- pred associativity_assertion(1014,40263 | ||
| 4369 | :- pred commutativity_assertion(1037,41242 | ||
| 4370 | :- pred accu_is_update(1057,41952 | ||
| 4371 | :- pred is_associative_construction(1078,42802 | ||
| 4372 | :- type accu_substs1095,43480 | ||
| 4373 | :- type accu_base1103,43744 | ||
| 4374 | :- pred accu_stage2(1124,44605 | ||
| 4375 | :- pred accu_substs_init(1179,46957 | ||
| 4376 | :- pred acc_var_subst_init(1194,47573 | ||
| 4377 | :- pred create_new_var(1207,48147 | ||
| 4378 | :- pred accu_process_assoc_set(1223,48862 | ||
| 4379 | :- pred accu_has_heuristic(1297,52081 | ||
| 4380 | :- pred accu_heuristic(1304,52336 | ||
| 4381 | :- pred accu_process_update_set(1318,52906 | ||
| 4382 | :- pred accu_divide_base_case(1380,55844 | ||
| 4383 | :- pred accu_related(1412,57146 | ||
| 4384 | :- pred lookup_call(1449,58601 | ||
| 4385 | :- pred accu_stage3(1470,59432 | ||
| 4386 | :- pred acc_proc_info(1508,61326 | ||
| 4387 | :- pred acc_pred_info(1556,63449 | ||
| 4388 | :- pred accu_create_goal(1600,65285 | ||
| 4389 | :- func create_acc_call(1621,66400 | ||
| 4390 | :- pred create_orig_goal(1634,66987 | ||
| 4391 | :- pred create_acc_goal(1662,68157 | ||
| 4392 | :- func create_new_orig_recursive_goals(1709,70225 | ||
| 4393 | :- func create_new_recursive_goals(1723,70918 | ||
| 4394 | :- func create_new_base_goals(1738,71717 | ||
| 4395 | :- pred acc_unification(1749,72156 | ||
| 4396 | :- pred accu_top_level(1766,72896 | ||
| 4397 | :- pred update_accumulator_pred(1856,76290 | ||
| 4398 | :- func accu_rename(1876,77253 | ||
| 4399 | :- func base_case_ids(1889,77784 | ||
| 4400 | :- func base_case_ids_set(1898,78048 | ||
| 4401 | :- func accu_goal_list(1905,78269 | ||
| 4402 | :- pred calculate_goal_info(1916,78680 | ||
| 4403 | :- func chain_subst(1932,79319 | ||
| 4404 | :- pred chain_subst_2(1938,79482 | ||
| 4405 | :- end_module transform_hlds.accumulator1953,79939 | ||
| 4406 | |||
| 4291 | c-src/c.c,76 | 4407 | c-src/c.c,76 |
| 4292 | T f(1,0 | 4408 | T f(1,0 |
| 4293 | }T i;2,14 | 4409 | }T i;2,14 |
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4 index d54cf1c9bfb..828a6b864cc 100644 --- a/test/manual/etags/ETAGS.good_4 +++ b/test/manual/etags/ETAGS.good_4 | |||
| @@ -4043,6 +4043,122 @@ Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % | |||
| 4043 | \global\def={=3307,107500 | 4043 | \global\def={=3307,107500 |
| 4044 | \def\normalbackslash{\normalbackslash3321,107882 | 4044 | \def\normalbackslash{\normalbackslash3321,107882 |
| 4045 | 4045 | ||
| 4046 | merc-src/accumulator.m,4275 | ||
| 4047 | :- module transform_hlds.accumulator145,5333 | ||
| 4048 | :- import_module hlds148,5386 | ||
| 4049 | :- import_module hlds.hlds_module149,5409 | ||
| 4050 | :- import_module hlds.hlds_pred150,5444 | ||
| 4051 | :- import_module univ152,5478 | ||
| 4052 | :- pred accu_transform_proc(159,5793 | ||
| 4053 | :- import_module hlds.assertion168,6135 | ||
| 4054 | :- import_module hlds.goal_util169,6168 | ||
| 4055 | :- import_module hlds.hlds_error_util170,6201 | ||
| 4056 | :- import_module hlds.hlds_goal171,6240 | ||
| 4057 | :- import_module hlds.hlds_out172,6273 | ||
| 4058 | :- import_module hlds.hlds_out.hlds_out_util173,6305 | ||
| 4059 | :- import_module hlds.hlds_promise174,6351 | ||
| 4060 | :- import_module hlds.instmap175,6387 | ||
| 4061 | :- import_module hlds.pred_table176,6418 | ||
| 4062 | :- import_module hlds.quantification177,6452 | ||
| 4063 | :- import_module hlds.status178,6490 | ||
| 4064 | :- import_module hlds.vartypes179,6520 | ||
| 4065 | :- import_module libs180,6552 | ||
| 4066 | :- import_module libs.globals181,6575 | ||
| 4067 | :- import_module libs.optimization_options182,6606 | ||
| 4068 | :- import_module libs.options183,6650 | ||
| 4069 | :- import_module mdbcomp184,6681 | ||
| 4070 | :- import_module mdbcomp.sym_name185,6707 | ||
| 4071 | :- import_module parse_tree186,6742 | ||
| 4072 | :- import_module parse_tree.error_util187,6771 | ||
| 4073 | :- import_module parse_tree.prog_data188,6811 | ||
| 4074 | :- import_module parse_tree.prog_mode189,6850 | ||
| 4075 | :- import_module parse_tree.prog_util190,6889 | ||
| 4076 | :- import_module parse_tree.set_of_var191,6928 | ||
| 4077 | :- import_module transform_hlds.goal_store192,6968 | ||
| 4078 | :- import_module assoc_list194,7013 | ||
| 4079 | :- import_module bool195,7042 | ||
| 4080 | :- import_module int196,7065 | ||
| 4081 | :- import_module io197,7087 | ||
| 4082 | :- import_module list198,7108 | ||
| 4083 | :- import_module map199,7131 | ||
| 4084 | :- import_module maybe200,7153 | ||
| 4085 | :- import_module pair201,7177 | ||
| 4086 | :- import_module require202,7200 | ||
| 4087 | :- import_module set203,7226 | ||
| 4088 | :- import_module solutions204,7248 | ||
| 4089 | :- import_module string205,7276 | ||
| 4090 | :- import_module term206,7301 | ||
| 4091 | :- import_module varset207,7324 | ||
| 4092 | :- type top_level213,7499 | ||
| 4093 | :- type accu_goal_id225,7900 | ||
| 4094 | :- type accu_case228,7964 | ||
| 4095 | :- type accu_goal_store234,8091 | ||
| 4096 | :- type accu_subst238,8216 | ||
| 4097 | :- type accu_warning240,8264 | ||
| 4098 | :- pred generate_warnings(334,12550 | ||
| 4099 | :- pred generate_warning(342,12895 | ||
| 4100 | :- pred should_attempt_accu_transform(365,13886 | ||
| 4101 | :- pred should_attempt_accu_transform_2(398,15406 | ||
| 4102 | :- pred accu_standardize(440,17390 | ||
| 4103 | :- pred identify_goal_type(465,18169 | ||
| 4104 | :- pred is_recursive_case(549,21175 | ||
| 4105 | :- type store_info560,21713 | ||
| 4106 | :- func initialize_goal_store(570,22060 | ||
| 4107 | :- pred accu_store(580,22421 | ||
| 4108 | :- pred identify_recursive_calls(601,23288 | ||
| 4109 | :- pred identify_out_and_out_prime(626,24396 | ||
| 4110 | :- type accu_sets676,26425 | ||
| 4111 | :- pred accu_stage1(689,26977 | ||
| 4112 | :- pred accu_stage1_2(727,28347 | ||
| 4113 | :- pred accu_sets_init(781,30557 | ||
| 4114 | :- func set_upto(796,30984 | ||
| 4115 | :- pred accu_before(812,31498 | ||
| 4116 | :- pred accu_assoc(835,32477 | ||
| 4117 | :- pred accu_construct(862,33712 | ||
| 4118 | :- pred accu_construct_assoc(896,35307 | ||
| 4119 | :- pred accu_update(938,37069 | ||
| 4120 | :- pred member_lessthan_goalid(964,38219 | ||
| 4121 | :- type accu_assoc975,38652 | ||
| 4122 | :- pred accu_is_associative(986,39138 | ||
| 4123 | :- pred associativity_assertion(1014,40263 | ||
| 4124 | :- pred commutativity_assertion(1037,41242 | ||
| 4125 | :- pred accu_is_update(1057,41952 | ||
| 4126 | :- pred is_associative_construction(1078,42802 | ||
| 4127 | :- type accu_substs1095,43480 | ||
| 4128 | :- type accu_base1103,43744 | ||
| 4129 | :- pred accu_stage2(1124,44605 | ||
| 4130 | :- pred accu_substs_init(1179,46957 | ||
| 4131 | :- pred acc_var_subst_init(1194,47573 | ||
| 4132 | :- pred create_new_var(1207,48147 | ||
| 4133 | :- pred accu_process_assoc_set(1223,48862 | ||
| 4134 | :- pred accu_has_heuristic(1297,52081 | ||
| 4135 | :- pred accu_heuristic(1304,52336 | ||
| 4136 | :- pred accu_process_update_set(1318,52906 | ||
| 4137 | :- pred accu_divide_base_case(1380,55844 | ||
| 4138 | :- pred accu_related(1412,57146 | ||
| 4139 | :- pred lookup_call(1449,58601 | ||
| 4140 | :- pred accu_stage3(1470,59432 | ||
| 4141 | :- pred acc_proc_info(1508,61326 | ||
| 4142 | :- pred acc_pred_info(1556,63449 | ||
| 4143 | :- pred accu_create_goal(1600,65285 | ||
| 4144 | :- func create_acc_call(1621,66400 | ||
| 4145 | :- pred create_orig_goal(1634,66987 | ||
| 4146 | :- pred create_acc_goal(1662,68157 | ||
| 4147 | :- func create_new_orig_recursive_goals(1709,70225 | ||
| 4148 | :- func create_new_recursive_goals(1723,70918 | ||
| 4149 | :- func create_new_base_goals(1738,71717 | ||
| 4150 | :- pred acc_unification(1749,72156 | ||
| 4151 | :- pred accu_top_level(1766,72896 | ||
| 4152 | :- pred update_accumulator_pred(1856,76290 | ||
| 4153 | :- func accu_rename(1876,77253 | ||
| 4154 | :- func base_case_ids(1889,77784 | ||
| 4155 | :- func base_case_ids_set(1898,78048 | ||
| 4156 | :- func accu_goal_list(1905,78269 | ||
| 4157 | :- pred calculate_goal_info(1916,78680 | ||
| 4158 | :- func chain_subst(1932,79319 | ||
| 4159 | :- pred chain_subst_2(1938,79482 | ||
| 4160 | :- end_module transform_hlds.accumulator1953,79939 | ||
| 4161 | |||
| 4046 | c-src/c.c,76 | 4162 | c-src/c.c,76 |
| 4047 | T f(1,0 | 4163 | T f(1,0 |
| 4048 | }T i;2,14 | 4164 | }T i;2,14 |
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5 index af70a109ef9..5b1dc4f7bc5 100644 --- a/test/manual/etags/ETAGS.good_5 +++ b/test/manual/etags/ETAGS.good_5 | |||
| @@ -5023,6 +5023,180 @@ Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % | |||
| 5023 | \global\def={=3307,107500 | 5023 | \global\def={=3307,107500 |
| 5024 | \def\normalbackslash{\normalbackslash3321,107882 | 5024 | \def\normalbackslash{\normalbackslash3321,107882 |
| 5025 | 5025 | ||
| 5026 | merc-src/accumulator.m,5996 | ||
| 5027 | :- module transform_hlds.accumulator145,5333 | ||
| 5028 | :- import_module hlds148,5386 | ||
| 5029 | :- import_module hlds.hlds_module149,5409 | ||
| 5030 | :- import_module hlds.hlds_pred150,5444 | ||
| 5031 | :- import_module univ152,5478 | ||
| 5032 | :- pred accu_transform_proc(159,5793 | ||
| 5033 | :- import_module hlds.assertion168,6135 | ||
| 5034 | :- import_module hlds.goal_util169,6168 | ||
| 5035 | :- import_module hlds.hlds_error_util170,6201 | ||
| 5036 | :- import_module hlds.hlds_goal171,6240 | ||
| 5037 | :- import_module hlds.hlds_out172,6273 | ||
| 5038 | :- import_module hlds.hlds_out.hlds_out_util173,6305 | ||
| 5039 | :- import_module hlds.hlds_promise174,6351 | ||
| 5040 | :- import_module hlds.instmap175,6387 | ||
| 5041 | :- import_module hlds.pred_table176,6418 | ||
| 5042 | :- import_module hlds.quantification177,6452 | ||
| 5043 | :- import_module hlds.status178,6490 | ||
| 5044 | :- import_module hlds.vartypes179,6520 | ||
| 5045 | :- import_module libs180,6552 | ||
| 5046 | :- import_module libs.globals181,6575 | ||
| 5047 | :- import_module libs.optimization_options182,6606 | ||
| 5048 | :- import_module libs.options183,6650 | ||
| 5049 | :- import_module mdbcomp184,6681 | ||
| 5050 | :- import_module mdbcomp.sym_name185,6707 | ||
| 5051 | :- import_module parse_tree186,6742 | ||
| 5052 | :- import_module parse_tree.error_util187,6771 | ||
| 5053 | :- import_module parse_tree.prog_data188,6811 | ||
| 5054 | :- import_module parse_tree.prog_mode189,6850 | ||
| 5055 | :- import_module parse_tree.prog_util190,6889 | ||
| 5056 | :- import_module parse_tree.set_of_var191,6928 | ||
| 5057 | :- import_module transform_hlds.goal_store192,6968 | ||
| 5058 | :- import_module assoc_list194,7013 | ||
| 5059 | :- import_module bool195,7042 | ||
| 5060 | :- import_module int196,7065 | ||
| 5061 | :- import_module io197,7087 | ||
| 5062 | :- import_module list198,7108 | ||
| 5063 | :- import_module map199,7131 | ||
| 5064 | :- import_module maybe200,7153 | ||
| 5065 | :- import_module pair201,7177 | ||
| 5066 | :- import_module require202,7200 | ||
| 5067 | :- import_module set203,7226 | ||
| 5068 | :- import_module solutions204,7248 | ||
| 5069 | :- import_module string205,7276 | ||
| 5070 | :- import_module term206,7301 | ||
| 5071 | :- import_module varset207,7324 | ||
| 5072 | :- type top_level213,7499 | ||
| 5073 | :- type accu_goal_id225,7900 | ||
| 5074 | :- type accu_case228,7964 | ||
| 5075 | :- type accu_goal_store234,8091 | ||
| 5076 | :- type accu_subst238,8216 | ||
| 5077 | :- type accu_warning240,8264 | ||
| 5078 | accu_transform_proc(247,8578 | ||
| 5079 | :- pred generate_warnings(334,12550 | ||
| 5080 | generate_warnings(337,12669 | ||
| 5081 | :- pred generate_warning(342,12895 | ||
| 5082 | generate_warning(345,13001 | ||
| 5083 | :- pred should_attempt_accu_transform(365,13886 | ||
| 5084 | should_attempt_accu_transform(370,14123 | ||
| 5085 | :- pred should_attempt_accu_transform_2(398,15406 | ||
| 5086 | should_attempt_accu_transform_2(405,15763 | ||
| 5087 | :- pred accu_standardize(440,17390 | ||
| 5088 | accu_standardize(442,17455 | ||
| 5089 | :- pred identify_goal_type(465,18169 | ||
| 5090 | identify_goal_type(469,18359 | ||
| 5091 | :- pred is_recursive_case(549,21175 | ||
| 5092 | is_recursive_case(551,21253 | ||
| 5093 | :- type store_info560,21713 | ||
| 5094 | :- func initialize_goal_store(570,22060 | ||
| 5095 | initialize_goal_store(573,22166 | ||
| 5096 | :- pred accu_store(580,22421 | ||
| 5097 | accu_store(584,22576 | ||
| 5098 | :- pred identify_recursive_calls(601,23288 | ||
| 5099 | identify_recursive_calls(604,23406 | ||
| 5100 | :- pred identify_out_and_out_prime(626,24396 | ||
| 5101 | identify_out_and_out_prime(631,24631 | ||
| 5102 | :- type accu_sets676,26425 | ||
| 5103 | :- pred accu_stage1(689,26977 | ||
| 5104 | accu_stage1(693,27155 | ||
| 5105 | :- pred accu_stage1_2(727,28347 | ||
| 5106 | accu_stage1_2(731,28515 | ||
| 5107 | :- pred accu_sets_init(781,30557 | ||
| 5108 | accu_sets_init(783,30605 | ||
| 5109 | :- func set_upto(796,30984 | ||
| 5110 | set_upto(798,31039 | ||
| 5111 | :- pred accu_before(812,31498 | ||
| 5112 | accu_before(815,31639 | ||
| 5113 | :- pred accu_assoc(835,32477 | ||
| 5114 | accu_assoc(838,32617 | ||
| 5115 | :- pred accu_construct(862,33712 | ||
| 5116 | accu_construct(865,33856 | ||
| 5117 | :- pred accu_construct_assoc(896,35307 | ||
| 5118 | accu_construct_assoc(899,35457 | ||
| 5119 | :- pred accu_update(938,37069 | ||
| 5120 | accu_update(941,37210 | ||
| 5121 | :- pred member_lessthan_goalid(964,38219 | ||
| 5122 | member_lessthan_goalid(967,38342 | ||
| 5123 | :- type accu_assoc975,38652 | ||
| 5124 | :- pred accu_is_associative(986,39138 | ||
| 5125 | accu_is_associative(989,39250 | ||
| 5126 | :- pred associativity_assertion(1014,40263 | ||
| 5127 | associativity_assertion(1017,40404 | ||
| 5128 | :- pred commutativity_assertion(1037,41242 | ||
| 5129 | commutativity_assertion(1040,41369 | ||
| 5130 | :- pred accu_is_update(1057,41952 | ||
| 5131 | accu_is_update(1060,42066 | ||
| 5132 | :- pred is_associative_construction(1078,42802 | ||
| 5133 | is_associative_construction(1081,42898 | ||
| 5134 | :- type accu_substs1095,43480 | ||
| 5135 | :- type accu_base1103,43744 | ||
| 5136 | :- pred accu_stage2(1124,44605 | ||
| 5137 | accu_stage2(1131,44946 | ||
| 5138 | :- pred accu_substs_init(1179,46957 | ||
| 5139 | accu_substs_init(1182,47097 | ||
| 5140 | :- pred acc_var_subst_init(1194,47573 | ||
| 5141 | acc_var_subst_init(1198,47718 | ||
| 5142 | :- pred create_new_var(1207,48147 | ||
| 5143 | create_new_var(1210,48288 | ||
| 5144 | :- pred accu_process_assoc_set(1223,48862 | ||
| 5145 | accu_process_assoc_set(1229,49150 | ||
| 5146 | :- pred accu_has_heuristic(1297,52081 | ||
| 5147 | accu_has_heuristic(1299,52161 | ||
| 5148 | :- pred accu_heuristic(1304,52336 | ||
| 5149 | accu_heuristic(1307,52457 | ||
| 5150 | :- pred accu_process_update_set(1318,52906 | ||
| 5151 | accu_process_update_set(1325,53221 | ||
| 5152 | :- pred accu_divide_base_case(1380,55844 | ||
| 5153 | accu_divide_base_case(1385,56059 | ||
| 5154 | :- pred accu_related(1412,57146 | ||
| 5155 | accu_related(1415,57270 | ||
| 5156 | :- pred lookup_call(1449,58601 | ||
| 5157 | lookup_call(1452,58715 | ||
| 5158 | :- pred accu_stage3(1470,59432 | ||
| 5159 | accu_stage3(1477,59826 | ||
| 5160 | :- pred acc_proc_info(1508,61326 | ||
| 5161 | acc_proc_info(1512,61485 | ||
| 5162 | :- pred acc_pred_info(1556,63449 | ||
| 5163 | acc_pred_info(1559,63597 | ||
| 5164 | :- pred accu_create_goal(1600,65285 | ||
| 5165 | accu_create_goal(1607,65628 | ||
| 5166 | :- func create_acc_call(1621,66400 | ||
| 5167 | create_acc_call(1625,66569 | ||
| 5168 | :- pred create_orig_goal(1634,66987 | ||
| 5169 | create_orig_goal(1638,67176 | ||
| 5170 | :- pred create_acc_goal(1662,68157 | ||
| 5171 | create_acc_goal(1667,68380 | ||
| 5172 | :- func create_new_orig_recursive_goals(1709,70225 | ||
| 5173 | create_new_orig_recursive_goals(1712,70368 | ||
| 5174 | :- func create_new_recursive_goals(1723,70918 | ||
| 5175 | create_new_recursive_goals(1727,71108 | ||
| 5176 | :- func create_new_base_goals(1738,71717 | ||
| 5177 | create_new_base_goals(1741,71831 | ||
| 5178 | :- pred acc_unification(1749,72156 | ||
| 5179 | acc_unification(1751,72225 | ||
| 5180 | :- pred accu_top_level(1766,72896 | ||
| 5181 | accu_top_level(1770,73058 | ||
| 5182 | :- pred update_accumulator_pred(1856,76290 | ||
| 5183 | update_accumulator_pred(1859,76411 | ||
| 5184 | :- func accu_rename(1876,77253 | ||
| 5185 | accu_rename(1879,77363 | ||
| 5186 | :- func base_case_ids(1889,77784 | ||
| 5187 | base_case_ids(1891,77846 | ||
| 5188 | :- func base_case_ids_set(1898,78048 | ||
| 5189 | base_case_ids_set(1900,78113 | ||
| 5190 | :- func accu_goal_list(1905,78269 | ||
| 5191 | accu_goal_list(1907,78349 | ||
| 5192 | :- pred calculate_goal_info(1916,78680 | ||
| 5193 | calculate_goal_info(1918,78753 | ||
| 5194 | :- func chain_subst(1932,79319 | ||
| 5195 | chain_subst(1934,79378 | ||
| 5196 | :- pred chain_subst_2(1938,79482 | ||
| 5197 | chain_subst_2(1941,79576 | ||
| 5198 | :- end_module transform_hlds.accumulator1953,79939 | ||
| 5199 | |||
| 5026 | c-src/c.c,76 | 5200 | c-src/c.c,76 |
| 5027 | T f(1,0 | 5201 | T f(1,0 |
| 5028 | }T i;2,14 | 5202 | }T i;2,14 |
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6 index abf21860c7a..68cbaa9b0a0 100644 --- a/test/manual/etags/ETAGS.good_6 +++ b/test/manual/etags/ETAGS.good_6 | |||
| @@ -5023,6 +5023,180 @@ Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % | |||
| 5023 | \global\def={=3307,107500 | 5023 | \global\def={=3307,107500 |
| 5024 | \def\normalbackslash{\normalbackslash3321,107882 | 5024 | \def\normalbackslash{\normalbackslash3321,107882 |
| 5025 | 5025 | ||
| 5026 | merc-src/accumulator.m,5996 | ||
| 5027 | :- module transform_hlds.accumulator145,5333 | ||
| 5028 | :- import_module hlds148,5386 | ||
| 5029 | :- import_module hlds.hlds_module149,5409 | ||
| 5030 | :- import_module hlds.hlds_pred150,5444 | ||
| 5031 | :- import_module univ152,5478 | ||
| 5032 | :- pred accu_transform_proc(159,5793 | ||
| 5033 | :- import_module hlds.assertion168,6135 | ||
| 5034 | :- import_module hlds.goal_util169,6168 | ||
| 5035 | :- import_module hlds.hlds_error_util170,6201 | ||
| 5036 | :- import_module hlds.hlds_goal171,6240 | ||
| 5037 | :- import_module hlds.hlds_out172,6273 | ||
| 5038 | :- import_module hlds.hlds_out.hlds_out_util173,6305 | ||
| 5039 | :- import_module hlds.hlds_promise174,6351 | ||
| 5040 | :- import_module hlds.instmap175,6387 | ||
| 5041 | :- import_module hlds.pred_table176,6418 | ||
| 5042 | :- import_module hlds.quantification177,6452 | ||
| 5043 | :- import_module hlds.status178,6490 | ||
| 5044 | :- import_module hlds.vartypes179,6520 | ||
| 5045 | :- import_module libs180,6552 | ||
| 5046 | :- import_module libs.globals181,6575 | ||
| 5047 | :- import_module libs.optimization_options182,6606 | ||
| 5048 | :- import_module libs.options183,6650 | ||
| 5049 | :- import_module mdbcomp184,6681 | ||
| 5050 | :- import_module mdbcomp.sym_name185,6707 | ||
| 5051 | :- import_module parse_tree186,6742 | ||
| 5052 | :- import_module parse_tree.error_util187,6771 | ||
| 5053 | :- import_module parse_tree.prog_data188,6811 | ||
| 5054 | :- import_module parse_tree.prog_mode189,6850 | ||
| 5055 | :- import_module parse_tree.prog_util190,6889 | ||
| 5056 | :- import_module parse_tree.set_of_var191,6928 | ||
| 5057 | :- import_module transform_hlds.goal_store192,6968 | ||
| 5058 | :- import_module assoc_list194,7013 | ||
| 5059 | :- import_module bool195,7042 | ||
| 5060 | :- import_module int196,7065 | ||
| 5061 | :- import_module io197,7087 | ||
| 5062 | :- import_module list198,7108 | ||
| 5063 | :- import_module map199,7131 | ||
| 5064 | :- import_module maybe200,7153 | ||
| 5065 | :- import_module pair201,7177 | ||
| 5066 | :- import_module require202,7200 | ||
| 5067 | :- import_module set203,7226 | ||
| 5068 | :- import_module solutions204,7248 | ||
| 5069 | :- import_module string205,7276 | ||
| 5070 | :- import_module term206,7301 | ||
| 5071 | :- import_module varset207,7324 | ||
| 5072 | :- type top_level213,7499 | ||
| 5073 | :- type accu_goal_id225,7900 | ||
| 5074 | :- type accu_case228,7964 | ||
| 5075 | :- type accu_goal_store234,8091 | ||
| 5076 | :- type accu_subst238,8216 | ||
| 5077 | :- type accu_warning240,8264 | ||
| 5078 | accu_transform_proc(247,8578 | ||
| 5079 | :- pred generate_warnings(334,12550 | ||
| 5080 | generate_warnings(337,12669 | ||
| 5081 | :- pred generate_warning(342,12895 | ||
| 5082 | generate_warning(345,13001 | ||
| 5083 | :- pred should_attempt_accu_transform(365,13886 | ||
| 5084 | should_attempt_accu_transform(370,14123 | ||
| 5085 | :- pred should_attempt_accu_transform_2(398,15406 | ||
| 5086 | should_attempt_accu_transform_2(405,15763 | ||
| 5087 | :- pred accu_standardize(440,17390 | ||
| 5088 | accu_standardize(442,17455 | ||
| 5089 | :- pred identify_goal_type(465,18169 | ||
| 5090 | identify_goal_type(469,18359 | ||
| 5091 | :- pred is_recursive_case(549,21175 | ||
| 5092 | is_recursive_case(551,21253 | ||
| 5093 | :- type store_info560,21713 | ||
| 5094 | :- func initialize_goal_store(570,22060 | ||
| 5095 | initialize_goal_store(573,22166 | ||
| 5096 | :- pred accu_store(580,22421 | ||
| 5097 | accu_store(584,22576 | ||
| 5098 | :- pred identify_recursive_calls(601,23288 | ||
| 5099 | identify_recursive_calls(604,23406 | ||
| 5100 | :- pred identify_out_and_out_prime(626,24396 | ||
| 5101 | identify_out_and_out_prime(631,24631 | ||
| 5102 | :- type accu_sets676,26425 | ||
| 5103 | :- pred accu_stage1(689,26977 | ||
| 5104 | accu_stage1(693,27155 | ||
| 5105 | :- pred accu_stage1_2(727,28347 | ||
| 5106 | accu_stage1_2(731,28515 | ||
| 5107 | :- pred accu_sets_init(781,30557 | ||
| 5108 | accu_sets_init(783,30605 | ||
| 5109 | :- func set_upto(796,30984 | ||
| 5110 | set_upto(798,31039 | ||
| 5111 | :- pred accu_before(812,31498 | ||
| 5112 | accu_before(815,31639 | ||
| 5113 | :- pred accu_assoc(835,32477 | ||
| 5114 | accu_assoc(838,32617 | ||
| 5115 | :- pred accu_construct(862,33712 | ||
| 5116 | accu_construct(865,33856 | ||
| 5117 | :- pred accu_construct_assoc(896,35307 | ||
| 5118 | accu_construct_assoc(899,35457 | ||
| 5119 | :- pred accu_update(938,37069 | ||
| 5120 | accu_update(941,37210 | ||
| 5121 | :- pred member_lessthan_goalid(964,38219 | ||
| 5122 | member_lessthan_goalid(967,38342 | ||
| 5123 | :- type accu_assoc975,38652 | ||
| 5124 | :- pred accu_is_associative(986,39138 | ||
| 5125 | accu_is_associative(989,39250 | ||
| 5126 | :- pred associativity_assertion(1014,40263 | ||
| 5127 | associativity_assertion(1017,40404 | ||
| 5128 | :- pred commutativity_assertion(1037,41242 | ||
| 5129 | commutativity_assertion(1040,41369 | ||
| 5130 | :- pred accu_is_update(1057,41952 | ||
| 5131 | accu_is_update(1060,42066 | ||
| 5132 | :- pred is_associative_construction(1078,42802 | ||
| 5133 | is_associative_construction(1081,42898 | ||
| 5134 | :- type accu_substs1095,43480 | ||
| 5135 | :- type accu_base1103,43744 | ||
| 5136 | :- pred accu_stage2(1124,44605 | ||
| 5137 | accu_stage2(1131,44946 | ||
| 5138 | :- pred accu_substs_init(1179,46957 | ||
| 5139 | accu_substs_init(1182,47097 | ||
| 5140 | :- pred acc_var_subst_init(1194,47573 | ||
| 5141 | acc_var_subst_init(1198,47718 | ||
| 5142 | :- pred create_new_var(1207,48147 | ||
| 5143 | create_new_var(1210,48288 | ||
| 5144 | :- pred accu_process_assoc_set(1223,48862 | ||
| 5145 | accu_process_assoc_set(1229,49150 | ||
| 5146 | :- pred accu_has_heuristic(1297,52081 | ||
| 5147 | accu_has_heuristic(1299,52161 | ||
| 5148 | :- pred accu_heuristic(1304,52336 | ||
| 5149 | accu_heuristic(1307,52457 | ||
| 5150 | :- pred accu_process_update_set(1318,52906 | ||
| 5151 | accu_process_update_set(1325,53221 | ||
| 5152 | :- pred accu_divide_base_case(1380,55844 | ||
| 5153 | accu_divide_base_case(1385,56059 | ||
| 5154 | :- pred accu_related(1412,57146 | ||
| 5155 | accu_related(1415,57270 | ||
| 5156 | :- pred lookup_call(1449,58601 | ||
| 5157 | lookup_call(1452,58715 | ||
| 5158 | :- pred accu_stage3(1470,59432 | ||
| 5159 | accu_stage3(1477,59826 | ||
| 5160 | :- pred acc_proc_info(1508,61326 | ||
| 5161 | acc_proc_info(1512,61485 | ||
| 5162 | :- pred acc_pred_info(1556,63449 | ||
| 5163 | acc_pred_info(1559,63597 | ||
| 5164 | :- pred accu_create_goal(1600,65285 | ||
| 5165 | accu_create_goal(1607,65628 | ||
| 5166 | :- func create_acc_call(1621,66400 | ||
| 5167 | create_acc_call(1625,66569 | ||
| 5168 | :- pred create_orig_goal(1634,66987 | ||
| 5169 | create_orig_goal(1638,67176 | ||
| 5170 | :- pred create_acc_goal(1662,68157 | ||
| 5171 | create_acc_goal(1667,68380 | ||
| 5172 | :- func create_new_orig_recursive_goals(1709,70225 | ||
| 5173 | create_new_orig_recursive_goals(1712,70368 | ||
| 5174 | :- func create_new_recursive_goals(1723,70918 | ||
| 5175 | create_new_recursive_goals(1727,71108 | ||
| 5176 | :- func create_new_base_goals(1738,71717 | ||
| 5177 | create_new_base_goals(1741,71831 | ||
| 5178 | :- pred acc_unification(1749,72156 | ||
| 5179 | acc_unification(1751,72225 | ||
| 5180 | :- pred accu_top_level(1766,72896 | ||
| 5181 | accu_top_level(1770,73058 | ||
| 5182 | :- pred update_accumulator_pred(1856,76290 | ||
| 5183 | update_accumulator_pred(1859,76411 | ||
| 5184 | :- func accu_rename(1876,77253 | ||
| 5185 | accu_rename(1879,77363 | ||
| 5186 | :- func base_case_ids(1889,77784 | ||
| 5187 | base_case_ids(1891,77846 | ||
| 5188 | :- func base_case_ids_set(1898,78048 | ||
| 5189 | base_case_ids_set(1900,78113 | ||
| 5190 | :- func accu_goal_list(1905,78269 | ||
| 5191 | accu_goal_list(1907,78349 | ||
| 5192 | :- pred calculate_goal_info(1916,78680 | ||
| 5193 | calculate_goal_info(1918,78753 | ||
| 5194 | :- func chain_subst(1932,79319 | ||
| 5195 | chain_subst(1934,79378 | ||
| 5196 | :- pred chain_subst_2(1938,79482 | ||
| 5197 | chain_subst_2(1941,79576 | ||
| 5198 | :- end_module transform_hlds.accumulator1953,79939 | ||
| 5199 | |||
| 5026 | c-src/c.c,76 | 5200 | c-src/c.c,76 |
| 5027 | T f(1,0 | 5201 | T f(1,0 |
| 5028 | }T i;2,14 | 5202 | }T i;2,14 |
diff --git a/test/manual/etags/Makefile b/test/manual/etags/Makefile index 8d56db29b72..b3a82fdba8d 100644 --- a/test/manual/etags/Makefile +++ b/test/manual/etags/Makefile | |||
| @@ -16,6 +16,7 @@ HTMLSRC=$(addprefix ./html-src/,softwarelibero.html index.shtml algrthms.html so | |||
| 16 | #JAVASRC=$(addprefix ./java-src/, ) | 16 | #JAVASRC=$(addprefix ./java-src/, ) |
| 17 | LUASRC=$(addprefix ./lua-src/,allegro.lua test.lua) | 17 | LUASRC=$(addprefix ./lua-src/,allegro.lua test.lua) |
| 18 | MAKESRC=$(addprefix ./make-src/,Makefile) | 18 | MAKESRC=$(addprefix ./make-src/,Makefile) |
| 19 | MERCSRC=$(addprefix ./merc-src/,accumulator.m) | ||
| 19 | OBJCSRC=$(addprefix ./objc-src/,Subprocess.h Subprocess.m PackInsp.h PackInsp.m) | 20 | OBJCSRC=$(addprefix ./objc-src/,Subprocess.h Subprocess.m PackInsp.h PackInsp.m) |
| 20 | OBJCPPSRC=$(addprefix ./objcpp-src/,SimpleCalc.H SimpleCalc.M) | 21 | OBJCPPSRC=$(addprefix ./objcpp-src/,SimpleCalc.H SimpleCalc.M) |
| 21 | PASSRC=$(addprefix ./pas-src/,common.pas) | 22 | PASSRC=$(addprefix ./pas-src/,common.pas) |
| @@ -32,7 +33,7 @@ YSRC=$(addprefix ./y-src/,parse.y parse.c atest.y cccp.c cccp.y) | |||
| 32 | SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\ | 33 | SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\ |
| 33 | ${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\ | 34 | ${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\ |
| 34 | ${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\ | 35 | ${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\ |
| 35 | ${PROLSRC} ${PYTSRC} ${RBSRC} ${RSSRC} ${SCMSRC} ${TEXSRC} ${YSRC} | 36 | ${PROLSRC} ${PYTSRC} ${RBSRC} ${RSSRC} ${SCMSRC} ${TEXSRC} ${YSRC} ${MERCSRC} |
| 36 | NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz | 37 | NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz |
| 37 | 38 | ||
| 38 | ETAGS_PROG=../../../lib-src/etags | 39 | ETAGS_PROG=../../../lib-src/etags |
diff --git a/test/manual/etags/merc-src/accumulator.m b/test/manual/etags/merc-src/accumulator.m new file mode 100644 index 00000000000..94a6b1d8589 --- /dev/null +++ b/test/manual/etags/merc-src/accumulator.m | |||
| @@ -0,0 +1,1954 @@ | |||
| 1 | %---------------------------------------------------------------------------% | ||
| 2 | % vim: ft=mercury ts=4 sw=4 et | ||
| 3 | %---------------------------------------------------------------------------% | ||
| 4 | % Copyright (C) 1999-2000,2002-2007, 2009-2012 The University of Melbourne. | ||
| 5 | % Copyright (C) 2015 The Mercury team. | ||
| 6 | % This file may only be copied under the terms of the GNU General | ||
| 7 | % Public License - see the file COPYING in the Mercury distribution. | ||
| 8 | %---------------------------------------------------------------------------% | ||
| 9 | % | ||
| 10 | % Module: accumulator.m. | ||
| 11 | % Main authors: petdr. | ||
| 12 | % | ||
| 13 | % Attempts to transform a single proc to a tail recursive form by | ||
| 14 | % introducing accumulators. The algorithm can do this if the code after | ||
| 15 | % the recursive call has either the order independent state update or | ||
| 16 | % associative property. | ||
| 17 | % | ||
| 18 | % /* Order independent State update property */ | ||
| 19 | % :- promise all [A,B,S0,S] | ||
| 20 | % ( | ||
| 21 | % (some[SA] (update(A, S0, SA), update(B, SA, S))) | ||
| 22 | % <=> | ||
| 23 | % (some[SB] (update(B, S0, SB), update(A, SB, S))) | ||
| 24 | % ). | ||
| 25 | % | ||
| 26 | % /* Associativity property */ | ||
| 27 | % :- promise all [A,B,C,ABC] | ||
| 28 | % ( | ||
| 29 | % (some[AB] (assoc(A, B, AB), assoc(AB, C, ABC))) | ||
| 30 | % <=> | ||
| 31 | % (some[BC] (assoc(B, C, BC), assoc(A, BC, ABC))) | ||
| 32 | % ). | ||
| 33 | % | ||
| 34 | % XXX What about exceptions and non-termination? | ||
| 35 | % | ||
| 36 | % The promise declarations above only provide promises about the declarative | ||
| 37 | % semantics, but in order to apply this optimization, we ought to check that | ||
| 38 | % it will preserve the operational semantics (modulo whatever changes are | ||
| 39 | % allowed by the language semantics options). | ||
| 40 | % | ||
| 41 | % Currently we check and respect the --fully-strict option, but not the | ||
| 42 | % --no-reorder-conj option. XXX we should check --no-reorder-conj! | ||
| 43 | % If --no-reorder-conj was set, it would still be OK to apply this | ||
| 44 | % transformation, but ONLY in cases where the goals which get reordered | ||
| 45 | % are guaranteed not to throw any exceptions. | ||
| 46 | % | ||
| 47 | % The algorithm implemented is a combination of the algorithms from | ||
| 48 | % "Making Mercury Programs Tail Recursive" and | ||
| 49 | % "State Update Transformation", which can be found at | ||
| 50 | % <http://www.cs.mu.oz.au/research/mercury/information/papers.html>. | ||
| 51 | % | ||
| 52 | % Note that currently "State Update Transformation" paper only resides | ||
| 53 | % in CVS papers archive in the directory update, but has been submitted | ||
| 54 | % to PPDP '00. | ||
| 55 | % | ||
| 56 | % The transformation recognises predicates in the form | ||
| 57 | % | ||
| 58 | % p(In, OutUpdate, OutAssoc) :- | ||
| 59 | % minimal(In), | ||
| 60 | % initialize(OutUpdate), | ||
| 61 | % base(OutAssoc). | ||
| 62 | % p(In, OutUpdate, OutAssoc) :- | ||
| 63 | % decompose(In, Current, Rest), | ||
| 64 | % p(Rest, OutUpdate0, OutAssoc0), | ||
| 65 | % update(Current, OutUpdate0, OutUpdate), | ||
| 66 | % assoc(Current, OutAssoc0, OutAssoc). | ||
| 67 | % | ||
| 68 | % which can be transformed by the algorithm in "State Update Transformation" to | ||
| 69 | % | ||
| 70 | % p(In, OutUpdate, OutAssoc) :- | ||
| 71 | % initialize(AccUpdate), | ||
| 72 | % p_acc(In, OutUpdate, OutAssoc, AccUpdate). | ||
| 73 | % | ||
| 74 | % p_acc(In, OutUpdate, OutAssoc, AccUpdate) :- | ||
| 75 | % minimal(In), | ||
| 76 | % base(OutAssoc), | ||
| 77 | % OutUpdate = AccUpdate. | ||
| 78 | % p_acc(In, OutUpdate, OutAssoc, AccUpdate0) :- | ||
| 79 | % decompose(In, Current, Rest), | ||
| 80 | % update(Current, AccUpdate0, AccUpdate), | ||
| 81 | % p_acc(Rest, OutUpdate, OutAssoc0, AccUpdate), | ||
| 82 | % assoc(Current, OutAssoc0, OutAssoc). | ||
| 83 | % | ||
| 84 | % we then apply the algorithm from "Making Mercury Programs Tail Recursive" | ||
| 85 | % to p_acc to obtain | ||
| 86 | % | ||
| 87 | % p_acc(In, OutUpdate, OutAssoc, AccUpdate) :- | ||
| 88 | % minimal(In), | ||
| 89 | % base(OutAssoc), | ||
| 90 | % OutUpdate = AccUpdate. | ||
| 91 | % p_acc(In, OutUpdate, OutAssoc, AccUpdate0) :- | ||
| 92 | % decompose(In, Current, Rest), | ||
| 93 | % update(Current, AccUpdate0, AccUpdate), | ||
| 94 | % p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, Current). | ||
| 95 | % | ||
| 96 | % p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- | ||
| 97 | % minimal(In), | ||
| 98 | % base(Base), | ||
| 99 | % assoc(AccAssoc0, Base, OutAssoc), | ||
| 100 | % OutUpdate = AccUpdate0. | ||
| 101 | % p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- | ||
| 102 | % decompose(In, Current, Rest), | ||
| 103 | % update(Current, AccUpdate0, AccUpdate), | ||
| 104 | % assoc(AccAssoc0, Current, AccAssoc), | ||
| 105 | % p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, AccAssoc). | ||
| 106 | % | ||
| 107 | % p_acc is no longer recursive and is only ever called from p, so we | ||
| 108 | % inline p_acc into p to obtain the final schema. | ||
| 109 | % | ||
| 110 | % p(In, OutUpdate, OutAssoc) :- | ||
| 111 | % minimal(In), | ||
| 112 | % base(OutAssoc), | ||
| 113 | % initialize(AccUpdate), | ||
| 114 | % OutUpdate = AccUpdate. | ||
| 115 | % p(In, OutUpdate, OutAssoc) :- | ||
| 116 | % decompose(In, Current, Rest), | ||
| 117 | % initialize(AccUpdate0), | ||
| 118 | % update(Current, AccUpdate0, AccUpdate), | ||
| 119 | % p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, Current). | ||
| 120 | % | ||
| 121 | % p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- | ||
| 122 | % minimal(In), | ||
| 123 | % base(Base), | ||
| 124 | % assoc(AccAssoc0, Base, OutAssoc), | ||
| 125 | % OutUpdate = AccUpdate0. | ||
| 126 | % p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- | ||
| 127 | % decompose(In, Current, Rest), | ||
| 128 | % update(Current, AccUpdate0, AccUpdate), | ||
| 129 | % assoc(AccAssoc0, Current, AccAssoc), | ||
| 130 | % p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, AccAssoc). | ||
| 131 | % | ||
| 132 | % The only real difficulty in this new transformation is identifying the | ||
| 133 | % initialize/1 and base/1 goals from the original base case. | ||
| 134 | % | ||
| 135 | % Note that if the recursive clause contains multiple calls to p, the | ||
| 136 | % transformation attempts to move each recursive call to the end | ||
| 137 | % until one succeeds. This makes the order of independent recursive | ||
| 138 | % calls in the body irrelevant. | ||
| 139 | % | ||
| 140 | % XXX Replace calls to can_reorder_goals with calls to the version that | ||
| 141 | % use the intermodule-analysis framework. | ||
| 142 | % | ||
| 143 | %---------------------------------------------------------------------------% | ||
| 144 | |||
| 145 | :- module transform_hlds.accumulator. | ||
| 146 | :- interface. | ||
| 147 | |||
| 148 | :- import_module hlds. | ||
| 149 | :- import_module hlds.hlds_module. | ||
| 150 | :- import_module hlds.hlds_pred. | ||
| 151 | |||
| 152 | :- import_module univ. | ||
| 153 | |||
| 154 | % Attempt to transform a procedure into accumulator recursive form. | ||
| 155 | % If we succeed, we will add the recursive version of the procedure | ||
| 156 | % to the module_info. However, we may also encounter errors, which | ||
| 157 | % we will add to the list of error_specs in the univ accumulator. | ||
| 158 | % | ||
| 159 | :- pred accu_transform_proc(pred_proc_id::in, pred_info::in, | ||
| 160 | proc_info::in, proc_info::out, module_info::in, module_info::out, | ||
| 161 | univ::in, univ::out) is det. | ||
| 162 | |||
| 163 | %---------------------------------------------------------------------------% | ||
| 164 | %---------------------------------------------------------------------------% | ||
| 165 | |||
| 166 | :- implementation. | ||
| 167 | |||
| 168 | :- import_module hlds.assertion. | ||
| 169 | :- import_module hlds.goal_util. | ||
| 170 | :- import_module hlds.hlds_error_util. | ||
| 171 | :- import_module hlds.hlds_goal. | ||
| 172 | :- import_module hlds.hlds_out. | ||
| 173 | :- import_module hlds.hlds_out.hlds_out_util. | ||
| 174 | :- import_module hlds.hlds_promise. | ||
| 175 | :- import_module hlds.instmap. | ||
| 176 | :- import_module hlds.pred_table. | ||
| 177 | :- import_module hlds.quantification. | ||
| 178 | :- import_module hlds.status. | ||
| 179 | :- import_module hlds.vartypes. | ||
| 180 | :- import_module libs. | ||
| 181 | :- import_module libs.globals. | ||
| 182 | :- import_module libs.optimization_options. | ||
| 183 | :- import_module libs.options. | ||
| 184 | :- import_module mdbcomp. | ||
| 185 | :- import_module mdbcomp.sym_name. | ||
| 186 | :- import_module parse_tree. | ||
| 187 | :- import_module parse_tree.error_util. | ||
| 188 | :- import_module parse_tree.prog_data. | ||
| 189 | :- import_module parse_tree.prog_mode. | ||
| 190 | :- import_module parse_tree.prog_util. | ||
| 191 | :- import_module parse_tree.set_of_var. | ||
| 192 | :- import_module transform_hlds.goal_store. | ||
| 193 | |||
| 194 | :- import_module assoc_list. | ||
| 195 | :- import_module bool. | ||
| 196 | :- import_module int. | ||
| 197 | :- import_module io. | ||
| 198 | :- import_module list. | ||
| 199 | :- import_module map. | ||
| 200 | :- import_module maybe. | ||
| 201 | :- import_module pair. | ||
| 202 | :- import_module require. | ||
| 203 | :- import_module set. | ||
| 204 | :- import_module solutions. | ||
| 205 | :- import_module string. | ||
| 206 | :- import_module term. | ||
| 207 | :- import_module varset. | ||
| 208 | |||
| 209 | %---------------------------------------------------------------------------% | ||
| 210 | |||
| 211 | % The form of the goal around the base and recursive cases. | ||
| 212 | % | ||
| 213 | :- type top_level | ||
| 214 | ---> switch_base_rec | ||
| 215 | ; switch_rec_base | ||
| 216 | ; disj_base_rec | ||
| 217 | ; disj_rec_base | ||
| 218 | ; ite_base_rec | ||
| 219 | ; ite_rec_base. | ||
| 220 | |||
| 221 | % An accu_goal_id represents a goal. The first field says which conjunction | ||
| 222 | % the goal came from (the base case or the recursive case), and the second | ||
| 223 | % gives the location of the goal in that conjunction. | ||
| 224 | % | ||
| 225 | :- type accu_goal_id | ||
| 226 | ---> accu_goal_id(accu_case, int). | ||
| 227 | |||
| 228 | :- type accu_case | ||
| 229 | ---> accu_base | ||
| 230 | ; accu_rec. | ||
| 231 | |||
| 232 | % The goal_store associates a goal with each goal_id. | ||
| 233 | % | ||
| 234 | :- type accu_goal_store == goal_store(accu_goal_id). | ||
| 235 | |||
| 236 | % A substitution from the first variable name to the second. | ||
| 237 | % | ||
| 238 | :- type accu_subst == map(prog_var, prog_var). | ||
| 239 | |||
| 240 | :- type accu_warning | ||
| 241 | ---> accu_warn(prog_context, pred_id, prog_var, prog_var). | ||
| 242 | % Warn that two prog_vars in a call to pred_id at the given context | ||
| 243 | % were swapped, which may cause an efficiency problem. | ||
| 244 | |||
| 245 | %---------------------------------------------------------------------------% | ||
| 246 | |||
| 247 | accu_transform_proc(proc(PredId, ProcId), PredInfo, !ProcInfo, !ModuleInfo, | ||
| 248 | !Cookie) :- | ||
| 249 | module_info_get_globals(!.ModuleInfo, Globals), | ||
| 250 | globals.get_opt_tuple(Globals, OptTuple), | ||
| 251 | DoLCMC = OptTuple ^ ot_opt_lcmc_accumulator, | ||
| 252 | globals.lookup_bool_option(Globals, fully_strict, FullyStrict), | ||
| 253 | ( if | ||
| 254 | should_attempt_accu_transform(!ModuleInfo, PredId, ProcId, PredInfo, | ||
| 255 | !ProcInfo, FullyStrict, DoLCMC, Warnings) | ||
| 256 | then | ||
| 257 | globals.lookup_bool_option(Globals, very_verbose, VeryVerbose), | ||
| 258 | ( | ||
| 259 | VeryVerbose = yes, | ||
| 260 | trace [io(!IO)] ( | ||
| 261 | module_info_get_name(!.ModuleInfo, ModuleName), | ||
| 262 | get_progress_output_stream(Globals, ModuleName, | ||
| 263 | ProgressStream, !IO), | ||
| 264 | PredStr = pred_id_to_string(!.ModuleInfo, PredId), | ||
| 265 | io.format(ProgressStream, | ||
| 266 | "%% Accumulators introduced into %s\n", [s(PredStr)], !IO) | ||
| 267 | ) | ||
| 268 | ; | ||
| 269 | VeryVerbose = no | ||
| 270 | ), | ||
| 271 | |||
| 272 | ( | ||
| 273 | Warnings = [] | ||
| 274 | ; | ||
| 275 | Warnings = [_ | _], | ||
| 276 | pred_info_get_context(PredInfo, Context), | ||
| 277 | PredPieces = describe_one_pred_name(!.ModuleInfo, | ||
| 278 | should_module_qualify, PredId), | ||
| 279 | InPieces = [words("In") | PredPieces] ++ [suffix(":"), nl], | ||
| 280 | InMsg = simple_msg(Context, | ||
| 281 | [option_is_set(warn_accumulator_swaps, yes, | ||
| 282 | [always(InPieces)])]), | ||
| 283 | |||
| 284 | proc_info_get_varset(!.ProcInfo, VarSet), | ||
| 285 | generate_warnings(!.ModuleInfo, VarSet, Warnings, WarnMsgs), | ||
| 286 | ( | ||
| 287 | Warnings = [_], | ||
| 288 | EnsurePieces = [words("Please ensure that this"), | ||
| 289 | words("argument rearrangement does not introduce"), | ||
| 290 | words("performance problems.")] | ||
| 291 | ; | ||
| 292 | Warnings = [_, _ | _], | ||
| 293 | EnsurePieces = [words("Please ensure that these"), | ||
| 294 | words("argument rearrangements do not introduce"), | ||
| 295 | words("performance problems.")] | ||
| 296 | ), | ||
| 297 | SuppressPieces = | ||
| 298 | [words("These warnings can be suppressed by"), | ||
| 299 | quote("--no-warn-accumulator-swaps"), suffix(".")], | ||
| 300 | VerbosePieces = [words("If a predicate has been declared"), | ||
| 301 | words("associative"), | ||
| 302 | words("via a"), quote("promise"), words("declaration,"), | ||
| 303 | words("the compiler will rearrange the order of"), | ||
| 304 | words("the arguments in calls to that predicate,"), | ||
| 305 | words("if by so doing it makes the containing predicate"), | ||
| 306 | words("tail recursive. In such situations, the compiler"), | ||
| 307 | words("will issue this warning. If this reordering"), | ||
| 308 | words("changes the performance characteristics"), | ||
| 309 | words("of the call to the predicate, use"), | ||
| 310 | quote("--no-accumulator-introduction"), | ||
| 311 | words("to turn the optimization off, or "), | ||
| 312 | quote("--no-warn-accumulator-swaps"), | ||
| 313 | words("to turn off the warnings.")], | ||
| 314 | EnsureSuppressMsg = simple_msg(Context, | ||
| 315 | [option_is_set(warn_accumulator_swaps, yes, | ||
| 316 | [always(EnsurePieces), always(SuppressPieces)]), | ||
| 317 | verbose_only(verbose_once, VerbosePieces)]), | ||
| 318 | Severity = severity_conditional(warn_accumulator_swaps, yes, | ||
| 319 | severity_warning, no), | ||
| 320 | Msgs = [InMsg | WarnMsgs] ++ [EnsureSuppressMsg], | ||
| 321 | Spec = error_spec($pred, Severity, phase_accumulator_intro, Msgs), | ||
| 322 | |||
| 323 | det_univ_to_type(!.Cookie, Specs0), | ||
| 324 | Specs = [Spec | Specs0], | ||
| 325 | type_to_univ(Specs, !:Cookie) | ||
| 326 | ) | ||
| 327 | else | ||
| 328 | true | ||
| 329 | ). | ||
| 330 | |||
| 331 | %---------------------------------------------------------------------------% | ||
| 332 | %---------------------------------------------------------------------------% | ||
| 333 | |||
| 334 | :- pred generate_warnings(module_info::in, prog_varset::in, | ||
| 335 | list(accu_warning)::in, list(error_msg)::out) is det. | ||
| 336 | |||
| 337 | generate_warnings(_, _, [], []). | ||
| 338 | generate_warnings(ModuleInfo, VarSet, [Warning | Warnings], [Msg | Msgs]) :- | ||
| 339 | generate_warning(ModuleInfo, VarSet, Warning, Msg), | ||
| 340 | generate_warnings(ModuleInfo, VarSet, Warnings, Msgs). | ||
| 341 | |||
| 342 | :- pred generate_warning(module_info::in, prog_varset::in, accu_warning::in, | ||
| 343 | error_msg::out) is det. | ||
| 344 | |||
| 345 | generate_warning(ModuleInfo, VarSet, Warning, Msg) :- | ||
| 346 | Warning = accu_warn(Context, PredId, VarA, VarB), | ||
| 347 | PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify, | ||
| 348 | PredId), | ||
| 349 | |||
| 350 | varset.lookup_name(VarSet, VarA, VarAName), | ||
| 351 | varset.lookup_name(VarSet, VarB, VarBName), | ||
| 352 | |||
| 353 | Pieces = [words("warning: the call to")] ++ PredPieces ++ | ||
| 354 | [words("has had the location of the variables"), | ||
| 355 | quote(VarAName), words("and"), quote(VarBName), | ||
| 356 | words("swapped to allow accumulator introduction."), nl], | ||
| 357 | Msg = simplest_msg(Context, Pieces). | ||
| 358 | |||
| 359 | %---------------------------------------------------------------------------% | ||
| 360 | %---------------------------------------------------------------------------% | ||
| 361 | |||
| 362 | % should_attempt_accu_transform is only true iff the current proc | ||
| 363 | % has been transformed to call the newly created accumulator proc. | ||
| 364 | % | ||
| 365 | :- pred should_attempt_accu_transform(module_info::in, module_info::out, | ||
| 366 | pred_id::in, proc_id::in, pred_info::in, proc_info::in, proc_info::out, | ||
| 367 | bool::in, maybe_opt_lcmc_accumulator::in, | ||
| 368 | list(accu_warning)::out) is semidet. | ||
| 369 | |||
| 370 | should_attempt_accu_transform(!ModuleInfo, PredId, ProcId, PredInfo, | ||
| 371 | !ProcInfo, FullyStrict, DoLCMC, Warnings) :- | ||
| 372 | proc_info_get_goal(!.ProcInfo, Goal0), | ||
| 373 | proc_info_get_headvars(!.ProcInfo, HeadVars), | ||
| 374 | proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InitialInstMap), | ||
| 375 | accu_standardize(Goal0, Goal), | ||
| 376 | identify_goal_type(PredId, ProcId, Goal, InitialInstMap, | ||
| 377 | TopLevel, Base, BaseInstMap, Rec, RecInstMap), | ||
| 378 | |||
| 379 | C = initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap), | ||
| 380 | identify_recursive_calls(PredId, ProcId, C, RecCallIds), | ||
| 381 | list.length(Rec, M), | ||
| 382 | |||
| 383 | should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, !ProcInfo, | ||
| 384 | HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC, | ||
| 385 | RecCallIds, C, M, Rec, Warnings). | ||
| 386 | |||
| 387 | % should_attempt_accu_transform_2 takes a list of locations of the | ||
| 388 | % recursive calls, and attempts to introduce accumulator into each of the | ||
| 389 | % recursive calls, stopping at the first one that succeeds. | ||
| 390 | % This catches the following case, as selecting the first recursive call | ||
| 391 | % allows the second recursive call to be moved before it, and | ||
| 392 | % OutA is in the correct spot in list.append. | ||
| 393 | % | ||
| 394 | % p(InA, OutA), | ||
| 395 | % p(InB, OutB), | ||
| 396 | % list.append(OutB, OutA, Out) | ||
| 397 | % | ||
| 398 | :- pred should_attempt_accu_transform_2(module_info::in, module_info::out, | ||
| 399 | pred_id::in, pred_info::in, proc_info::in, proc_info::out, | ||
| 400 | list(prog_var)::in, instmap::in, top_level::in, bool::in, | ||
| 401 | maybe_opt_lcmc_accumulator::in, | ||
| 402 | list(accu_goal_id)::in, accu_goal_store::in, int::in, list(hlds_goal)::in, | ||
| 403 | list(accu_warning)::out) is semidet. | ||
| 404 | |||
| 405 | should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, !ProcInfo, | ||
| 406 | HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC, | ||
| 407 | [Id | Ids], C, M, Rec, Warnings) :- | ||
| 408 | proc_info_get_vartypes(!.ProcInfo, VarTypes0), | ||
| 409 | identify_out_and_out_prime(!.ModuleInfo, VarTypes0, InitialInstMap, | ||
| 410 | Id, Rec, HeadVars, Out, OutPrime, HeadToCallSubst, CallToHeadSubst), | ||
| 411 | ( if | ||
| 412 | accu_stage1(!.ModuleInfo, VarTypes0, FullyStrict, DoLCMC, Id, M, C, | ||
| 413 | Sets), | ||
| 414 | accu_stage2(!.ModuleInfo, !.ProcInfo, Id, C, Sets, OutPrime, Out, | ||
| 415 | VarSet, VarTypes, Accs, BaseCase, BasePairs, Substs, CS, | ||
| 416 | WarningsPrime), | ||
| 417 | accu_stage3(Id, Accs, VarSet, VarTypes, C, CS, Substs, | ||
| 418 | HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, Out, | ||
| 419 | TopLevel, PredId, PredInfo, !ProcInfo, !ModuleInfo) | ||
| 420 | then | ||
| 421 | Warnings = WarningsPrime | ||
| 422 | else | ||
| 423 | should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, | ||
| 424 | !ProcInfo, HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC, | ||
| 425 | Ids, C, M, Rec, Warnings) | ||
| 426 | ). | ||
| 427 | |||
| 428 | %---------------------------------------------------------------------------% | ||
| 429 | %---------------------------------------------------------------------------% | ||
| 430 | |||
| 431 | % Transform the goal into a standard form that is amenable to | ||
| 432 | % introducing accumulators. | ||
| 433 | % | ||
| 434 | % At the moment all this does is remove any extra disj/conj wrappers | ||
| 435 | % around the top level goal. | ||
| 436 | % | ||
| 437 | % Future work is for this code to rearrange code with multiple base | ||
| 438 | % and recursive cases into a single base and recursive case. | ||
| 439 | % | ||
| 440 | :- pred accu_standardize(hlds_goal::in, hlds_goal::out) is det. | ||
| 441 | |||
| 442 | accu_standardize(Goal0, Goal) :- | ||
| 443 | ( if | ||
| 444 | Goal0 = hlds_goal(GoalExpr0, _), | ||
| 445 | ( | ||
| 446 | GoalExpr0 = conj(plain_conj, [Goal1]) | ||
| 447 | ; | ||
| 448 | GoalExpr0 = disj([Goal1]) | ||
| 449 | ) | ||
| 450 | then | ||
| 451 | accu_standardize(Goal1, Goal) | ||
| 452 | else | ||
| 453 | Goal = Goal0 | ||
| 454 | ). | ||
| 455 | |||
| 456 | %---------------------------------------------------------------------------% | ||
| 457 | %---------------------------------------------------------------------------% | ||
| 458 | |||
| 459 | % This predicate takes the original goal and identifies the `shape' | ||
| 460 | % of the goal around the recursive and base cases. | ||
| 461 | % | ||
| 462 | % Note that the base case can contain a recursive call, as the | ||
| 463 | % transformation doesn't depend on what is in the base case. | ||
| 464 | % | ||
| 465 | :- pred identify_goal_type(pred_id::in, proc_id::in, hlds_goal::in, | ||
| 466 | instmap::in, top_level::out, list(hlds_goal)::out, instmap::out, | ||
| 467 | list(hlds_goal)::out, instmap::out) is semidet. | ||
| 468 | |||
| 469 | identify_goal_type(PredId, ProcId, Goal, InitialInstMap, Type, | ||
| 470 | Base, BaseInstMap, Rec, RecInstMap) :- | ||
| 471 | Goal = hlds_goal(GoalExpr, _GoalInfo), | ||
| 472 | ( | ||
| 473 | GoalExpr = switch(_Var, _CanFail, Cases), | ||
| 474 | ( if | ||
| 475 | Cases = [case(_IdA, [], GoalA), case(_IdB, [], GoalB)], | ||
| 476 | goal_to_conj_list(GoalA, GoalAList), | ||
| 477 | goal_to_conj_list(GoalB, GoalBList) | ||
| 478 | then | ||
| 479 | ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then | ||
| 480 | Type = switch_rec_base, | ||
| 481 | Base = GoalBList, | ||
| 482 | Rec = GoalAList | ||
| 483 | else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then | ||
| 484 | Type = switch_base_rec, | ||
| 485 | Base = GoalAList, | ||
| 486 | Rec = GoalBList | ||
| 487 | else | ||
| 488 | fail | ||
| 489 | ), | ||
| 490 | BaseInstMap = InitialInstMap, | ||
| 491 | RecInstMap = InitialInstMap | ||
| 492 | else | ||
| 493 | fail | ||
| 494 | ) | ||
| 495 | ; | ||
| 496 | GoalExpr = disj(Goals), | ||
| 497 | ( if | ||
| 498 | Goals = [GoalA, GoalB], | ||
| 499 | goal_to_conj_list(GoalA, GoalAList), | ||
| 500 | goal_to_conj_list(GoalB, GoalBList) | ||
| 501 | then | ||
| 502 | ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then | ||
| 503 | Type = disj_rec_base, | ||
| 504 | Base = GoalBList, | ||
| 505 | Rec = GoalAList | ||
| 506 | else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then | ||
| 507 | Type = disj_base_rec, | ||
| 508 | Base = GoalAList, | ||
| 509 | Rec = GoalBList | ||
| 510 | else | ||
| 511 | fail | ||
| 512 | ), | ||
| 513 | BaseInstMap = InitialInstMap, | ||
| 514 | RecInstMap = InitialInstMap | ||
| 515 | else | ||
| 516 | fail | ||
| 517 | ) | ||
| 518 | ; | ||
| 519 | GoalExpr = if_then_else(_Vars, Cond, Then, Else), | ||
| 520 | Cond = hlds_goal(_CondGoalExpr, CondGoalInfo), | ||
| 521 | CondInstMapDelta = goal_info_get_instmap_delta(CondGoalInfo), | ||
| 522 | |||
| 523 | goal_to_conj_list(Then, GoalAList), | ||
| 524 | goal_to_conj_list(Else, GoalBList), | ||
| 525 | ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then | ||
| 526 | Type = ite_rec_base, | ||
| 527 | Base = GoalBList, | ||
| 528 | Rec = GoalAList, | ||
| 529 | |||
| 530 | BaseInstMap = InitialInstMap, | ||
| 531 | apply_instmap_delta(CondInstMapDelta, InitialInstMap, RecInstMap) | ||
| 532 | else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then | ||
| 533 | Type = ite_base_rec, | ||
| 534 | Base = GoalAList, | ||
| 535 | Rec = GoalBList, | ||
| 536 | |||
| 537 | RecInstMap = InitialInstMap, | ||
| 538 | apply_instmap_delta(CondInstMapDelta, InitialInstMap, BaseInstMap) | ||
| 539 | else | ||
| 540 | fail | ||
| 541 | ) | ||
| 542 | ). | ||
| 543 | |||
| 544 | % is_recursive_case(Gs, Id) is true iff the list of goals, Gs, | ||
| 545 | % contains a call to the procedure specified by Id, where the call | ||
| 546 | % is located in a position that can be used by the transformation | ||
| 547 | % (i.e. not hidden in a compound goal). | ||
| 548 | % | ||
| 549 | :- pred is_recursive_case(list(hlds_goal)::in, pred_proc_id::in) is semidet. | ||
| 550 | |||
| 551 | is_recursive_case(Goals, proc(PredId, ProcId)) :- | ||
| 552 | list.append(_Initial, [RecursiveCall | _Final], Goals), | ||
| 553 | RecursiveCall = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _). | ||
| 554 | |||
| 555 | %---------------------------------------------------------------------------% | ||
| 556 | %---------------------------------------------------------------------------% | ||
| 557 | |||
| 558 | % The store info is folded over the list of goals which | ||
| 559 | % represent the base and recursive case conjunctions. | ||
| 560 | :- type store_info | ||
| 561 | ---> store_info( | ||
| 562 | store_loc :: int, | ||
| 563 | % The location of the goal in the conjunction. | ||
| 564 | store_instmap :: instmap, | ||
| 565 | store_goals :: accu_goal_store | ||
| 566 | ). | ||
| 567 | |||
| 568 | % Initialise the goal_store, which will hold the C_{a,b} goals. | ||
| 569 | % | ||
| 570 | :- func initialize_goal_store(list(hlds_goal), instmap, | ||
| 571 | list(hlds_goal), instmap) = accu_goal_store. | ||
| 572 | |||
| 573 | initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap) = C :- | ||
| 574 | goal_store_init(C0), | ||
| 575 | list.foldl3(accu_store(accu_rec), Rec, | ||
| 576 | 1, _, RecInstMap, _, C0, C1), | ||
| 577 | list.foldl3(accu_store(accu_base), Base, | ||
| 578 | 1, _, BaseInstMap, _, C1, C). | ||
| 579 | |||
| 580 | :- pred accu_store(accu_case::in, hlds_goal::in, | ||
| 581 | int::in, int::out, instmap::in, instmap::out, | ||
| 582 | accu_goal_store::in, accu_goal_store::out) is det. | ||
| 583 | |||
| 584 | accu_store(Case, Goal, !N, !InstMap, !GoalStore) :- | ||
| 585 | Id = accu_goal_id(Case, !.N), | ||
| 586 | goal_store_det_insert(Id, stored_goal(Goal, !.InstMap), !GoalStore), | ||
| 587 | |||
| 588 | !:N = !.N + 1, | ||
| 589 | Goal = hlds_goal(_, GoalInfo), | ||
| 590 | InstMapDelta = goal_info_get_instmap_delta(GoalInfo), | ||
| 591 | apply_instmap_delta(InstMapDelta, !InstMap). | ||
| 592 | |||
| 593 | %---------------------------------------------------------------------------% | ||
| 594 | %---------------------------------------------------------------------------% | ||
| 595 | |||
| 596 | % Determine the k's which are recursive calls. | ||
| 597 | % Note that this doesn't find recursive calls which are `hidden' | ||
| 598 | % in compound goals, this is not a problem as currently we can't use | ||
| 599 | % these to do transformation. | ||
| 600 | % | ||
| 601 | :- pred identify_recursive_calls(pred_id::in, proc_id::in, | ||
| 602 | accu_goal_store::in, list(accu_goal_id)::out) is det. | ||
| 603 | |||
| 604 | identify_recursive_calls(PredId, ProcId, GoalStore, Ids) :- | ||
| 605 | P = | ||
| 606 | ( pred(Key::out) is nondet :- | ||
| 607 | goal_store_member(GoalStore, Key, stored_goal(Goal, _InstMap)), | ||
| 608 | Key = accu_goal_id(accu_rec, _), | ||
| 609 | Goal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _) | ||
| 610 | ), | ||
| 611 | solutions.solutions(P, Ids). | ||
| 612 | |||
| 613 | %---------------------------------------------------------------------------% | ||
| 614 | %---------------------------------------------------------------------------% | ||
| 615 | |||
| 616 | % Determine the variables which are members of the sets Out and Out', | ||
| 617 | % and initialize the substitutions between the two sets. | ||
| 618 | % | ||
| 619 | % This is done by identifing those variables whose instantiatedness change | ||
| 620 | % in the goals after the recursive call and are headvars. | ||
| 621 | % | ||
| 622 | % Note that we are only identifying the output variables which will need | ||
| 623 | % to be accumulated, as there may be other output variables which are | ||
| 624 | % produced prior to the recursive call. | ||
| 625 | % | ||
| 626 | :- pred identify_out_and_out_prime(module_info::in, vartypes::in, instmap::in, | ||
| 627 | accu_goal_id::in, list(hlds_goal)::in, | ||
| 628 | list(prog_var)::in, list(prog_var)::out, list(prog_var)::out, | ||
| 629 | accu_subst::out, accu_subst::out) is det. | ||
| 630 | |||
| 631 | identify_out_and_out_prime(ModuleInfo, VarTypes, InitialInstMap, GoalId, | ||
| 632 | Rec, HeadVars, Out, OutPrime, HeadToCallSubst, CallToHeadSubst) :- | ||
| 633 | GoalId = accu_goal_id(_Case, K), | ||
| 634 | ( if | ||
| 635 | list.take(K, Rec, InitialGoals), | ||
| 636 | list.drop(K-1, Rec, FinalGoals), | ||
| 637 | FinalGoals = [hlds_goal(plain_call(_, _, Args, _, _, _), _) | Rest] | ||
| 638 | then | ||
| 639 | goal_list_instmap_delta(InitialGoals, InitInstMapDelta), | ||
| 640 | apply_instmap_delta( InitInstMapDelta, | ||
| 641 | InitialInstMap, InstMapBeforeRest), | ||
| 642 | |||
| 643 | goal_list_instmap_delta(Rest, InstMapDelta), | ||
| 644 | apply_instmap_delta(InstMapDelta, InstMapBeforeRest, InstMapAfterRest), | ||
| 645 | |||
| 646 | instmap_changed_vars(ModuleInfo, VarTypes, | ||
| 647 | InstMapBeforeRest, InstMapAfterRest, ChangedVars), | ||
| 648 | |||
| 649 | assoc_list.from_corresponding_lists(HeadVars, Args, HeadArg0), | ||
| 650 | |||
| 651 | Member = | ||
| 652 | ( pred(M::in) is semidet :- | ||
| 653 | M = HeadVar - _, | ||
| 654 | set_of_var.member(ChangedVars, HeadVar) | ||
| 655 | ), | ||
| 656 | list.filter(Member, HeadArg0, HeadArg), | ||
| 657 | list.map(fst, HeadArg, Out), | ||
| 658 | list.map(snd, HeadArg, OutPrime), | ||
| 659 | |||
| 660 | map.from_assoc_list(HeadArg, HeadToCallSubst), | ||
| 661 | |||
| 662 | list.map((pred(X-Y::in, Y-X::out) is det), HeadArg, ArgHead), | ||
| 663 | map.from_assoc_list(ArgHead, CallToHeadSubst) | ||
| 664 | else | ||
| 665 | unexpected($pred, "test failed") | ||
| 666 | ). | ||
| 667 | |||
| 668 | %---------------------------------------------------------------------------% | ||
| 669 | %---------------------------------------------------------------------------% | ||
| 670 | |||
| 671 | % For each goal after the recursive call, we place that goal | ||
| 672 | % into a set according to what properties that goal has. | ||
| 673 | % For the definition of what goes into each set, inspect the documentation | ||
| 674 | % for the functions named before, assoc, and so on. | ||
| 675 | % | ||
| 676 | :- type accu_sets | ||
| 677 | ---> accu_sets( | ||
| 678 | as_before :: set(accu_goal_id), | ||
| 679 | as_assoc :: set(accu_goal_id), | ||
| 680 | as_construct_assoc :: set(accu_goal_id), | ||
| 681 | as_construct :: set(accu_goal_id), | ||
| 682 | as_update :: set(accu_goal_id), | ||
| 683 | as_reject :: set(accu_goal_id) | ||
| 684 | ). | ||
| 685 | |||
| 686 | % Stage 1 is responsible for identifying which goals are associative, | ||
| 687 | % which can be moved before the recursive call and so on. | ||
| 688 | % | ||
| 689 | :- pred accu_stage1(module_info::in, vartypes::in, bool::in, | ||
| 690 | maybe_opt_lcmc_accumulator::in, accu_goal_id::in, int::in, | ||
| 691 | accu_goal_store::in, accu_sets::out) is semidet. | ||
| 692 | |||
| 693 | accu_stage1(ModuleInfo, VarTypes, FullyStrict, DoLCMC, GoalId, M, GoalStore, | ||
| 694 | Sets) :- | ||
| 695 | GoalId = accu_goal_id(Case, K), | ||
| 696 | NextGoalId = accu_goal_id(Case, K + 1), | ||
| 697 | accu_sets_init(Sets0), | ||
| 698 | accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, | ||
| 699 | GoalStore, Sets0, Sets1), | ||
| 700 | Sets1 = accu_sets(Before, Assoc, | ||
| 701 | ConstructAssoc, Construct, Update, Reject), | ||
| 702 | Sets = accu_sets(Before `set.union` set_upto(Case, K - 1), Assoc, | ||
| 703 | ConstructAssoc, Construct, Update, Reject), | ||
| 704 | |||
| 705 | % Continue the transformation only if the set reject is empty and | ||
| 706 | % the set assoc or update contains something that needs to be moved | ||
| 707 | % before the recursive call. | ||
| 708 | set.is_empty(Reject), | ||
| 709 | ( | ||
| 710 | not set.is_empty(Assoc) | ||
| 711 | ; | ||
| 712 | not set.is_empty(Update) | ||
| 713 | ), | ||
| 714 | ( | ||
| 715 | DoLCMC = do_not_opt_lcmc_accumulator, | ||
| 716 | % If LCMC is not turned on, then there must be no construction | ||
| 717 | % unifications after the recursive call. | ||
| 718 | set.is_empty(Construct), | ||
| 719 | set.is_empty(ConstructAssoc) | ||
| 720 | ; | ||
| 721 | DoLCMC = opt_lcmc_accumulator | ||
| 722 | ). | ||
| 723 | |||
| 724 | % For each goal after the recursive call decide which set | ||
| 725 | % the goal belongs to. | ||
| 726 | % | ||
| 727 | :- pred accu_stage1_2(module_info::in, vartypes::in, bool::in, | ||
| 728 | accu_goal_id::in, int::in, int::in, accu_goal_store::in, | ||
| 729 | accu_sets::in, accu_sets::out) is det. | ||
| 730 | |||
| 731 | accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, GoalId, K, M, GoalStore, | ||
| 732 | !Sets) :- | ||
| 733 | GoalId = accu_goal_id(Case, I), | ||
| 734 | NextGoalId = accu_goal_id(Case, I + 1), | ||
| 735 | ( if I > M then | ||
| 736 | true | ||
| 737 | else | ||
| 738 | ( if | ||
| 739 | accu_before(ModuleInfo, VarTypes, FullyStrict, GoalId, K, | ||
| 740 | GoalStore, !.Sets) | ||
| 741 | then | ||
| 742 | !Sets ^ as_before := set.insert(!.Sets ^ as_before, GoalId), | ||
| 743 | accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, | ||
| 744 | GoalStore, !Sets) | ||
| 745 | else if | ||
| 746 | accu_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K, | ||
| 747 | GoalStore, !.Sets) | ||
| 748 | then | ||
| 749 | !Sets ^ as_assoc := set.insert(!.Sets ^ as_assoc, GoalId), | ||
| 750 | accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, | ||
| 751 | GoalStore, !Sets) | ||
| 752 | else if | ||
| 753 | accu_construct(ModuleInfo, VarTypes, FullyStrict, GoalId, K, | ||
| 754 | GoalStore, !.Sets) | ||
| 755 | then | ||
| 756 | !Sets ^ as_construct := set.insert(!.Sets ^ as_construct, GoalId), | ||
| 757 | accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, | ||
| 758 | GoalStore, !Sets) | ||
| 759 | else if | ||
| 760 | accu_construct_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K, | ||
| 761 | GoalStore, !.Sets) | ||
| 762 | then | ||
| 763 | !Sets ^ as_construct_assoc := | ||
| 764 | set.insert(!.Sets ^ as_construct_assoc, GoalId), | ||
| 765 | accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, | ||
| 766 | GoalStore, !Sets) | ||
| 767 | else if | ||
| 768 | accu_update(ModuleInfo, VarTypes, FullyStrict, GoalId, K, | ||
| 769 | GoalStore, !.Sets) | ||
| 770 | then | ||
| 771 | !Sets ^ as_update := set.insert(!.Sets ^ as_update, GoalId), | ||
| 772 | accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, | ||
| 773 | GoalStore, !Sets) | ||
| 774 | else | ||
| 775 | !Sets ^ as_reject := set.insert(!.Sets ^ as_reject, GoalId) | ||
| 776 | ) | ||
| 777 | ). | ||
| 778 | |||
| 779 | %---------------------------------------------------------------------------% | ||
| 780 | |||
| 781 | :- pred accu_sets_init(accu_sets::out) is det. | ||
| 782 | |||
| 783 | accu_sets_init(Sets) :- | ||
| 784 | set.init(EmptySet), | ||
| 785 | Before = EmptySet, | ||
| 786 | Assoc = EmptySet, | ||
| 787 | ConstructAssoc = EmptySet, | ||
| 788 | Construct = EmptySet, | ||
| 789 | Update = EmptySet, | ||
| 790 | Reject = EmptySet, | ||
| 791 | Sets = accu_sets(Before, Assoc, ConstructAssoc, Construct, Update, Reject). | ||
| 792 | |||
| 793 | % set_upto(Case, K) returns the set | ||
| 794 | % {accu_goal_id(Case, 1) .. accu_goal_id(Case, K)}. | ||
| 795 | % | ||
| 796 | :- func set_upto(accu_case, int) = set(accu_goal_id). | ||
| 797 | |||
| 798 | set_upto(Case, K) = Set :- | ||
| 799 | ( if K =< 0 then | ||
| 800 | set.init(Set) | ||
| 801 | else | ||
| 802 | Set0 = set_upto(Case, K - 1), | ||
| 803 | set.insert(accu_goal_id(Case, K), Set0, Set) | ||
| 804 | ). | ||
| 805 | |||
| 806 | %---------------------------------------------------------------------------% | ||
| 807 | |||
| 808 | % A goal is a member of the before set iff the goal only depends on goals | ||
| 809 | % which are before the recursive call or can be moved before the recursive | ||
| 810 | % call (member of the before set). | ||
| 811 | % | ||
| 812 | :- pred accu_before(module_info::in, vartypes::in, bool::in, | ||
| 813 | accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. | ||
| 814 | |||
| 815 | accu_before(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :- | ||
| 816 | GoalId = accu_goal_id(Case, _I), | ||
| 817 | Before = Sets ^ as_before, | ||
| 818 | goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), | ||
| 819 | ( | ||
| 820 | member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, | ||
| 821 | stored_goal(EarlierGoal, EarlierInstMap)), | ||
| 822 | not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, | ||
| 823 | EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) | ||
| 824 | ) | ||
| 825 | => | ||
| 826 | ( | ||
| 827 | set.member(LessThanGoalId, set_upto(Case, K - 1) `union` Before) | ||
| 828 | ). | ||
| 829 | |||
| 830 | % A goal is a member of the assoc set iff the goal only depends on goals | ||
| 831 | % upto and including the recursive call and goals which can be moved | ||
| 832 | % before the recursive call (member of the before set) AND the goal | ||
| 833 | % is associative. | ||
| 834 | % | ||
| 835 | :- pred accu_assoc(module_info::in, vartypes::in, bool::in, | ||
| 836 | accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. | ||
| 837 | |||
| 838 | accu_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :- | ||
| 839 | GoalId = accu_goal_id(Case, _I), | ||
| 840 | Before = Sets ^ as_before, | ||
| 841 | goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), | ||
| 842 | LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _), | ||
| 843 | accu_is_associative(ModuleInfo, PredId, Args, _), | ||
| 844 | ( | ||
| 845 | % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. | ||
| 846 | % See the diff with the previous version. | ||
| 847 | member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, | ||
| 848 | stored_goal(EarlierGoal, EarlierInstMap)), | ||
| 849 | not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, | ||
| 850 | EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) | ||
| 851 | ) | ||
| 852 | => | ||
| 853 | ( | ||
| 854 | set.member(LessThanGoalId, set_upto(Case, K) `union` Before) | ||
| 855 | ). | ||
| 856 | |||
| 857 | % A goal is a member of the construct set iff the goal only depends | ||
| 858 | % on goals upto and including the recursive call and goals which | ||
| 859 | % can be moved before the recursive call (member of the before set) | ||
| 860 | % AND the goal is construction unification. | ||
| 861 | % | ||
| 862 | :- pred accu_construct(module_info::in, vartypes::in, bool::in, | ||
| 863 | accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. | ||
| 864 | |||
| 865 | accu_construct(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, | ||
| 866 | Sets) :- | ||
| 867 | GoalId = accu_goal_id(Case, _I), | ||
| 868 | Before = Sets ^ as_before, | ||
| 869 | Construct = Sets ^ as_construct, | ||
| 870 | goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), | ||
| 871 | LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo), | ||
| 872 | Unify = construct(_, _, _, _, _, _, _), | ||
| 873 | ( | ||
| 874 | % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. | ||
| 875 | % See the diff with the previous version. | ||
| 876 | member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, | ||
| 877 | stored_goal(EarlierGoal, EarlierInstMap)), | ||
| 878 | not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, | ||
| 879 | EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) | ||
| 880 | ) | ||
| 881 | => | ||
| 882 | ( | ||
| 883 | set.member(LessThanGoalId, | ||
| 884 | set_upto(Case, K) `union` Before `union` Construct) | ||
| 885 | ). | ||
| 886 | |||
| 887 | % A goal is a member of the construct_assoc set iff the goal depends only | ||
| 888 | % on goals upto and including the recursive call and goals which can be | ||
| 889 | % moved before the recursive call (member of the before set) and goals | ||
| 890 | % which are associative AND the goal is construction unification AND | ||
| 891 | % there is only one member of the assoc set which the construction | ||
| 892 | % unification depends on AND the construction unification can be expressed | ||
| 893 | % as a call to the member of the assoc set which the construction | ||
| 894 | % unification depends on. | ||
| 895 | % | ||
| 896 | :- pred accu_construct_assoc(module_info::in, vartypes::in, bool::in, | ||
| 897 | accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. | ||
| 898 | |||
| 899 | accu_construct_assoc(ModuleInfo, VarTypes, FullyStrict, | ||
| 900 | GoalId, K, GoalStore, Sets) :- | ||
| 901 | GoalId = accu_goal_id(Case, _I), | ||
| 902 | Before = Sets ^ as_before, | ||
| 903 | Assoc = Sets ^ as_assoc, | ||
| 904 | ConstructAssoc = Sets ^ as_construct_assoc, | ||
| 905 | goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), | ||
| 906 | LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo), | ||
| 907 | Unify = construct(_, ConsId, _, _, _, _, _), | ||
| 908 | |||
| 909 | goal_store_all_ancestors(GoalStore, GoalId, VarTypes, ModuleInfo, | ||
| 910 | FullyStrict, Ancestors), | ||
| 911 | |||
| 912 | set.is_singleton(Assoc `intersect` Ancestors, AssocId), | ||
| 913 | goal_store_lookup(GoalStore, AssocId, | ||
| 914 | stored_goal(AssocGoal, _AssocInstMap)), | ||
| 915 | AssocGoal = hlds_goal(plain_call(PredId, _, _, _, _, _), _), | ||
| 916 | |||
| 917 | is_associative_construction(ModuleInfo, PredId, ConsId), | ||
| 918 | ( | ||
| 919 | % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. | ||
| 920 | % See the diff with the previous version. | ||
| 921 | member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, | ||
| 922 | stored_goal(EarlierGoal, EarlierInstMap)), | ||
| 923 | not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, | ||
| 924 | EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) | ||
| 925 | ) | ||
| 926 | => | ||
| 927 | ( | ||
| 928 | set.member(LessThanGoalId, | ||
| 929 | set_upto(Case, K) `union` Before `union` Assoc | ||
| 930 | `union` ConstructAssoc) | ||
| 931 | ). | ||
| 932 | |||
| 933 | % A goal is a member of the update set iff the goal only depends | ||
| 934 | % on goals upto and including the recursive call and goals which | ||
| 935 | % can be moved before the recursive call (member of the before set) | ||
| 936 | % AND the goal updates some state. | ||
| 937 | % | ||
| 938 | :- pred accu_update(module_info::in, vartypes::in, bool::in, | ||
| 939 | accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. | ||
| 940 | |||
| 941 | accu_update(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :- | ||
| 942 | GoalId = accu_goal_id(Case, _I), | ||
| 943 | Before = Sets ^ as_before, | ||
| 944 | goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), | ||
| 945 | LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _), | ||
| 946 | accu_is_update(ModuleInfo, PredId, Args, _), | ||
| 947 | ( | ||
| 948 | % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. | ||
| 949 | % See the diff with the previous version. | ||
| 950 | member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, | ||
| 951 | stored_goal(EarlierGoal, EarlierInstMap)), | ||
| 952 | not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, | ||
| 953 | EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) | ||
| 954 | ) | ||
| 955 | => | ||
| 956 | ( | ||
| 957 | set.member(LessThanGoalId, set_upto(Case, K) `union` Before) | ||
| 958 | ). | ||
| 959 | |||
| 960 | % member_lessthan_goalid(GS, IdA, IdB, GB) is true iff the goal_id, IdB, | ||
| 961 | % and its associated goal, GB, is a member of the goal_store, GS, | ||
| 962 | % and IdB is less than IdA. | ||
| 963 | % | ||
| 964 | :- pred member_lessthan_goalid(accu_goal_store::in, | ||
| 965 | accu_goal_id::in, accu_goal_id::out, stored_goal::out) is nondet. | ||
| 966 | |||
| 967 | member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, LessThanGoal) :- | ||
| 968 | goal_store_member(GoalStore, LessThanGoalId, LessThanGoal), | ||
| 969 | GoalId = accu_goal_id(Case, I), | ||
| 970 | LessThanGoalId = accu_goal_id(Case, J), | ||
| 971 | J < I. | ||
| 972 | |||
| 973 | %---------------------------------------------------------------------------% | ||
| 974 | |||
| 975 | :- type accu_assoc | ||
| 976 | ---> accu_assoc( | ||
| 977 | set_of_progvar, % the associative input args | ||
| 978 | prog_var, % the corresponding output arg | ||
| 979 | bool % is the predicate commutative? | ||
| 980 | ). | ||
| 981 | |||
| 982 | % If accu_is_associative is true, it returns the two arguments which are | ||
| 983 | % associative and the variable which depends on those two arguments, | ||
| 984 | % and an indicator of whether or not the predicate is commutative. | ||
| 985 | % | ||
| 986 | :- pred accu_is_associative(module_info::in, pred_id::in, list(prog_var)::in, | ||
| 987 | accu_assoc::out) is semidet. | ||
| 988 | |||
| 989 | accu_is_associative(ModuleInfo, PredId, Args, Result) :- | ||
| 990 | module_info_pred_info(ModuleInfo, PredId, PredInfo), | ||
| 991 | pred_info_get_assertions(PredInfo, Assertions), | ||
| 992 | AssertionsList = set.to_sorted_list(Assertions), | ||
| 993 | associativity_assertion(ModuleInfo, AssertionsList, Args, | ||
| 994 | AssociativeVarsOutputVar), | ||
| 995 | ( if | ||
| 996 | commutativity_assertion(ModuleInfo, AssertionsList, Args, | ||
| 997 | _CommutativeVars) | ||
| 998 | then | ||
| 999 | IsCommutative = yes | ||
| 1000 | else | ||
| 1001 | IsCommutative = no | ||
| 1002 | ), | ||
| 1003 | AssociativeVarsOutputVar = | ||
| 1004 | associative_vars_output_var(AssociativeVars, OutputVar), | ||
| 1005 | Result = accu_assoc(AssociativeVars, OutputVar, IsCommutative). | ||
| 1006 | |||
| 1007 | % Does there exist one (and only one) associativity assertion for the | ||
| 1008 | % current predicate? | ||
| 1009 | % The 'and only one condition' is required because we currently | ||
| 1010 | % do not handle the case of predicates which have individual parts | ||
| 1011 | % which are associative, because then we do not know which variable | ||
| 1012 | % is descended from which. | ||
| 1013 | % | ||
| 1014 | :- pred associativity_assertion(module_info::in, list(assert_id)::in, | ||
| 1015 | list(prog_var)::in, associative_vars_output_var::out) is semidet. | ||
| 1016 | |||
| 1017 | associativity_assertion(ModuleInfo, [AssertId | AssertIds], Args0, | ||
| 1018 | AssociativeVarsOutputVar) :- | ||
| 1019 | ( if | ||
| 1020 | assertion.is_associativity_assertion(ModuleInfo, AssertId, | ||
| 1021 | Args0, AssociativeVarsOutputVarPrime) | ||
| 1022 | then | ||
| 1023 | AssociativeVarsOutputVar = AssociativeVarsOutputVarPrime, | ||
| 1024 | not associativity_assertion(ModuleInfo, AssertIds, Args0, _) | ||
| 1025 | else | ||
| 1026 | associativity_assertion(ModuleInfo, AssertIds, Args0, | ||
| 1027 | AssociativeVarsOutputVar) | ||
| 1028 | ). | ||
| 1029 | |||
| 1030 | % Does there exist one (and only one) commutativity assertion for the | ||
| 1031 | % current predicate? | ||
| 1032 | % The 'and only one condition' is required because we currently | ||
| 1033 | % do not handle the case of predicates which have individual | ||
| 1034 | % parts which are commutative, because then we do not know which variable | ||
| 1035 | % is descended from which. | ||
| 1036 | % | ||
| 1037 | :- pred commutativity_assertion(module_info::in,list(assert_id)::in, | ||
| 1038 | list(prog_var)::in, set_of_progvar::out) is semidet. | ||
| 1039 | |||
| 1040 | commutativity_assertion(ModuleInfo, [AssertId | AssertIds], Args0, | ||
| 1041 | CommutativeVars) :- | ||
| 1042 | ( if | ||
| 1043 | assertion.is_commutativity_assertion(ModuleInfo, AssertId, | ||
| 1044 | Args0, CommutativeVarsPrime) | ||
| 1045 | then | ||
| 1046 | CommutativeVars = CommutativeVarsPrime, | ||
| 1047 | not commutativity_assertion(ModuleInfo, AssertIds, Args0, _) | ||
| 1048 | else | ||
| 1049 | commutativity_assertion(ModuleInfo, AssertIds, Args0, | ||
| 1050 | CommutativeVars) | ||
| 1051 | ). | ||
| 1052 | |||
| 1053 | %---------------------------------------------------------------------------% | ||
| 1054 | |||
| 1055 | % Does the current predicate update some state? | ||
| 1056 | % | ||
| 1057 | :- pred accu_is_update(module_info::in, pred_id::in, list(prog_var)::in, | ||
| 1058 | state_update_vars::out) is semidet. | ||
| 1059 | |||
| 1060 | accu_is_update(ModuleInfo, PredId, Args, ResultStateVars) :- | ||
| 1061 | module_info_pred_info(ModuleInfo, PredId, PredInfo), | ||
| 1062 | pred_info_get_assertions(PredInfo, Assertions), | ||
| 1063 | list.filter_map( | ||
| 1064 | ( pred(AssertId::in, StateVars::out) is semidet :- | ||
| 1065 | assertion.is_update_assertion(ModuleInfo, AssertId, | ||
| 1066 | PredId, Args, StateVars) | ||
| 1067 | ), | ||
| 1068 | set.to_sorted_list(Assertions), Result), | ||
| 1069 | % XXX Maybe we should just match on the first result, | ||
| 1070 | % just in case there are duplicate promises. | ||
| 1071 | Result = [ResultStateVars]. | ||
| 1072 | |||
| 1073 | %---------------------------------------------------------------------------% | ||
| 1074 | |||
| 1075 | % Can the construction unification be expressed as a call to the | ||
| 1076 | % specified predicate. | ||
| 1077 | % | ||
| 1078 | :- pred is_associative_construction(module_info::in, pred_id::in, cons_id::in) | ||
| 1079 | is semidet. | ||
| 1080 | |||
| 1081 | is_associative_construction(ModuleInfo, PredId, ConsId) :- | ||
| 1082 | module_info_pred_info(ModuleInfo, PredId, PredInfo), | ||
| 1083 | pred_info_get_assertions(PredInfo, Assertions), | ||
| 1084 | list.filter( | ||
| 1085 | ( pred(AssertId::in) is semidet :- | ||
| 1086 | assertion.is_construction_equivalence_assertion(ModuleInfo, | ||
| 1087 | AssertId, ConsId, PredId) | ||
| 1088 | ), | ||
| 1089 | set.to_sorted_list(Assertions), Result), | ||
| 1090 | Result = [_ | _]. | ||
| 1091 | |||
| 1092 | %---------------------------------------------------------------------------% | ||
| 1093 | %---------------------------------------------------------------------------% | ||
| 1094 | |||
| 1095 | :- type accu_substs | ||
| 1096 | ---> accu_substs( | ||
| 1097 | acc_var_subst :: accu_subst, | ||
| 1098 | rec_call_subst :: accu_subst, | ||
| 1099 | assoc_call_subst :: accu_subst, | ||
| 1100 | update_subst :: accu_subst | ||
| 1101 | ). | ||
| 1102 | |||
| 1103 | :- type accu_base | ||
| 1104 | ---> accu_base( | ||
| 1105 | % goals which initialize update | ||
| 1106 | init_update :: set(accu_goal_id), | ||
| 1107 | |||
| 1108 | % goals which initialize assoc | ||
| 1109 | init_assoc :: set(accu_goal_id), | ||
| 1110 | |||
| 1111 | % other goals | ||
| 1112 | other :: set(accu_goal_id) | ||
| 1113 | ). | ||
| 1114 | |||
| 1115 | % Stage 2 is responsible for identifying the substitutions which | ||
| 1116 | % are needed to mimic the unfold/fold process that was used as | ||
| 1117 | % the justification of the algorithm in the paper. | ||
| 1118 | % It is also responsible for ensuring that the reordering of arguments | ||
| 1119 | % doesn't worsen the big-O complexity of the procedure. | ||
| 1120 | % It also divides the base case into goals that initialize the | ||
| 1121 | % variables used by the update goals, and those used by the assoc | ||
| 1122 | % goals and then all the rest. | ||
| 1123 | % | ||
| 1124 | :- pred accu_stage2(module_info::in, proc_info::in, | ||
| 1125 | accu_goal_id::in, accu_goal_store::in, accu_sets::in, | ||
| 1126 | list(prog_var)::in, list(prog_var)::in, prog_varset::out, vartypes::out, | ||
| 1127 | list(prog_var)::out, accu_base::out, list(pair(prog_var))::out, | ||
| 1128 | accu_substs::out, accu_goal_store::out, list(accu_warning)::out) | ||
| 1129 | is semidet. | ||
| 1130 | |||
| 1131 | accu_stage2(ModuleInfo, ProcInfo0, GoalId, GoalStore, Sets, OutPrime, Out, | ||
| 1132 | !:VarSet, !:VarTypes, Accs, BaseCase, BasePairs, !:Substs, | ||
| 1133 | CS, Warnings) :- | ||
| 1134 | Sets = accu_sets(Before0, Assoc, ConstructAssoc, Construct, Update, _), | ||
| 1135 | GoalId = accu_goal_id(Case, K), | ||
| 1136 | Before = Before0 `union` set_upto(Case, K-1), | ||
| 1137 | |||
| 1138 | % Note Update set is not placed in the after set, as the after set is used | ||
| 1139 | % to determine the variables that need to be accumulated for the | ||
| 1140 | % associative calls. | ||
| 1141 | After = Assoc `union` ConstructAssoc `union` Construct, | ||
| 1142 | |||
| 1143 | P = | ||
| 1144 | ( pred(Id::in, Set0::in, Set::out) is det :- | ||
| 1145 | goal_store_lookup(GoalStore, Id, stored_goal(Goal, _InstMap)), | ||
| 1146 | Goal = hlds_goal(_GoalExpr, GoalInfo), | ||
| 1147 | NonLocals = goal_info_get_nonlocals(GoalInfo), | ||
| 1148 | set_of_var.union(NonLocals, Set0, Set) | ||
| 1149 | ), | ||
| 1150 | list.foldl(P, set.to_sorted_list(Before), | ||
| 1151 | set_of_var.init, BeforeNonLocals), | ||
| 1152 | list.foldl(P, set.to_sorted_list(After), | ||
| 1153 | set_of_var.init, AfterNonLocals), | ||
| 1154 | InitAccs = set_of_var.intersect(BeforeNonLocals, AfterNonLocals), | ||
| 1155 | |||
| 1156 | proc_info_get_varset(ProcInfo0, !:VarSet), | ||
| 1157 | proc_info_get_vartypes(ProcInfo0, !:VarTypes), | ||
| 1158 | |||
| 1159 | accu_substs_init(set_of_var.to_sorted_list(InitAccs), !VarSet, !VarTypes, | ||
| 1160 | !:Substs), | ||
| 1161 | |||
| 1162 | set_of_var.list_to_set(OutPrime, OutPrimeSet), | ||
| 1163 | accu_process_assoc_set(ModuleInfo, GoalStore, set.to_sorted_list(Assoc), | ||
| 1164 | OutPrimeSet, !Substs, !VarSet, !VarTypes, CS, Warnings), | ||
| 1165 | |||
| 1166 | accu_process_update_set(ModuleInfo, GoalStore, set.to_sorted_list(Update), | ||
| 1167 | OutPrimeSet, !Substs, !VarSet, !VarTypes, UpdateOut, UpdateAccOut, | ||
| 1168 | BasePairs), | ||
| 1169 | |||
| 1170 | Accs = set_of_var.to_sorted_list(InitAccs) ++ UpdateAccOut, | ||
| 1171 | |||
| 1172 | accu_divide_base_case(ModuleInfo, !.VarTypes, GoalStore, UpdateOut, Out, | ||
| 1173 | UpdateBase, AssocBase, OtherBase), | ||
| 1174 | |||
| 1175 | BaseCase = accu_base(UpdateBase, AssocBase, OtherBase). | ||
| 1176 | |||
| 1177 | %---------------------------------------------------------------------------% | ||
| 1178 | |||
| 1179 | :- pred accu_substs_init(list(prog_var)::in, prog_varset::in, prog_varset::out, | ||
| 1180 | vartypes::in, vartypes::out, accu_substs::out) is det. | ||
| 1181 | |||
| 1182 | accu_substs_init(InitAccs, !VarSet, !VarTypes, Substs) :- | ||
| 1183 | map.init(Subst), | ||
| 1184 | acc_var_subst_init(InitAccs, !VarSet, !VarTypes, AccVarSubst), | ||
| 1185 | RecCallSubst = Subst, | ||
| 1186 | AssocCallSubst = Subst, | ||
| 1187 | UpdateSubst = Subst, | ||
| 1188 | Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, | ||
| 1189 | UpdateSubst). | ||
| 1190 | |||
| 1191 | % Initialise the acc_var_subst to be from Var to A_Var where Var is a | ||
| 1192 | % member of InitAccs and A_Var is a fresh variable of the same type of Var. | ||
| 1193 | % | ||
| 1194 | :- pred acc_var_subst_init(list(prog_var)::in, | ||
| 1195 | prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, | ||
| 1196 | accu_subst::out) is det. | ||
| 1197 | |||
| 1198 | acc_var_subst_init([], !VarSet, !VarTypes, map.init). | ||
| 1199 | acc_var_subst_init([Var | Vars], !VarSet, !VarTypes, Subst) :- | ||
| 1200 | create_new_var(Var, "A_", AccVar, !VarSet, !VarTypes), | ||
| 1201 | acc_var_subst_init(Vars, !VarSet, !VarTypes, Subst0), | ||
| 1202 | map.det_insert(Var, AccVar, Subst0, Subst). | ||
| 1203 | |||
| 1204 | % Create a fresh variable which is the same type as the old variable | ||
| 1205 | % and has the same name except that it begins with the prefix. | ||
| 1206 | % | ||
| 1207 | :- pred create_new_var(prog_var::in, string::in, prog_var::out, | ||
| 1208 | prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det. | ||
| 1209 | |||
| 1210 | create_new_var(OldVar, Prefix, NewVar, !VarSet, !VarTypes) :- | ||
| 1211 | varset.lookup_name(!.VarSet, OldVar, OldName), | ||
| 1212 | string.append(Prefix, OldName, NewName), | ||
| 1213 | varset.new_named_var(NewName, NewVar, !VarSet), | ||
| 1214 | lookup_var_type(!.VarTypes, OldVar, Type), | ||
| 1215 | add_var_type(NewVar, Type, !VarTypes). | ||
| 1216 | |||
| 1217 | %---------------------------------------------------------------------------% | ||
| 1218 | |||
| 1219 | % For each member of the assoc set determine the substitutions needed, | ||
| 1220 | % and also check the efficiency of the procedure isn't worsened | ||
| 1221 | % by reordering the arguments to a call. | ||
| 1222 | % | ||
| 1223 | :- pred accu_process_assoc_set(module_info::in, accu_goal_store::in, | ||
| 1224 | list(accu_goal_id)::in, set_of_progvar::in, | ||
| 1225 | accu_substs::in, accu_substs::out, | ||
| 1226 | prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, | ||
| 1227 | accu_goal_store::out, list(accu_warning)::out) is semidet. | ||
| 1228 | |||
| 1229 | accu_process_assoc_set(_ModuleInfo, _GS, [], _OutPrime, !Substs, | ||
| 1230 | !VarSet, !VarTypes, CS, []) :- | ||
| 1231 | goal_store_init(CS). | ||
| 1232 | accu_process_assoc_set(ModuleInfo, GS, [Id | Ids], OutPrime, !Substs, | ||
| 1233 | !VarSet, !VarTypes, CS, Warnings) :- | ||
| 1234 | !.Substs = accu_substs(AccVarSubst, RecCallSubst0, AssocCallSubst0, | ||
| 1235 | UpdateSubst), | ||
| 1236 | |||
| 1237 | lookup_call(GS, Id, stored_goal(Goal, InstMap)), | ||
| 1238 | |||
| 1239 | Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), GoalInfo), | ||
| 1240 | accu_is_associative(ModuleInfo, PredId, Args, AssocInfo), | ||
| 1241 | AssocInfo = accu_assoc(Vars, AssocOutput, IsCommutative), | ||
| 1242 | OutPrimeVars = set_of_var.intersect(Vars, OutPrime), | ||
| 1243 | set_of_var.is_singleton(OutPrimeVars, DuringAssocVar), | ||
| 1244 | set_of_var.is_singleton(set_of_var.difference(Vars, OutPrimeVars), | ||
| 1245 | BeforeAssocVar), | ||
| 1246 | |||
| 1247 | map.lookup(AccVarSubst, BeforeAssocVar, AccVar), | ||
| 1248 | create_new_var(BeforeAssocVar, "NewAcc_", NewAcc, !VarSet, !VarTypes), | ||
| 1249 | |||
| 1250 | map.det_insert(DuringAssocVar, AccVar, AssocCallSubst0, AssocCallSubst1), | ||
| 1251 | map.det_insert(AssocOutput, NewAcc, AssocCallSubst1, AssocCallSubst), | ||
| 1252 | map.det_insert(DuringAssocVar, AssocOutput, RecCallSubst0, RecCallSubst1), | ||
| 1253 | map.det_insert(BeforeAssocVar, NewAcc, RecCallSubst1, RecCallSubst), | ||
| 1254 | |||
| 1255 | !:Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, | ||
| 1256 | UpdateSubst), | ||
| 1257 | |||
| 1258 | % ONLY swap the order of the variables if the goal is | ||
| 1259 | % associative and not commutative. | ||
| 1260 | ( | ||
| 1261 | IsCommutative = yes, | ||
| 1262 | CSGoal = stored_goal(Goal, InstMap), | ||
| 1263 | CurWarnings = [] | ||
| 1264 | ; | ||
| 1265 | IsCommutative = no, | ||
| 1266 | |||
| 1267 | % Ensure that the reordering doesn't cause a efficiency problem. | ||
| 1268 | module_info_pred_info(ModuleInfo, PredId, PredInfo), | ||
| 1269 | ModuleName = pred_info_module(PredInfo), | ||
| 1270 | PredName = pred_info_name(PredInfo), | ||
| 1271 | Arity = pred_info_orig_arity(PredInfo), | ||
| 1272 | ( if accu_has_heuristic(ModuleName, PredName, Arity) then | ||
| 1273 | % Only do the transformation if the accumulator variable is | ||
| 1274 | % *not* in a position where it will control the running time | ||
| 1275 | % of the predicate. | ||
| 1276 | accu_heuristic(ModuleName, PredName, Arity, Args, | ||
| 1277 | PossibleDuringAssocVars), | ||
| 1278 | set_of_var.member(PossibleDuringAssocVars, DuringAssocVar), | ||
| 1279 | CurWarnings = [] | ||
| 1280 | else | ||
| 1281 | ProgContext = goal_info_get_context(GoalInfo), | ||
| 1282 | CurWarnings = [accu_warn(ProgContext, PredId, BeforeAssocVar, | ||
| 1283 | DuringAssocVar)] | ||
| 1284 | ), | ||
| 1285 | % Swap the arguments. | ||
| 1286 | [A, B] = set_of_var.to_sorted_list(Vars), | ||
| 1287 | map.from_assoc_list([A - B, B - A], Subst), | ||
| 1288 | rename_some_vars_in_goal(Subst, Goal, SwappedGoal), | ||
| 1289 | CSGoal = stored_goal(SwappedGoal, InstMap) | ||
| 1290 | ), | ||
| 1291 | |||
| 1292 | accu_process_assoc_set(ModuleInfo, GS, Ids, OutPrime, !Substs, | ||
| 1293 | !VarSet, !VarTypes, CS0, Warnings0), | ||
| 1294 | goal_store_det_insert(Id, CSGoal, CS0, CS), | ||
| 1295 | Warnings = Warnings0 ++ CurWarnings. | ||
| 1296 | |||
| 1297 | :- pred accu_has_heuristic(module_name::in, string::in, arity::in) is semidet. | ||
| 1298 | |||
| 1299 | accu_has_heuristic(unqualified("list"), "append", 3). | ||
| 1300 | |||
| 1301 | % heuristic returns the set of which head variables are important | ||
| 1302 | % in the running time of the predicate. | ||
| 1303 | % | ||
| 1304 | :- pred accu_heuristic(module_name::in, string::in, arity::in, | ||
| 1305 | list(prog_var)::in, set_of_progvar::out) is semidet. | ||
| 1306 | |||
| 1307 | accu_heuristic(unqualified("list"), "append", 3, [_Typeinfo, A, _B, _C], | ||
| 1308 | Set) :- | ||
| 1309 | set_of_var.make_singleton(A, Set). | ||
| 1310 | |||
| 1311 | %---------------------------------------------------------------------------% | ||
| 1312 | |||
| 1313 | % For each member of the update set determine the substitutions needed | ||
| 1314 | % (creating the accumulator variables when needed). | ||
| 1315 | % Also associate with each Output variable which accumulator variable | ||
| 1316 | % to get the result from. | ||
| 1317 | % | ||
| 1318 | :- pred accu_process_update_set(module_info::in, accu_goal_store::in, | ||
| 1319 | list(accu_goal_id)::in, set_of_progvar::in, | ||
| 1320 | accu_substs::in, accu_substs::out, | ||
| 1321 | prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, | ||
| 1322 | list(prog_var)::out, list(prog_var)::out, list(pair(prog_var))::out) | ||
| 1323 | is semidet. | ||
| 1324 | |||
| 1325 | accu_process_update_set(_ModuleInfo, _GS, [], _OutPrime, !Substs, | ||
| 1326 | !VarSet, !VarTypes, [], [], []). | ||
| 1327 | accu_process_update_set(ModuleInfo, GS, [Id | Ids], OutPrime, !Substs, | ||
| 1328 | !VarSet, !VarTypes, StateOutputVars, Accs, BasePairs) :- | ||
| 1329 | !.Substs = accu_substs(AccVarSubst0, RecCallSubst0, AssocCallSubst, | ||
| 1330 | UpdateSubst0), | ||
| 1331 | lookup_call(GS, Id, stored_goal(Goal, _InstMap)), | ||
| 1332 | |||
| 1333 | Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _GoalInfo), | ||
| 1334 | accu_is_update(ModuleInfo, PredId, Args, StateVars), | ||
| 1335 | StateVars = state_update_vars(StateVarA, StateVarB), | ||
| 1336 | |||
| 1337 | ( if set_of_var.member(OutPrime, StateVarA) then | ||
| 1338 | StateInputVar = StateVarA, | ||
| 1339 | StateOutputVar = StateVarB | ||
| 1340 | else | ||
| 1341 | StateInputVar = StateVarB, | ||
| 1342 | StateOutputVar = StateVarA | ||
| 1343 | ), | ||
| 1344 | |||
| 1345 | create_new_var(StateInputVar, "Acc_", Acc0, !VarSet, !VarTypes), | ||
| 1346 | create_new_var(StateOutputVar, "Acc_", Acc, !VarSet, !VarTypes), | ||
| 1347 | |||
| 1348 | map.det_insert(StateInputVar, Acc0, UpdateSubst0, UpdateSubst1), | ||
| 1349 | map.det_insert(StateOutputVar, Acc, UpdateSubst1, UpdateSubst), | ||
| 1350 | map.det_insert(StateInputVar, StateOutputVar, RecCallSubst0, RecCallSubst), | ||
| 1351 | map.det_insert(Acc, Acc0, AccVarSubst0, AccVarSubst), | ||
| 1352 | !:Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, | ||
| 1353 | UpdateSubst), | ||
| 1354 | |||
| 1355 | accu_process_update_set(ModuleInfo, GS, Ids, OutPrime, !Substs, | ||
| 1356 | !VarSet, !VarTypes, StateOutputVars0, Accs0, BasePairs0), | ||
| 1357 | |||
| 1358 | % Rather then concatenating to start of the list we concatenate to the end | ||
| 1359 | % of the list. This allows the accumulator introduction to be applied | ||
| 1360 | % as the heuristic will succeed (remember after transforming the two | ||
| 1361 | % input variables will have their order swapped, so they must be in the | ||
| 1362 | % inefficient order to start with) | ||
| 1363 | |||
| 1364 | StateOutputVars = StateOutputVars0 ++ [StateOutputVar], | ||
| 1365 | Accs = Accs0 ++ [Acc], | ||
| 1366 | BasePairs = BasePairs0 ++ [StateOutputVar - Acc0]. | ||
| 1367 | |||
| 1368 | %---------------------------------------------------------------------------% | ||
| 1369 | |||
| 1370 | % divide_base_case(UpdateOut, Out, U, A, O) is true iff given the output | ||
| 1371 | % variables which are instantiated by update goals, UpdateOut, and all | ||
| 1372 | % the variables that need to be accumulated, Out, divide the base case up | ||
| 1373 | % into three sets, those base case goals which initialize the variables | ||
| 1374 | % used by update calls, U, those which initialize variables used by | ||
| 1375 | % assoc calls, A, and the rest of the goals, O. Note that the sets | ||
| 1376 | % are not necessarily disjoint, as the result of a goal may be used | ||
| 1377 | % to initialize a variable in both U and A, so both U and A will contain | ||
| 1378 | % the same goal_id. | ||
| 1379 | % | ||
| 1380 | :- pred accu_divide_base_case(module_info::in, vartypes::in, | ||
| 1381 | accu_goal_store::in, list(prog_var)::in, list(prog_var)::in, | ||
| 1382 | set(accu_goal_id)::out, set(accu_goal_id)::out, set(accu_goal_id)::out) | ||
| 1383 | is det. | ||
| 1384 | |||
| 1385 | accu_divide_base_case(ModuleInfo, VarTypes, C, UpdateOut, Out, | ||
| 1386 | UpdateBase, AssocBase, OtherBase) :- | ||
| 1387 | list.delete_elems(Out, UpdateOut, AssocOut), | ||
| 1388 | |||
| 1389 | list.map(accu_related(ModuleInfo, VarTypes, C), UpdateOut, UpdateBaseList), | ||
| 1390 | list.map(accu_related(ModuleInfo, VarTypes, C), AssocOut, AssocBaseList), | ||
| 1391 | UpdateBase = set.power_union(set.list_to_set(UpdateBaseList)), | ||
| 1392 | AssocBase = set.power_union(set.list_to_set(AssocBaseList)), | ||
| 1393 | |||
| 1394 | Set = base_case_ids_set(C) `difference` (UpdateBase `union` AssocBase), | ||
| 1395 | set.to_sorted_list(Set, List), | ||
| 1396 | |||
| 1397 | list.map( | ||
| 1398 | ( pred(GoalId::in, Ancestors::out) is det :- | ||
| 1399 | goal_store_all_ancestors(C, GoalId, VarTypes, | ||
| 1400 | ModuleInfo, no, Ancestors) | ||
| 1401 | ), List, OtherBaseList), | ||
| 1402 | |||
| 1403 | OtherBase = set.list_to_set(List) `union` | ||
| 1404 | (base_case_ids_set(C) `intersect` | ||
| 1405 | set.power_union(set.list_to_set(OtherBaseList))). | ||
| 1406 | |||
| 1407 | % accu_related(ModuleInfo, VarTypes, GoalStore, Var, Related): | ||
| 1408 | % | ||
| 1409 | % From GoalStore, return all the goal_ids, Related, which are needed | ||
| 1410 | % to initialize Var. | ||
| 1411 | % | ||
| 1412 | :- pred accu_related(module_info::in, vartypes::in, accu_goal_store::in, | ||
| 1413 | prog_var::in, set(accu_goal_id)::out) is det. | ||
| 1414 | |||
| 1415 | accu_related(ModuleInfo, VarTypes, GoalStore, Var, Related) :- | ||
| 1416 | solutions.solutions( | ||
| 1417 | ( pred(Key::out) is nondet :- | ||
| 1418 | goal_store_member(GoalStore, Key, stored_goal(Goal, InstMap0)), | ||
| 1419 | Key = accu_goal_id(accu_base, _), | ||
| 1420 | Goal = hlds_goal(_GoalExpr, GoalInfo), | ||
| 1421 | InstMapDelta = goal_info_get_instmap_delta(GoalInfo), | ||
| 1422 | apply_instmap_delta(InstMapDelta, InstMap0, InstMap), | ||
| 1423 | instmap_changed_vars(ModuleInfo, VarTypes, | ||
| 1424 | InstMap0, InstMap, ChangedVars), | ||
| 1425 | set_of_var.is_singleton(ChangedVars, Var) | ||
| 1426 | ), Ids), | ||
| 1427 | ( | ||
| 1428 | Ids = [], | ||
| 1429 | unexpected($pred, "no Id") | ||
| 1430 | ; | ||
| 1431 | Ids = [Id], | ||
| 1432 | goal_store_all_ancestors(GoalStore, Id, VarTypes, ModuleInfo, no, | ||
| 1433 | Ancestors), | ||
| 1434 | list.filter((pred(accu_goal_id(accu_base, _)::in) is semidet), | ||
| 1435 | set.to_sorted_list(set.insert(Ancestors, Id)), RelatedList), | ||
| 1436 | Related = set.list_to_set(RelatedList) | ||
| 1437 | ; | ||
| 1438 | Ids = [_, _ | _], | ||
| 1439 | unexpected($pred, "more than one Id") | ||
| 1440 | ). | ||
| 1441 | |||
| 1442 | %---------------------------------------------------------------------------% | ||
| 1443 | |||
| 1444 | :- inst stored_goal_plain_call for goal_store.stored_goal/0 | ||
| 1445 | ---> stored_goal(goal_plain_call, ground). | ||
| 1446 | |||
| 1447 | % Do a goal_store_lookup where the result is known to be a call. | ||
| 1448 | % | ||
| 1449 | :- pred lookup_call(accu_goal_store::in, accu_goal_id::in, | ||
| 1450 | stored_goal::out(stored_goal_plain_call)) is det. | ||
| 1451 | |||
| 1452 | lookup_call(GoalStore, Id, stored_goal(Call, InstMap)) :- | ||
| 1453 | goal_store_lookup(GoalStore, Id, stored_goal(Goal, InstMap)), | ||
| 1454 | ( if | ||
| 1455 | Goal = hlds_goal(GoalExpr, GoalInfo), | ||
| 1456 | GoalExpr = plain_call(_, _, _, _, _, _) | ||
| 1457 | then | ||
| 1458 | Call = hlds_goal(GoalExpr, GoalInfo) | ||
| 1459 | else | ||
| 1460 | unexpected($pred, "not a call") | ||
| 1461 | ). | ||
| 1462 | |||
| 1463 | %---------------------------------------------------------------------------% | ||
| 1464 | %---------------------------------------------------------------------------% | ||
| 1465 | |||
| 1466 | % accu_stage3 creates the accumulator version of the predicate using | ||
| 1467 | % the substitutions determined in stage2. It also redefines the | ||
| 1468 | % original procedure to call the accumulator version of the procedure. | ||
| 1469 | % | ||
| 1470 | :- pred accu_stage3(accu_goal_id::in, list(prog_var)::in, prog_varset::in, | ||
| 1471 | vartypes::in, accu_goal_store::in, accu_goal_store::in, | ||
| 1472 | accu_substs::in, accu_subst::in, accu_subst::in, | ||
| 1473 | accu_base::in, list(pair(prog_var))::in, accu_sets::in, | ||
| 1474 | list(prog_var)::in, top_level::in, pred_id::in, pred_info::in, | ||
| 1475 | proc_info::in, proc_info::out, module_info::in, module_info::out) is det. | ||
| 1476 | |||
| 1477 | accu_stage3(RecCallId, Accs, VarSet, VarTypes, C, CS, Substs, | ||
| 1478 | HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, Out, | ||
| 1479 | TopLevel, OrigPredId, OrigPredInfo, !OrigProcInfo, !ModuleInfo) :- | ||
| 1480 | acc_proc_info(Accs, VarSet, VarTypes, Substs, !.OrigProcInfo, | ||
| 1481 | AccTypes, AccProcInfo), | ||
| 1482 | acc_pred_info(AccTypes, Out, AccProcInfo, OrigPredId, OrigPredInfo, | ||
| 1483 | AccProcId, AccPredInfo), | ||
| 1484 | AccName = unqualified(pred_info_name(AccPredInfo)), | ||
| 1485 | |||
| 1486 | module_info_get_predicate_table(!.ModuleInfo, PredTable0), | ||
| 1487 | predicate_table_insert(AccPredInfo, AccPredId, PredTable0, PredTable), | ||
| 1488 | module_info_set_predicate_table(PredTable, !ModuleInfo), | ||
| 1489 | accu_create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs, | ||
| 1490 | HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, C, CS, | ||
| 1491 | OrigBaseGoal, OrigRecGoal, AccBaseGoal, AccRecGoal), | ||
| 1492 | |||
| 1493 | proc_info_get_goal(!.OrigProcInfo, OrigGoal0), | ||
| 1494 | accu_top_level(TopLevel, OrigGoal0, OrigBaseGoal, OrigRecGoal, | ||
| 1495 | AccBaseGoal, AccRecGoal, OrigGoal, AccGoal), | ||
| 1496 | |||
| 1497 | proc_info_set_goal(OrigGoal, !OrigProcInfo), | ||
| 1498 | proc_info_set_varset(VarSet, !OrigProcInfo), | ||
| 1499 | proc_info_set_vartypes(VarTypes, !OrigProcInfo), | ||
| 1500 | |||
| 1501 | requantify_proc_general(ordinary_nonlocals_no_lambda, !OrigProcInfo), | ||
| 1502 | update_accumulator_pred(AccPredId, AccProcId, AccGoal, !ModuleInfo). | ||
| 1503 | |||
| 1504 | %---------------------------------------------------------------------------% | ||
| 1505 | |||
| 1506 | % Construct a proc_info for the introduced predicate. | ||
| 1507 | % | ||
| 1508 | :- pred acc_proc_info(list(prog_var)::in, prog_varset::in, vartypes::in, | ||
| 1509 | accu_substs::in, proc_info::in, list(mer_type)::out, proc_info::out) | ||
| 1510 | is det. | ||
| 1511 | |||
| 1512 | acc_proc_info(Accs0, VarSet, VarTypes, Substs, OrigProcInfo, | ||
| 1513 | AccTypes, AccProcInfo) :- | ||
| 1514 | % ProcInfo Stuff that must change. | ||
| 1515 | proc_info_get_headvars(OrigProcInfo, HeadVars0), | ||
| 1516 | proc_info_get_argmodes(OrigProcInfo, HeadModes0), | ||
| 1517 | |||
| 1518 | proc_info_get_inst_varset(OrigProcInfo, InstVarSet), | ||
| 1519 | proc_info_get_inferred_determinism(OrigProcInfo, Detism), | ||
| 1520 | proc_info_get_goal(OrigProcInfo, Goal), | ||
| 1521 | proc_info_get_context(OrigProcInfo, Context), | ||
| 1522 | proc_info_get_rtti_varmaps(OrigProcInfo, RttiVarMaps), | ||
| 1523 | proc_info_get_is_address_taken(OrigProcInfo, IsAddressTaken), | ||
| 1524 | proc_info_get_has_parallel_conj(OrigProcInfo, HasParallelConj), | ||
| 1525 | proc_info_get_var_name_remap(OrigProcInfo, VarNameRemap), | ||
| 1526 | |||
| 1527 | Substs = accu_substs(AccVarSubst, _RecCallSubst, _AssocCallSubst, | ||
| 1528 | _UpdateSubst), | ||
| 1529 | list.map(map.lookup(AccVarSubst), Accs0, Accs), | ||
| 1530 | |||
| 1531 | % We place the extra accumulator variables at the start, because placing | ||
| 1532 | % them at the end breaks the convention that the last variable of a | ||
| 1533 | % function is the output variable. | ||
| 1534 | HeadVars = Accs ++ HeadVars0, | ||
| 1535 | |||
| 1536 | % XXX we don't want to use the inst of the var as it can be more specific | ||
| 1537 | % than it should be. ie int_const(1) when it should be any integer. | ||
| 1538 | % However this will no longer handle partially instantiated data | ||
| 1539 | % structures. | ||
| 1540 | Inst = ground(shared, none_or_default_func), | ||
| 1541 | inst_lists_to_mode_list([Inst], [Inst], Mode), | ||
| 1542 | list.duplicate(list.length(Accs), list.det_head(Mode), AccModes), | ||
| 1543 | HeadModes = AccModes ++ HeadModes0, | ||
| 1544 | |||
| 1545 | lookup_var_types(VarTypes, Accs, AccTypes), | ||
| 1546 | |||
| 1547 | SeqNum = item_no_seq_num, | ||
| 1548 | proc_info_create(Context, SeqNum, VarSet, VarTypes, HeadVars, | ||
| 1549 | InstVarSet, HeadModes, detism_decl_none, Detism, Goal, RttiVarMaps, | ||
| 1550 | IsAddressTaken, HasParallelConj, VarNameRemap, AccProcInfo). | ||
| 1551 | |||
| 1552 | %---------------------------------------------------------------------------% | ||
| 1553 | |||
| 1554 | % Construct the pred_info for the introduced predicate. | ||
| 1555 | % | ||
| 1556 | :- pred acc_pred_info(list(mer_type)::in, list(prog_var)::in, proc_info::in, | ||
| 1557 | pred_id::in, pred_info::in, proc_id::out, pred_info::out) is det. | ||
| 1558 | |||
| 1559 | acc_pred_info(NewTypes, OutVars, NewProcInfo, OrigPredId, OrigPredInfo, | ||
| 1560 | NewProcId, NewPredInfo) :- | ||
| 1561 | % PredInfo stuff that must change. | ||
| 1562 | pred_info_get_arg_types(OrigPredInfo, TypeVarSet, ExistQVars, Types0), | ||
| 1563 | |||
| 1564 | ModuleName = pred_info_module(OrigPredInfo), | ||
| 1565 | Name = pred_info_name(OrigPredInfo), | ||
| 1566 | PredOrFunc = pred_info_is_pred_or_func(OrigPredInfo), | ||
| 1567 | pred_info_get_context(OrigPredInfo, PredContext), | ||
| 1568 | pred_info_get_markers(OrigPredInfo, Markers), | ||
| 1569 | pred_info_get_class_context(OrigPredInfo, ClassContext), | ||
| 1570 | pred_info_get_origin(OrigPredInfo, OldOrigin), | ||
| 1571 | pred_info_get_var_name_remap(OrigPredInfo, VarNameRemap), | ||
| 1572 | |||
| 1573 | set.init(Assertions), | ||
| 1574 | |||
| 1575 | proc_info_get_context(NewProcInfo, Context), | ||
| 1576 | term.context_line(Context, Line), | ||
| 1577 | Counter = 0, | ||
| 1578 | |||
| 1579 | Types = NewTypes ++ Types0, | ||
| 1580 | |||
| 1581 | make_pred_name_with_context(ModuleName, "AccFrom", PredOrFunc, Name, | ||
| 1582 | Line, Counter, SymName), | ||
| 1583 | |||
| 1584 | OutVarNums = list.map(term.var_to_int, OutVars), | ||
| 1585 | Origin = origin_transformed(transform_accumulator(OutVarNums), | ||
| 1586 | OldOrigin, OrigPredId), | ||
| 1587 | GoalType = goal_not_for_promise(np_goal_type_none), | ||
| 1588 | pred_info_create(ModuleName, SymName, PredOrFunc, PredContext, Origin, | ||
| 1589 | pred_status(status_local), Markers, Types, TypeVarSet, | ||
| 1590 | ExistQVars, ClassContext, Assertions, VarNameRemap, GoalType, | ||
| 1591 | NewProcInfo, NewProcId, NewPredInfo). | ||
| 1592 | |||
| 1593 | %---------------------------------------------------------------------------% | ||
| 1594 | |||
| 1595 | % create_goal creates the new base and recursive case of the | ||
| 1596 | % original procedure (OrigBaseGoal and OrigRecGoal) and the base | ||
| 1597 | % and recursive cases of accumulator version (AccBaseGoal and | ||
| 1598 | % AccRecGoal). | ||
| 1599 | % | ||
| 1600 | :- pred accu_create_goal(accu_goal_id::in, list(prog_var)::in, | ||
| 1601 | pred_id::in, proc_id::in, sym_name::in, accu_substs::in, | ||
| 1602 | accu_subst::in, accu_subst::in, accu_base::in, | ||
| 1603 | list(pair(prog_var))::in, accu_sets::in, | ||
| 1604 | accu_goal_store::in, accu_goal_store::in, | ||
| 1605 | hlds_goal::out, hlds_goal::out, hlds_goal::out, hlds_goal::out) is det. | ||
| 1606 | |||
| 1607 | accu_create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs, | ||
| 1608 | HeadToCallSubst, CallToHeadSubst, BaseIds, BasePairs, | ||
| 1609 | Sets, C, CS, OrigBaseGoal, OrigRecGoal, AccBaseGoal, AccRecGoal) :- | ||
| 1610 | lookup_call(C, RecCallId, stored_goal(OrigCall, _InstMap)), | ||
| 1611 | Call = create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName), | ||
| 1612 | create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst, | ||
| 1613 | BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal), | ||
| 1614 | create_acc_goal(Call, Substs, HeadToCallSubst, BaseIds, BasePairs, | ||
| 1615 | Sets, C, CS, AccBaseGoal, AccRecGoal). | ||
| 1616 | |||
| 1617 | % create_acc_call takes the original call and generates a call to the | ||
| 1618 | % accumulator version of the call, which can have the substitutions | ||
| 1619 | % applied to it easily. | ||
| 1620 | % | ||
| 1621 | :- func create_acc_call(hlds_goal::in(goal_plain_call), list(prog_var)::in, | ||
| 1622 | pred_id::in, proc_id::in, sym_name::in) = (hlds_goal::out(goal_plain_call)) | ||
| 1623 | is det. | ||
| 1624 | |||
| 1625 | create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName) = Call :- | ||
| 1626 | OrigCall = hlds_goal(OrigCallExpr, GoalInfo), | ||
| 1627 | OrigCallExpr = plain_call(_PredId, _ProcId, Args, Builtin, Context, _Name), | ||
| 1628 | CallExpr = plain_call(AccPredId, AccProcId, Accs ++ Args, Builtin, | ||
| 1629 | Context, AccName), | ||
| 1630 | Call = hlds_goal(CallExpr, GoalInfo). | ||
| 1631 | |||
| 1632 | % Create the goals which are to replace the original predicate. | ||
| 1633 | % | ||
| 1634 | :- pred create_orig_goal(hlds_goal::in, accu_substs::in, | ||
| 1635 | accu_subst::in, accu_subst::in, accu_base::in, accu_sets::in, | ||
| 1636 | accu_goal_store::in, hlds_goal::out, hlds_goal::out) is det. | ||
| 1637 | |||
| 1638 | create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst, | ||
| 1639 | BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal) :- | ||
| 1640 | Substs = accu_substs(_AccVarSubst, _RecCallSubst, _AssocCallSubst, | ||
| 1641 | UpdateSubst), | ||
| 1642 | |||
| 1643 | BaseIds = accu_base(UpdateBase, _AssocBase, _OtherBase), | ||
| 1644 | Before = Sets ^ as_before, | ||
| 1645 | Update = Sets ^ as_update, | ||
| 1646 | |||
| 1647 | U = create_new_orig_recursive_goals(UpdateBase, Update, | ||
| 1648 | HeadToCallSubst, UpdateSubst, C), | ||
| 1649 | |||
| 1650 | rename_some_vars_in_goal(CallToHeadSubst, Call, BaseCall), | ||
| 1651 | Cbefore = accu_goal_list(set.to_sorted_list(Before), C), | ||
| 1652 | Uupdate = accu_goal_list(set.to_sorted_list(UpdateBase) ++ | ||
| 1653 | set.to_sorted_list(Update), U), | ||
| 1654 | Cbase = accu_goal_list(base_case_ids(C), C), | ||
| 1655 | calculate_goal_info(conj(plain_conj, Cbefore ++ Uupdate ++ [BaseCall]), | ||
| 1656 | OrigRecGoal), | ||
| 1657 | calculate_goal_info(conj(plain_conj, Cbase), OrigBaseGoal). | ||
| 1658 | |||
| 1659 | % Create the goals which are to go in the new accumulator version | ||
| 1660 | % of the predicate. | ||
| 1661 | % | ||
| 1662 | :- pred create_acc_goal(hlds_goal::in, accu_substs::in, accu_subst::in, | ||
| 1663 | accu_base::in, list(pair(prog_var))::in, accu_sets::in, | ||
| 1664 | accu_goal_store::in, accu_goal_store::in, | ||
| 1665 | hlds_goal::out, hlds_goal::out) is det. | ||
| 1666 | |||
| 1667 | create_acc_goal(Call, Substs, HeadToCallSubst, BaseIds, BasePairs, Sets, | ||
| 1668 | C, CS, AccBaseGoal, AccRecGoal) :- | ||
| 1669 | Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, | ||
| 1670 | UpdateSubst), | ||
| 1671 | |||
| 1672 | BaseIds = accu_base(_UpdateBase, AssocBase, OtherBase), | ||
| 1673 | Sets = accu_sets(Before, Assoc, ConstructAssoc, Construct, Update, | ||
| 1674 | _Reject), | ||
| 1675 | |||
| 1676 | rename_some_vars_in_goal(RecCallSubst, Call, RecCall), | ||
| 1677 | |||
| 1678 | Cbefore = accu_goal_list(set.to_sorted_list(Before), C), | ||
| 1679 | |||
| 1680 | % Create the goals which will be used in the new recursive case. | ||
| 1681 | R = create_new_recursive_goals(Assoc, Construct `union` ConstructAssoc, | ||
| 1682 | Update, AssocCallSubst, AccVarSubst, UpdateSubst, C, CS), | ||
| 1683 | |||
| 1684 | Rassoc = accu_goal_list(set.to_sorted_list(Assoc), R), | ||
| 1685 | Rupdate = accu_goal_list(set.to_sorted_list(Update), R), | ||
| 1686 | Rconstruct = accu_goal_list(set.to_sorted_list(Construct `union` | ||
| 1687 | ConstructAssoc), R), | ||
| 1688 | |||
| 1689 | % Create the goals which will be used in the new base case. | ||
| 1690 | B = create_new_base_goals(Assoc `union` Construct `union` | ||
| 1691 | ConstructAssoc, C, AccVarSubst, HeadToCallSubst), | ||
| 1692 | Bafter = set.to_sorted_list(Assoc `union` | ||
| 1693 | Construct `union` ConstructAssoc), | ||
| 1694 | |||
| 1695 | BaseCase = accu_goal_list(set.to_sorted_list(AssocBase `union` OtherBase) | ||
| 1696 | ++ Bafter, B), | ||
| 1697 | |||
| 1698 | list.map(acc_unification, BasePairs, UpdateBase), | ||
| 1699 | |||
| 1700 | calculate_goal_info(conj(plain_conj, Cbefore ++ Rassoc ++ Rupdate | ||
| 1701 | ++ [RecCall] ++ Rconstruct), AccRecGoal), | ||
| 1702 | calculate_goal_info(conj(plain_conj, UpdateBase ++ BaseCase), AccBaseGoal). | ||
| 1703 | |||
| 1704 | % Create the U set of goals (those that will be used in the original | ||
| 1705 | % recursive case) by renaming all the goals which are used to initialize | ||
| 1706 | % the update state variable using the head_to_call followed by the | ||
| 1707 | % update_subst, and rename all the update goals using the update_subst. | ||
| 1708 | % | ||
| 1709 | :- func create_new_orig_recursive_goals(set(accu_goal_id), set(accu_goal_id), | ||
| 1710 | accu_subst, accu_subst, accu_goal_store) = accu_goal_store. | ||
| 1711 | |||
| 1712 | create_new_orig_recursive_goals(UpdateBase, Update, HeadToCallSubst, | ||
| 1713 | UpdateSubst, C) | ||
| 1714 | = accu_rename(set.to_sorted_list(Update), UpdateSubst, C, Ubase) :- | ||
| 1715 | Ubase = accu_rename(set.to_sorted_list(UpdateBase), | ||
| 1716 | chain_subst(HeadToCallSubst, UpdateSubst), C, goal_store_init). | ||
| 1717 | |||
| 1718 | % Create the R set of goals (those that will be used in the new | ||
| 1719 | % recursive case) by renaming all the members of assoc in CS | ||
| 1720 | % using assoc_call_subst and all the members of (construct U | ||
| 1721 | % construct_assoc) in C with acc_var_subst. | ||
| 1722 | % | ||
| 1723 | :- func create_new_recursive_goals(set(accu_goal_id), set(accu_goal_id), | ||
| 1724 | set(accu_goal_id), accu_subst, accu_subst, accu_subst, | ||
| 1725 | accu_goal_store, accu_goal_store) = accu_goal_store. | ||
| 1726 | |||
| 1727 | create_new_recursive_goals(Assoc, Constructs, Update, | ||
| 1728 | AssocCallSubst, AccVarSubst, UpdateSubst, C, CS) | ||
| 1729 | = accu_rename(set.to_sorted_list(Constructs), AccVarSubst, C, RBase) :- | ||
| 1730 | RBase0 = accu_rename(set.to_sorted_list(Assoc), AssocCallSubst, CS, | ||
| 1731 | goal_store_init), | ||
| 1732 | RBase = accu_rename(set.to_sorted_list(Update), UpdateSubst, C, RBase0). | ||
| 1733 | |||
| 1734 | % Create the B set of goals (those that will be used in the new base case) | ||
| 1735 | % by renaming all the base case goals of C with head_to_call and all the | ||
| 1736 | % members of (assoc U construct U construct_assoc) of C with acc_var_subst. | ||
| 1737 | % | ||
| 1738 | :- func create_new_base_goals(set(accu_goal_id), accu_goal_store, | ||
| 1739 | accu_subst, accu_subst) = accu_goal_store. | ||
| 1740 | |||
| 1741 | create_new_base_goals(Ids, C, AccVarSubst, HeadToCallSubst) | ||
| 1742 | = accu_rename(set.to_sorted_list(Ids), AccVarSubst, C, Bbase) :- | ||
| 1743 | Bbase = accu_rename(base_case_ids(C), HeadToCallSubst, C, goal_store_init). | ||
| 1744 | |||
| 1745 | % acc_unification(O-A, G): | ||
| 1746 | % | ||
| 1747 | % is true if G represents the assignment unification Out = Acc. | ||
| 1748 | % | ||
| 1749 | :- pred acc_unification(pair(prog_var)::in, hlds_goal::out) is det. | ||
| 1750 | |||
| 1751 | acc_unification(Out - Acc, Goal) :- | ||
| 1752 | UnifyMode = unify_modes_li_lf_ri_rf(free, ground_inst, | ||
| 1753 | ground_inst, ground_inst), | ||
| 1754 | Context = unify_context(umc_explicit, []), | ||
| 1755 | Expr = unify(Out, rhs_var(Acc), UnifyMode, assign(Out,Acc), Context), | ||
| 1756 | set_of_var.list_to_set([Out, Acc], NonLocalVars), | ||
| 1757 | InstMapDelta = instmap_delta_bind_var(Out), | ||
| 1758 | goal_info_init(NonLocalVars, InstMapDelta, detism_det, purity_pure, Info), | ||
| 1759 | Goal = hlds_goal(Expr, Info). | ||
| 1760 | |||
| 1761 | %---------------------------------------------------------------------------% | ||
| 1762 | |||
| 1763 | % Given the top level structure of the goal create new version | ||
| 1764 | % with new base and recursive cases plugged in. | ||
| 1765 | % | ||
| 1766 | :- pred accu_top_level(top_level::in, hlds_goal::in, | ||
| 1767 | hlds_goal::in, hlds_goal::in, hlds_goal::in, | ||
| 1768 | hlds_goal::in, hlds_goal::out, hlds_goal::out) is det. | ||
| 1769 | |||
| 1770 | accu_top_level(TopLevel, Goal, OrigBaseGoal, OrigRecGoal, | ||
| 1771 | NewBaseGoal, NewRecGoal, OrigGoal, NewGoal) :- | ||
| 1772 | ( | ||
| 1773 | TopLevel = switch_base_rec, | ||
| 1774 | ( if | ||
| 1775 | Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo), | ||
| 1776 | Cases0 = [case(IdA, [], _), case(IdB, [], _)] | ||
| 1777 | then | ||
| 1778 | OrigCases = [case(IdA, [], OrigBaseGoal), | ||
| 1779 | case(IdB, [], OrigRecGoal)], | ||
| 1780 | OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo), | ||
| 1781 | |||
| 1782 | NewCases = [case(IdA, [], NewBaseGoal), case(IdB, [], NewRecGoal)], | ||
| 1783 | NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo) | ||
| 1784 | else | ||
| 1785 | unexpected($pred, "not the correct top level") | ||
| 1786 | ) | ||
| 1787 | ; | ||
| 1788 | TopLevel = switch_rec_base, | ||
| 1789 | ( if | ||
| 1790 | Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo), | ||
| 1791 | Cases0 = [case(IdA, [], _), case(IdB, [], _)] | ||
| 1792 | then | ||
| 1793 | OrigCases = [case(IdA, [], OrigRecGoal), | ||
| 1794 | case(IdB, [], OrigBaseGoal)], | ||
| 1795 | OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo), | ||
| 1796 | |||
| 1797 | NewCases = [case(IdA, [], NewRecGoal), case(IdB, [], NewBaseGoal)], | ||
| 1798 | NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo) | ||
| 1799 | else | ||
| 1800 | unexpected($pred, "not the correct top level") | ||
| 1801 | ) | ||
| 1802 | ; | ||
| 1803 | TopLevel = disj_base_rec, | ||
| 1804 | ( if | ||
| 1805 | Goal = hlds_goal(disj(Goals), GoalInfo), | ||
| 1806 | Goals = [_, _] | ||
| 1807 | then | ||
| 1808 | OrigGoals = [OrigBaseGoal, OrigRecGoal], | ||
| 1809 | OrigGoal = hlds_goal(disj(OrigGoals), GoalInfo), | ||
| 1810 | |||
| 1811 | NewGoals = [NewBaseGoal, NewRecGoal], | ||
| 1812 | NewGoal = hlds_goal(disj(NewGoals), GoalInfo) | ||
| 1813 | else | ||
| 1814 | unexpected($pred, "not the correct top level") | ||
| 1815 | ) | ||
| 1816 | ; | ||
| 1817 | TopLevel = disj_rec_base, | ||
| 1818 | ( if | ||
| 1819 | Goal = hlds_goal(disj(Goals), GoalInfo), | ||
| 1820 | Goals = [_, _] | ||
| 1821 | then | ||
| 1822 | OrigGoals = [OrigRecGoal, OrigBaseGoal], | ||
| 1823 | OrigGoal = hlds_goal(disj(OrigGoals), GoalInfo), | ||
| 1824 | |||
| 1825 | NewGoals = [NewRecGoal, NewBaseGoal], | ||
| 1826 | NewGoal = hlds_goal(disj(NewGoals), GoalInfo) | ||
| 1827 | else | ||
| 1828 | unexpected($pred, "not the correct top level") | ||
| 1829 | ) | ||
| 1830 | ; | ||
| 1831 | TopLevel = ite_base_rec, | ||
| 1832 | ( if Goal = hlds_goal(if_then_else(Vars, Cond, _, _), GoalInfo) then | ||
| 1833 | OrigGoal = hlds_goal(if_then_else(Vars, Cond, | ||
| 1834 | OrigBaseGoal, OrigRecGoal), GoalInfo), | ||
| 1835 | NewGoal = hlds_goal(if_then_else(Vars, Cond, | ||
| 1836 | NewBaseGoal, NewRecGoal), GoalInfo) | ||
| 1837 | else | ||
| 1838 | unexpected($pred, "not the correct top level") | ||
| 1839 | ) | ||
| 1840 | ; | ||
| 1841 | TopLevel = ite_rec_base, | ||
| 1842 | ( if Goal = hlds_goal(if_then_else(Vars, Cond, _, _), GoalInfo) then | ||
| 1843 | OrigGoal = hlds_goal(if_then_else(Vars, Cond, | ||
| 1844 | OrigRecGoal, OrigBaseGoal), GoalInfo), | ||
| 1845 | NewGoal = hlds_goal(if_then_else(Vars, Cond, | ||
| 1846 | NewRecGoal, NewBaseGoal), GoalInfo) | ||
| 1847 | else | ||
| 1848 | unexpected($pred, "not the correct top level") | ||
| 1849 | ) | ||
| 1850 | ). | ||
| 1851 | |||
| 1852 | %---------------------------------------------------------------------------% | ||
| 1853 | |||
| 1854 | % Place the accumulator version of the predicate in the HLDS. | ||
| 1855 | % | ||
| 1856 | :- pred update_accumulator_pred(pred_id::in, proc_id::in, | ||
| 1857 | hlds_goal::in, module_info::in, module_info::out) is det. | ||
| 1858 | |||
| 1859 | update_accumulator_pred(NewPredId, NewProcId, AccGoal, !ModuleInfo) :- | ||
| 1860 | module_info_pred_proc_info(!.ModuleInfo, NewPredId, NewProcId, | ||
| 1861 | PredInfo, ProcInfo0), | ||
| 1862 | proc_info_set_goal(AccGoal, ProcInfo0, ProcInfo1), | ||
| 1863 | requantify_proc_general(ordinary_nonlocals_no_lambda, ProcInfo1, ProcInfo), | ||
| 1864 | module_info_set_pred_proc_info(NewPredId, NewProcId, | ||
| 1865 | PredInfo, ProcInfo, !ModuleInfo). | ||
| 1866 | |||
| 1867 | %---------------------------------------------------------------------------% | ||
| 1868 | %---------------------------------------------------------------------------% | ||
| 1869 | |||
| 1870 | % accu_rename(Ids, Subst, From, Initial): | ||
| 1871 | % | ||
| 1872 | % Return a goal_store, Final, which is the result of looking up each | ||
| 1873 | % member of set of goal_ids, Ids, in the goal_store, From, applying | ||
| 1874 | % the substitution and then storing the goal into the goal_store, Initial. | ||
| 1875 | % | ||
| 1876 | :- func accu_rename(list(accu_goal_id), accu_subst, | ||
| 1877 | accu_goal_store, accu_goal_store) = accu_goal_store. | ||
| 1878 | |||
| 1879 | accu_rename(Ids, Subst, From, Initial) = Final :- | ||
| 1880 | list.foldl( | ||
| 1881 | ( pred(Id::in, GS0::in, GS::out) is det :- | ||
| 1882 | goal_store_lookup(From, Id, stored_goal(Goal0, InstMap)), | ||
| 1883 | rename_some_vars_in_goal(Subst, Goal0, Goal), | ||
| 1884 | goal_store_det_insert(Id, stored_goal(Goal, InstMap), GS0, GS) | ||
| 1885 | ), Ids, Initial, Final). | ||
| 1886 | |||
| 1887 | % Return all the goal_ids which belong in the base case. | ||
| 1888 | % | ||
| 1889 | :- func base_case_ids(accu_goal_store) = list(accu_goal_id). | ||
| 1890 | |||
| 1891 | base_case_ids(GS) = Base :- | ||
| 1892 | solutions.solutions( | ||
| 1893 | ( pred(Key::out) is nondet :- | ||
| 1894 | goal_store_member(GS, Key, _Goal), | ||
| 1895 | Key = accu_goal_id(accu_base, _) | ||
| 1896 | ), Base). | ||
| 1897 | |||
| 1898 | :- func base_case_ids_set(accu_goal_store) = set(accu_goal_id). | ||
| 1899 | |||
| 1900 | base_case_ids_set(GS) = set.list_to_set(base_case_ids(GS)). | ||
| 1901 | |||
| 1902 | % Given a list of goal_ids, return the list of hlds_goals from | ||
| 1903 | % the goal_store. | ||
| 1904 | % | ||
| 1905 | :- func accu_goal_list(list(accu_goal_id), accu_goal_store) = list(hlds_goal). | ||
| 1906 | |||
| 1907 | accu_goal_list(Ids, GS) = Goals :- | ||
| 1908 | list.map( | ||
| 1909 | ( pred(Key::in, G::out) is det :- | ||
| 1910 | goal_store_lookup(GS, Key, stored_goal(G, _)) | ||
| 1911 | ), Ids, Goals). | ||
| 1912 | |||
| 1913 | %---------------------------------------------------------------------------% | ||
| 1914 | %---------------------------------------------------------------------------% | ||
| 1915 | |||
| 1916 | :- pred calculate_goal_info(hlds_goal_expr::in, hlds_goal::out) is det. | ||
| 1917 | |||
| 1918 | calculate_goal_info(GoalExpr, hlds_goal(GoalExpr, GoalInfo)) :- | ||
| 1919 | ( if GoalExpr = conj(plain_conj, GoalList) then | ||
| 1920 | goal_list_nonlocals(GoalList, NonLocals), | ||
| 1921 | goal_list_instmap_delta(GoalList, InstMapDelta), | ||
| 1922 | goal_list_determinism(GoalList, Detism), | ||
| 1923 | |||
| 1924 | goal_info_init(NonLocals, InstMapDelta, Detism, purity_pure, GoalInfo) | ||
| 1925 | else | ||
| 1926 | unexpected($pred, "not a conj") | ||
| 1927 | ). | ||
| 1928 | |||
| 1929 | %---------------------------------------------------------------------------% | ||
| 1930 | %---------------------------------------------------------------------------% | ||
| 1931 | |||
| 1932 | :- func chain_subst(accu_subst, accu_subst) = accu_subst. | ||
| 1933 | |||
| 1934 | chain_subst(AtoB, BtoC) = AtoC :- | ||
| 1935 | map.keys(AtoB, Keys), | ||
| 1936 | chain_subst_2(Keys, AtoB, BtoC, AtoC). | ||
| 1937 | |||
| 1938 | :- pred chain_subst_2(list(A)::in, map(A, B)::in, map(B, C)::in, | ||
| 1939 | map(A, C)::out) is det. | ||
| 1940 | |||
| 1941 | chain_subst_2([], _, _, AtoC) :- | ||
| 1942 | map.init(AtoC). | ||
| 1943 | chain_subst_2([A | As], AtoB, BtoC, AtoC) :- | ||
| 1944 | chain_subst_2(As, AtoB, BtoC, AtoC0), | ||
| 1945 | map.lookup(AtoB, A, B), | ||
| 1946 | ( if map.search(BtoC, B, C) then | ||
| 1947 | map.det_insert(A, C, AtoC0, AtoC) | ||
| 1948 | else | ||
| 1949 | AtoC = AtoC0 | ||
| 1950 | ). | ||
| 1951 | |||
| 1952 | %---------------------------------------------------------------------------% | ||
| 1953 | :- end_module transform_hlds.accumulator. | ||
| 1954 | %---------------------------------------------------------------------------% | ||
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index be02c30a752..fb9441eb66e 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el | |||
| @@ -53,7 +53,7 @@ | |||
| 53 | "Compile the compiler and load it to compile it-self. | 53 | "Compile the compiler and load it to compile it-self. |
| 54 | Check that the resulting binaries do not differ." | 54 | Check that the resulting binaries do not differ." |
| 55 | :tags '(:expensive-test :nativecomp) | 55 | :tags '(:expensive-test :nativecomp) |
| 56 | (let* ((byte-native-for-bootstrap t) ; FIXME HACK | 56 | (let* ((byte+native-compile t) ; FIXME HACK |
| 57 | (comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el" | 57 | (comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el" |
| 58 | (ert-resource-directory))) | 58 | (ert-resource-directory))) |
| 59 | (comp1-src (make-temp-file "stage1-" nil ".el")) | 59 | (comp1-src (make-temp-file "stage1-" nil ".el")) |