aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorYuuki Harano2021-06-13 17:34:06 +0900
committerYuuki Harano2021-06-13 17:34:06 +0900
commit7d5e94bada09e642a8bfc4f66804f7948bad40bc (patch)
tree38629672102b31bb38a855f24d4dd009e212c10d
parent7673b6b9eb0af3add73e1614a466f142092b00aa (diff)
parentdc471feee3bcac872cc52cdc73282955cd2d219d (diff)
downloademacs-7d5e94bada09e642a8bfc4f66804f7948bad40bc.tar.gz
emacs-7d5e94bada09e642a8bfc4f66804f7948bad40bc.zip
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
-rw-r--r--configure.ac31
-rw-r--r--doc/emacs/display.texi40
-rw-r--r--doc/emacs/docstyle.texi1
-rw-r--r--doc/emacs/fixit.texi2
-rw-r--r--doc/emacs/killing.texi56
-rw-r--r--doc/emacs/misc.texi6
-rw-r--r--doc/emacs/windows.texi3
-rw-r--r--doc/lispref/help.texi18
-rw-r--r--doc/lispref/internals.texi2
-rw-r--r--doc/lispref/macros.texi2
-rw-r--r--doc/lispref/modes.texi3
-rw-r--r--doc/lispref/os.texi22
-rw-r--r--doc/lispref/searching.texi9
-rw-r--r--doc/lispref/syntax.texi14
-rw-r--r--doc/lispref/variables.texi6
-rw-r--r--doc/lispref/windows.texi65
-rw-r--r--doc/man/emacs.1.in4
-rw-r--r--doc/man/etags.123
-rw-r--r--doc/misc/eieio.texi88
-rw-r--r--doc/misc/emacs-mime.texi5
-rw-r--r--doc/misc/erc.texi4
-rw-r--r--doc/misc/gnus.texi39
-rw-r--r--etc/NEWS130
-rw-r--r--lib-src/etags.c505
-rw-r--r--lib/Makefile.in2
-rw-r--r--lisp/Makefile.in4
-rw-r--r--lisp/auth-source.el4
-rw-r--r--lisp/cedet/ede/base.el46
-rw-r--r--lisp/cedet/ede/config.el2
-rw-r--r--lisp/cedet/ede/generic.el2
-rw-r--r--lisp/cedet/ede/proj-obj.el4
-rw-r--r--lisp/cedet/ede/proj.el12
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el4
-rw-r--r--lisp/cedet/semantic/db-el.el4
-rw-r--r--lisp/cedet/semantic/db-javascript.el4
-rw-r--r--lisp/cedet/semantic/db.el4
-rw-r--r--lisp/cedet/semantic/ede-grammar.el12
-rw-r--r--lisp/cedet/semantic/symref/grep.el2
-rw-r--r--lisp/cedet/srecode/compile.el7
-rw-r--r--lisp/cedet/srecode/insert.el17
-rw-r--r--lisp/custom.el2
-rw-r--r--lisp/dired-aux.el15
-rw-r--r--lisp/dired.el68
-rw-r--r--lisp/electric.el5
-rw-r--r--lisp/emacs-lisp/benchmark.el3
-rw-r--r--lisp/emacs-lisp/byte-opt.el10
-rw-r--r--lisp/emacs-lisp/bytecomp.el4
-rw-r--r--lisp/emacs-lisp/chart.el2
-rw-r--r--lisp/emacs-lisp/comp.el33
-rw-r--r--lisp/emacs-lisp/eieio-base.el2
-rw-r--r--lisp/emacs-lisp/eieio-core.el127
-rw-r--r--lisp/emacs-lisp/eieio-custom.el2
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el10
-rw-r--r--lisp/emacs-lisp/eieio.el57
-rw-r--r--lisp/emacs-lisp/elp.el18
-rw-r--r--lisp/emacs-lisp/shortdoc.el48
-rw-r--r--lisp/emacs-lisp/syntax.el4
-rw-r--r--lisp/epa-ks.el40
-rw-r--r--lisp/erc/erc.el4
-rw-r--r--lisp/eshell/em-hist.el2
-rw-r--r--lisp/fileloop.el3
-rw-r--r--lisp/files.el7
-rw-r--r--lisp/format.el2
-rw-r--r--lisp/fringe.el11
-rw-r--r--lisp/gnus/gnus-art.el144
-rw-r--r--lisp/gnus/gnus-group.el42
-rw-r--r--lisp/gnus/gnus-sum.el22
-rw-r--r--lisp/gnus/gnus-topic.el15
-rw-r--r--lisp/gnus/gnus.el8
-rw-r--r--lisp/gnus/nnimap.el5
-rw-r--r--lisp/help-fns.el56
-rw-r--r--lisp/hl-line.el5
-rw-r--r--lisp/ibuffer.el7
-rw-r--r--lisp/icomplete.el424
-rw-r--r--lisp/indent.el4
-rw-r--r--lisp/isearch.el8
-rw-r--r--lisp/kmacro.el2
-rw-r--r--lisp/ldefs-boot.el259
-rw-r--r--lisp/leim/quail/latin-ltx.el52
-rw-r--r--lisp/menu-bar.el1
-rw-r--r--lisp/mh-e/mh-e.el7
-rw-r--r--lisp/minibuffer.el37
-rw-r--r--lisp/mpc.el33
-rw-r--r--lisp/msb.el9
-rw-r--r--lisp/net/browse-url.el36
-rw-r--r--lisp/net/mailcap.el23
-rw-r--r--lisp/net/rcirc.el3
-rw-r--r--lisp/net/tramp.el2
-rw-r--r--lisp/progmodes/etags.el4
-rw-r--r--lisp/progmodes/fortran.el143
-rw-r--r--lisp/progmodes/grep.el39
-rw-r--r--lisp/progmodes/hideif.el1217
-rw-r--r--lisp/progmodes/octave.el2
-rw-r--r--lisp/progmodes/perl-mode.el2
-rw-r--r--lisp/progmodes/xref.el2
-rw-r--r--lisp/server.el15
-rw-r--r--lisp/shell.el17
-rw-r--r--lisp/simple.el39
-rw-r--r--lisp/so-long.el8
-rw-r--r--lisp/subr.el14
-rw-r--r--lisp/term/x-win.el2
-rw-r--r--lisp/textmodes/flyspell.el27
-rw-r--r--lisp/textmodes/tex-mode.el12
-rw-r--r--lisp/time-stamp.el376
-rw-r--r--lisp/transient.el8
-rw-r--r--lisp/vc/ediff-diff.el5
-rw-r--r--lisp/vc/vc-git.el18
-rw-r--r--lisp/wdired.el33
-rw-r--r--lisp/whitespace.el3
-rw-r--r--lisp/wid-edit.el5
-rw-r--r--lisp/windmove.el175
-rw-r--r--lisp/window.el160
-rw-r--r--lisp/xdg.el2
-rw-r--r--src/character.c16
-rw-r--r--src/character.h2
-rw-r--r--src/composite.c76
-rw-r--r--src/composite.h23
-rw-r--r--src/data.c4
-rw-r--r--src/editfns.c2
-rw-r--r--src/frame.c12
-rw-r--r--src/frame.h5
-rw-r--r--src/image.c23
-rw-r--r--src/keyboard.c122
-rw-r--r--src/minibuf.c2
-rw-r--r--src/nsfns.m16
-rw-r--r--src/nsimage.m9
-rw-r--r--src/nsterm.h6
-rw-r--r--src/nsterm.m158
-rw-r--r--src/window.c35
-rw-r--r--src/xdisp.c33
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl14
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl10
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl21
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el59
-rw-r--r--test/lisp/progmodes/octave-tests.el49
-rw-r--r--test/lisp/progmodes/xref-tests.el40
-rw-r--r--test/lisp/subr-tests.el10
-rw-r--r--test/lisp/time-stamp-tests.el38
-rw-r--r--test/manual/etags/CTAGS.good114
-rw-r--r--test/manual/etags/ETAGS.good_1116
-rw-r--r--test/manual/etags/ETAGS.good_2174
-rw-r--r--test/manual/etags/ETAGS.good_3116
-rw-r--r--test/manual/etags/ETAGS.good_4116
-rw-r--r--test/manual/etags/ETAGS.good_5174
-rw-r--r--test/manual/etags/ETAGS.good_6174
-rw-r--r--test/manual/etags/Makefile3
-rw-r--r--test/manual/etags/merc-src/accumulator.m1954
-rw-r--r--test/src/comp-tests.el2
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
3849AC_DEFUN([libgccjit_not_found], [ 3849AC_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.
3851Please try installing libgccjit or similar package. 3851Please try installing libgccjit or a similar package.
3852If you are sure you want Emacs compiled without elisp native compiler, pass 3852If you are sure you want Emacs be compiled without ELisp native compiler,
3853 --without-native-compilation 3853pass the --without-native-compilation option to configure.])])
3854to configure.])])
3855 3854
3856AC_DEFUN([libgccjit_dev_not_found], [ 3855AC_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
3858not found. 3857not found.
3859Please try installing libgccjit-dev or similar package. 3858Please try installing libgccjit-dev or a similar package.
3860If you are sure you want Emacs compiled without elisp native compiler, pass 3859If you are sure you want Emacs be compiled without ELisp native compiler,
3861--without-nativecomp 3860pass the --without-nativecomp option to configure.])])
3862to configure.])])
3863 3861
3864AC_DEFUN([libgccjit_broken], [ 3862AC_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
3866You can verify it yourself compiling: 3864the libgccjit library; see config.log for the details of the failure.
3865The 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>.
3868Please report the issue to your distribution if libgccjit was installed through 3867You can try compiling it yourself to investigate the issues.
3869that. 3868Please report the issue to your distribution if libgccjit was installed
3870Here instructions on how to compile and install libgccjit from source: 3869through that.
3870You can find the instructions on how to compile and install libgccjit from
3871source on this site:
3871<https://gcc.gnu.org/wiki/JIT>.])]) 3872<https://gcc.gnu.org/wiki/JIT>.])])
3872 3873
3873HAVE_NATIVE_COMP=no 3874HAVE_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
1189program. 1189program.
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
1194the indicator locally or globally, respectively. 1194the indicator locally or globally, respectively.
1195 1195
1196Alternatively, you can set the two buffer-local variables 1196Alternatively, you can set the two buffer-local variables
@@ -1220,8 +1220,8 @@ The value @code{nil} disables the indicator. When the mode is enabled
1220through the functions @code{display-fill-column-indicator-mode} or 1220through 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
1222character specified by this variable, if it is non-@code{nil}; 1222character specified by this variable, if it is non-@code{nil};
1223otherwise Emacs will use the character @samp{U+2502 VERTICAL LINE}, 1223otherwise Emacs will use the character U+2502 @sc{box drawings light vertical},
1224falling back to @samp{|} if @code{U+2502} cannot be displayed. 1224falling 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
1579characters}. Two of these are displayed specially: the newline 1579characters}. Two of these are displayed specially: the newline
1580character (Unicode code point @code{U+000A}) is displayed by starting 1580character (Unicode code point U+000A) is displayed by starting
1581a new line, while the tab character (@code{U+0009}) is displayed as a 1581a new line, while the tab character (U+0009) is displayed as a
1582space that extends to the next tab stop column (normally every 8 1582space that extends to the next tab stop column (normally every 8
1583columns). The number of spaces per tab is controlled by the 1583columns). The number of spaces per tab is controlled by the
1584buffer-local variable @code{tab-width}, which must have an integer 1584buffer-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
1587definition of @key{TAB} as a command. 1587definition 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 1590U+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
1592the @code{escape-glyph} face. For instance, the @samp{control-A} 1592the @code{escape-glyph} face. For instance, the @samp{control-A}
1593character, @code{U+0001}, is displayed as @samp{^A}. 1593character, 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 1598U+009F (octal 237) are displayed as @dfn{octal escape
1599sequences}, with the @code{escape-glyph} face. For instance, 1599sequences}, with the @code{escape-glyph} face. For instance,
1600character code @code{U+0098} (octal 230) is displayed as @samp{\230}. 1600character code U+0098 (octal 230) is displayed as @samp{\230}.
1601If you change the buffer-local variable @code{ctl-arrow} to 1601If 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
1603as octal escape sequences instead of caret escape sequences. (You can 1603as 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
1616realization, e.g., by yanking; for instance, source code compilers 1616realization, e.g., by yanking; for instance, source code compilers
1617typically do not treat non-@acronym{ASCII} spaces as whitespace 1617typically do not treat non-@acronym{ASCII} spaces as whitespace
1618characters. To deal with this problem, Emacs displays such characters 1618characters. To deal with this problem, Emacs displays such characters
1619specially: it displays @code{U+00A0} (no-break space) and other 1619specially: it displays U+00A0 @sc{no-break space} and other
1620characters from the Unicode horizontal space class with the 1620characters 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
1622hyphen), @code{U+2010} (hyphen), and @code{U+2011} (non-breaking 1622hyphen}, U+2010 @sc{hyphen}, and U+2011 @sc{non-breaking
1623hyphen) with the @code{nobreak-hyphen} face. To disable this, change 1623hyphen} with the @code{nobreak-hyphen} face. To disable this, change
1624the variable @code{nobreak-char-display} to @code{nil}. If you give 1624the variable @code{nobreak-char-display} to @code{nil}. If you give
1625this variable a non-@code{nil} and non-@code{t} value, Emacs instead 1625this variable a non-@code{nil} and non-@code{t} value, Emacs instead
1626displays such characters as a highlighted backslash followed by a 1626displays such characters as a highlighted backslash followed by a
@@ -1829,15 +1829,15 @@ variable @code{visual-line-fringe-indicators}.
1829That produces incorrect results when CJK and Latin text are mixed 1829That produces incorrect results when CJK and Latin text are mixed
1830together (because CJK characters don't use whitespace to separate 1830together (because CJK characters don't use whitespace to separate
1831words). You can customize the option @code{word-wrap-by-category} to 1831words). You can customize the option @code{word-wrap-by-category} to
1832allow Emacs to break lines after any character with ``|'' category 1832allow 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
1834provides better support for CJK characters. Also, if this variable is 1834provides better support for CJK characters. Also, if this variable is
1835set using Customize, Emacs automatically loads @file{kinsoku.el}. 1835set using Customize, Emacs automatically loads @file{kinsoku.el}.
1836When @file{kinsoku.el} is loaded, Emacs respects kinsoku rules when 1836When @file{kinsoku.el} is loaded, Emacs respects kinsoku rules when
1837breaking lines. That means characters with the ``>'' category don't 1837breaking lines. That means characters with the @samp{>} category don't
1838appear at the beginning of a line (e.g., U+FF0C FULLWIDTH COMMA), and 1838appear at the beginning of a line (e.g., U+FF0C @sc{fullwidth comma}), and
1839characters with the ``<'' category don't appear at the end of a line 1839characters 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
1841set of a character using the commands @code{char-category-set} and 1841set 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
1843on the character and looking at the ``category'' section in the 1843on 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
365information. 365information.
366 366
367@item u 367@item u
368Insert the lower-case version of this word in your private dic@-tion@-ary 368Insert the lower-case version of this word in your private dictionary
369file. 369file.
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;
311e.g., @kbd{C-u 4 C-y} reinserts the fourth most recent kill. 311e.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}
315has placed any text in the system clipboard more recently than the 315first checks if another application has placed any text in the system
316last Emacs kill. If so, it inserts the clipboard's text instead. 316clipboard more recently than the last Emacs kill. If so, it inserts
317Thus, Emacs effectively treats ``cut'' or ``copy'' clipboard 317the clipboard's text instead. Thus, Emacs effectively treats ``cut''
318operations performed in other applications like Emacs kills, except 318or ``copy'' clipboard operations performed in other applications like
319that they are not recorded in the kill ring. @xref{Cut and Paste}, 319Emacs kills, except that they are not recorded in the kill ring.
320for 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.)
371last-yank pointer which points at an entry in the kill ring. Each 371last-yank pointer which points at an entry in the kill ring. Each
372time you kill, the last-yank pointer moves to the newly made entry at 372time you kill, the last-yank pointer moves to the newly made entry at
373the front of the ring. @kbd{C-y} yanks the entry which the last-yank 373the front of the ring. @kbd{C-y} yanks the entry which the last-yank
374pointer points to. @kbd{M-y} moves the last-yank pointer to a 374pointer points to. @kbd{M-y} after a @kbd{C-y} or another @kbd{M-y}
375different entry, and the text in the buffer changes to match. Enough 375moves 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 376buffer changes to match. Enough @kbd{M-y} commands one after another
377you can get any entry into the buffer. Eventually the pointer reaches 377can move the pointer to any entry in the ring, so you can get any
378the end of the ring; the next @kbd{M-y} loops back around to the first 378entry into the buffer. Eventually the pointer reaches the end of the
379entry again. 379ring; 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
382not change the order of the entries in the ring, which always runs from 382not 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
388the ring; from the front of the ring, it moves around to the last 388the ring; from the front of the ring, it moves around to the last
389entry and continues forward from there. 389entry 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
392stop doing @kbd{M-y} commands and it will stay there. It's just a copy 392can stop doing @kbd{M-y} commands and the last yanked text will stay
393of the kill ring entry, so editing it in the buffer does not change 393there. It's just a copy of the kill ring entry, so editing it in the
394what's in the ring. As long as no new killing is done, the last-yank 394buffer does not change what's in the ring. As long as no new killing
395pointer remains at the same place in the kill ring, so repeating 395is 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. 396ring, so repeating @kbd{C-y} will yank another copy of the same
397previous 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
399last-yank pointer to the entry that it yanks. 400last-yank pointer to the entry that it yanks.
@@ -404,11 +405,18 @@ one of the previous kills. You can use the minibuffer history
404commands (@pxref{Minibuffer History}) to navigate or search through 405commands (@pxref{Minibuffer History}) to navigate or search through
405the entries in the kill ring until you find the one you want to 406the entries in the kill ring until you find the one you want to
406reinsert. Or you can use completion commands (@pxref{Completion 407reinsert. Or you can use completion commands (@pxref{Completion
407Commands}) to complete on the list of entries in the kill ring or pop 408Commands}) to complete on an entry from the list of entries in the
408up the @file{*Completions*} buffer with the candidate entries from 409kill ring or pop up the @file{*Completions*} buffer with the candidate
409which you can choose. After selecting the kill-ring entry, you can 410entries from which you can choose. After selecting the kill-ring
410optionally edit it in the minibuffer. Finally, type @kbd{RET} to exit 411entry, you can optionally edit it in the minibuffer. Finally, type
411the minibuffer and insert the selected text. 412@kbd{RET} to exit the minibuffer and insert the text of the selected
413kill-ring entry. Like in case of @kbd{M-y} after another yank
414command, the last-yank pointer is left pointing at the text you just
415yanked, whether it is one of the previous kills or an entry from the
416kill-ring that you edited before inserting it. (In the latter case,
417the edited entry is added to the front of the kill-ring.) So here,
418too, typing @kbd{C-y} will yank another copy of the text just
419inserted.
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
414command that is not a yank command, @kbd{M-y} leaves the cursor in 422command 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
1864editor---in this case @command{emacsclient}---to exit before doing 1864editor---in this case @command{emacsclient}---to exit before doing
1865something else. 1865something else.
1866 1866
1867@findex server-edit-abort
1868 If you want to abandon the edit instead, use the @w{@kbd{M-x
1869server-edit-abort}} command. This sends a message back to the
1870@command{emacsclient} program, telling it to exit with abnormal exit
1871status, 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
1868arguments: @samp{emacsclient @var{file1} @var{file2} ...} tells the 1874arguments: @samp{emacsclient @var{file1} @var{file2} ...} tells the
1869Emacs server to visit @var{file1}, @var{file2}, and so forth. Emacs 1875Emacs 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
310minibuffer window, even if that is active at the time). Deleting the 310minibuffer window, even if that is active at the time). Deleting the
311window has no effect on the buffer it used to display; the buffer 311window has no effect on the buffer it used to display; the buffer
312continues to exist, and you can still switch to it with @kbd{C-x b}. 312continues to exist, and you can still switch to it with @kbd{C-x b}.
313The option @code{delete-window-choose-selected} allows to choose which
314window becomes the new selected window instead (@pxref{Deleting
315Windows,,, 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
842will be printed as 842will 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*
869Like @code{:no-eval}, but alaways inserts @samp{[it depends]} as the 869Like @code{:no-eval}, but always inserts @samp{[it depends]} as the
870result. 870result. 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
876will result in: 877will 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
896Used to output an example result from non-evaluating example forms. 897Used to output an example result from non-evaluating example forms.
898For 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
906will result in:
907
908@example
909(looking-at "f[0-9]")
910eg. @click{} t
911@end example
912
903@item :result-string 913@item :result-string
904@itemx :eg-result-string 914@itemx :eg-result-string
905These two are the same as @code{:result} and @code{:eg-result}, 915These 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
953Lisp packages can add functions to groups with this command. Each 963Lisp 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
956in the function group to insert the function into. 966in 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
1429Emacs primitives, convert @code{emacs_value} objects to and from C 1429Emacs primitives, convert @code{emacs_value} objects to and from C
1430datatypes (@pxref{Module Values}), or interact with Emacs in any other 1430datatypes (@pxref{Module Values}), or interact with Emacs in any other
1431way, some call from Emacs to @code{emacs_module_init} or to a module 1431way, some call from Emacs to @code{emacs_module_init} or to a module
1432function must be in the call stack. Module function may not interact 1432function must be in the call stack. Module functions may not interact
1433with Emacs while garbage collection is running; @pxref{Garbage 1433with Emacs while garbage collection is running; @pxref{Garbage
1434Collection}. They may only interact with Emacs from Lisp interpreter 1434Collection}. They may only interact with Emacs from Lisp interpreter
1435threads (including the main thread) created by Emacs; @pxref{Threads}. 1435threads (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.
3004However, @var{facespec} can also evaluate to a list of this form: 3004However, @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
2370The argument @var{meta} controls support for input character codes 2370The argument @var{meta} controls support for input character codes
2371above 127. If @var{meta} is @code{t}, Emacs converts characters with 2371above 127. If @var{meta} is @code{t}, Emacs converts characters with
2372the 8th bit set into Meta characters. If @var{meta} is @code{nil}, 2372the 8th bit set into Meta characters, before it decodes them as needed
2373(@pxref{Terminal I/O Encoding}). If @var{meta} is @code{nil},
2373Emacs disregards the 8th bit; this is necessary when the terminal uses 2374Emacs disregards the 8th bit; this is necessary when the terminal uses
2374it as a parity bit. If @var{meta} is neither @code{t} nor @code{nil}, 2375it as a parity bit. If @var{meta} is the symbol @code{encoded}, Emacs
2375Emacs uses all 8 bits of input unchanged. This is good for terminals 2376first decodes the characters using all the 8 bits of each byte, and
2376that use 8-bit character sets. 2377then converts the decoded single-byte characters into Meta characters
2378if 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
2380input unchanged, both before and after decoding them. This is good
2381for terminals that use 8-bit character sets and don't encode the Meta
2382modifier as the eighth bit.
2377 2383
2378If @var{quit-char} is non-@code{nil}, it specifies the character to 2384If @var{quit-char} is non-@code{nil}, it specifies the character to
2379use for quitting. Normally this character is @kbd{C-g}. 2385use 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
2398when @var{interrupt} is @code{nil}. 2404when @var{interrupt} is @code{nil}.
2399@item meta 2405@item meta
2400is @code{t} if Emacs treats the eighth bit of input characters as 2406is @code{t} if Emacs treats the eighth bit of input characters as
2401the meta bit; @code{nil} means Emacs clears the eighth bit of every 2407the Meta bit before decoding input; @code{encoded} if Emacs treats the
2402input character; any other value means Emacs uses all eight bits as the 2408eighth bit of the decoded single-byte characters as the Meta bit;
2403basic character code. 2409@code{nil} if Emacs clears the eighth bit of every input character;
2410any other value means Emacs uses all eight bits as the basic character
2411code.
2404@item quit 2412@item quit
2405is the character Emacs currently uses for quitting, usually @kbd{C-g}. 2413is 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
371These are @dfn{non-greedy} variants of the operators @samp{*}, @samp{+} 371are @dfn{non-greedy} variants of the operators @samp{*}, @samp{+}
372and @samp{?}. Where those operators match the largest possible 372and @samp{?}. Where those operators match the largest possible
373substring (consistent with matching the entire containing expression), 373substring (consistent with matching the entire containing expression),
374the non-greedy variants match the smallest possible substring 374the non-greedy variants match the smallest possible substring
@@ -443,6 +443,13 @@ including newline. However, a reversed range should always be from
443the letter @samp{z} to the letter @samp{a} to make it clear that it is 443the letter @samp{z} to the letter @samp{a} to make it clear that it is
444not a typo; for example, @samp{[+-*/]} should be avoided, because it 444not a typo; for example, @samp{[+-*/]} should be avoided, because it
445matches only @samp{/} rather than the likely-intended four characters. 445matches only @samp{/} rather than the likely-intended four characters.
446
447@item
448If the end points of a range are raw 8-bit bytes (@pxref{Text
449Representations}), or if the range start is ASCII and the end is a raw
450byte (as in @samp{[a-\377]}), the range will match only ASCII
451characters and raw 8-bit bytes, but not non-ASCII characters. This
452feature is intended for searching text in unibyte buffers and strings.
446@end enumerate 453@end enumerate
447 454
448Some kinds of character alternatives are not the best style even 455Some 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}),
572and by Font Lock mode during syntactic fontification (@pxref{Syntactic 572and by Font Lock mode during syntactic fontification (@pxref{Syntactic
573Font Lock}). It is called with two arguments, @var{start} and 573Font 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
575which it should act. It is allowed to call @code{syntax-ppss} on any 575which it should act. It is allowed to arbitrarily move point within
576position before @var{end}, but if a Lisp program calls 576the 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 577need to use @code{save-excursion} (@pxref{Excursions}). It is also
578some earlier position, then it is that program's responsibility to 578allowed to call @code{syntax-ppss} on any position before @var{end},
579call @code{syntax-ppss-flush-cache} to flush the now obsolete info 579but if a Lisp program calls @code{syntax-ppss} on some position and
580from the cache. 580later modifies the buffer at some earlier position, then it is that
581program's responsibility to call @code{syntax-ppss-flush-cache} to
582flush 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
1582value (@pxref{Default Value}) of @var{variable} instead. 1582value (@pxref{Default Value}) of @var{variable} instead.
1583@end defun 1583@end defun
1584 1584
1585@defun buffer-local-boundp variable buffer
1586This returns non-@code{nil} if there's either a buffer-local binding
1587of @var{variable} (a symbol) in buffer @var{buffer}, or @var{variable}
1588has a global binding.
1589@end defun
1590
1585@defun buffer-local-variables &optional buffer 1591@defun buffer-local-variables &optional buffer
1586This function returns a list describing the buffer-local variables in 1592This function returns a list describing the buffer-local variables in
1587buffer @var{buffer}. (If @var{buffer} is omitted, the current buffer 1593buffer @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
1318Parameters}. 1318Parameters}.
1319@end deffn 1319@end deffn
1320 1320
1321When @code{delete-window} deletes the selected window of its frame, it
1322has to make another window the new selected window of that frame. The
1323following option allows configuring which window is chosen.
1324
1325@defopt delete-window-choose-selected
1326This option allows specifying which window should become a frame's
1327selected window after @code{delete-window} has deleted the previously
1328selected 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}
1335choose the window comprising the frame coordinates of point of the
1336previously selected window on that frame.
1337
1338@item @code{nil}
1339choose the first window (the window returned by
1340@code{frame-first-window}) on that frame.
1341@end itemize
1342
1343A window with a non-@code{nil} @code{no-other-window} parameter is
1344chosen only if all other windows on that frame have that parameter set
1345to 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
1322This function makes @var{window} fill its frame, deleting other 1349This function makes @var{window} fill its frame, deleting other
1323windows as necessary. If @var{window} is omitted or @code{nil}, it 1350windows 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{}
1869This macro executes @var{forms} with @var{frame} as the selected
1870frame. The value returned is the value of the last form in
1871@var{forms}. This macro saves and restores the selected frame, and
1872changes the order of neither the recently selected windows nor the
1873buffers in the buffer list.
1874@end defmac
1875
1841@defun frame-selected-window &optional frame 1876@defun frame-selected-window &optional frame
1842This function returns the window on @var{frame} that is selected 1877This function returns the window on @var{frame} that is selected
1843within that frame. @var{frame} should be a live frame; if omitted or 1878within that frame. @var{frame} should be a live frame; if omitted or
@@ -1999,7 +2034,7 @@ meaning as for @code{next-window}.
1999criterion, without selecting it: 2034criterion, 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
2003This function returns a live window which is heuristically the least 2038This function returns a live window which is heuristically the least
2004recently used. The optional argument @var{all-frames} has 2039recently used. The optional argument @var{all-frames} has
2005the same meaning as in @code{next-window}. 2040the same meaning as in @code{next-window}.
@@ -2010,33 +2045,25 @@ window (@pxref{Dedicated Windows}) is never a candidate unless the
2010optional argument @var{dedicated} is non-@code{nil}. The selected 2045optional argument @var{dedicated} is non-@code{nil}. The selected
2011window is never returned, unless it is the only candidate. However, if 2046window is never returned, unless it is the only candidate. However, if
2012the optional argument @var{not-selected} is non-@code{nil}, this 2047the optional argument @var{not-selected} is non-@code{nil}, this
2013function returns @code{nil} in that case. 2048function 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
2018This function is like @code{get-lru-window}, but it returns the most 2055This function is like @code{get-lru-window}, but it returns the most
2019recently used window instead. The meaning of the arguments is the 2056recently used window instead. The meaning of the arguments is the
2020same as described for @code{get-lru-window}. 2057same 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
2025This function returns the window with the largest area (height times 2062This function returns the window with the largest area (height times
2026width). The optional argument @var{all-frames} specifies the windows to 2063width). If there are two candidate windows of the same size, it prefers
2027search, and has the same meaning as in @code{next-window}. 2064the one that comes first in the cyclic ordering of windows, starting
2028 2065from the selected window. The meaning of the arguments is the same as
2029A minibuffer window is never a candidate. A dedicated window 2066for @code{get-lru-window}.
2030(@pxref{Dedicated Windows}) is never a candidate unless the optional
2031argument @var{dedicated} is non-@code{nil}. The selected window is not
2032a candidate if the optional argument @var{not-selected} is
2033non-@code{nil}. If the optional argument @var{not-selected} is
2034non-@code{nil} and the selected window is the only candidate, this
2035function returns @code{nil}.
2036
2037If there are two candidate windows of the same size, this function
2038prefers the one that comes first in the cyclic ordering of windows,
2039starting 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
200has been tailored to work well with the X window system. 200has been tailored to work well with the X Window System.
201If you run 201If you run
202.I Emacs 202.I Emacs
203from under X windows, it will create its own X window to 203from 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.
567The complete text of the Emacs reference manual is included in a 567The complete text of the Emacs reference manual is included in a
568convenient tree structured form. 568convenient tree structured form.
569Also includes the Emacs Lisp Reference Manual, useful to anyone 569This includes the Emacs Lisp Reference Manual, useful to anyone
570wishing to write programs in the Emacs Lisp extension language, 570wishing to write programs in the Emacs Lisp extension language,
571and the Introduction to Programming in Emacs Lisp. 571and 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
52the syntax of C, Objective C, C++, Java, Fortran, Ada, Cobol, Erlang, 52the syntax of C, Objective C, C++, Java, Fortran, Ada, Cobol, Erlang,
53Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Pascal, Perl, 53Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Mercury, Pascal,
54Ruby, Rust, PHP, PostScript, Python, Prolog, Scheme and 54Perl, Ruby, Rust, PHP, PostScript, Python, Prolog, Scheme and most
55most assembler\-like syntaxes. 55assembler\-like syntaxes.
56Both forms read the files specified on the command line, and write a tag 56Both forms read the files specified on the command line, and write a tag
57table (defaults: \fBTAGS\fP for \fBetags\fP, \fBtags\fP for 57table (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.
91In C and derived languages, create tags for function declarations, 91In C and derived languages, create tags for function declarations,
92and create tags for extern variables unless \-\-no\-globals is used. 92and create tags for extern variables unless \-\-no\-globals is used.
93In Lisp, create tags for (defvar foo) declarations. 93In Lisp, create tags for (defvar foo) declarations.
94In Mercury, declarations start a line with "\|\fB:-\fP\|" and are always
95tagged. In addition, this option tags predicates or functions in first
96rules of clauses, as in Prolog.
94.TP 97.TP
95.B \-D, \-\-no\-defines 98.B \-D, \-\-no\-defines
96Do not create tag entries for C preprocessor constant definitions 99Do 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++.
125Parse the following files according to the given language. More than 128Parse the following files according to the given language. More than
126one such options may be intermixed with filenames. Use \fB\-\-help\fP 129one such options may be intermixed with filenames. Use \fB\-\-help\fP
127to get a list of the available languages and their default filename 130to get a list of the available languages and their default filename
128extensions. The "auto" language can be used to restore automatic 131extensions. For example, as Mercury and Objective-C have same
129detection of language based on the file name. The "none" 132filename extension \fI.m\fP, a test based on contents tries to detect
130language may be used to disable language parsing altogether; only 133the language. If this test fails, \fB\-\-language=\fP\fImercury\fP or
131regexp matching is done in this case (see the \fB\-\-regex\fP option). 134\fB\-\-language=\fP\fIobjc\fP should be used.
135The "auto" language can be used to restore automatic detection of language
136based on the file name. The "none" language may be used to disable language
137parsing 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
134Create tag entries for variables that are members of structure-like 141Create 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.
117Execute the program SCRIPTNAME to dial the phone." 117Execute 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
696There are several ways to access slot values in an object. The naming 696There are several ways to access slot values in an object.
697and argument-order conventions are similar to those used for 697The following accessors are defined by CLOS to reference or modify
698referencing vectors (@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference 698slot values, and use the previously mentioned set/ref routines.
699Manual}). 699
700@defun slot-value object slot
701@anchor{slot-value}
702This function retrieves the value of @var{slot} from @var{object}.
703
704This is a generalized variable that can be used with @code{setf} to
705modify the value stored in @var{slot}. @xref{Generalized
706Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
707@end defun
708
709@defun set-slot-value object slot value
710@anchor{set-slot-value}
711This function sets the value of @var{slot} from @var{object}.
712
713This is not a CLOS function, but is the obsolete setter for
714@code{slot-value} used by the @code{setf} macro. It is therefore
715recommended 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
720This function unbinds @var{slot} in @var{object}. Referencing an
721unbound slot can signal an error.
722@end defun
723
724The following accessors follow a naming and argument-order conventions
725are 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}
703This macro retrieves the value stored in @var{obj} in the named 730This 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
705creates the slot. 732not be quoted.
706 733
707This is a generalized variable that can be used with @code{setf} to 734This is a generalized variable that can be used with @code{setf} to
708modify the value stored in @var{slot}. @xref{Generalized 735modify 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
740The following accessors are defined by CLOS to reference or modify
741slot values, and use the previously mentioned set/ref routines.
742
743@defun slot-value object slot
744@anchor{slot-value}
745This function retrieves the value of @var{slot} from @var{object}.
746Unlike @code{oref}, the symbol for @var{slot} must be quoted.
747
748This is a generalized variable that can be used with @code{setf} to
749modify the value stored in @var{slot}. @xref{Generalized
750Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
751@end defun
752
753@defun set-slot-value object slot value
754@anchor{set-slot-value}
755This function sets the value of @var{slot} from @var{object}. Unlike
756@code{oset}, the symbol for @var{slot} must be quoted.
757
758This is not a CLOS function, but is the obsolete setter for
759@code{slot-value} used by the @code{setf} macro. It is therefore
760recommended 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
765This function unbinds @var{slot} in @var{object}. Referencing an
766unbound 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}
771In OBJECT's @var{slot}, add @var{item} to the list of elements. 769In 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
807variable name of the same name as the slot. 805variable 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
984The first argument of a static method will be a class rather than an 982The argument of a static method will be a class rather than an object.
985object. Use the functions @code{oref-default} or @code{oset-default} which 983Use the functions @code{oref-default} or @code{oset-default} which
986will work on a class. 984will work on a class.
987 985
988A class's @code{make-instance} method is defined as a static 986A class's @code{make-instance} method is defined as a static
@@ -1238,12 +1236,6 @@ of CLOS.
1238Return the list of public slots for @var{obj}. 1236Return the list of public slots for @var{obj}.
1239@end defun 1237@end defun
1240 1238
1241@defun class-slot-initarg class slot
1242For 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.
1656that was requested, and optional @var{new-value} is the value that was desired 1648that was requested, and optional @var{new-value} is the value that was desired
1657to be set. 1649to be set.
1658 1650
1659This method is called from @code{oref}, @code{oset}, and other functions which 1651This method is called from @code{slot-value}, @code{set-slot-value},
1660directly reference slots in EIEIO objects. 1652and other functions which directly reference slots in EIEIO objects.
1661 1653
1662The default method signals an error of type @code{invalid-slot-name}. 1654The 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
1870Interface functions: 1870Interface functions:
1871 1871
1872@table @code 1872@table @code
1873@item mailcap-view-file
1874@findex mailcap-view-file
1875Prompt for a file name, and start a viewer applicable for the file
1876type 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
518for the values of the other parameters. 518for 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}
545will be @code{nil}. 545will 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
551To use a certificate with @code{erc-tls}, specify the optional 551To 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
2586Set the mark on the current group (@code{gnus-group-mark-group}). 2586Toggle the process mark for the current group
2587(@code{gnus-group-mark-group}).@*
2588If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark
2589for 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
2593Remove the mark from the current group 2596Remove 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
2599Remove the mark from all groups (@code{gnus-group-unmark-all-groups}). 2602Remove 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
2604Mark all groups between point and mark (@code{gnus-group-mark-region}). 2607Mark 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
4044Mark all groups in the current topic with the process mark 4047Toggle 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
4046sub-topics unless given a prefix. 4049sub-topics unless given a prefix.@*
4050If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark
4051for 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}:
5241Be aware, though, that this will make entering an @acronym{NNTP} group 5246Be aware, though, that this will make entering an @acronym{NNTP} group
5242much, much slower, so this is not recommended. 5247much, much slower, so this is not recommended.
5243 5248
5249One particular scenario in which it can be desirable to not use
5250@samp{XOVER} is for @code{nnvirtual} groups in order to support
5251limiting by extra headers (e.g., by the newsgroup of its component
5252groups). Because group parameters are not inherited, a separate
5253select 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
6620Mark the current article with the process mark 6631Toggle 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 6633If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark
6634for 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
6628Remove the process mark, if any, from the current article 6641Remove 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
10565Pick the article or thread on the current line 10578Pick the article or thread on the current line or unpick it if is
10566(@code{gnus-pick-article-or-thread}). If the variable 10579already 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
10568entire thread when used at the first article of the thread. Otherwise, 10581entire thread when used at the first article of the thread. Otherwise,
10569it selects just the article. If given a numerical prefix, go to that 10582it selects just the article. If given a numerical prefix, go to that
10570thread or article and pick it. (The line number is normally displayed 10583thread or article and pick it. (The line number is normally displayed
10571at the beginning of the summary pick lines.) 10584at the beginning of the summary pick lines.) If
10585@code{gnus-process-mark-toggle} is @code{nil}, this key will pick an
10586article or thread.
10572 10587
10573@item @key{SPC} 10588@item @key{SPC}
10574@kindex SPC @r{(Pick)} 10589@kindex SPC @r{(Pick)}
diff --git a/etc/NEWS b/etc/NEWS
index 49bde94e8dc..1693342f0af 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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.
116See https://mercurylang.org.
117
118+++
119** Etags command line option '--declarations' now has Mercury-specific behavior.
120All Mercury declarations are tagged by default. However, for
121compatibility with 'etags' support for Prolog, predicates and
122functions appearing first in clauses will also be tagged if 'etags' is
123invoked 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'.
116This command updates the syntax highlighting in this buffer. 127This 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
295about the different options to visit a file, how you can disable the 306about the different options to visit a file, how you can disable the
296prompt, and how you can tweak the file size threshold. 307prompt, and how you can tweak the file size threshold.
297 308
309+++
310** Improved support for terminal emulators that encode the Meta flag.
311Some terminal emulators set the 8th bit of Meta characters, and then
312encode the resulting character code as if it were non-ASCII character
313above codepoint 127. Previously, the only way of using these in Emacs
314was to set up the terminal emulator to use the 'ESC' characters to send
315Meta 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
317emulators 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
510about how to exit the client frame. If 'server-client-instructions' 532about how to exit the client frame. If 'server-client-instructions'
511is set to nil, this message is inhibited. 533is set to nil, this message is inhibited.
512 534
535+++
536*** New command 'server-edit-abort'.
537This command (not bound to any key by default) can be used to abort
538an edit instead of marking it as "Done" (which the 'C-x #' command
539does). The 'emacsclient' program exits with an abnormal status as
540result 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'.
538This mode is intended to be used with Icomplete or Fido, to display the 567This mode is intended to be used with Icomplete ('M-x icomplete-mode')
539list of completions candidates vertically instead of horizontally. 568or Fido ('M-x fido-mode'), to display the list of completions
569candidates vertically instead of horizontally. When used with
570Icomplete, completions are rotated and selection kept at the top.
571When used with Fido, completions scroll like a typical dropdown
572widget.
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.
579Icomplete doesn't hide the hint with the previously computed
580completions anymore when compute delay is in effect, or the previous
581computation has been aborted by input. Instead it shows the previous
582completions 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.
600These 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'.
609This allows to choose a frame's selected window after deleting the
610previously 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
615new optional argument NO-OTHER which, if non-nil, avoids returning a
616window 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'.
558This is like 'display-buffer-use-some-window', but won't reuse the 620This is like 'display-buffer-use-some-window', but won't reuse the
559current window, and when called repeatedly will try not to reuse a 621current 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
829completion over Git branch names. The default is nil, which causes 891completion over Git branch names. The default is nil, which causes
830tags to be considered as well. 892tags to be considered as well.
831 893
894---
895*** New user option 'vc-git-log-switches'.
896String 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,
902instead of sets, the process mark.
903
904+++
905*** New user option 'gnus-process-mark-toggle'.
906If non-nil (the default), the '#' command in the Group and Summary
907buffers 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'.
836If non-nil (the default), create registry entries for all messages. 912If non-nil (the default), create registry entries for all messages.
837If nil, don't automatically create entries, they must be created 913If nil, don't automatically create entries, they must be created
@@ -1037,6 +1113,15 @@ grep-like tools.
1037On systems where the grep command supports it, directories will be 1113On systems where the grep command supports it, directories will be
1038skipped. 1114skipped.
1039 1115
1116*** Commands that use 'grep-find' now follow symlinks for command-line args.
1117This is because the default value of 'grep-find-template' now includes
1118the 'find' option '-H'. Commands that use that variable, including
1119indirectly via a call to 'xref-matches-in-directory', might be
1120affected. In particular, there should be no need anymore to ensure
1121any directory names on the 'find' command lines end in a slash.
1122This 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.
1059This can be used instead of 'describe-function' for interactive 1144This can be used instead of 'describe-function' for interactive
1060commands and is globally bound to `C-h x'. 1145commands 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'.
1067It enables outlines in the output buffer of `describe-bindings' that 1152It enables outlines in the output buffer of 'describe-bindings' that
1068can provide a better overview in a long list of available bindings. 1153can 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.
1252This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the 1337This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the
1253command line under point (and any following output). 1338command line under point (and any following output).
1254 1339
1340---
1341*** New user option 'shell-has-auto-cd'.
1342If non-nil, 'shell-mode' handles implicit "cd" commands, changing the
1343directory if the command is a directory. Useful for shells like "zsh"
1344that 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
1542either an internal or external browser. 1633either an internal or external browser.
1543 1634
1635---
1636*** Support for browsing of remote files.
1637If a remote file is taken, a local temporary copy of that file is
1638passed 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'.
2092This can be used to change the priority of the hl-line overlays.
2093
2094+++
2095*** New command 'mailcap-view-file'.
2096This command will open a viewer based on the file type, as determined
2097by "~/.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).
2561To 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.
2455To restore the old binding, say something like: 2567To 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
2502were read as integers and the exponent ignored: 2.e6 was interpreted as the 2614were read as integers and the exponent ignored: 2.e6 was interpreted as the
2503integer 2. Such numerals are now read as floats with the exponent included: 2615integer 2. Such numerals are now read as floats with the exponent included:
25042.e6 is now read as the floating-point value 2000000.0. 26162.e6 is now read as the floating-point value 2000000.0.
2505That is, (read-from-string "1.e3") => (1000.0 . 4) now. 2617That 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
2711the Emacs Lisp reference manual for background. 2823the 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.
2715These variables describe facts about the SQL standard and 2827These variables describe facts about the SQL standard and
2716product-specific additions. There should be no need for users to 2828product-specific additions. There should be no need for users to
2717customize them. 2829customize 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'.
2836This 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.
2724When several subprocesses produce output simultaneously at high rate, 2840When 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. */
146static void 153static void
147memcpyz (void *dest, void const *src, ptrdiff_t len) 154memcpyz (void *dest, void const *src, ptrdiff_t len)
148{ 155{
@@ -359,6 +366,7 @@ static void HTML_labels (FILE *);
359static void Lisp_functions (FILE *); 366static void Lisp_functions (FILE *);
360static void Lua_functions (FILE *); 367static void Lua_functions (FILE *);
361static void Makefile_targets (FILE *); 368static void Makefile_targets (FILE *);
369static void Mercury_functions (FILE *);
362static void Pascal_functions (FILE *); 370static void Pascal_functions (FILE *);
363static void Perl_functions (FILE *); 371static void Perl_functions (FILE *);
364static void PHP_functions (FILE *); 372static void PHP_functions (FILE *);
@@ -379,6 +387,7 @@ static ptrdiff_t readline_internal (linebuffer *, FILE *, char const *);
379static bool nocase_tail (const char *); 387static bool nocase_tail (const char *);
380static void get_tag (char *, char **); 388static void get_tag (char *, char **);
381static void get_lispy_tag (char *); 389static void get_lispy_tag (char *);
390static void test_objc_is_mercury (char *, language **);
382 391
383static void analyze_regex (char *); 392static void analyze_regex (char *);
384static void free_regexps (void); 393static 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\
685unless you specify '--no-globals'."; 694unless you specify '--no-globals'.";
686 695
696/* Mercury and Objective C share the same .m file extensions. */
697static const char *Mercury_suffixes [] =
698 {"m",
699 NULL};
700static const char Mercury_help [] =
701 "In Mercury code, tags are all declarations beginning a line with ':-'\n\
702and optionally Prolog-like definitions (first rule for a predicate or \
703function).\n\
704To enable this behavior, run etags using --declarations.";
705static bool with_mercury_definitions = false;
706float mercury_heuristics_ratio = MERCURY_HEURISTICS_RATIO;
707
687static const char *Objc_suffixes [] = 708static 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};
691static const char Objc_help [] = 712static 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\
693class categories, methods and protocols. Tags for variables and\n\ 714class 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
6117static ptrdiff_t mercury_pr (char *, char *, ptrdiff_t);
6118static void mercury_skip_comment (linebuffer *, FILE *);
6119static bool is_mercury_type = false;
6120static bool is_mercury_quantifier = false;
6121static 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
6148static void
6149test_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
6272static void
6273Mercury_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
6314static void
6315mercury_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
6372static 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
6377static size_t
6378mercury_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
6520static ptrdiff_t
6521mercury_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 $@)
66Makefile: ../config.status $(srcdir)/Makefile.in 66Makefile: ../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:
274ifeq ($(HAVE_NATIVE_COMP),yes) 274ifeq ($(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)
278else 278else
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
295ifeq ($(HAVE_NATIVE_COMP),yes) 295ifeq ($(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 $<
299else 299else
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
91which files this object is interested in." 91which 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.")
236This FTP site should be in Emacs form as needed by `ange-ftp'. 236This FTP site should be in Emacs form as needed by `ange-ftp'.
237If this slot is nil, then use `ftp-site' instead.") 237If 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.")
96This filename excludes the directory name and is used to 96This filename excludes the directory name and is used to
97initialize the :file slot of the persistent baseclass.") 97initialize 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.
327When a cache directory is specified, then this refers to the directory 327When a cache directory is specified, then this refers to the directory
328this database contains symbols for.") 328this 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
113additional static argument data.")) 113additional static argument data.")
114 (key :initform nil :allocation :class
115 :documentation
116 "The character code used to identify inserters of this style.
117All 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.
115Plain text strings are not handled via this baseclass." 120Plain 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.
94Optional SKIPRESOLVER means to avoid refreshing the tag list, 96Optional 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.
738It is the responsibility of the inserter algorithm to clear this 741It 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).
2825If FILE is non-nil, include only those whose wildcard pattern (if any) 2825If FILE is non-nil, include only those whose wildcard pattern (if any)
2826matches FILE. 2826matches FILE.
2827If SUBDIRS is non-nil, also include the dired buffers of
2828directories below DIR.
2827The list is in reverse order of buffer creation, most recent last. 2829The list is in reverse order of buffer creation, most recent last.
2828As a side effect, killed dired buffers for DIR are removed from 2830As a side effect, killed dired buffers for DIR are removed from
2829dired-buffers." 2831dired-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.
4166Native compilation equivalent to `batch-byte-compile'." 4175Native 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.
4179Generate .elc files in addition to the .eln files. 4188Generate .elc files in addition to the .eln files.
4180Force the produced .eln to be outputted in the eln system 4189Force the produced .eln to be outputted in the eln system
4181directory (the last entry in `native-comp-eln-load-path'). 4190directory (the last entry in `native-comp-eln-load-path') unless
4182If the environment variable 'NATIVE_DISABLED' is set, only byte 4191`native-compile-target-directory' is non-nil. If the environment
4183compile." 4192variable '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."
522If SKIPNIL is non-nil, then if default value is nil return t instead." 531If 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."
715INSTANCE is the object being referenced. SLOTNAME is the offending 726INSTANCE is the object being referenced. SLOTNAME is the offending
716slot. If the slot is ok, return VALUE. 727slot. If the slot is ok, return VALUE.
717Argument FN is the function calling this verifier." 728Argument 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.
760Fills in OBJ's SLOT with its default value." 771Fills 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'.
822Fills in the default value in CLASS' in SLOT with VALUE." 833Fills 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.
47This is the next line of documentation.") 47This 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."
248Possible values are those symbols supported by the `exp-button-type' argument 248Possible values are those symbols supported by the `exp-button-type' argument
249to `speedbar-make-tag-line'." 249to `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."
286Slot is the name of the slot when created by `defclass' or the label
287created 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.
297The default value is the value installed in a class with the :initform 314CLASS can also be an object, in which case we use the object's class."
298tag. SLOT can be the slot name, or the tag specified by the :initarg
299tag 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
490information for all instrumented functions is reset after results are 494information for all instrumented functions is reset after results are
491displayed." 495displayed."
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
125delimiter or an Escaped or Char-quoted character.")) 125delimiter 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.
129This function is useful for
130`syntax-propertize-extend-region-functions';
131see 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
44This is used by `epa-ks-lookup-key', for looking up public keys." 44This 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.
147If 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
2226That is, if called with 2226That 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
2230then the server and full-name will be set to those values, 2230then the server and full-name will be set to those values,
2231whereas `erc-compute-port' and `erc-compute-nick' will be invoked 2231whereas `erc-compute-port' and `erc-compute-nick' will be invoked
@@ -2260,7 +2260,7 @@ Non-interactively, it takes the keyword arguments
2260 2260
2261That is, if called with 2261That 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
2265then the server and full-name will be set to those values, 2265then the server and full-name will be set to those values,
2266whereas `erc-compute-port' and `erc-compute-nick' will be invoked 2266whereas `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
183To modify the appearance of the fringe in a specific frame, use 183To modify the appearance of the fringe in a specific frame, use
184the interactive function `set-fringe-style'." 184the interactive function `set-fringe-style'.
185
186Note that, despite the name, this is not a variable that controls
187a (major or minor) Emacs mode, but controls the appearance of the
188fringes."
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
248fringe widths set by this command. This command applies to all 252fringe widths set by this command. This command applies to all
249frames that exist and frames to be created in the future. If you 253frames that exist and frames to be created in the future. If you
250want to set the default appearance of fringes on the selected 254want to set the default appearance of fringes on the selected
251frame only, see the command `set-fringe-style'." 255frame only, see the command `set-fringe-style'.
256
257Note that, despite the name, this is not a (major or minor) Emacs
258mode, 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.
171This variable can also be a list of regexp of headers to remain visible. 171This variable can also be a list of regexp of headers to remain visible.
172If this variable is non-nil, `gnus-ignored-headers' will be ignored." 172If 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
402regexp grouping should be displayed and highlighted. The fourth 407regexp grouping should be displayed and highlighted. The fourth
403is the face used for highlighting." 408is 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."
1935Return nil if the group isn't displayed." 1945Return 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.
1441If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." 1441If 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.
1188If the number of articles in a newsgroup is greater than this value, 1196If 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.
114See `icomplete-delay-completions-threshold'." 120See `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.
153Used to implement the option `icomplete-show-matches-on-no-input'.") 159Used 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.
220Second entry becomes the first and can be selected with 245Second 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.
604Should be run in on the minibuffer `pre-command-hook'.
605See `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.
709Return 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.
41This function will be called with no arguments. 41This function will be called with no arguments.
42If it is called somewhere where auto-indentation cannot be done 42If it is called somewhere where it cannot auto-indent, the function
43\(e.g. inside a string), the function should simply return `noindent'. 43should return `noindent' to signal that it didn't.
44Setting this function is all you need to make TAB indent appropriately. 44Setting this function is all you need to make TAB indent appropriately.
45Don't rebind TAB unless you really need to.") 45Don'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').
409Larger values may reduce Isearch's responsiveness to user input; 409Larger values may reduce Isearch's responsiveness to user input;
410smaller values make matches highlight slowly. 410smaller 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.
3471STRING's characters are translated using `translation-table-for-input' 3467STRING'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" "\
1069Show commands (interactively callable functions) that match PATTERN. 1069Show 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" "\
5342Given FILE remove all its *.eln files in `comp-eln-load-path' 5342Given FILE remove all its *.eln files in `native-comp-eln-load-path'
5343sharing the original source filename (including FILE). 5343sharing 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" "\
5348Given a Lisp source FILENAME return the corresponding .eln file if found. 5348Given a Lisp source FILENAME return the corresponding .eln file if found.
5349Search happens in `comp-eln-load-path'. 5349Search 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)
5374Like `batch-native-compile', but used for bootstrap. 5374Like `batch-native-compile', but used for bootstrap.
5375Generate .elc files in addition to the .eln files. 5375Generate .elc files in addition to the .eln files.
5376Force the produced .eln to be outputted in the eln system 5376Force the produced .eln to be outputted in the eln system
5377directory (the last entry in `comp-eln-load-path'). 5377directory (the last entry in `native-comp-eln-load-path').
5378If the environment variable 'NATIVE_DISABLED' is set, only byte 5378If the environment variable 'NATIVE_DISABLED' is set, only byte
5379compile." nil nil) 5379compile." nil nil)
5380 5380
@@ -5394,7 +5394,7 @@ nil -- Select all files.
5394a string -- A regular expression selecting files with matching names. 5394a string -- A regular expression selecting files with matching names.
5395a function -- A function selecting files with matching names. 5395a function -- A function selecting files with matching names.
5396 5396
5397The variable `comp-async-jobs-number' specifies the number 5397The variable `native-comp-async-jobs-number' specifies the number
5398of (commands) to run simultaneously. 5398of (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" "\
7213Delete the active region.
7214If 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 "\
9399If non-nil, evaluating defining forms instruments for Edebug.
9400This 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
9404You can use the command `edebug-all-defs' to toggle the value of this
9405variable. 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 "\
9412Non-nil means evaluation of all forms will instrument for Edebug.
9413This doesn't apply to loading or evaluations in the minibuffer.
9414Use 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" "\
9393Return t if SPEC uses only extant spec symbols. 9419Return t if SPEC uses only extant spec symbols.
9394An extant spec symbol is a symbol that is not a function and has a 9420An 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" "\
10578Ask a keyserver for all keys matching QUERY.
10579
10580The keyserver to be used is specified by `epa-keyserver'.
10581
10582If EXACT is non-nil (interactively, prefix argument), require
10583exact matches.
10584
10585Note that the request may fail if the query is not specific
10586enough, 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.
12603If optional IN-OTHER-WINDOW is non-nil, find the file in the other window. 12649If optional IN-OTHER-WINDOW is non-nil, find the file in the other window.
12604If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines. 12650If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines.
12605 12651
12652If optional EVENT is non-nil (default `last-nonmenu-event', move
12653point to the end position of that event before calling the
12654various ff-* hooks.
12655
12606Variables of interest include: 12656Variables 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" "\
15816Display the full documentation of COMMAND (a symbol).
15817When 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" "\
15766Return the name of the C file where SUBR-OR-VAR is defined. 15822Return the name of the C file where SUBR-OR-VAR is defined.
15767KIND should be `var' for a variable or `subr' for a subroutine. 15823KIND should be `var' for a variable or `subr' for a subroutine.
@@ -16076,22 +16132,30 @@ also supported.
16076 16132
16077There are several ways to change text in hexl mode: 16133There are several ways to change text in hexl mode:
16078 16134
16079ASCII characters (character between space (0x20) and tilde (0x7E)) are 16135Self-inserting characters are bound to `hexl-self-insert' so you
16080bound to self-insert so you can simply type the character and it will 16136can simply type the character and it will insert itself (actually
16081insert itself (actually overstrike) into the buffer. 16137overstrike) into the buffer. However, inserting non-ASCII characters
16138requires caution: the buffer's coding-system should correspond to
16139the encoding on disk, and multibyte characters should be inserted
16140with cursor on the first byte of a multibyte sequence whose length
16141is identical to the length of the multibyte sequence to be inserted,
16142otherwise this could produce invalid multibyte sequences. Non-ASCII
16143characters in ISO-2022 encodings should preferably inserted byte by
16144byte, to avoid problems caused by the designation sequences before
16145the 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
16084it isn't bound to self-insert. An octal number can be supplied in place 16148it isn't bound to self-insert. An octal number can be supplied in place
16085of another key to insert the octal number's ASCII representation. 16149of 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
16088into the buffer at the current point. 16152into 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
16091into the buffer at the current point. 16155into 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
16094into the buffer at the current point. 16158into 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" "\
16108Edit file FILENAME as a binary file in hex dump format. 16172Edit file FILENAME as a binary file in hex dump format.
16109Switch to a buffer visiting file FILENAME, creating one if none exists, 16173Switch to a buffer visiting file FILENAME, creating one if none exists,
16110and edit the file in `hexl-mode'. 16174and edit the file in `hexl-mode'. The buffer's coding-system will be
16175no-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.")
19272Uninstall jka-compr. 19337Uninstall jka-compr.
19273This removes the entries in `file-name-handler-alist' and `auto-mode-alist' 19338This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
19274and `inhibit-local-variables-suffixes' that were added 19339and `inhibit-local-variables-suffixes' that were added
19275by `jka-compr-installed'." nil nil) 19340by `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" "\
19953Setup a buffer to enter a log message. 20018Setup a buffer to enter a VC commit log message.
19954The buffer is put in mode MODE or `log-edit-mode' if MODE is nil. 20019The buffer is put in mode MODE, or `log-edit-mode' if MODE is nil.
19955\\<log-edit-mode-map> 20020\\<log-edit-mode-map>
19956If SETUP is non-nil, erase the buffer and run `log-edit-hook'. 20021If SETUP is non-nil, erase the buffer and run `log-edit-hook'.
19957Set mark and point around the entire contents of the buffer, so 20022Set mark and point around the entire contents of the buffer, so
19958that it is easy to kill the contents of the buffer with 20023that 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
19960invoking the command \\[log-edit-done] (`log-edit-done') will 20025or she is expected to invoke the command \\[log-edit-done] (`log-edit-done'),
19961call CALLBACK to do the actual commit. 20026which will call CALLBACK, a function to do the actual commit.
19962 20027
19963PARAMS if non-nil is an alist of variables and buffer-local 20028PARAMS, if non-nil, is an alist of variables and buffer-local
19964values to give them in the Log Edit buffer. Possible keys and 20029values to give to those variables in the Log Edit buffer. Possible
19965associated values: 20030keys 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
19972If BUFFER is non-nil `log-edit' will jump to that buffer, use it 20037If BUFFER is non-nil, `log-edit' will switch to that buffer, use it
19973to edit the log message and go back to the current buffer when 20038to edit the log message and go back to the current buffer when
19974done. Otherwise, it uses the current buffer. 20039done. 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" "\
20580Call Mairix with SEARCH.
20581If THREADS is non-nil, also display whole threads of found
20582messages. Results will be put into the default search file.
20583
20584\(fn SEARCH THREADS)" t nil)
20585
20586(autoload 'mairix-use-saved-search "mairix" "\
20587Use a saved search for querying Mairix." t nil)
20588
20589(autoload 'mairix-edit-saved-searches-customize "mairix" "\
20590Edit the list of saved searches in a customization buffer." t nil)
20591
20592(autoload 'mairix-search-from-this-article "mairix" "\
20593Search messages from sender of the current article.
20594This is effectively a shortcut for calling `mairix-search' with
20595f:current_from. If prefix THREADS is non-nil, include whole
20596threads.
20597
20598\(fn THREADS)" t nil)
20599
20600(autoload 'mairix-search-thread-this-article "mairix" "\
20601Search thread for the current article.
20602This is effectively a shortcut for calling `mairix-search'
20603with m:msgid of the current article and enabled threads." t nil)
20604
20605(autoload 'mairix-widget-search-based-on-article "mairix" "\
20606Create mairix query based on current article using widgets." t nil)
20607
20608(autoload 'mairix-edit-saved-searches "mairix" "\
20609Edit current mairix searches." t nil)
20610
20611(autoload 'mairix-widget-search "mairix" "\
20612Create mairix query interactively using graphical widgets.
20613MVALUES may contain values from current article.
20614
20615\(fn &optional MVALUES)" t nil)
20616
20617(autoload 'mairix-update-database "mairix" "\
20618Call mairix for updating the database for SERVERS.
20619Mairix 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.")
21518Set up isearch to search multiple buffers. 21627Set up isearch to search multiple buffers.
21519Intended to be added to `isearch-mode-hook'." nil nil) 21628Intended to be added to `isearch-mode-hook'." nil nil)
21520 21629
21630(autoload 'multi-isearch-switch-buffer "misearch" "\
21631Switch to the next buffer in multi-buffer search." nil nil)
21632
21521(autoload 'multi-isearch-buffers "misearch" "\ 21633(autoload 'multi-isearch-buffers "misearch" "\
21522Start multi-buffer Isearch on a list of BUFFERS. 21634Start multi-buffer Isearch on a list of BUFFERS.
21523This list can contain live buffers or their names. 21635This 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" "\
24249Toggle Outline minor mode. 24361Toggle 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" "\
25314Run `pp-eval-expression' on sexp before point. 25426Run `pp-eval-expression' on sexp before point.
25315With argument, pretty-print output into current buffer. 25427With ARG, pretty-print output into current buffer.
25316Ignores leading comment characters. 25428Ignores 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" "\
25321Run `pp-macroexpand-expression' on sexp before point. 25433Run `pp-macroexpand-expression' on sexp before point.
25322With argument, pretty-print output into current buffer. 25434With ARG, pretty-print output into current buffer.
25323Ignores leading comment characters. 25435Ignores 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*\"
26996in another window, initially containing an empty regexp. 27108in another window, initially containing an empty regexp.
26997 27109
26998As you edit the regexp in the \"*RE-Builder*\" buffer, the 27110As you edit the regexp in the \"*RE-Builder*\" buffer, the
26999matching parts of the target buffer will be highlighted." t nil) 27111matching parts of the target buffer will be highlighted.
27112
27113Case-sensitivity can be toggled with \\[reb-toggle-case]. The
27114regexp builder supports three different forms of input which can
27115be set with \\[reb-change-syntax]. More options and details are
27116provided 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" "\
28019Ask user a multiple choice question. 28136Ask user to select an entry from CHOICES, promting with PROMPT.
28020PROMPT should be a string that will be displayed as the prompt. 28137This function allows to ask the user a multiple-choice question.
28021 28138
28022CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a 28139CHOICES should be a list of the form (KEY NAME [DESCRIPTION]).
28023character to be entered. NAME is a short name for the entry to 28140KEY is a character the user should type to select the entry.
28024be displayed while prompting (if there's room, it might be 28141NAME is a short name for the entry to be displayed while prompting
28025shortened). DESCRIPTION is an optional longer explanation that 28142\(if there's no room, it might be shortened).
28026will be displayed in a help buffer if the user requests more 28143DESCRIPTION is an optional longer description of the entry; it will
28027help. 28144be displayed in a help buffer if the user requests more help. This
28145help description has a fixed format in columns. For greater
28146flexibility, instead of passing a DESCRIPTION, the caller can pass
28147the optional argument HELP-STRING. This argument is a string that
28148should contain a more detailed description of all of the possible
28149choices. `read-multiple-choice' will display that description in a
28150help buffer if the user requests that.
28028 28151
28029This function translates user input into responses by consulting 28152This function translates user input into responses by consulting
28030the bindings in `query-replace-map'; see the documentation of 28153the bindings in `query-replace-map'; see the documentation of
28031that variable for more information. In this case, the useful 28154that variable for more information. The relevant bindings for the
28032bindings are `recenter', `scroll-up', and `scroll-down'. If the 28155purposes of this function are `recenter', `scroll-up', `scroll-down',
28033user enters `recenter', `scroll-up', or `scroll-down' responses, 28156and `edit'.
28034perform the requested window recentering or scrolling and ask 28157If the user types the `recenter', `scroll-up', or `scroll-down'
28035again. 28158responses, the function performs the requested window recentering or
28036 28159scrolling, and then asks the question again. If the user enters `edit',
28037When `use-dialog-box' is t (the default), this function can pop 28160the function starts a recursive edit. When the user exit the recursive
28038up a dialog window to collect the user input. That functionality 28161edit, the multiple-choice prompt gains focus again.
28039requires `display-popup-menus-p' to return t. Otherwise, a 28162
28040text dialog will be used. 28163When `use-dialog-box' is t (the default), and the command using this
28164function was invoked via the mouse, this function pops up a GUI dialog
28165to collect the user input, but only if Emacs is capable of using GUI
28166dialogs. Otherwise, the function will always use text-mode dialogs.
28041 28167
28042The return value is the matching entry from the CHOICES list. 28168The 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,
34136like \"/sys\" or \"/C:\".") 34262like \"/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) "\
34139Load 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)) 34265Load 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 "\
34142Add 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)) 34268Add 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 "\
34178Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) 34304Regular 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) "\
34307Load 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 "\
34183Add 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))) 34310Add 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' 790The 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.
130If SELECTFUN is non-nil, elements aren't compared directly, but instead 130Elements aren't compared directly, but instead
131they are passed through SELECTFUN before comparison." 131they 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.
762Display the current buffer's file if FILE is nil or if called 763Display the current buffer's file if FILE is nil or if called
763interactively. Turn the filename into a URL with function 764interactively. 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.
800See `browse-url' for details.
801
797Display the current buffer if BUFFER is nil. Display only the 802Display the current buffer if BUFFER is nil. Display only the
798currently visible part of BUFFER (from a temporary file) if buffer is 803currently visible part of BUFFER (from a temporary file) if buffer is
799narrowed." 804narrowed."
@@ -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.
851See `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.
860Prompt for a URL, defaulting to the URL at or before point. 866This will typically (by default) open URL with an external web
861Invokes a suitable browser function which does the actual job. 867browser, but a wide variety of different methods can be used,
868depending on the URL type.
862 869
863The variables `browse-url-browser-function', 870The variables `browse-url-browser-function',
864`browse-url-handlers', and `browse-url-default-handlers' 871`browse-url-handlers', and `browse-url-default-handlers'
865determine which browser function to use. 872determine which browser function to use.
866 873
874This command prompts for a URL, defaulting to the URL at or
875before point.
876
867The additional ARGS are passed to the browser function. See the 877The additional ARGS are passed to the browser function. See the
868doc strings of the actual functions, starting with 878doc 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.
908Variable `browse-url-browser-function' says which browser to use. 918See `browse-url' for details.
909Optional prefix argument ARG non-nil inverts the value of the option 919Optional 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.
950The URL is the one around or before the position of the mouse click 960See `browse-url' for details.
951but point is not changed. Variable `browse-url-browser-function' 961
952says which browser to use." 962The URL is the one around or before the position of the mouse
963click 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'.
1796If `current-prefix-arg' is non-nil, use 1808If `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.
1161This normally involves executing some external program to display
1162the file.
1163
1164See \"~/.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.
2053VEC-OR-PROC identifies the connection to use, SIGNAL is the 2053VEC-OR-PROC identifies the connection to use, SIGNAL is the
2054signal identifier to be raised, remaining arguments passed to 2054signal 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.
1810Stops when a match is found. 1810Stops when a match is found.
1811To continue searching for next match, use command \\[tags-loop-continue]. 1811To continue searching for next match, use the command \\[fileloop-continue].
1812 1812
1813If FILES if non-nil should be a list or an iterator returning the 1813If FILES if non-nil should be a list or an iterator returning the
1814files to search. The search will be restricted to these files. 1814files 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.
1835Third arg DELIMITED (prefix arg) means replace only word-delimited matches. 1835Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
1836If you exit (\\[keyboard-quit], RET or q), you can resume the query replace 1836If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
1837with the command \\[tags-loop-continue]. 1837with the command \\[fileloop-continue].
1838For non-interactive use, superseded by `fileloop-initialize-replace'." 1838For 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.
141Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion: 157Most 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.
164Effective only if `hide-ifdef-expand-reinclusion-protection' is t." 180Effective 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'.
332It will backup this variable to `hide-ifdef-env-backup' before clearing to 363It will backup this variable to `hide-ifdef-env-backup' before clearing to
333prevent accidental clearance." 364prevent accidental clearance.
365When 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.
386If 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.
434The evaluator is given a canonical form and returns t if text under 492The evaluator is given a canonical form and returns t if text under
435that form should be displayed.") 493that 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.
732Assuming we've just regexp-matched with `hif-decfloat-regexp' and it matched.
733if 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.
756Assuming we've just regexp-matched with `hif-hexfloat-regexp' and it matched.
757if 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.
800Assuming 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.
675Self-reference (directly or indirectly) tokens are not expanded. 1100Self-reference (directly or indirectly) tokens are not expanded.
676EXPAND_LIST is the list of macro names currently being expanded, used for 1101EXPAND_LIST is the list of macro names currently being expanded, used for
677detecting self-reference." 1102detecting self-reference.
1103Function-like macros with calling depth LEVEL 0 does not expand arguments,
1104this 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.
746Return translated list in prefix form. MACRONAME is applied when invoking 1184Return translated list in prefix form. MACRONAME is applied when invoking
747macros to prevent self-reference." 1185macros 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.
879factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' | 1323factor : `!' 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.
989Currently support only simple token concatenation. Also support weird (but 1448Also support weird (but valid) token concatenation like `>' ## `>' becomes `>>'.
990valid) token concatenation like `>' ## `>' becomes `>>'. Here we take care only 1449Here we take care only those that can be evaluated during preprocessing time and
991those that can be evaluated during preprocessing time and ignore all those that 1450ignore all those that can only be evaluated at C(++) runtime (like `++', `--'
992can only be evaluated at C(++) runtime (like `++', `--' and `+='...)." 1451and `+='...)."
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)))))
1002preprocessing 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.
1436Does nothing if `hide-ifdef-lines' is nil." 1959Does 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.
1485It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag 2008It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag
1486indicating that we should expand the #ifdef even if it should be hidden. 2009indicating that we should expand the #ifdef even if it should be hidden.
1487Refer to `hide-ifdef-expand-reinclusion-protection' for more details." 2010Refer 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.
1569If no region active, find the current #ifdefs and evaluate the result. 2139If no region is currently active, find the current #ifdef/#define and evaluate
2140the result; otherwise it looks for current word at point.
1570Currently it supports only math calculations, strings or argumented macros can 2141Currently it supports only math calculations, strings or argumented macros can
1571not be expanded." 2142not be expanded.
2143This function by default ignores parsing error and return `false' on evaluating
2144runtime C(++) statements or tokens that normal C(++) preprocessor can't perform;
2145however, 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'."
1745It does not do the work that's pointless to redo on a recursive entry." 2375It 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.
1853Assume that defined symbols have been added to `hide-ifdef-env'. 2496Assume that defined symbols have been added to `hide-ifdef-env'.
1854The text hidden is the text that would not be included by the C 2497The text hidden is the text that would not be included by the C
1855preprocessor if it were given the file with those symbols defined. 2498preprocessor if it were given the file with those symbols defined.
1856With prefix command presents it will also hide the #ifdefs themselves. 2499With prefix command presents it will also hide the #ifdefs themselves.
1857 2500
2501Hiding will only be performed within the marked region if there is one.
2502
1858Turn off hiding by calling `show-ifdefs'." 2503Turn 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
1608which filenames are considered temporary. 1608which filenames are considered temporary.
1609 1609
1610If invoked with a prefix argument, or if there is no server process running, 1610If invoked with a prefix argument, or if there is no server process running,
1611starts server process and that is all. Invoked by \\[server-edit]." 1611starts server process and that is all. Invoked by \\[server-edit].
1612
1613To 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.
326Implicit \"cd\" is changing the directory if the command is a directory.
327You can make this variable buffer-local to change it, per shell-mode instance.
328Useful 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.
4222As defined by `max-mini-window-height'. FRAME defaults to the
4223selected frame. Result may be a floating-point number,
4224i.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.
4222MESSAGE may be either a string or a buffer. 4232MESSAGE may be either a string or a buffer.
4223 4233
4224A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long 4234A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long
4225for maximum height of the echo area, as defined by `max-mini-window-height' 4235for maximum height of the echo area, as defined by `max-mini-window-lines'
4226if `resize-mini-windows' is non-nil. 4236if `resize-mini-windows' is non-nil.
4227 4237
4228Returns either the string shown in the echo area, or when a pop-up 4238Returns 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
4335Optional fifth arg REPLACE, if non-nil, means to insert the 4338Optional fifth arg REPLACE, if non-nil, means to insert the
4336output in place of text from START to END, putting point and mark 4339output in place of text from START to END, putting point and mark
4337around it. 4340around it. If REPLACE is the symbol `no-mark', don't set the mark.
4338 4341
4339Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer 4342Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
4340or buffer name to which to direct the command's standard error 4343or 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.
200Also 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.
200This is morally equivalent to (setf PLACE (cons NEWELT PLACE)), 208This is morally equivalent to (setf PLACE (cons NEWELT PLACE)),
@@ -2476,7 +2484,11 @@ file name without extension.
2476If TYPE is nil, then any kind of definition is acceptable. If 2484If TYPE is nil, then any kind of definition is acceptable. If
2477TYPE is `defun', `defvar', or `defface', that specifies function 2485TYPE is `defun', `defvar', or `defface', that specifies function
2478definition, variable definition, or face definition only. 2486definition, variable definition, or face definition only.
2479Otherwise TYPE is assumed to be a symbol property." 2487Otherwise TYPE is assumed to be a symbol property.
2488
2489This function only works for symbols defined in Lisp files. For
2490symbols that are defined in C files, use `help-C-file-name'
2491instead."
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.
132That is performed after all conflict markers in it have been 139That 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.
1136If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. 1145If 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.
440Every element of ALIST has the form (FN KEY), where KEY is
441appended to MODIFIERS, adding PREFIX to the beginning, before
442installing the key. Previous bindings of FN are unbound.
443If 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'.
432Keybindings are of the form MODIFIERS-{left,right,up,down}, 462Keybindings are of the form MODIFIERS-{left,right,up,down},
433where MODIFIERS is either a list of modifiers or a single modifier. 463where MODIFIERS is either a list of modifiers or a single modifier.
464If MODIFIERS is `none', the keybindings will be directly bound to
465the arrow keys.
434Default value of MODIFIERS is `shift'." 466Default 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'."
546Keys are bound to commands that display the next buffer in the specified 580Keys are bound to commands that display the next buffer in the specified
547direction. Keybindings are of the form MODIFIERS-{left,right,up,down}, 581direction. Keybindings are of the form MODIFIERS-{left,right,up,down},
548where MODIFIERS is either a list of modifiers or a single modifier. 582where MODIFIERS is either a list of modifiers or a single modifier.
583If MODIFIERS is `none', the keybindings will be directly bound to
584the arrow keys.
549Default value of MODIFIERS is `shift-meta'." 585Default 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."
618Keys are bound to commands that delete windows in the specified 656Keys are bound to commands that delete windows in the specified
619direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down}, 657direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down},
620where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or 658where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or
621a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'." 659a single modifier.
660If PREFIX is `none', no prefix is used. If MODIFIERS is `none', the keybindings
661are directly bound to the arrow keys.
662Default 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."
673Keys are bound to commands that swap the states of the selected window 717Keys are bound to commands that swap the states of the selected window
674with the window in the specified direction. Keybindings are of the form 718with the window in the specified direction. Keybindings are of the form
675MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers 719MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers
676or a single modifier. Default value of MODIFIERS is `shift-super'." 720or a single modifier.
721If MODIFIERS is `none', the keybindings will be directly bound to the
722arrow keys.
723Default 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.
753See `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.
769See `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.
788See `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.
804See `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.
2504Return a full-width window if possible. A minibuffer window is 2504Return a full-width window if possible. A minibuffer window is
2505never a candidate. A dedicated window is never a candidate 2505never a candidate. A dedicated window is never a candidate
2506unless DEDICATED is non-nil, so if all windows are dedicated, the 2506unless DEDICATED is non-nil, so if all windows are dedicated, the
2507value is nil. Avoid returning the selected window if possible. 2507value is nil. Avoid returning the selected window if possible.
2508Optional argument NOT-SELECTED non-nil means never return the 2508Optional argument NOT-SELECTED non-nil means never return the
2509selected window. 2509selected window. Optional argument NO-OTHER non-nil means to
2510never return a window whose 'no-other-window' parameter is
2511non-nil.
2510 2512
2511The following non-nil values of the optional argument ALL-FRAMES 2513The following non-nil values of the optional argument ALL-FRAMES
2512have special meanings: 2514have 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.
2543A minibuffer window is never a candidate. A dedicated window is 2547A minibuffer window is never a candidate. A dedicated window is
2544never a candidate unless DEDICATED is non-nil, so if all windows 2548never a candidate unless DEDICATED is non-nil, so if all windows
2545are dedicated, the value is nil. Optional argument NOT-SELECTED 2549are dedicated, the value is nil. Optional argument NOT-SELECTED
2546non-nil means never return the selected window. 2550non-nil means never return the selected window. Optional
2551argument NO-OTHER non-nil means to never return a window whose
2552'no-other-window' parameter is non-nil.
2547 2553
2548The following non-nil values of the optional argument ALL-FRAMES 2554The following non-nil values of the optional argument ALL-FRAMES
2549have special meanings: 2555have 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.
2575A minibuffer window is never a candidate. A dedicated window is 2583A minibuffer window is never a candidate. A dedicated window is
2576never a candidate unless DEDICATED is non-nil, so if all windows 2584never a candidate unless DEDICATED is non-nil, so if all windows
2577are dedicated, the value is nil. Optional argument NOT-SELECTED 2585are dedicated, the value is nil. Optional argument NOT-SELECTED
2578non-nil means never return the selected window. 2586non-nil means never return the selected window. Optional
2587argument NO-OTHER non-nil means to never return a window whose
2588'no-other-window' parameter is non-nil.
2579 2589
2580The following non-nil values of the optional argument ALL-FRAMES 2590The following non-nil values of the optional argument ALL-FRAMES
2581have special meanings: 2591have 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) 4147X and Y are FRAME-relative pixel coordinates. A coordinate on an
4136 (let ((parent (window-parent window))) 4148edge shared by two windows is attributed to the window on the
4137 (catch 'done 4149right (or below). Return nil if no such window can be found.
4138 (while parent 4150
4139 (if (eq parent root) 4151Optional argument FRAME must specify a live frame and defaults to
4140 (throw 'done t) 4152the selected one. Optional argument NO-OTHER non-nil means to
4141 (setq parent (window-parent parent)))))))) 4153return nil if the window located at the specified coordinates has
4154a 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.
4174When a frame's selected window gets deleted, Emacs has to choose
4175another live window on that frame to serve as its selected
4176window. This option allows to control which window gets selected
4177instead.
4178
4179The possible choices are 'mru' (the default) to select the most
4180recently used window on that frame, and 'pos' to choose the
4181window at the frame coordinates of point of the previously
4182selected window. If this is nil, choose the frame's first window
4183instead. A window with a non-nil `no-other-window' parameter is
4184chosen only if all windows on that frame have that parameter set
4185to 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.
4145WINDOW must be a valid window and defaults to the selected one. 4195WINDOW must be a valid window and defaults to the selected one.
4146Return nil. 4196Return 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
4157argument. Signal an error if WINDOW is either the only window on 4207argument. Signal an error if WINDOW is either the only window on
4158its frame, the last non-side window, or part of an atomic window 4208its frame, the last non-side window, or part of an atomic window
4159that is its frame's root window." 4209that is its frame's root window.
4210
4211If WINDOW is the selected window on its frame, choose some other
4212window as that frame's selected window according to the value of
4213the 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
334ptrdiff_t 335ptrdiff_t
335lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to, 336lisp_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);
573extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int, 573extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int,
574 ptrdiff_t *, ptrdiff_t *); 574 ptrdiff_t *, ptrdiff_t *);
575extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, ptrdiff_t, 575extern 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
578extern Lisp_Object Vchar_unify_table; 578extern Lisp_Object Vchar_unify_table;
579extern Lisp_Object string_escape_byte8 (Lisp_Object); 579extern 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
1482bool 1528bool
1483find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, 1529find_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);
320extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t, 337extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t,
321 struct font_metrics *); 338 struct font_metrics *);
322 339
323extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t *, 340extern 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
327extern void composition_compute_stop_pos (struct composition_it *, 344extern 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. */)
2200DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p, 2200DEFUN ("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.
2203BUFFER defaults to the current buffer. */) 2203BUFFER defaults to the current buffer.
2204
2205Also 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
3302Lisp_Object 3299Lisp_Object
3303image_find_image_file (Lisp_Object file) 3300image_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
5022static Lisp_Object button_down_location; 5042static 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. */
5046static 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'. */)
11047DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0, 11103DEFUN ("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.
11049If META is t, Emacs will accept 8-bit input, and interpret the 8th 11105If META is t, Emacs will accept 8-bit input, and interpret the 8th
11050bit as the Meta modifier. 11106bit as the Meta modifier before it decodes the characters.
11107
11108If META is `encoded', Emacs will interpret the 8th bit of single-byte
11109characters after decoding the characters.
11051 11110
11052If META is nil, Emacs will ignore the top bit, on the assumption it is 11111If META is nil, Emacs will ignore the top bit, on the assumption it is
11053parity. 11112parity.
@@ -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).
11139Third arg META t means accept 8-bit input (for a Meta key). 11200Third 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.
11142Optional fourth arg QUIT if non-nil specifies character to use for quitting. 11205Optional fourth arg QUIT if non-nil specifies character to use for quitting.
11143See also `current-input-mode'. */) 11206See 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.
11166The elements of this list correspond to the arguments of 11232The 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
12349Also see `set-message-function' (which controls how non-error messages
12350are 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.
1954Otherwise if Emacs is hidden, it is unhidden. 1954Otherwise if Emacs is hidden, it is unhidden.
1955If ON is equal to `activate', Emacs is unhidden and becomes 1955If ON is equal to `activate', Emacs is unhidden and becomes
1956the active application. */) 1956the active application.
1957 (Lisp_Object on) 1957If ON is equal to `activate-front', Emacs is unhidden and
1958becomes the active application, but only the selected frame
1959is 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
35660displayed in the echo area. If this function returns any other non-nil 35665displayed in the echo area. If this function returns any other non-nil
35661value, this means that the message was already handled, and the original 35666value, this means that the message was already handled, and the original
35662message text will not be displayed in the echo area. 35667message text will not be displayed in the echo area.
35663See also `clear-message-function' that can be used to clear the 35668
35664message displayed by this function. */); 35669Also see `clear-message-function' (which can be used to clear the
35670message 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.
3use utf8;
4
5# Following code is the example from the report Bug#22355 which needed
6# attention in perl-mode.
7
8printf 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
6s/LEFT/L/g || s/RIGHT/R/g || s/aVALUE\D+//g;
7s/LEFT/L/g||s/RIGHT/R/g||s/aVALUE\D+//g;
8
9s/LEFT/L/g && s/RIGHT/R/g && s/aVALUE\D+//g;
10s/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
3my $good = XML::LibXML->load_xml( string => q{<div class="clearfix">});
4my $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
9my $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 \"|&\".
382Regular 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 \"|&\".
393Regular 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 \"=>\".
413Related, check that calling a method named q is not mistaken as a
414quotelike 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'.
382The test uses the syntax property \"inside a string\" for the 431The 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
448font-lock-constant-face. If seen as a division, then it doesn't 497font-lock-constant-face. If seen as a division, then it doesn't
449have a face property." 498have 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 * \\
37c;
38")
39 "a = b + a * \\
40 c;
41"))
42 (should (equal (octave-test--indent "a = \\
43b;
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
2461absolute_dirname c-src/etags.c /^absolute_dirname (char *file, char *dir)$/ 2461absolute_dirname c-src/etags.c /^absolute_dirname (char *file, char *dir)$/
2462absolute_filename c-src/etags.c /^absolute_filename (char *file, char *dir)$/ 2462absolute_filename c-src/etags.c /^absolute_filename (char *file, char *dir)$/
2463abt cp-src/c.C 55 2463abt cp-src/c.C 55
2464acc_pred_info merc-src/accumulator.m /^:- pred acc_pred_info(list(mer_type)::in, list(pro/
2465acc_proc_info merc-src/accumulator.m /^:- pred acc_proc_info(list(prog_var)::in, prog_var/
2466acc_unification merc-src/accumulator.m /^:- pred acc_unification(pair(prog_var)::in, hlds_g/
2467acc_var_subst_init merc-src/accumulator.m /^:- pred acc_var_subst_init(list(prog_var)::in,$/
2464accent_key_syms c-src/emacs/src/keyboard.c 4625 2468accent_key_syms c-src/emacs/src/keyboard.c 4625
2465access_keymap_keyremap c-src/emacs/src/keyboard.c /^access_keymap_keyremap (Lisp_Object map, Lisp_Obje/ 2469access_keymap_keyremap c-src/emacs/src/keyboard.c /^access_keymap_keyremap (Lisp_Object map, Lisp_Obje/
2470accu_assoc merc-src/accumulator.m /^:- pred accu_assoc(module_info::in, vartypes::in, /
2471accu_assoc merc-src/accumulator.m /^:- type accu_assoc$/
2472accu_base merc-src/accumulator.m /^:- type accu_base$/
2473accu_before merc-src/accumulator.m /^:- pred accu_before(module_info::in, vartypes::in,/
2474accu_case merc-src/accumulator.m /^:- type accu_case$/
2475accu_construct merc-src/accumulator.m /^:- pred accu_construct(module_info::in, vartypes::/
2476accu_construct_assoc merc-src/accumulator.m /^:- pred accu_construct_assoc(module_info::in, vart/
2477accu_create_goal merc-src/accumulator.m /^:- pred accu_create_goal(accu_goal_id::in, list(pr/
2478accu_divide_base_case merc-src/accumulator.m /^:- pred accu_divide_base_case(module_info::in, var/
2479accu_goal_id merc-src/accumulator.m /^:- type accu_goal_id$/
2480accu_goal_list merc-src/accumulator.m /^:- func accu_goal_list(list(accu_goal_id), accu_go/
2481accu_goal_store merc-src/accumulator.m /^:- type accu_goal_store == goal_store(accu_goal_id/
2482accu_has_heuristic merc-src/accumulator.m /^:- pred accu_has_heuristic(module_name::in, string/
2483accu_heuristic merc-src/accumulator.m /^:- pred accu_heuristic(module_name::in, string::in/
2484accu_is_associative merc-src/accumulator.m /^:- pred accu_is_associative(module_info::in, pred_/
2485accu_is_update merc-src/accumulator.m /^:- pred accu_is_update(module_info::in, pred_id::i/
2486accu_process_assoc_set merc-src/accumulator.m /^:- pred accu_process_assoc_set(module_info::in, ac/
2487accu_process_update_set merc-src/accumulator.m /^:- pred accu_process_update_set(module_info::in, a/
2488accu_related merc-src/accumulator.m /^:- pred accu_related(module_info::in, vartypes::in/
2489accu_rename merc-src/accumulator.m /^:- func accu_rename(list(accu_goal_id), accu_subst/
2490accu_sets merc-src/accumulator.m /^:- type accu_sets$/
2491accu_sets_init merc-src/accumulator.m /^:- pred accu_sets_init(accu_sets::out) is det.$/
2492accu_stage1 merc-src/accumulator.m /^:- pred accu_stage1(module_info::in, vartypes::in,/
2493accu_stage1_2 merc-src/accumulator.m /^:- pred accu_stage1_2(module_info::in, vartypes::i/
2494accu_stage2 merc-src/accumulator.m /^:- pred accu_stage2(module_info::in, proc_info::in/
2495accu_stage3 merc-src/accumulator.m /^:- pred accu_stage3(accu_goal_id::in, list(prog_va/
2496accu_standardize merc-src/accumulator.m /^:- pred accu_standardize(hlds_goal::in, hlds_goal:/
2497accu_store merc-src/accumulator.m /^:- pred accu_store(accu_case::in, hlds_goal::in,$/
2498accu_subst merc-src/accumulator.m /^:- type accu_subst == map(prog_var, prog_var).$/
2499accu_substs merc-src/accumulator.m /^:- type accu_substs$/
2500accu_substs_init merc-src/accumulator.m /^:- pred accu_substs_init(list(prog_var)::in, prog_/
2501accu_top_level merc-src/accumulator.m /^:- pred accu_top_level(top_level::in, hlds_goal::i/
2502accu_transform_proc merc-src/accumulator.m /^:- pred accu_transform_proc(pred_proc_id::in, pred/
2503accu_update merc-src/accumulator.m /^:- pred accu_update(module_info::in, vartypes::in,/
2504accu_warning merc-src/accumulator.m /^:- type accu_warning$/
2466act prol-src/natded.prolog /^act(OutForm,OutSyn,Ws):-$/ 2505act prol-src/natded.prolog /^act(OutForm,OutSyn,Ws):-$/
2467action prol-src/natded.prolog /^action(KeyVals):-$/ 2506action prol-src/natded.prolog /^action(KeyVals):-$/
2468active_maps c-src/emacs/src/keyboard.c /^active_maps (Lisp_Object first_event)$/ 2507active_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
2534assert c-src/etags.c 135 2573assert c-src/etags.c 135
2535assert c-src/etags.c /^# define assert(x) ((void) 0)$/ 2574assert c-src/etags.c /^# define assert(x) ((void) 0)$/
2536assign_neighbor cp-src/clheir.hpp /^ void assign_neighbor(int direction, location */ 2575assign_neighbor cp-src/clheir.hpp /^ void assign_neighbor(int direction, location */
2576assoc_list merc-src/accumulator.m /^:- import_module assoc_list.$/
2577associativity_assertion merc-src/accumulator.m /^:- pred associativity_assertion(module_info::in, l/
2537at_end c-src/etags.c 249 2578at_end c-src/etags.c 249
2538at_filename c-src/etags.c 247 2579at_filename c-src/etags.c 247
2539at_language c-src/etags.c 245 2580at_language c-src/etags.c 245
@@ -2567,6 +2608,8 @@ bas_syn prol-src/natded.prolog /^bas_syn(n(_)).$/
2567base c-src/emacs/src/lisp.h 2188 2608base c-src/emacs/src/lisp.h 2188
2568base cp-src/c.C /^double base (void) const { return rng_base; }$/ 2609base cp-src/c.C /^double base (void) const { return rng_base; }$/
2569base cp-src/Range.h /^ double base (void) const { return rng_base; }$/ 2610base cp-src/Range.h /^ double base (void) const { return rng_base; }$/
2611base_case_ids merc-src/accumulator.m /^:- func base_case_ids(accu_goal_store) = list(accu/
2612base_case_ids_set merc-src/accumulator.m /^:- func base_case_ids_set(accu_goal_store) = set(a/
2570baz= ruby-src/test1.ru /^ :baz,$/ 2613baz= ruby-src/test1.ru /^ :baz,$/
2571bb c.c 275 2614bb c.c 275
2572bbb c.c 251 2615bbb c.c 251
@@ -2604,6 +2647,7 @@ bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/
2604bodyindent tex-src/texinfo.tex /^\\advance\\leftskip by \\defbodyindent \\advance \\righ/ 2647bodyindent tex-src/texinfo.tex /^\\advance\\leftskip by \\defbodyindent \\advance \\righ/
2605bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/ 2648bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/
2606bool c.c 222 2649bool c.c 222
2650bool merc-src/accumulator.m /^:- import_module bool.$/
2607bool_header_size c-src/emacs/src/lisp.h 1472 2651bool_header_size c-src/emacs/src/lisp.h 1472
2608bool_vector_bitref c-src/emacs/src/lisp.h /^bool_vector_bitref (Lisp_Object a, EMACS_INT i)$/ 2652bool_vector_bitref c-src/emacs/src/lisp.h /^bool_vector_bitref (Lisp_Object a, EMACS_INT i)$/
2609bool_vector_bytes c-src/emacs/src/lisp.h /^bool_vector_bytes (EMACS_INT size)$/ 2653bool_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
2645caccacacca c.c /^caccacacca (a,b,c,d,e,f,g)$/ 2689caccacacca c.c /^caccacacca (a,b,c,d,e,f,g)$/
2646cacheLRUEntry_s c.c 172 2690cacheLRUEntry_s c.c 172
2647cacheLRUEntry_t c.c 177 2691cacheLRUEntry_t c.c 177
2692calculate_goal_info merc-src/accumulator.m /^:- pred calculate_goal_info(hlds_goal_expr::in, hl/
2648calloc c-src/emacs/src/gmalloc.c 66 2693calloc c-src/emacs/src/gmalloc.c 66
2649calloc c-src/emacs/src/gmalloc.c 70 2694calloc c-src/emacs/src/gmalloc.c 70
2650calloc c-src/emacs/src/gmalloc.c /^calloc (size_t nmemb, size_t size)$/ 2695calloc c-src/emacs/src/gmalloc.c /^calloc (size_t nmemb, size_t size)$/
@@ -2665,6 +2710,8 @@ cgrep html-src/software.html /^cgrep$/
2665chain c-src/emacs/src/lisp.h 1162 2710chain c-src/emacs/src/lisp.h 1162
2666chain c-src/emacs/src/lisp.h 2206 2711chain c-src/emacs/src/lisp.h 2206
2667chain c-src/emacs/src/lisp.h 2396 2712chain c-src/emacs/src/lisp.h 2396
2713chain_subst merc-src/accumulator.m /^:- func chain_subst(accu_subst, accu_subst) = accu/
2714chain_subst_2 merc-src/accumulator.m /^:- pred chain_subst_2(list(A)::in, map(A, B)::in, /
2668char_bits c-src/emacs/src/lisp.h 2443 2715char_bits c-src/emacs/src/lisp.h 2443
2669char_table_specials c-src/emacs/src/lisp.h 1692 2716char_table_specials c-src/emacs/src/lisp.h 1692
2670charpos c-src/emacs/src/lisp.h 2011 2717charpos c-src/emacs/src/lisp.h 2011
@@ -2707,6 +2754,7 @@ command_loop_1 c-src/emacs/src/keyboard.c /^command_loop_1 (void)$/
2707command_loop_2 c-src/emacs/src/keyboard.c /^command_loop_2 (Lisp_Object ignore)$/ 2754command_loop_2 c-src/emacs/src/keyboard.c /^command_loop_2 (Lisp_Object ignore)$/
2708command_loop_level c-src/emacs/src/keyboard.c 195 2755command_loop_level c-src/emacs/src/keyboard.c 195
2709comment php-src/lce_functions.php /^ function comment($line, $class)$/ 2756comment php-src/lce_functions.php /^ function comment($line, $class)$/
2757commutativity_assertion merc-src/accumulator.m /^:- pred commutativity_assertion(module_info::in,li/
2710compile_empty prol-src/natded.prolog /^compile_empty:-$/ 2758compile_empty prol-src/natded.prolog /^compile_empty:-$/
2711compile_lex prol-src/natded.prolog /^compile_lex(File):-$/ 2759compile_lex prol-src/natded.prolog /^compile_lex(File):-$/
2712complete prol-src/natded.prolog /^complete(Cat):-$/ 2760complete prol-src/natded.prolog /^complete(Cat):-$/
@@ -2740,6 +2788,13 @@ create-bar forth-src/test-forth.fth /^: create-bar foo ;$/
2740createPOEntries php-src/lce_functions.php /^ function createPOEntries()$/ 2788createPOEntries php-src/lce_functions.php /^ function createPOEntries()$/
2741createWidgets pyt-src/server.py /^ def createWidgets(self, host):$/ 2789createWidgets pyt-src/server.py /^ def createWidgets(self, host):$/
2742createWidgets pyt-src/server.py /^ def createWidgets(self):$/ 2790createWidgets pyt-src/server.py /^ def createWidgets(self):$/
2791create_acc_call merc-src/accumulator.m /^:- func create_acc_call(hlds_goal::in(goal_plain_c/
2792create_acc_goal merc-src/accumulator.m /^:- pred create_acc_goal(hlds_goal::in, accu_substs/
2793create_new_base_goals merc-src/accumulator.m /^:- func create_new_base_goals(set(accu_goal_id), a/
2794create_new_orig_recursive_goals merc-src/accumulator.m /^:- func create_new_orig_recursive_goals(set(accu_g/
2795create_new_recursive_goals merc-src/accumulator.m /^:- func create_new_recursive_goals(set(accu_goal_i/
2796create_new_var merc-src/accumulator.m /^:- pred create_new_var(prog_var::in, string::in, p/
2797create_orig_goal merc-src/accumulator.m /^:- pred create_orig_goal(hlds_goal::in, accu_subst/
2743cscInitTime cp-src/c.C 7 2798cscInitTime cp-src/c.C 7
2744cscSegmentationTime cp-src/c.C 8 2799cscSegmentationTime cp-src/c.C 8
2745cstack c-src/etags.c 2523 2800cstack c-src/etags.c 2523
@@ -3104,6 +3159,8 @@ gcpro c-src/emacs/src/lisp.h 3042
3104gcpro c-src/emacs/src/lisp.h 3132 3159gcpro c-src/emacs/src/lisp.h 3132
3105gen_help_event c-src/emacs/src/keyboard.c /^gen_help_event (Lisp_Object help, Lisp_Object fram/ 3160gen_help_event c-src/emacs/src/keyboard.c /^gen_help_event (Lisp_Object help, Lisp_Object fram/
3106genalgorithm html-src/algrthms.html /^Generating the Data<\/font><\/i><\/b>$/ 3161genalgorithm html-src/algrthms.html /^Generating the Data<\/font><\/i><\/b>$/
3162generate_warning merc-src/accumulator.m /^:- pred generate_warning(module_info::in, prog_var/
3163generate_warnings merc-src/accumulator.m /^:- pred generate_warnings(module_info::in, prog_va/
3107generic_object cp-src/clheir.cpp /^generic_object::generic_object(void)$/ 3164generic_object cp-src/clheir.cpp /^generic_object::generic_object(void)$/
3108generic_object cp-src/clheir.hpp 13 3165generic_object cp-src/clheir.hpp 13
3109getArchs objc-src/PackInsp.m /^-(void)getArchs$/ 3166getArchs 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)$/
3172help_form_saved_window_configs c-src/emacs/src/keyboard.c 2156 3229help_form_saved_window_configs c-src/emacs/src/keyboard.c 2156
3173helpwin pyt-src/server.py /^def helpwin(helpdict):$/ 3230helpwin pyt-src/server.py /^def helpwin(helpdict):$/
3174hide_cursor cp-src/screen.cpp /^void hide_cursor(void)$/ 3231hide_cursor cp-src/screen.cpp /^void hide_cursor(void)$/
3232hlds merc-src/accumulator.m /^:- import_module hlds.$/
3233hlds.assertion merc-src/accumulator.m /^:- import_module hlds.assertion.$/
3234hlds.goal_util merc-src/accumulator.m /^:- import_module hlds.goal_util.$/
3235hlds.hlds_error_util merc-src/accumulator.m /^:- import_module hlds.hlds_error_util.$/
3236hlds.hlds_goal merc-src/accumulator.m /^:- import_module hlds.hlds_goal.$/
3237hlds.hlds_module merc-src/accumulator.m /^:- import_module hlds.hlds_module.$/
3238hlds.hlds_out merc-src/accumulator.m /^:- import_module hlds.hlds_out.$/
3239hlds.hlds_out.hlds_out_util merc-src/accumulator.m /^:- import_module hlds.hlds_out.hlds_out_util.$/
3240hlds.hlds_pred merc-src/accumulator.m /^:- import_module hlds.hlds_pred.$/
3241hlds.hlds_promise merc-src/accumulator.m /^:- import_module hlds.hlds_promise.$/
3242hlds.instmap merc-src/accumulator.m /^:- import_module hlds.instmap.$/
3243hlds.pred_table merc-src/accumulator.m /^:- import_module hlds.pred_table.$/
3244hlds.quantification merc-src/accumulator.m /^:- import_module hlds.quantification.$/
3245hlds.status merc-src/accumulator.m /^:- import_module hlds.status.$/
3246hlds.vartypes merc-src/accumulator.m /^:- import_module hlds.vartypes.$/
3175htmltreelist prol-src/natded.prolog /^htmltreelist([]).$/ 3247htmltreelist prol-src/natded.prolog /^htmltreelist([]).$/
3176hybrid_aligned_alloc c-src/emacs/src/gmalloc.c /^hybrid_aligned_alloc (size_t alignment, size_t siz/ 3248hybrid_aligned_alloc c-src/emacs/src/gmalloc.c /^hybrid_aligned_alloc (size_t alignment, size_t siz/
3177hybrid_calloc c-src/emacs/src/gmalloc.c /^hybrid_calloc (size_t nmemb, size_t size)$/ 3249hybrid_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\
3191ialpage tex-src/texinfo.tex /^ \\availdimen@=\\pageheight \\advance\\availdimen@ by/ 3263ialpage tex-src/texinfo.tex /^ \\availdimen@=\\pageheight \\advance\\availdimen@ by/
3192ialpage tex-src/texinfo.tex /^ \\dimen@=\\pageheight \\advance\\dimen@ by-\\ht\\pa/ 3264ialpage tex-src/texinfo.tex /^ \\dimen@=\\pageheight \\advance\\dimen@ by-\\ht\\pa/
3193ialpage= tex-src/texinfo.tex /^ \\output={\\global\\setbox\\partialpage=$/ 3265ialpage= tex-src/texinfo.tex /^ \\output={\\global\\setbox\\partialpage=$/
3266identify_goal_type merc-src/accumulator.m /^:- pred identify_goal_type(pred_id::in, proc_id::i/
3267identify_out_and_out_prime merc-src/accumulator.m /^:- pred identify_out_and_out_prime(module_info::in/
3268identify_recursive_calls merc-src/accumulator.m /^:- pred identify_recursive_calls(pred_id::in, proc/
3194idx c-src/emacs/src/lisp.h 3150 3269idx c-src/emacs/src/lisp.h 3150
3195ignore_case c-src/etags.c 266 3270ignore_case c-src/etags.c 266
3196ignore_mouse_drag_p c-src/emacs/src/keyboard.c 1256 3271ignore_mouse_drag_p c-src/emacs/src/keyboard.c 1256
@@ -3220,6 +3295,7 @@ inita c.c /^static void inita () {}$/
3220initb c.c /^static void initb () {}$/ 3295initb c.c /^static void initb () {}$/
3221initial_kboard c-src/emacs/src/keyboard.c 84 3296initial_kboard c-src/emacs/src/keyboard.c 84
3222initialize-new-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun initialize-new-tags-table ()$/ 3297initialize-new-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun initialize-new-tags-table ()$/
3298initialize_goal_store merc-src/accumulator.m /^:- func initialize_goal_store(list(hlds_goal), ins/
3223initialize_random_junk y-src/cccp.y /^initialize_random_junk ()$/ 3299initialize_random_junk y-src/cccp.y /^initialize_random_junk ()$/
3224input-pending-p c-src/emacs/src/keyboard.c /^DEFUN ("input-pending-p", Finput_pending_p, Sinput/ 3300input-pending-p c-src/emacs/src/keyboard.c /^DEFUN ("input-pending-p", Finput_pending_p, Sinput/
3225input_available_clear_time c-src/emacs/src/keyboard.c 324 3301input_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
3235instance_method_question? ruby-src/test.rb /^ def instance_method_question?$/ 3311instance_method_question? ruby-src/test.rb /^ def instance_method_question?$/
3236instr y-src/parse.y 81 3312instr y-src/parse.y 81
3237instruct c-src/etags.c 2527 3313instruct c-src/etags.c 2527
3314int merc-src/accumulator.m /^:- import_module int.$/
3238intNumber go-src/test1.go 13 3315intNumber go-src/test1.go 13
3239integer c-src/emacs/src/lisp.h 2127 3316integer c-src/emacs/src/lisp.h 2127
3240integer y-src/cccp.y 112 3317integer y-src/cccp.y 112
@@ -3257,6 +3334,7 @@ intoken c-src/etags.c /^#define intoken(c) (_itk[CHAR (c)]) \/* c can be in/
3257intspec c-src/emacs/src/lisp.h 1688 3334intspec c-src/emacs/src/lisp.h 1688
3258intvar c-src/emacs/src/lisp.h 2277 3335intvar c-src/emacs/src/lisp.h 2277
3259invalidate_nodes c-src/etags.c /^invalidate_nodes (fdesc *badfdp, node **npp)$/ 3336invalidate_nodes c-src/etags.c /^invalidate_nodes (fdesc *badfdp, node **npp)$/
3337io merc-src/accumulator.m /^:- import_module io.$/
3260ipc3dCSC19 cp-src/c.C 6 3338ipc3dCSC19 cp-src/c.C 6
3261ipc3dChannelType cp-src/c.C 1 3339ipc3dChannelType cp-src/c.C 1
3262ipc3dIslandHierarchy cp-src/c.C 1 3340ipc3dIslandHierarchy cp-src/c.C 1
@@ -3266,6 +3344,7 @@ irregular_location cp-src/clheir.hpp /^ irregular_location(double xi, double
3266isComment php-src/lce_functions.php /^ function isComment($class)$/ 3344isComment php-src/lce_functions.php /^ function isComment($class)$/
3267isHoliday cp-src/functions.cpp /^bool isHoliday ( Date d ){$/ 3345isHoliday cp-src/functions.cpp /^bool isHoliday ( Date d ){$/
3268isLeap cp-src/functions.cpp /^bool isLeap ( int year ){$/ 3346isLeap cp-src/functions.cpp /^bool isLeap ( int year ){$/
3347is_associative_construction merc-src/accumulator.m /^:- pred is_associative_construction(module_info::i/
3269is_curly_brace_form c-src/h.h 54 3348is_curly_brace_form c-src/h.h 54
3270is_explicit c-src/h.h 49 3349is_explicit c-src/h.h 49
3271is_func c-src/etags.c 221 3350is_func c-src/etags.c 221
@@ -3274,6 +3353,7 @@ is_idchar y-src/cccp.y 948
3274is_idstart y-src/cccp.y 950 3353is_idstart y-src/cccp.y 950
3275is_muldiv_operation cp-src/c.C /^is_muldiv_operation(pc)$/ 3354is_muldiv_operation cp-src/c.C /^is_muldiv_operation(pc)$/
3276is_ordset prol-src/ordsets.prolog /^is_ordset(X) :- var(X), !, fail.$/ 3355is_ordset prol-src/ordsets.prolog /^is_ordset(X) :- var(X), !, fail.$/
3356is_recursive_case merc-src/accumulator.m /^:- pred is_recursive_case(list(hlds_goal)::in, pre/
3277iso_lispy_function_keys c-src/emacs/src/keyboard.c 5151 3357iso_lispy_function_keys c-src/emacs/src/keyboard.c 5151
3278isoperator prol-src/natded.prolog /^isoperator(Char):-$/ 3358isoperator prol-src/natded.prolog /^isoperator(Char):-$/
3279isoptab prol-src/natded.prolog /^isoptab('%').$/ 3359isoptab prol-src/natded.prolog /^isoptab('%').$/
@@ -3370,6 +3450,10 @@ letter: tex-src/texinfo.tex /^\\xdef\\thischapter{Appendix \\appendixletter: \\n
3370level c-src/emacs/src/lisp.h 3153 3450level c-src/emacs/src/lisp.h 3153
3371lex prol-src/natded.prolog /^lex(W,SynOut,Sem):-$/ 3451lex prol-src/natded.prolog /^lex(W,SynOut,Sem):-$/
3372lexptr y-src/cccp.y 332 3452lexptr y-src/cccp.y 332
3453libs merc-src/accumulator.m /^:- import_module libs.$/
3454libs.globals merc-src/accumulator.m /^:- import_module libs.globals.$/
3455libs.optimization_options merc-src/accumulator.m /^:- import_module libs.optimization_options.$/
3456libs.options merc-src/accumulator.m /^:- import_module libs.options.$/
3373licenze html-src/softwarelibero.html /^Licenze d'uso di un programma$/ 3457licenze html-src/softwarelibero.html /^Licenze d'uso di un programma$/
3374limit cp-src/Range.h /^ double limit (void) const { return rng_limit; }$/ 3458limit cp-src/Range.h /^ double limit (void) const { return rng_limit; }$/
3375line c-src/etags.c 2493 3459line c-src/etags.c 2493
@@ -3427,6 +3511,7 @@ lispy_modifier_list c-src/emacs/src/keyboard.c /^lispy_modifier_list (int modifi
3427lispy_multimedia_keys c-src/emacs/src/keyboard.c 4962 3511lispy_multimedia_keys c-src/emacs/src/keyboard.c 4962
3428lispy_wheel_names c-src/emacs/src/keyboard.c 5174 3512lispy_wheel_names c-src/emacs/src/keyboard.c 5174
3429list c-src/emacs/src/gmalloc.c 186 3513list c-src/emacs/src/gmalloc.c 186
3514list merc-src/accumulator.m /^:- import_module list.$/
3430list-tags el-src/emacs/lisp/progmodes/etags.el /^(defun list-tags (file &optional _next-match)$/ 3515list-tags el-src/emacs/lisp/progmodes/etags.el /^(defun list-tags (file &optional _next-match)$/
3431list-tags-function el-src/emacs/lisp/progmodes/etags.el /^(defvar list-tags-function nil$/ 3516list-tags-function el-src/emacs/lisp/progmodes/etags.el /^(defvar list-tags-function nil$/
3432list2i c-src/emacs/src/lisp.h /^list2i (EMACS_INT x, EMACS_INT y)$/ 3517list2i 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
3443location cp-src/clheir.hpp 33 3528location cp-src/clheir.hpp 33
3444location cp-src/clheir.hpp /^ location() { }$/ 3529location cp-src/clheir.hpp /^ location() { }$/
3445lookup y-src/cccp.y /^lookup (name, len, hash)$/ 3530lookup y-src/cccp.y /^lookup (name, len, hash)$/
3531lookup_call merc-src/accumulator.m /^:- pred lookup_call(accu_goal_store::in, accu_goal/
3446lowcase c-src/etags.c /^#define lowcase(c) tolower (CHAR (c))$/ 3532lowcase c-src/etags.c /^#define lowcase(c) tolower (CHAR (c))$/
3447lucid_event_type_list_p c-src/emacs/src/keyboard.c /^lucid_event_type_list_p (Lisp_Object object)$/ 3533lucid_event_type_list_p c-src/emacs/src/keyboard.c /^lucid_event_type_list_p (Lisp_Object object)$/
3448mabort c-src/emacs/src/gmalloc.c /^mabort (enum mcheck_status status)$/ 3534mabort 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)$/
3488man manpage make-src/Makefile /^man manpage: etags.1.man$/ 3574man manpage make-src/Makefile /^man manpage: etags.1.man$/
3489mao c-src/h.h 101 3575mao c-src/h.h 101
3490map c-src/emacs/src/keyboard.c 8748 3576map c-src/emacs/src/keyboard.c 8748
3577map merc-src/accumulator.m /^:- import_module map.$/
3491map_word prol-src/natded.prolog /^map_word([[_]|Ws],Exp):-$/ 3578map_word prol-src/natded.prolog /^map_word([[_]|Ws],Exp):-$/
3492mapping html-src/algrthms.html /^Mapping the Channel Symbols$/ 3579mapping html-src/algrthms.html /^Mapping the Channel Symbols$/
3493mapsyn prol-src/natded.prolog /^mapsyn(A\/B,AM\/BM):-$/ 3580mapsyn prol-src/natded.prolog /^mapsyn(A\/B,AM\/BM):-$/
@@ -3501,15 +3588,19 @@ max_args c-src/emacs/src/lisp.h 1686
3501max_num_directions cp-src/clheir.hpp 31 3588max_num_directions cp-src/clheir.hpp 31
3502max_num_generic_objects cp-src/clheir.cpp 9 3589max_num_generic_objects cp-src/clheir.cpp 9
3503maxargs c-src/emacs/src/lisp.h 2831 3590maxargs c-src/emacs/src/lisp.h 2831
3591maybe merc-src/accumulator.m /^:- import_module maybe.$/
3504maybe_gc c-src/emacs/src/lisp.h /^maybe_gc (void)$/ 3592maybe_gc c-src/emacs/src/lisp.h /^maybe_gc (void)$/
3505mcCSC cp-src/c.C 6 3593mcCSC cp-src/c.C 6
3506mcheck c-src/emacs/src/gmalloc.c /^mcheck (void (*func) (enum mcheck_status))$/ 3594mcheck c-src/emacs/src/gmalloc.c /^mcheck (void (*func) (enum mcheck_status))$/
3507mcheck_status c-src/emacs/src/gmalloc.c 283 3595mcheck_status c-src/emacs/src/gmalloc.c 283
3508mcheck_used c-src/emacs/src/gmalloc.c 2012 3596mcheck_used c-src/emacs/src/gmalloc.c 2012
3597mdbcomp merc-src/accumulator.m /^:- import_module mdbcomp.$/
3598mdbcomp.sym_name merc-src/accumulator.m /^:- import_module mdbcomp.sym_name.$/
3509me22b lua-src/test.lua /^ local function test.me22b (one)$/ 3599me22b lua-src/test.lua /^ local function test.me22b (one)$/
3510me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/ 3600me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/
3511memalign c-src/emacs/src/gmalloc.c /^memalign (size_t alignment, size_t size)$/ 3601memalign c-src/emacs/src/gmalloc.c /^memalign (size_t alignment, size_t size)$/
3512member prol-src/natded.prolog /^member(X,[X|_]).$/ 3602member prol-src/natded.prolog /^member(X,[X|_]).$/
3603member_lessthan_goalid merc-src/accumulator.m /^:- pred member_lessthan_goalid(accu_goal_store::in/
3513memclear c-src/emacs/src/lisp.h /^memclear (void *p, ptrdiff_t nbytes)$/ 3604memclear c-src/emacs/src/lisp.h /^memclear (void *p, ptrdiff_t nbytes)$/
3514menu_bar_item c-src/emacs/src/keyboard.c /^menu_bar_item (Lisp_Object key, Lisp_Object item, / 3605menu_bar_item c-src/emacs/src/keyboard.c /^menu_bar_item (Lisp_Object key, Lisp_Object item, /
3515menu_bar_items c-src/emacs/src/keyboard.c /^menu_bar_items (Lisp_Object old)$/ 3606menu_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
3780pMu c-src/emacs/src/lisp.h 156 3871pMu c-src/emacs/src/lisp.h 156
3781p_next c-src/etags.c 258 3872p_next c-src/etags.c 258
3782pagesize c-src/emacs/src/gmalloc.c 1703 3873pagesize c-src/emacs/src/gmalloc.c 1703
3874pair merc-src/accumulator.m /^:- import_module pair.$/
3783parent c-src/emacs/src/keyboard.c 8745 3875parent c-src/emacs/src/keyboard.c 8745
3784parent c-src/emacs/src/lisp.h 1590 3876parent c-src/emacs/src/lisp.h 1590
3785parse prol-src/natded.prolog /^parse(Ws,Cat):-$/ 3877parse prol-src/natded.prolog /^parse(Ws,Cat):-$/
@@ -3797,6 +3889,12 @@ parse_return y-src/parse.y 74
3797parse_return_error y-src/cccp.y 70 3889parse_return_error y-src/cccp.y 70
3798parse_solitary_modifier c-src/emacs/src/keyboard.c /^parse_solitary_modifier (Lisp_Object symbol)$/ 3890parse_solitary_modifier c-src/emacs/src/keyboard.c /^parse_solitary_modifier (Lisp_Object symbol)$/
3799parse_tool_bar_item c-src/emacs/src/keyboard.c /^parse_tool_bar_item (Lisp_Object key, Lisp_Object / 3891parse_tool_bar_item c-src/emacs/src/keyboard.c /^parse_tool_bar_item (Lisp_Object key, Lisp_Object /
3892parse_tree merc-src/accumulator.m /^:- import_module parse_tree.$/
3893parse_tree.error_util merc-src/accumulator.m /^:- import_module parse_tree.error_util.$/
3894parse_tree.prog_data merc-src/accumulator.m /^:- import_module parse_tree.prog_data.$/
3895parse_tree.prog_mode merc-src/accumulator.m /^:- import_module parse_tree.prog_mode.$/
3896parse_tree.prog_util merc-src/accumulator.m /^:- import_module parse_tree.prog_util.$/
3897parse_tree.set_of_var merc-src/accumulator.m /^:- import_module parse_tree.set_of_var.$/
3800pat c-src/etags.c 262 3898pat c-src/etags.c 262
3801pattern c-src/etags.c 260 3899pattern c-src/etags.c 260
3802pdlcount c-src/emacs/src/lisp.h 3046 3900pdlcount c-src/emacs/src/lisp.h 3046
@@ -3989,6 +4087,7 @@ removeexp prol-src/natded.prolog /^removeexp(E,E,'NIL'):-!.$/
3989reorder_modifiers c-src/emacs/src/keyboard.c /^reorder_modifiers (Lisp_Object symbol)$/ 4087reorder_modifiers c-src/emacs/src/keyboard.c /^reorder_modifiers (Lisp_Object symbol)$/
3990request c.c /^request request (a, b)$/ 4088request c.c /^request request (a, b)$/
3991requeued_events_pending_p c-src/emacs/src/keyboard.c /^requeued_events_pending_p (void)$/ 4089requeued_events_pending_p c-src/emacs/src/keyboard.c /^requeued_events_pending_p (void)$/
4090require merc-src/accumulator.m /^:- import_module require.$/
3992required_argument c-src/getopt.h 90 4091required_argument c-src/getopt.h 90
3993reset-this-command-lengths c-src/emacs/src/keyboard.c /^DEFUN ("reset-this-command-lengths", Freset_this_c/ 4092reset-this-command-lengths c-src/emacs/src/keyboard.c /^DEFUN ("reset-this-command-lengths", Freset_this_c/
3994restore_getcjmp c-src/emacs/src/keyboard.c /^restore_getcjmp (sys_jmp_buf temp)$/ 4093restore_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
4061serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/ 4160serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/
4062serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/ 4161serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/
4063set cp-src/conway.hpp /^ void set(void) { alive = 1; }$/ 4162set cp-src/conway.hpp /^ void set(void) { alive = 1; }$/
4163set merc-src/accumulator.m /^:- import_module set.$/
4064set-input-interrupt-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-interrupt-mode", Fset_input_inte/ 4164set-input-interrupt-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-interrupt-mode", Fset_input_inte/
4065set-input-meta-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-meta-mode", Fset_input_meta_mode/ 4165set-input-meta-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-meta-mode", Fset_input_meta_mode/
4066set-input-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-mode", Fset_input_mode, Sset_inp/ 4166set-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
4088set_symbol_function c-src/emacs/src/lisp.h /^set_symbol_function (Lisp_Object sym, Lisp_Object / 4188set_symbol_function c-src/emacs/src/lisp.h /^set_symbol_function (Lisp_Object sym, Lisp_Object /
4089set_symbol_next c-src/emacs/src/lisp.h /^set_symbol_next (Lisp_Object sym, struct Lisp_Symb/ 4189set_symbol_next c-src/emacs/src/lisp.h /^set_symbol_next (Lisp_Object sym, struct Lisp_Symb/
4090set_symbol_plist c-src/emacs/src/lisp.h /^set_symbol_plist (Lisp_Object sym, Lisp_Object pli/ 4190set_symbol_plist c-src/emacs/src/lisp.h /^set_symbol_plist (Lisp_Object sym, Lisp_Object pli/
4191set_upto merc-src/accumulator.m /^:- func set_upto(accu_case, int) = set(accu_goal_i/
4091set_waiting_for_input c-src/emacs/src/keyboard.c /^set_waiting_for_input (struct timespec *time_to_cl/ 4192set_waiting_for_input c-src/emacs/src/keyboard.c /^set_waiting_for_input (struct timespec *time_to_cl/
4092setref tex-src/texinfo.tex /^\\expandafter\\expandafter\\expandafter\\appendixsetre/ 4193setref tex-src/texinfo.tex /^\\expandafter\\expandafter\\expandafter\\appendixsetre/
4093setup cp-src/c.C 5 4194setup cp-src/c.C 5
4094shift cp-src/functions.cpp /^void Date::shift ( void ){\/\/Shift this date to pre/ 4195shift cp-src/functions.cpp /^void Date::shift ( void ){\/\/Shift this date to pre/
4095shouldLoad objc-src/PackInsp.m /^-(BOOL)shouldLoad$/ 4196shouldLoad objc-src/PackInsp.m /^-(BOOL)shouldLoad$/
4197should_attempt_accu_transform merc-src/accumulator.m /^:- pred should_attempt_accu_transform(module_info:/
4198should_attempt_accu_transform_2 merc-src/accumulator.m /^:- pred should_attempt_accu_transform_2(module_inf/
4096should_see_this_array_type cp-src/c.C 156 4199should_see_this_array_type cp-src/c.C 156
4097should_see_this_function_pointer cp-src/c.C 153 4200should_see_this_function_pointer cp-src/c.C 153
4098should_see_this_one_enclosed_in_extern_C cp-src/c.C 149 4201should_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)$/
4122skip_spaces c-src/etags.c /^skip_spaces (char *cp)$/ 4225skip_spaces c-src/etags.c /^skip_spaces (char *cp)$/
4123snarf-tag-function el-src/emacs/lisp/progmodes/etags.el /^(defvar snarf-tag-function nil$/ 4226snarf-tag-function el-src/emacs/lisp/progmodes/etags.el /^(defvar snarf-tag-function nil$/
4124snone c-src/etags.c 2443 4227snone c-src/etags.c 2443
4228solutions merc-src/accumulator.m /^:- import_module solutions.$/
4125some_mouse_moved c-src/emacs/src/keyboard.c /^some_mouse_moved (void)$/ 4229some_mouse_moved c-src/emacs/src/keyboard.c /^some_mouse_moved (void)$/
4126space tex-src/texinfo.tex /^ {#2\\labelspace #1}\\dotfill\\doshortpageno{#3}}%/ 4230space tex-src/texinfo.tex /^ {#2\\labelspace #1}\\dotfill\\doshortpageno{#3}}%/
4127space tex-src/texinfo.tex /^ \\dosubsubsecentry{#2.#3.#4.#5\\labelspace#1}{#6}}/ 4231space 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; }$/
4171step cp-src/clheir.hpp /^ virtual void step(void) { }$/ 4275step cp-src/clheir.hpp /^ virtual void step(void) { }$/
4172step_everybody cp-src/clheir.cpp /^void step_everybody(void)$/ 4276step_everybody cp-src/clheir.cpp /^void step_everybody(void)$/
4173stop_polling c-src/emacs/src/keyboard.c /^stop_polling (void)$/ 4277stop_polling c-src/emacs/src/keyboard.c /^stop_polling (void)$/
4278store_info merc-src/accumulator.m /^:- type store_info$/
4174store_user_signal_events c-src/emacs/src/keyboard.c /^store_user_signal_events (void)$/ 4279store_user_signal_events c-src/emacs/src/keyboard.c /^store_user_signal_events (void)$/
4175str go-src/test1.go 9 4280str go-src/test1.go 9
4176strcaseeq c-src/etags.c /^#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=/ 4281strcaseeq c-src/etags.c /^#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=/
4177streq c-src/etags.c /^#define streq(s,t) (assert ((s)!=NULL || (t)!=NULL/ 4282streq c-src/etags.c /^#define streq(s,t) (assert ((s)!=NULL || (t)!=NULL/
4283string merc-src/accumulator.m /^:- import_module string.$/
4178string_intervals c-src/emacs/src/lisp.h /^string_intervals (Lisp_Object s)$/ 4284string_intervals c-src/emacs/src/lisp.h /^string_intervals (Lisp_Object s)$/
4179stripLine php-src/lce_functions.php /^ function stripLine($line, $class)$/ 4285stripLine php-src/lce_functions.php /^ function stripLine($line, $class)$/
4180stripname pas-src/common.pas /^function stripname; (* ($/ 4286stripname pas-src/common.pas /^function stripname; (* ($/
@@ -4314,6 +4420,7 @@ tee ruby-src/test1.ru /^ attr_accessor :tee$/
4314tee= ruby-src/test1.ru /^ attr_accessor :tee$/ 4420tee= ruby-src/test1.ru /^ attr_accessor :tee$/
4315temporarily_switch_to_single_kboard c-src/emacs/src/keyboard.c /^temporarily_switch_to_single_kboard (struct frame / 4421temporarily_switch_to_single_kboard c-src/emacs/src/keyboard.c /^temporarily_switch_to_single_kboard (struct frame /
4316tend c-src/etags.c 2432 4422tend c-src/etags.c 2432
4423term merc-src/accumulator.m /^:- import_module term.$/
4317terminate objc-src/Subprocess.m /^- terminate:sender$/ 4424terminate objc-src/Subprocess.m /^- terminate:sender$/
4318terminateInput objc-src/Subprocess.m /^- terminateInput$/ 4425terminateInput objc-src/Subprocess.m /^- terminateInput$/
4319test c-src/emacs/src/lisp.h 1871 4426test 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
4365tool_bar_items_vector c-src/emacs/src/keyboard.c 7965 4472tool_bar_items_vector c-src/emacs/src/keyboard.c 7965
4366toolkit_menubar_in_use c-src/emacs/src/keyboard.c /^toolkit_menubar_in_use (struct frame *f)$/ 4473toolkit_menubar_in_use c-src/emacs/src/keyboard.c /^toolkit_menubar_in_use (struct frame *f)$/
4367top-level c-src/emacs/src/keyboard.c /^DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, / 4474top-level c-src/emacs/src/keyboard.c /^DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, /
4475top_level merc-src/accumulator.m /^:- type top_level$/
4368top_level_1 c-src/emacs/src/keyboard.c /^top_level_1 (Lisp_Object ignore)$/ 4476top_level_1 c-src/emacs/src/keyboard.c /^top_level_1 (Lisp_Object ignore)$/
4369top_level_2 c-src/emacs/src/keyboard.c /^top_level_2 (void)$/ 4477top_level_2 c-src/emacs/src/keyboard.c /^top_level_2 (void)$/
4370total_keys c-src/emacs/src/keyboard.c 97 4478total_keys c-src/emacs/src/keyboard.c 97
@@ -4376,6 +4484,9 @@ tpcmd c-src/h.h 15
4376track-mouse c-src/emacs/src/keyboard.c /^DEFUN ("internal--track-mouse", Ftrack_mouse, Stra/ 4484track-mouse c-src/emacs/src/keyboard.c /^DEFUN ("internal--track-mouse", Ftrack_mouse, Stra/
4377tracking_off c-src/emacs/src/keyboard.c /^tracking_off (Lisp_Object old_value)$/ 4485tracking_off c-src/emacs/src/keyboard.c /^tracking_off (Lisp_Object old_value)$/
4378traffic_light cp-src/conway.cpp /^void traffic_light(int x, int y)$/ 4486traffic_light cp-src/conway.cpp /^void traffic_light(int x, int y)$/
4487transform_hlds.accumulator merc-src/accumulator.m /^:- module transform_hlds.accumulator.$/
4488transform_hlds.accumulator merc-src/accumulator.m /^:- end_module transform_hlds.accumulator.$/
4489transform_hlds.goal_store merc-src/accumulator.m /^:- import_module transform_hlds.goal_store.$/
4379translate c-src/emacs/src/regex.h 361 4490translate c-src/emacs/src/regex.h 361
4380treats cp-src/c.C 131 4491treats cp-src/c.C 131
4381tt prol-src/natded.prolog /^tt:-$/ 4492tt prol-src/natded.prolog /^tt:-$/
@@ -4421,12 +4532,14 @@ unblock_input c-src/emacs/src/keyboard.c /^unblock_input (void)$/
4421unblock_input_to c-src/emacs/src/keyboard.c /^unblock_input_to (int level)$/ 4532unblock_input_to c-src/emacs/src/keyboard.c /^unblock_input_to (int level)$/
4422unchar c-src/h.h 99 4533unchar c-src/h.h 99
4423unexpand-abbrev c-src/abbrev.c /^DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexp/ 4534unexpand-abbrev c-src/abbrev.c /^DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexp/
4535univ merc-src/accumulator.m /^:- import_module univ.$/
4424unread_switch_frame c-src/emacs/src/keyboard.c 204 4536unread_switch_frame c-src/emacs/src/keyboard.c 204
4425unsignedp y-src/cccp.y 112 4537unsignedp y-src/cccp.y 112
4426unwind c-src/emacs/src/lisp.h 2962 4538unwind c-src/emacs/src/lisp.h 2962
4427unwind_int c-src/emacs/src/lisp.h 2972 4539unwind_int c-src/emacs/src/lisp.h 2972
4428unwind_ptr c-src/emacs/src/lisp.h 2967 4540unwind_ptr c-src/emacs/src/lisp.h 2967
4429unwind_void c-src/emacs/src/lisp.h 2976 4541unwind_void c-src/emacs/src/lisp.h 2976
4542update_accumulator_pred merc-src/accumulator.m /^:- pred update_accumulator_pred(pred_id::in, proc_/
4430uprintmax_t c-src/emacs/src/lisp.h 149 4543uprintmax_t c-src/emacs/src/lisp.h 149
4431uprintmax_t c-src/emacs/src/lisp.h 154 4544uprintmax_t c-src/emacs/src/lisp.h 154
4432usage perl-src/yagrip.pl /^sub usage {$/ 4545usage perl-src/yagrip.pl /^sub usage {$/
@@ -4458,6 +4571,7 @@ varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/
4458varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/ 4571varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/
4459varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/ 4572varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/
4460varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/ 4573varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/
4574varset merc-src/accumulator.m /^:- import_module varset.$/
4461vcopy c-src/emacs/src/lisp.h /^vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Objec/ 4575vcopy c-src/emacs/src/lisp.h /^vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Objec/
4462vectorlike_header c-src/emacs/src/lisp.h 1343 4576vectorlike_header c-src/emacs/src/lisp.h 1343
4463verde cp-src/c.C 40 4577verde 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
3884merc-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
3884c-src/c.c,76 4000c-src/c.c,76
3885T f(1,0 4001T 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
4457merc-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
4509accu_transform_proc(247,8578
4510:- pred generate_warnings(334,12550
4511generate_warnings(337,12669
4512:- pred generate_warning(342,12895
4513generate_warning(345,13001
4514:- pred should_attempt_accu_transform(365,13886
4515should_attempt_accu_transform(370,14123
4516:- pred should_attempt_accu_transform_2(398,15406
4517should_attempt_accu_transform_2(405,15763
4518:- pred accu_standardize(440,17390
4519accu_standardize(442,17455
4520:- pred identify_goal_type(465,18169
4521identify_goal_type(469,18359
4522:- pred is_recursive_case(549,21175
4523is_recursive_case(551,21253
4524:- type store_info560,21713
4525:- func initialize_goal_store(570,22060
4526initialize_goal_store(573,22166
4527:- pred accu_store(580,22421
4528accu_store(584,22576
4529:- pred identify_recursive_calls(601,23288
4530identify_recursive_calls(604,23406
4531:- pred identify_out_and_out_prime(626,24396
4532identify_out_and_out_prime(631,24631
4533:- type accu_sets676,26425
4534:- pred accu_stage1(689,26977
4535accu_stage1(693,27155
4536:- pred accu_stage1_2(727,28347
4537accu_stage1_2(731,28515
4538:- pred accu_sets_init(781,30557
4539accu_sets_init(783,30605
4540:- func set_upto(796,30984
4541set_upto(798,31039
4542:- pred accu_before(812,31498
4543accu_before(815,31639
4544:- pred accu_assoc(835,32477
4545accu_assoc(838,32617
4546:- pred accu_construct(862,33712
4547accu_construct(865,33856
4548:- pred accu_construct_assoc(896,35307
4549accu_construct_assoc(899,35457
4550:- pred accu_update(938,37069
4551accu_update(941,37210
4552:- pred member_lessthan_goalid(964,38219
4553member_lessthan_goalid(967,38342
4554:- type accu_assoc975,38652
4555:- pred accu_is_associative(986,39138
4556accu_is_associative(989,39250
4557:- pred associativity_assertion(1014,40263
4558associativity_assertion(1017,40404
4559:- pred commutativity_assertion(1037,41242
4560commutativity_assertion(1040,41369
4561:- pred accu_is_update(1057,41952
4562accu_is_update(1060,42066
4563:- pred is_associative_construction(1078,42802
4564is_associative_construction(1081,42898
4565:- type accu_substs1095,43480
4566:- type accu_base1103,43744
4567:- pred accu_stage2(1124,44605
4568accu_stage2(1131,44946
4569:- pred accu_substs_init(1179,46957
4570accu_substs_init(1182,47097
4571:- pred acc_var_subst_init(1194,47573
4572acc_var_subst_init(1198,47718
4573:- pred create_new_var(1207,48147
4574create_new_var(1210,48288
4575:- pred accu_process_assoc_set(1223,48862
4576accu_process_assoc_set(1229,49150
4577:- pred accu_has_heuristic(1297,52081
4578accu_has_heuristic(1299,52161
4579:- pred accu_heuristic(1304,52336
4580accu_heuristic(1307,52457
4581:- pred accu_process_update_set(1318,52906
4582accu_process_update_set(1325,53221
4583:- pred accu_divide_base_case(1380,55844
4584accu_divide_base_case(1385,56059
4585:- pred accu_related(1412,57146
4586accu_related(1415,57270
4587:- pred lookup_call(1449,58601
4588lookup_call(1452,58715
4589:- pred accu_stage3(1470,59432
4590accu_stage3(1477,59826
4591:- pred acc_proc_info(1508,61326
4592acc_proc_info(1512,61485
4593:- pred acc_pred_info(1556,63449
4594acc_pred_info(1559,63597
4595:- pred accu_create_goal(1600,65285
4596accu_create_goal(1607,65628
4597:- func create_acc_call(1621,66400
4598create_acc_call(1625,66569
4599:- pred create_orig_goal(1634,66987
4600create_orig_goal(1638,67176
4601:- pred create_acc_goal(1662,68157
4602create_acc_goal(1667,68380
4603:- func create_new_orig_recursive_goals(1709,70225
4604create_new_orig_recursive_goals(1712,70368
4605:- func create_new_recursive_goals(1723,70918
4606create_new_recursive_goals(1727,71108
4607:- func create_new_base_goals(1738,71717
4608create_new_base_goals(1741,71831
4609:- pred acc_unification(1749,72156
4610acc_unification(1751,72225
4611:- pred accu_top_level(1766,72896
4612accu_top_level(1770,73058
4613:- pred update_accumulator_pred(1856,76290
4614update_accumulator_pred(1859,76411
4615:- func accu_rename(1876,77253
4616accu_rename(1879,77363
4617:- func base_case_ids(1889,77784
4618base_case_ids(1891,77846
4619:- func base_case_ids_set(1898,78048
4620base_case_ids_set(1900,78113
4621:- func accu_goal_list(1905,78269
4622accu_goal_list(1907,78349
4623:- pred calculate_goal_info(1916,78680
4624calculate_goal_info(1918,78753
4625:- func chain_subst(1932,79319
4626chain_subst(1934,79378
4627:- pred chain_subst_2(1938,79482
4628chain_subst_2(1941,79576
4629:- end_module transform_hlds.accumulator1953,79939
4630
4457c-src/c.c,76 4631c-src/c.c,76
4458T f(1,0 4632T 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
4291merc-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
4291c-src/c.c,76 4407c-src/c.c,76
4292T f(1,0 4408T 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
4046merc-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
4046c-src/c.c,76 4162c-src/c.c,76
4047T f(1,0 4163T 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
5026merc-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
5078accu_transform_proc(247,8578
5079:- pred generate_warnings(334,12550
5080generate_warnings(337,12669
5081:- pred generate_warning(342,12895
5082generate_warning(345,13001
5083:- pred should_attempt_accu_transform(365,13886
5084should_attempt_accu_transform(370,14123
5085:- pred should_attempt_accu_transform_2(398,15406
5086should_attempt_accu_transform_2(405,15763
5087:- pred accu_standardize(440,17390
5088accu_standardize(442,17455
5089:- pred identify_goal_type(465,18169
5090identify_goal_type(469,18359
5091:- pred is_recursive_case(549,21175
5092is_recursive_case(551,21253
5093:- type store_info560,21713
5094:- func initialize_goal_store(570,22060
5095initialize_goal_store(573,22166
5096:- pred accu_store(580,22421
5097accu_store(584,22576
5098:- pred identify_recursive_calls(601,23288
5099identify_recursive_calls(604,23406
5100:- pred identify_out_and_out_prime(626,24396
5101identify_out_and_out_prime(631,24631
5102:- type accu_sets676,26425
5103:- pred accu_stage1(689,26977
5104accu_stage1(693,27155
5105:- pred accu_stage1_2(727,28347
5106accu_stage1_2(731,28515
5107:- pred accu_sets_init(781,30557
5108accu_sets_init(783,30605
5109:- func set_upto(796,30984
5110set_upto(798,31039
5111:- pred accu_before(812,31498
5112accu_before(815,31639
5113:- pred accu_assoc(835,32477
5114accu_assoc(838,32617
5115:- pred accu_construct(862,33712
5116accu_construct(865,33856
5117:- pred accu_construct_assoc(896,35307
5118accu_construct_assoc(899,35457
5119:- pred accu_update(938,37069
5120accu_update(941,37210
5121:- pred member_lessthan_goalid(964,38219
5122member_lessthan_goalid(967,38342
5123:- type accu_assoc975,38652
5124:- pred accu_is_associative(986,39138
5125accu_is_associative(989,39250
5126:- pred associativity_assertion(1014,40263
5127associativity_assertion(1017,40404
5128:- pred commutativity_assertion(1037,41242
5129commutativity_assertion(1040,41369
5130:- pred accu_is_update(1057,41952
5131accu_is_update(1060,42066
5132:- pred is_associative_construction(1078,42802
5133is_associative_construction(1081,42898
5134:- type accu_substs1095,43480
5135:- type accu_base1103,43744
5136:- pred accu_stage2(1124,44605
5137accu_stage2(1131,44946
5138:- pred accu_substs_init(1179,46957
5139accu_substs_init(1182,47097
5140:- pred acc_var_subst_init(1194,47573
5141acc_var_subst_init(1198,47718
5142:- pred create_new_var(1207,48147
5143create_new_var(1210,48288
5144:- pred accu_process_assoc_set(1223,48862
5145accu_process_assoc_set(1229,49150
5146:- pred accu_has_heuristic(1297,52081
5147accu_has_heuristic(1299,52161
5148:- pred accu_heuristic(1304,52336
5149accu_heuristic(1307,52457
5150:- pred accu_process_update_set(1318,52906
5151accu_process_update_set(1325,53221
5152:- pred accu_divide_base_case(1380,55844
5153accu_divide_base_case(1385,56059
5154:- pred accu_related(1412,57146
5155accu_related(1415,57270
5156:- pred lookup_call(1449,58601
5157lookup_call(1452,58715
5158:- pred accu_stage3(1470,59432
5159accu_stage3(1477,59826
5160:- pred acc_proc_info(1508,61326
5161acc_proc_info(1512,61485
5162:- pred acc_pred_info(1556,63449
5163acc_pred_info(1559,63597
5164:- pred accu_create_goal(1600,65285
5165accu_create_goal(1607,65628
5166:- func create_acc_call(1621,66400
5167create_acc_call(1625,66569
5168:- pred create_orig_goal(1634,66987
5169create_orig_goal(1638,67176
5170:- pred create_acc_goal(1662,68157
5171create_acc_goal(1667,68380
5172:- func create_new_orig_recursive_goals(1709,70225
5173create_new_orig_recursive_goals(1712,70368
5174:- func create_new_recursive_goals(1723,70918
5175create_new_recursive_goals(1727,71108
5176:- func create_new_base_goals(1738,71717
5177create_new_base_goals(1741,71831
5178:- pred acc_unification(1749,72156
5179acc_unification(1751,72225
5180:- pred accu_top_level(1766,72896
5181accu_top_level(1770,73058
5182:- pred update_accumulator_pred(1856,76290
5183update_accumulator_pred(1859,76411
5184:- func accu_rename(1876,77253
5185accu_rename(1879,77363
5186:- func base_case_ids(1889,77784
5187base_case_ids(1891,77846
5188:- func base_case_ids_set(1898,78048
5189base_case_ids_set(1900,78113
5190:- func accu_goal_list(1905,78269
5191accu_goal_list(1907,78349
5192:- pred calculate_goal_info(1916,78680
5193calculate_goal_info(1918,78753
5194:- func chain_subst(1932,79319
5195chain_subst(1934,79378
5196:- pred chain_subst_2(1938,79482
5197chain_subst_2(1941,79576
5198:- end_module transform_hlds.accumulator1953,79939
5199
5026c-src/c.c,76 5200c-src/c.c,76
5027T f(1,0 5201T 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
5026merc-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
5078accu_transform_proc(247,8578
5079:- pred generate_warnings(334,12550
5080generate_warnings(337,12669
5081:- pred generate_warning(342,12895
5082generate_warning(345,13001
5083:- pred should_attempt_accu_transform(365,13886
5084should_attempt_accu_transform(370,14123
5085:- pred should_attempt_accu_transform_2(398,15406
5086should_attempt_accu_transform_2(405,15763
5087:- pred accu_standardize(440,17390
5088accu_standardize(442,17455
5089:- pred identify_goal_type(465,18169
5090identify_goal_type(469,18359
5091:- pred is_recursive_case(549,21175
5092is_recursive_case(551,21253
5093:- type store_info560,21713
5094:- func initialize_goal_store(570,22060
5095initialize_goal_store(573,22166
5096:- pred accu_store(580,22421
5097accu_store(584,22576
5098:- pred identify_recursive_calls(601,23288
5099identify_recursive_calls(604,23406
5100:- pred identify_out_and_out_prime(626,24396
5101identify_out_and_out_prime(631,24631
5102:- type accu_sets676,26425
5103:- pred accu_stage1(689,26977
5104accu_stage1(693,27155
5105:- pred accu_stage1_2(727,28347
5106accu_stage1_2(731,28515
5107:- pred accu_sets_init(781,30557
5108accu_sets_init(783,30605
5109:- func set_upto(796,30984
5110set_upto(798,31039
5111:- pred accu_before(812,31498
5112accu_before(815,31639
5113:- pred accu_assoc(835,32477
5114accu_assoc(838,32617
5115:- pred accu_construct(862,33712
5116accu_construct(865,33856
5117:- pred accu_construct_assoc(896,35307
5118accu_construct_assoc(899,35457
5119:- pred accu_update(938,37069
5120accu_update(941,37210
5121:- pred member_lessthan_goalid(964,38219
5122member_lessthan_goalid(967,38342
5123:- type accu_assoc975,38652
5124:- pred accu_is_associative(986,39138
5125accu_is_associative(989,39250
5126:- pred associativity_assertion(1014,40263
5127associativity_assertion(1017,40404
5128:- pred commutativity_assertion(1037,41242
5129commutativity_assertion(1040,41369
5130:- pred accu_is_update(1057,41952
5131accu_is_update(1060,42066
5132:- pred is_associative_construction(1078,42802
5133is_associative_construction(1081,42898
5134:- type accu_substs1095,43480
5135:- type accu_base1103,43744
5136:- pred accu_stage2(1124,44605
5137accu_stage2(1131,44946
5138:- pred accu_substs_init(1179,46957
5139accu_substs_init(1182,47097
5140:- pred acc_var_subst_init(1194,47573
5141acc_var_subst_init(1198,47718
5142:- pred create_new_var(1207,48147
5143create_new_var(1210,48288
5144:- pred accu_process_assoc_set(1223,48862
5145accu_process_assoc_set(1229,49150
5146:- pred accu_has_heuristic(1297,52081
5147accu_has_heuristic(1299,52161
5148:- pred accu_heuristic(1304,52336
5149accu_heuristic(1307,52457
5150:- pred accu_process_update_set(1318,52906
5151accu_process_update_set(1325,53221
5152:- pred accu_divide_base_case(1380,55844
5153accu_divide_base_case(1385,56059
5154:- pred accu_related(1412,57146
5155accu_related(1415,57270
5156:- pred lookup_call(1449,58601
5157lookup_call(1452,58715
5158:- pred accu_stage3(1470,59432
5159accu_stage3(1477,59826
5160:- pred acc_proc_info(1508,61326
5161acc_proc_info(1512,61485
5162:- pred acc_pred_info(1556,63449
5163acc_pred_info(1559,63597
5164:- pred accu_create_goal(1600,65285
5165accu_create_goal(1607,65628
5166:- func create_acc_call(1621,66400
5167create_acc_call(1625,66569
5168:- pred create_orig_goal(1634,66987
5169create_orig_goal(1638,67176
5170:- pred create_acc_goal(1662,68157
5171create_acc_goal(1667,68380
5172:- func create_new_orig_recursive_goals(1709,70225
5173create_new_orig_recursive_goals(1712,70368
5174:- func create_new_recursive_goals(1723,70918
5175create_new_recursive_goals(1727,71108
5176:- func create_new_base_goals(1738,71717
5177create_new_base_goals(1741,71831
5178:- pred acc_unification(1749,72156
5179acc_unification(1751,72225
5180:- pred accu_top_level(1766,72896
5181accu_top_level(1770,73058
5182:- pred update_accumulator_pred(1856,76290
5183update_accumulator_pred(1859,76411
5184:- func accu_rename(1876,77253
5185accu_rename(1879,77363
5186:- func base_case_ids(1889,77784
5187base_case_ids(1891,77846
5188:- func base_case_ids_set(1898,78048
5189base_case_ids_set(1900,78113
5190:- func accu_goal_list(1905,78269
5191accu_goal_list(1907,78349
5192:- pred calculate_goal_info(1916,78680
5193calculate_goal_info(1918,78753
5194:- func chain_subst(1932,79319
5195chain_subst(1934,79378
5196:- pred chain_subst_2(1938,79482
5197chain_subst_2(1941,79576
5198:- end_module transform_hlds.accumulator1953,79939
5199
5026c-src/c.c,76 5200c-src/c.c,76
5027T f(1,0 5201T 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/, )
17LUASRC=$(addprefix ./lua-src/,allegro.lua test.lua) 17LUASRC=$(addprefix ./lua-src/,allegro.lua test.lua)
18MAKESRC=$(addprefix ./make-src/,Makefile) 18MAKESRC=$(addprefix ./make-src/,Makefile)
19MERCSRC=$(addprefix ./merc-src/,accumulator.m)
19OBJCSRC=$(addprefix ./objc-src/,Subprocess.h Subprocess.m PackInsp.h PackInsp.m) 20OBJCSRC=$(addprefix ./objc-src/,Subprocess.h Subprocess.m PackInsp.h PackInsp.m)
20OBJCPPSRC=$(addprefix ./objcpp-src/,SimpleCalc.H SimpleCalc.M) 21OBJCPPSRC=$(addprefix ./objcpp-src/,SimpleCalc.H SimpleCalc.M)
21PASSRC=$(addprefix ./pas-src/,common.pas) 22PASSRC=$(addprefix ./pas-src/,common.pas)
@@ -32,7 +33,7 @@ YSRC=$(addprefix ./y-src/,parse.y parse.c atest.y cccp.c cccp.y)
32SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\ 33SRCS=${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}
36NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz 37NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz
37 38
38ETAGS_PROG=../../../lib-src/etags 39ETAGS_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
247accu_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
337generate_warnings(_, _, [], []).
338generate_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
345generate_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
370should_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
405should_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
442accu_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
469identify_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
551is_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
573initialize_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
584accu_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
604identify_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
631identify_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
693accu_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
731accu_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
783accu_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
798set_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
815accu_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
838accu_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
865accu_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
899accu_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
941accu_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
967member_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
989accu_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
1017associativity_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
1040commutativity_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
1060accu_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
1081is_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
1131accu_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
1182accu_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
1198acc_var_subst_init([], !VarSet, !VarTypes, map.init).
1199acc_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
1210create_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
1229accu_process_assoc_set(_ModuleInfo, _GS, [], _OutPrime, !Substs,
1230 !VarSet, !VarTypes, CS, []) :-
1231 goal_store_init(CS).
1232accu_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
1299accu_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
1307accu_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
1325accu_process_update_set(_ModuleInfo, _GS, [], _OutPrime, !Substs,
1326 !VarSet, !VarTypes, [], [], []).
1327accu_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
1385accu_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
1415accu_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
1452lookup_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
1477accu_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
1512acc_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
1559acc_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
1607accu_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
1625create_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
1638create_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
1667create_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
1712create_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
1727create_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
1741create_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
1751acc_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
1770accu_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
1859update_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
1879accu_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
1891base_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
1900base_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
1907accu_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
1918calculate_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
1934chain_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
1941chain_subst_2([], _, _, AtoC) :-
1942 map.init(AtoC).
1943chain_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.
54Check that the resulting binaries do not differ." 54Check 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"))