aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2020-11-22 22:23:16 +0100
committerAndrea Corallo2020-11-22 22:23:16 +0100
commit033e96055cc172d8d84adc128aee7f7d9889bb00 (patch)
tree4e6e0a24c60f4c8776fb574bf31727dcaf4af4ba
parent6781cd670d1487bbf0364d80de68ca9733342769 (diff)
parent9b6ad3107f93d40f82c3c53dc0984c6d70aded83 (diff)
downloademacs-033e96055cc172d8d84adc128aee7f7d9889bb00.tar.gz
emacs-033e96055cc172d8d84adc128aee7f7d9889bb00.zip
Merge remote-tracking branch 'savannah/master' into HEAD
-rw-r--r--.gitignore1
-rw-r--r--INSTALL28
-rw-r--r--doc/emacs/mule.texi6
-rw-r--r--doc/emacs/package.texi16
-rw-r--r--doc/lispref/edebug.texi8
-rw-r--r--doc/lispref/help.texi5
-rw-r--r--doc/lispref/minibuf.texi10
-rw-r--r--doc/lispref/os.texi22
-rw-r--r--doc/lispref/windows.texi7
-rw-r--r--etc/NEWS59
-rw-r--r--etc/PROBLEMS6
-rw-r--r--lib-src/etags.c36
-rw-r--r--lib-src/make-fingerprint.c9
-rw-r--r--lisp/allout.el11
-rw-r--r--lisp/calc/calc-aent.el35
-rw-r--r--lisp/calc/calc-alg.el7
-rw-r--r--lisp/calc/calc-arith.el10
-rw-r--r--lisp/calc/calc-ext.el38
-rw-r--r--lisp/calc/calc-forms.el2
-rw-r--r--lisp/calc/calc-frac.el5
-rw-r--r--lisp/calc/calc-funcs.el11
-rw-r--r--lisp/calc/calc-help.el50
-rw-r--r--lisp/calc/calc-lang.el364
-rw-r--r--lisp/calc/calc-macs.el6
-rw-r--r--lisp/calc/calc-map.el43
-rw-r--r--lisp/calc/calc-misc.el11
-rw-r--r--lisp/calc/calc-mode.el2
-rw-r--r--lisp/calc/calc-mtx.el6
-rw-r--r--lisp/calc/calc-poly.el21
-rw-r--r--lisp/calc/calc-prog.el14
-rw-r--r--lisp/calc/calc-rewr.el77
-rw-r--r--lisp/calc/calc-store.el71
-rw-r--r--lisp/calc/calc-stuff.el6
-rw-r--r--lisp/calc/calc-units.el40
-rw-r--r--lisp/calc/calc-vec.el18
-rw-r--r--lisp/calc/calc-yank.el11
-rw-r--r--lisp/calc/calc.el11
-rw-r--r--lisp/calc/calcalg2.el583
-rw-r--r--lisp/calc/calcalg3.el16
-rw-r--r--lisp/calc/calccomp.el117
-rw-r--r--lisp/cedet/inversion.el6
-rw-r--r--lisp/cedet/semantic/bovine/el.el26
-rw-r--r--lisp/cedet/semantic/format.el11
-rw-r--r--lisp/cedet/semantic/ia.el11
-rw-r--r--lisp/cedet/semantic/sort.el6
-rw-r--r--lisp/cedet/semantic/symref/grep.el22
-rw-r--r--lisp/cedet/semantic/tag.el11
-rw-r--r--lisp/cus-dep.el2
-rw-r--r--lisp/cus-edit.el36
-rw-r--r--lisp/cus-face.el4
-rw-r--r--lisp/edmacro.el51
-rw-r--r--lisp/emacs-lisp/advice.el42
-rw-r--r--lisp/emacs-lisp/benchmark.el2
-rw-r--r--lisp/emacs-lisp/bytecomp.el3
-rw-r--r--lisp/emacs-lisp/cl-extra.el29
-rw-r--r--lisp/emacs-lisp/cl-macs.el26
-rw-r--r--lisp/emacs-lisp/cl-seq.el13
-rw-r--r--lisp/emacs-lisp/easymenu.el1
-rw-r--r--lisp/emacs-lisp/edebug.el20
-rw-r--r--lisp/emacs-lisp/lisp.el16
-rw-r--r--lisp/emacs-lisp/package.el46
-rw-r--r--lisp/emacs-lisp/pp.el40
-rw-r--r--lisp/emacs-lisp/regi.el21
-rw-r--r--lisp/emulation/edt.el3
-rw-r--r--lisp/emulation/viper-util.el8
-rw-r--r--lisp/epa.el9
-rw-r--r--lisp/erc/erc-log.el3
-rw-r--r--lisp/erc/erc.el4
-rw-r--r--lisp/eshell/em-basic.el9
-rw-r--r--lisp/eshell/em-cmpl.el53
-rw-r--r--lisp/eshell/em-dirs.el5
-rw-r--r--lisp/eshell/em-hist.el19
-rw-r--r--lisp/eshell/em-ls.el76
-rw-r--r--lisp/eshell/em-pred.el46
-rw-r--r--lisp/eshell/em-prompt.el7
-rw-r--r--lisp/eshell/em-smart.el25
-rw-r--r--lisp/eshell/em-unix.el5
-rw-r--r--lisp/eshell/esh-arg.el79
-rw-r--r--lisp/eshell/esh-cmd.el32
-rw-r--r--lisp/eshell/esh-mode.el58
-rw-r--r--lisp/eshell/esh-module.el19
-rw-r--r--lisp/eshell/esh-proc.el10
-rw-r--r--lisp/eshell/esh-var.el20
-rw-r--r--lisp/ffap.el45
-rw-r--r--lisp/files-x.el10
-rw-r--r--lisp/files.el65
-rw-r--r--lisp/filesets.el78
-rw-r--r--lisp/find-lisp.el24
-rw-r--r--lisp/generic-x.el121
-rw-r--r--lisp/gnus/gnus-agent.el31
-rw-r--r--lisp/gnus/gnus-art.el2
-rw-r--r--lisp/gnus/gnus-search.el9
-rw-r--r--lisp/gnus/message.el2
-rw-r--r--lisp/gnus/nnmairix.el84
-rw-r--r--lisp/help.el1
-rw-r--r--lisp/ibuf-ext.el19
-rw-r--r--lisp/international/mule-cmds.el99
-rw-r--r--lisp/international/mule-diag.el13
-rw-r--r--lisp/international/quail.el18
-rw-r--r--lisp/jsonrpc.el16
-rw-r--r--lisp/mail/reporter.el14
-rw-r--r--lisp/mail/supercite.el30
-rw-r--r--lisp/mh-e/mh-alias.el31
-rw-r--r--lisp/mh-e/mh-comp.el110
-rw-r--r--lisp/mh-e/mh-identity.el7
-rw-r--r--lisp/mh-e/mh-utils.el5
-rw-r--r--lisp/net/dig.el6
-rw-r--r--lisp/net/eudc-bob.el12
-rw-r--r--lisp/net/eudc-export.el11
-rw-r--r--lisp/net/eudc.el237
-rw-r--r--lisp/net/eudcb-bbdb.el43
-rw-r--r--lisp/net/mairix.el83
-rw-r--r--lisp/net/sieve-mode.el2
-rw-r--r--lisp/net/tramp-adb.el39
-rw-r--r--lisp/net/tramp-compat.el8
-rw-r--r--lisp/net/tramp-integration.el34
-rw-r--r--lisp/net/tramp-sh.el153
-rw-r--r--lisp/net/tramp-smb.el4
-rw-r--r--lisp/net/tramp.el14
-rw-r--r--lisp/newcomment.el10
-rw-r--r--lisp/org/org.el28
-rw-r--r--lisp/password-cache.el4
-rw-r--r--lisp/pcmpl-gnu.el30
-rw-r--r--lisp/play/handwrite.el2
-rw-r--r--lisp/progmodes/cc-langs.el2
-rw-r--r--lisp/progmodes/compile.el67
-rw-r--r--lisp/progmodes/cperl-mode.el155
-rw-r--r--lisp/progmodes/gdb-mi.el48
-rw-r--r--lisp/progmodes/grep.el146
-rw-r--r--lisp/progmodes/idlw-help.el21
-rw-r--r--lisp/progmodes/idlw-shell.el62
-rw-r--r--lisp/progmodes/idlwave.el95
-rw-r--r--lisp/progmodes/make-mode.el6
-rw-r--r--lisp/progmodes/perl-mode.el2
-rw-r--r--lisp/progmodes/prolog.el3
-rw-r--r--lisp/simple.el59
-rw-r--r--lisp/subr.el46
-rw-r--r--lisp/term.el13
-rw-r--r--lisp/term/w32-win.el79
-rw-r--r--lisp/textmodes/bibtex.el88
-rw-r--r--lisp/textmodes/rst.el2
-rw-r--r--lisp/textmodes/table.el55
-rw-r--r--lisp/time-stamp.el8
-rw-r--r--lisp/url/url-auth.el3
-rw-r--r--lisp/url/url-http.el4
-rw-r--r--lisp/url/url-news.el3
-rw-r--r--lisp/url/url-proxy.el3
-rw-r--r--lisp/url/url.el14
-rw-r--r--lisp/vc/diff-mode.el3
-rw-r--r--lisp/vc/ediff-wind.el13
-rw-r--r--nt/INSTALL18
-rw-r--r--nt/INSTALL.W6412
-rw-r--r--src/buffer.c7
-rw-r--r--src/buffer.h3
-rw-r--r--src/data.c12
-rw-r--r--src/dispnew.c10
-rw-r--r--src/fns.c23
-rw-r--r--src/image.c45
-rw-r--r--src/keyboard.c14
-rw-r--r--src/keymap.c30
-rw-r--r--src/minibuf.c5
-rw-r--r--src/term.c8
-rw-r--r--src/termhooks.h4
-rw-r--r--src/w32term.c16
-rw-r--r--src/window.c21
-rw-r--r--src/xdisp.c18
-rw-r--r--src/xterm.c24
-rw-r--r--test/lisp/cedet/semantic-utest.el7
-rw-r--r--test/lisp/cus-edit-tests.el80
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el32
-rw-r--r--test/lisp/help-tests.el6
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl16
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el15
-rw-r--r--test/manual/etags/ETAGS.good_114
-rw-r--r--test/manual/etags/ETAGS.good_214
-rw-r--r--test/manual/etags/ETAGS.good_314
-rw-r--r--test/manual/etags/ETAGS.good_414
-rw-r--r--test/manual/etags/ETAGS.good_514
-rw-r--r--test/manual/etags/ETAGS.good_614
-rw-r--r--test/manual/indent/tcl.tcl4
-rw-r--r--test/src/data-tests.el50
-rw-r--r--test/src/fns-tests.el7
-rw-r--r--test/src/keymap-tests.el81
-rw-r--r--test/src/syntax-resources/syntax-comments.txt26
-rw-r--r--test/src/syntax-tests.el66
185 files changed, 3225 insertions, 2807 deletions
diff --git a/.gitignore b/.gitignore
index b1522432b1c..e4379d0bef6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -199,7 +199,6 @@ src/bootstrap-emacs
199src/emacs 199src/emacs
200src/emacs-[0-9]* 200src/emacs-[0-9]*
201src/temacs 201src/temacs
202src/fingerprint.c
203src/dmpstruct.h 202src/dmpstruct.h
204src/*.pdmp 203src/*.pdmp
205 204
diff --git a/INSTALL b/INSTALL
index e880b4e3547..5909e8c9fcf 100644
--- a/INSTALL
+++ b/INSTALL
@@ -117,19 +117,25 @@ ADDITIONAL DISTRIBUTION FILES
117 117
118* Complex Text Layout support libraries 118* Complex Text Layout support libraries
119 119
120On GNU and Unix systems, Emacs needs the optional libraries "m17n-db", 120On GNU and Unix systems, Emacs needs optional libraries to correctly
121"libm17n-flt", "libotf" to correctly display such complex scripts as 121display such complex scripts as Indic and Khmer, and also for scripts
122Indic and Khmer, and also for scripts that require Arabic shaping 122that require Arabic shaping support (Arabic and Farsi). If the
123support (Arabic and Farsi). On some systems, particularly GNU/Linux, 123HarfBuzz library is installed, Emacs will build with it and use it for
124these libraries may be already present or available as additional 124this purpose. HarfBuzz is the preferred shaping engine, both on Posix
125packages. Note that if there is a separate 'dev' or 'devel' package, 125hosts and on MS-Windows, so we recommend installing it before building
126for use at compilation time rather than run time, you will need that 126Emacs. The alternative for GNU/Linux and Posix systems is to use the
127as well as the corresponding run time package; typically the dev 127"m17n-db", "libm17n-flt", and "libotf" libraries. (On some systems,
128package will contain header files and a library archive. Otherwise, 128particularly GNU/Linux, these libraries may be already present or
129you can download the libraries from <https://www.nongnu.org/m17n/>. 129available as additional packages.) Note that if there is a separate
130'dev' or 'devel' package, for use at compilation time rather than run
131time, you will need that as well as the corresponding run time
132package; typically the dev package will contain header files and a
133library archive. On MS-Windows, if HarfBuzz is not available, Emacs
134will use the Uniscribe shaping engine that is part of the OS.
130 135
131Note that Emacs cannot support complex scripts on a TTY, unless the 136Note that Emacs cannot support complex scripts on a TTY, unless the
132terminal includes such a support. 137terminal includes such a support. However, most modern terminal
138emulators, such as xterm, do support such scripts.
133 139
134* intlfonts-VERSION.tar.gz 140* intlfonts-VERSION.tar.gz
135 141
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 72ae7697677..bf7088d8db1 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -563,6 +563,12 @@ method's keys by defining key bindings in the keymap returned by the
563function @code{quail-translation-keymap}, using @code{define-key}. 563function @code{quail-translation-keymap}, using @code{define-key}.
564@xref{Init Rebinding}. 564@xref{Init Rebinding}.
565 565
566 Input methods are inhibited when the text in the buffer is read-only
567for some reason. This is so single-character key bindings work in
568modes that make buffer text or parts of it read-only, such as
569@code{read-only-mode} and @code{image-mode}, even when an input method
570is active.
571
566 Another facility for typing characters not on your keyboard is by 572 Another facility for typing characters not on your keyboard is by
567using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single 573using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single
568character based on its Unicode name or code-point; see @ref{Inserting 574character based on its Unicode name or code-point; see @ref{Inserting
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 56e8ee1363a..4981dd50c75 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -187,6 +187,14 @@ Filter package list by archive (@code{package-menu-filter-by-archive}).
187This prompts for a package archive (e.g., @samp{gnu}), then shows only 187This prompts for a package archive (e.g., @samp{gnu}), then shows only
188packages from that archive. 188packages from that archive.
189 189
190@item / d
191@kindex / d @r{(Package Menu)}
192@findex package-menu-filter-by-description
193Filter package list by description
194(@code{package-menu-filter-by-description}). This prompts for a
195regular expression, then shows only packages with descriptions
196matching that regexp.
197
190@item / k 198@item / k
191@kindex / k @r{(Package Menu)} 199@kindex / k @r{(Package Menu)}
192@findex package-menu-filter-by-keyword 200@findex package-menu-filter-by-keyword
@@ -194,6 +202,14 @@ Filter package list by keyword (@code{package-menu-filter-by-keyword}).
194This prompts for a keyword (e.g., @samp{games}), then shows only 202This prompts for a keyword (e.g., @samp{games}), then shows only
195packages with that keyword. 203packages with that keyword.
196 204
205@item / N
206@kindex / N @r{(Package Menu)}
207@findex package-menu-filter-by-name-or-description
208Filter package list by name or description
209(@code{package-menu-filter-by-name-or-description}). This prompts for
210a regular expression, then shows only packages with a name or
211description matching that regexp.
212
197@item / n 213@item / n
198@kindex / n @r{(Package Menu)} 214@kindex / n @r{(Package Menu)}
199@findex package-menu-filter-by-name 215@findex package-menu-filter-by-name
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 6e9ec47f7b0..820fdb9bea0 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -425,7 +425,8 @@ arrange to deinstrument it.
425@item ? 425@item ?
426Display the help message for Edebug (@code{edebug-help}). 426Display the help message for Edebug (@code{edebug-help}).
427 427
428@item C-] 428@item a
429@itemx C-]
429Abort one level back to the previous command level 430Abort one level back to the previous command level
430(@code{abort-recursive-edit}). 431(@code{abort-recursive-edit}).
431 432
@@ -446,7 +447,7 @@ Redisplay the most recently known expression result in the echo area
446 447
447@item d 448@item d
448Display a backtrace, excluding Edebug's own functions for clarity 449Display a backtrace, excluding Edebug's own functions for clarity
449(@code{edebug-backtrace}). 450(@code{edebug-pop-to-backtrace}).
450 451
451@xref{Backtraces}, for a description of backtraces 452@xref{Backtraces}, for a description of backtraces
452and the commands which work on them. 453and the commands which work on them.
@@ -640,7 +641,8 @@ configuration is the collection of windows and contents that were in
640effect outside of Edebug. 641effect outside of Edebug.
641 642
642@table @kbd 643@table @kbd
643@item v 644@item P
645@itemx v
644Switch to viewing the outside window configuration 646Switch to viewing the outside window configuration
645(@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug. 647(@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug.
646 648
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 2fa54e3b66b..90406df9c19 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -676,8 +676,9 @@ If this variable is non-@code{nil}, its value is a form to evaluate
676whenever the character @code{help-char} is read. If evaluating the form 676whenever the character @code{help-char} is read. If evaluating the form
677produces a string, that string is displayed. 677produces a string, that string is displayed.
678 678
679A command that calls @code{read-event}, @code{read-char-choice}, or 679A command that calls @code{read-event}, @code{read-char-choice},
680@code{read-char} probably should bind @code{help-form} to a 680@code{read-char}, @code{read-char-from-minibuffer}, or
681@code{y-or-n-p} probably should bind @code{help-form} to a
681non-@code{nil} expression while it does input. (The time when you 682non-@code{nil} expression while it does input. (The time when you
682should not do this is when @kbd{C-h} has some other meaning.) 683should not do this is when @kbd{C-h} has some other meaning.)
683Evaluating this expression should result in a string that explains 684Evaluating this expression should result in a string that explains
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index b6a3434d15e..f1cfd29ef14 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2109,6 +2109,11 @@ special responses @code{recenter}, @code{scroll-up},
2109@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in 2109@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
2110@code{query-replace-map}), this function performs the specified window 2110@code{query-replace-map}), this function performs the specified window
2111recentering or scrolling operation, and poses the question again. 2111recentering or scrolling operation, and poses the question again.
2112
2113If you bind @code{help-form} (@pxref{Help Functions}) to
2114a non-@code{nil} value while calling @code{y-or-n-p}, then pressing
2115@code{help-char} causes it to evaluate @code{help-form} and display
2116the result. @code{help-char} is automatically added to @var{prompt}.
2112@end defun 2117@end defun
2113 2118
2114@defun y-or-n-p-with-timeout prompt seconds default 2119@defun y-or-n-p-with-timeout prompt seconds default
@@ -2317,6 +2322,11 @@ character. Optionally, it ignores any input that is not a member of
2317@var{chars}, a list of accepted characters. The @var{history} 2322@var{chars}, a list of accepted characters. The @var{history}
2318argument specifies the history list symbol to use; if it is omitted or 2323argument specifies the history list symbol to use; if it is omitted or
2319@code{nil}, this function doesn't use the history. 2324@code{nil}, this function doesn't use the history.
2325
2326If you bind @code{help-form} (@pxref{Help Functions}) to
2327a non-@code{nil} value while calling @code{read-char-from-minibuffer},
2328then pressing @code{help-char} causes it to evaluate @code{help-form}
2329and display the result.
2320@end defun 2330@end defun
2321 2331
2322@node Reading a Password 2332@node Reading a Password
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 2c30d8ad892..f897cfa4eab 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1077,12 +1077,19 @@ directories in a search path (as found in an environment variable). Its
1077value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems. 1077value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems.
1078@end defvar 1078@end defvar
1079 1079
1080@defun path-separator
1081This function returns the connection-local value of variable
1082@code{path-separator}. That is @code{";"} for MS systems and a local
1083@code{default-directory}, and @code{":"} for Unix and GNU systems, or
1084a remote @code{default-directory}.
1085@end defun
1086
1080@defun parse-colon-path path 1087@defun parse-colon-path path
1081This function takes a search path string such as the value of 1088This function takes a search path string such as the value of
1082the @env{PATH} environment variable, and splits it at the separators, 1089the @env{PATH} environment variable, and splits it at the separators,
1083returning a list of directories. @code{nil} in this list means 1090returning a list of directories. @code{nil} in this list means
1084the current directory. Although the function's name says 1091the current directory. Although the function's name says
1085``colon'', it actually uses the value of @code{path-separator}. 1092``colon'', it actually uses the value of variable @code{path-separator}.
1086 1093
1087@example 1094@example
1088(parse-colon-path ":/foo:/bar") 1095(parse-colon-path ":/foo:/bar")
@@ -1155,6 +1162,19 @@ in the system's terminal driver, before Emacs was started.
1155@c The value is @code{nil} if Emacs is running under a window system. 1162@c The value is @code{nil} if Emacs is running under a window system.
1156@end defvar 1163@end defvar
1157 1164
1165@defvar null-device
1166This variable holds the system null device. Its value is
1167@code{"/dev/null"} for Unix and GNU systems, and @code{"NUL"} for MS
1168systems.
1169@end defvar
1170
1171@defun null-device
1172This function returns the connection-local value of variable
1173@code{null-device}. That is @code{"NUL"} for MS systems and a local
1174@code{default-directory}, and @code{"/dev/null"} for Unix and GNU
1175systems, or a remote @code{default-directory}.
1176@end defun
1177
1158@node User Identification 1178@node User Identification
1159@section User Identification 1179@section User Identification
1160@cindex user identification 1180@cindex user identification
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 5ec23a9c876..2d092e1842a 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -5869,13 +5869,16 @@ which window parameters (if any) are saved by this function.
5869@xref{Window Parameters}. 5869@xref{Window Parameters}.
5870@end defun 5870@end defun
5871 5871
5872@defun set-window-configuration configuration 5872@defun set-window-configuration configuration &optional dont-set-frame
5873This function restores the configuration of windows and buffers as 5873This function restores the configuration of windows and buffers as
5874specified by @var{configuration}, for the frame that 5874specified by @var{configuration}, for the frame that
5875@var{configuration} was created for, regardless of whether that frame 5875@var{configuration} was created for, regardless of whether that frame
5876is selected or not. The argument @var{configuration} must be a value 5876is selected or not. The argument @var{configuration} must be a value
5877that was previously returned by @code{current-window-configuration} 5877that was previously returned by @code{current-window-configuration}
5878for that frame. 5878for that frame. Normally the function also selects the frame which is
5879recorded in the configuration, but if @var{dont-set-frame} is
5880non-@code{nil}, it leaves selected the frame which was current at the
5881start of the function.
5879 5882
5880If the frame from which @var{configuration} was saved is dead, all 5883If the frame from which @var{configuration} was saved is dead, all
5881this function does is to restore the value of the variable 5884this function does is to restore the value of the variable
diff --git a/etc/NEWS b/etc/NEWS
index 803185f0665..2cea803374d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -103,7 +103,7 @@ unsystematic behavior, which mixed these two is no longer available.
103+++ 103+++
104** New system for displaying documentation for groups of functions. 104** New system for displaying documentation for groups of functions.
105This can either be used by saying 'M-x shortdoc-display-group' and 105This can either be used by saying 'M-x shortdoc-display-group' and
106choosing a group, or clicking a button in the *Help* buffers when 106choosing a group, or clicking a button in the "*Help*" buffers when
107looking at the doc string of a function that belongs to one of these 107looking at the doc string of a function that belongs to one of these
108groups. 108groups.
109 109
@@ -187,6 +187,11 @@ space characters.
187freenode IRC network for years now. Occurrences of "irc.freenode.net" 187freenode IRC network for years now. Occurrences of "irc.freenode.net"
188have been replaced with "chat.freenode.net" throughout Emacs. 188have been replaced with "chat.freenode.net" throughout Emacs.
189 189
190+++
191** New functions 'null-device' and 'path-separator'.
192These functions return the connection local value of the respective
193variables. This can be used for remote hosts.
194
190 195
191* Editing Changes in Emacs 28.1 196* Editing Changes in Emacs 28.1
192 197
@@ -203,6 +208,12 @@ This command would previously not redefine values defined by these
203forms, but this command has now been changed to work more like 208forms, but this command has now been changed to work more like
204'eval-defun', and reset the values as specified. 209'eval-defun', and reset the values as specified.
205 210
211---
212** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'.
213'copy-region-blink-delay' specifies a delay to indicate the region
214copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies
215a delay to show a paired character to delete.
216
206+++ 217+++
207** New command 'undo-redo'. 218** New command 'undo-redo'.
208It undoes previous undo commands, but doesn't record itself as an 219It undoes previous undo commands, but doesn't record itself as an
@@ -282,7 +293,7 @@ indentation is done using SMIE or with the old ad-hoc code.
282When a warning is displayed to the user, the resulting buffer now has 293When a warning is displayed to the user, the resulting buffer now has
283buttons which allow making permanent changes to the treatment of that 294buttons which allow making permanent changes to the treatment of that
284warning. Automatic showing of the warning can be disabled (although 295warning. Automatic showing of the warning can be disabled (although
285it is still logged to the *Messages* buffer), or the warning can be 296it is still logged to the "*Messages*" buffer), or the warning can be
286disabled entirely. 297disabled entirely.
287 298
288** mspool.el 299** mspool.el
@@ -471,13 +482,13 @@ tags to be considered as well.
471** Gnus 482** Gnus
472 483
473+++ 484+++
474*** New gnus-search library 485*** New gnus-search library.
475A new unified search syntax which can be used across multiple 486A new unified search syntax which can be used across multiple
476supported search engines. Set 'gnus-search-use-parsed-queries' to 487supported search engines. Set 'gnus-search-use-parsed-queries' to
477non-nil to enable. 488non-nil to enable.
478 489
479+++ 490+++
480*** New value for user option 'smiley-style' 491*** New value for user option 'smiley-style'.
481Smileys can now be rendered with emojis instead of small images when 492Smileys can now be rendered with emojis instead of small images when
482using the new 'emoji' value in 'smiley-style'. 493using the new 'emoji' value in 'smiley-style'.
483 494
@@ -706,6 +717,16 @@ This file was a compatibility kludge which is no longer needed.
706To revert to the previous behavior, 717To revert to the previous behavior,
707'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. 718'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
708 719
720** Customize
721
722*** Most customize commands now hide obsolete user options.
723Obsolete user options are no longer shown in the listings produced by
724the commands 'customize', 'customize-group', 'customize-apropos' and
725'customize-changed-options'.
726
727To customize obsolete user options, use 'customize-option' or
728'customize-saved'.
729
709** Edebug 730** Edebug
710 731
711+++ 732+++
@@ -825,12 +846,14 @@ equivalent to '(map (:sym sym))'.
825 846
826+++ 847+++
827*** New commands to filter the package list. 848*** New commands to filter the package list.
828The filter command key bindings are as follows: 849The filter commands are bound to the following keys:
829 850
830key binding 851key binding
831--- ------- 852--- -------
832/ a package-menu-filter-by-archive 853/ a package-menu-filter-by-archive
854/ d package-menu-filter-by-description
833/ k package-menu-filter-by-keyword 855/ k package-menu-filter-by-keyword
856/ N package-menu-filter-by-name-or-description
834/ n package-menu-filter-by-name 857/ n package-menu-filter-by-name
835/ s package-menu-filter-by-status 858/ s package-menu-filter-by-status
836/ v package-menu-filter-by-version 859/ v package-menu-filter-by-version
@@ -872,7 +895,7 @@ Customize 'gdb-max-source-window-count' to use more than one window.
872Control source file display by 'gdb-display-source-buffer-action'. 895Control source file display by 'gdb-display-source-buffer-action'.
873 896
874+++ 897+++
875*** The default value of gdb-mi-decode-strings is now t. 898*** The default value of 'gdb-mi-decode-strings' is now t.
876This means that the default coding-system is now used to decode strings 899This means that the default coding-system is now used to decode strings
877and source file names from GDB. 900and source file names from GDB.
878 901
@@ -1141,8 +1164,8 @@ project's root directory, respectively.
1141** xref 1164** xref
1142 1165
1143--- 1166---
1144*** Prefix arg of 'xref-goto-xref' quits the *xref* buffer. 1167*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer.
1145So typing 'C-u RET' in the *xref* buffer quits its window 1168So typing 'C-u RET' in the "*xref*" buffer quits its window
1146before navigating to the selected location. 1169before navigating to the selected location.
1147 1170
1148** json.el 1171** json.el
@@ -1305,6 +1328,11 @@ This new command (bound to 'C-c C-l') regenerates the current hunk.
1305 1328
1306** Miscellaneous 1329** Miscellaneous
1307 1330
1331---
1332*** New user option 'bibtex-unify-case-convert'.
1333This new option allows the user to customize how case is converted
1334when unifying entries.
1335
1308+++ 1336+++
1309*** 'format-seconds' can now be used for sub-second times. 1337*** 'format-seconds' can now be used for sub-second times.
1310The new optional "," parameter has been added, and 1338The new optional "," parameter has been added, and
@@ -1320,7 +1348,7 @@ buffers. This can be controlled by customizing the variable
1320--- 1348---
1321*** New user option 'compilation-search-all-directories'. 1349*** New user option 'compilation-search-all-directories'.
1322When doing parallel builds, directories and compilation errors may 1350When doing parallel builds, directories and compilation errors may
1323arrive in the *compilation* buffer out-of-order. If this variable is 1351arrive in the "*compilation*" buffer out-of-order. If this variable is
1324non-nil (the default), Emacs will now search backwards in the buffer 1352non-nil (the default), Emacs will now search backwards in the buffer
1325for any directory the file with errors may be in. If nil, this won't 1353for any directory the file with errors may be in. If nil, this won't
1326be done (and this restores how this previously worked). 1354be done (and this restores how this previously worked).
@@ -1750,6 +1778,17 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
1750* Lisp Changes in Emacs 28.1 1778* Lisp Changes in Emacs 28.1
1751 1779
1752+++ 1780+++
1781** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'.
1782If you bind 'help-form' to a non-nil value while calling these functions,
1783then pressing 'C-h' (help-char) causes the function to evaluate 'help-form'
1784and display the result.
1785
1786+++
1787** 'set-window-configuration' now takes an optional 'dont-set-frame'
1788parameter which, when non-nil, instructs the function not to select
1789the frame recorded in the configuration.
1790
1791+++
1753** 'define-globalized-minor-mode' now takes a ':predicate' parameter. 1792** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
1754This can be used to control which major modes the minor mode should be 1793This can be used to control which major modes the minor mode should be
1755used in. 1794used in.
@@ -1992,7 +2031,7 @@ image API via 'M-x report-emacs-bug'.
1992 2031
1993-- 2032--
1994** On macOS, 's-<left>' and 's-<right>' are now bound to 2033** On macOS, 's-<left>' and 's-<right>' are now bound to
1995'move-beginning-of-line' and 'move-end-of-line' respectively. The commands 2034'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
1996to select previous/next frame are still bound to 's-~' and 's-`'. 2035to select previous/next frame are still bound to 's-~' and 's-`'.
1997 2036
1998 2037
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 8ed92ab75e0..f24c6f03c8e 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -352,11 +352,11 @@ is the current directory.
352*** Set find-function-C-source-directory accordingly. 352*** Set find-function-C-source-directory accordingly.
353 353
354Once you have installed the source package, for example at 354Once you have installed the source package, for example at
355/home/myself/deb-src/emacs-26.3, add the following line to your 355/home/myself/deb-src/emacs-27.1, add the following line to your
356startup file: 356startup file:
357 357
358 (setq find-function-C-source-directory 358 (setq find-function-C-source-directory
359 "/home/myself/deb-src/emacs-26.3/src/") 359 "/home/myself/deb-src/emacs-27.1/src/")
360 360
361The installation directory of the Emacs source package will contain 361The installation directory of the Emacs source package will contain
362the exact package name and version number of Emacs that is installed 362the exact package name and version number of Emacs that is installed
@@ -386,7 +386,7 @@ To get describe-function and similar commands to work, you can then
386add something like the following to your startup file: 386add something like the following to your startup file:
387 387
388 (setq find-function-C-source-directory 388 (setq find-function-C-source-directory
389 "/usr/src/debug/emacs-26.3-1.fc31.x86_64/src/") 389 "/usr/src/debug/emacs-27.1-1.fc31.x86_64/src/")
390 390
391However, the exact directory name will depend on the system, and you 391However, the exact directory name will depend on the system, and you
392will need to both upgrade source and debug info when your system 392will need to both upgrade source and debug info when your system
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 146cf612505..4315771a496 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -1974,14 +1974,13 @@ make_tag (const char *name, /* tag name, or NULL if unnamed */
1974 1974
1975/* Record a tag. */ 1975/* Record a tag. */
1976static void 1976static void
1977pfnote (char *name, bool is_func, char *linestart, ptrdiff_t linelen, 1977pfnote (char *name, /* tag name, or NULL if unnamed */
1978 intmax_t lno, intmax_t cno) 1978 bool is_func, /* tag is a function */
1979 /* tag name, or NULL if unnamed */ 1979 char *linestart, /* start of the line where tag is */
1980 /* tag is a function */ 1980 ptrdiff_t linelen, /* length of the line where tag is */
1981 /* start of the line where tag is */ 1981 intmax_t lno, /* line number */
1982 /* length of the line where tag is */ 1982 intmax_t cno) /* character number */
1983 /* line number */ 1983
1984 /* character number */
1985{ 1984{
1986 register node *np; 1985 register node *np;
1987 1986
@@ -2905,15 +2904,13 @@ static void make_C_tag (bool);
2905 */ 2904 */
2906 2905
2907static bool 2906static bool
2908consider_token (char *str, ptrdiff_t len, int c, int *c_extp, 2907consider_token (char *str, /* IN: token pointer */
2909 ptrdiff_t bracelev, ptrdiff_t parlev, bool *is_func_or_var) 2908 ptrdiff_t len, /* IN: token length */
2910 /* IN: token pointer */ 2909 int c, /* IN: first char after the token */
2911 /* IN: token length */ 2910 int *c_extp, /* IN, OUT: C extensions mask */
2912 /* IN: first char after the token */ 2911 ptrdiff_t bracelev, /* IN: brace level */
2913 /* IN, OUT: C extensions mask */ 2912 ptrdiff_t parlev, /* IN: parenthesis level */
2914 /* IN: brace level */ 2913 bool *is_func_or_var) /* OUT: function or variable found */
2915 /* IN: parenthesis level */
2916 /* OUT: function or variable found */
2917{ 2914{
2918 /* When structdef is stagseen, scolonseen, or snone with bracelev > 0, 2915 /* When structdef is stagseen, scolonseen, or snone with bracelev > 0,
2919 structtype is the type of the preceding struct-like keyword, and 2916 structtype is the type of the preceding struct-like keyword, and
@@ -3312,9 +3309,8 @@ perhaps_more_input (FILE *inf)
3312 * C syntax and adds them to the list. 3309 * C syntax and adds them to the list.
3313 */ 3310 */
3314static void 3311static void
3315C_entries (int c_ext, FILE *inf) 3312C_entries (int c_ext, /* extension of C */
3316 /* extension of C */ 3313 FILE *inf) /* input file */
3317 /* input file */
3318{ 3314{
3319 char c; /* latest char read; '\0' for end of line */ 3315 char c; /* latest char read; '\0' for end of line */
3320 char *lp; /* pointer one beyond the character `c' */ 3316 char *lp; /* pointer one beyond the character `c' */
diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c
index c013d0aca3b..b72ee90bbca 100644
--- a/lib-src/make-fingerprint.c
+++ b/lib-src/make-fingerprint.c
@@ -19,9 +19,12 @@ You should have received a copy of the GNU General Public License
19along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ 19along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
20 20
21 21
22/* The arguments given to this program are all the object files that 22/* The argument given to this program is the initial version of the
23 go into building GNU Emacs. There is no special search logic to find 23 temacs executable file used when building GNU Emacs. This program computes
24 the files. */ 24 a digest fingerprint for the executable, and modifies the binary in
25 place, replacing all instances of the existing fingerprint (normally
26 the default fingerprint from libgnu's lib/fingerprint.c) with the
27 new value. With option -r, it just prints the digest. */
25 28
26#include <config.h> 29#include <config.h>
27 30
diff --git a/lisp/allout.el b/lisp/allout.el
index b56071de59e..a4802a1c2a6 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -5583,12 +5583,11 @@ used verbatim."
5583 "Return copy of STRING for literal reproduction across LaTeX processing. 5583 "Return copy of STRING for literal reproduction across LaTeX processing.
5584Expresses the original characters (including carriage returns) of the 5584Expresses the original characters (including carriage returns) of the
5585string across LaTeX processing." 5585string across LaTeX processing."
5586 (mapconcat (function 5586 (mapconcat (lambda (char)
5587 (lambda (char) 5587 (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
5588 (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) 5588 (concat "\\char" (number-to-string char) "{}"))
5589 (concat "\\char" (number-to-string char) "{}")) 5589 ((= char ?\n) "\\\\")
5590 ((= char ?\n) "\\\\") 5590 (t (char-to-string char))))
5591 (t (char-to-string char)))))
5592 string 5591 string
5593 "")) 5592 ""))
5594;;;_ > allout-latex-verbatim-quote-curr-line () 5593;;;_ > allout-latex-verbatim-quote-curr-line ()
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 6c162b55f7b..338f0ea43e0 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -76,8 +76,8 @@
76 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp)))) 76 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
77 (setq alg-exp (list (nth 2 (car alg-exp))))) 77 (setq alg-exp (list (nth 2 (car alg-exp)))))
78 (setq calc-quick-prev-results alg-exp 78 (setq calc-quick-prev-results alg-exp
79 buf (mapconcat (function (lambda (x) 79 buf (mapconcat (lambda (x)
80 (math-format-value x 1000))) 80 (math-format-value x 1000))
81 alg-exp 81 alg-exp
82 " ") 82 " ")
83 shortbuf buf) 83 shortbuf buf)
@@ -197,18 +197,17 @@
197 (calc-language (if (memq calc-language '(nil big)) 197 (calc-language (if (memq calc-language '(nil big))
198 'flat calc-language)) 198 'flat calc-language))
199 (calc-dollar-values (mapcar 199 (calc-dollar-values (mapcar
200 (function 200 (lambda (x)
201 (lambda (x) 201 (if (stringp x)
202 (if (stringp x) 202 (progn
203 (progn 203 (setq x (math-read-exprs x))
204 (setq x (math-read-exprs x)) 204 (if (eq (car-safe x)
205 (if (eq (car-safe x) 205 'error)
206 'error) 206 (throw 'calc-error
207 (throw 'calc-error 207 (calc-eval-error
208 (calc-eval-error 208 (cdr x)))
209 (cdr x))) 209 (car x)))
210 (car x))) 210 x))
211 x)))
212 args)) 211 args))
213 (calc-dollar-used 0) 212 (calc-dollar-used 0)
214 (res (if (stringp str) 213 (res (if (stringp str)
@@ -640,10 +639,10 @@ in Calc algebraic input.")
640 (math-find-user-tokens (car (car p))) 639 (math-find-user-tokens (car (car p)))
641 (setq p (cdr p))) 640 (setq p (cdr p)))
642 (setq calc-user-tokens (mapconcat 'identity 641 (setq calc-user-tokens (mapconcat 'identity
643 (sort (mapcar 'car math-toks) 642 (sort (mapcar #'car math-toks)
644 (function (lambda (x y) 643 (lambda (x y)
645 (> (length x) 644 (> (length x)
646 (length y))))) 645 (length y))))
647 "\\|") 646 "\\|")
648 calc-last-main-parse-table mtab 647 calc-last-main-parse-table mtab
649 calc-last-user-lang-parse-table ltab 648 calc-last-user-lang-parse-table ltab
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index efb68395f7e..53ca01d9516 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -1785,7 +1785,7 @@ and should return the simplified expression to use (or nil)."
1785 (cons (nth 2 expr) math-poly-neg-powers)))) 1785 (cons (nth 2 expr) math-poly-neg-powers))))
1786 (not (Math-zerop (nth 2 expr))) 1786 (not (Math-zerop (nth 2 expr)))
1787 (let ((p1 (math-is-poly-rec (nth 1 expr) negpow))) 1787 (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
1788 (mapcar (function (lambda (x) (math-div x (nth 2 expr)))) 1788 (mapcar (lambda (x) (math-div x (nth 2 expr)))
1789 p1)))) 1789 p1))))
1790 ((and (eq (car expr) 'calcFunc-exp) 1790 ((and (eq (car expr) 'calcFunc-exp)
1791 (equal math-var '(var e var-e))) 1791 (equal math-var '(var e var-e)))
@@ -1838,8 +1838,9 @@ and should return the simplified expression to use (or nil)."
1838(defun math-polynomial-base (top-expr &optional pred) 1838(defun math-polynomial-base (top-expr &optional pred)
1839 "Find the variable (or sub-expression) which is the base of polynomial expr." 1839 "Find the variable (or sub-expression) which is the base of polynomial expr."
1840 (let ((math-poly-base-pred 1840 (let ((math-poly-base-pred
1841 (or pred (function (lambda (base) (math-polynomial-p 1841 (or pred (lambda (base)
1842 top-expr base)))))) 1842 (math-polynomial-p
1843 top-expr base)))))
1843 (or (let ((math-poly-base-const-ok nil)) 1844 (or (let ((math-poly-base-const-ok nil))
1844 (math-polynomial-base-rec top-expr)) 1845 (math-polynomial-base-rec top-expr))
1845 (let ((math-poly-base-const-ok t)) 1846 (let ((math-poly-base-const-ok t))
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index ae397c4f2c4..c11cecfd545 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -2390,7 +2390,7 @@
2390 (math-trunc (nth 3 a))))) 2390 (math-trunc (nth 3 a)))))
2391 ((math-provably-integerp a) a) 2391 ((math-provably-integerp a) a)
2392 ((Math-vectorp a) 2392 ((Math-vectorp a)
2393 (math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a)) 2393 (math-map-vec (lambda (x) (math-trunc x math-trunc-prec)) a))
2394 ((math-infinitep a) 2394 ((math-infinitep a)
2395 (if (or (math-posp a) (math-negp a)) 2395 (if (or (math-posp a) (math-negp a))
2396 a 2396 a
@@ -2453,7 +2453,7 @@
2453 (math-add (math-floor (nth 3 a)) -1) 2453 (math-add (math-floor (nth 3 a)) -1)
2454 (math-floor (nth 3 a))))) 2454 (math-floor (nth 3 a)))))
2455 ((Math-vectorp a) 2455 ((Math-vectorp a)
2456 (math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a)) 2456 (math-map-vec (lambda (x) (math-floor x math-floor-prec)) a))
2457 ((math-infinitep a) 2457 ((math-infinitep a)
2458 (if (or (math-posp a) (math-negp a)) 2458 (if (or (math-posp a) (math-negp a))
2459 a 2459 a
@@ -2520,7 +2520,7 @@
2520 (math-ceiling (nth 2 a))) 2520 (math-ceiling (nth 2 a)))
2521 (math-ceiling (nth 3 a)))) 2521 (math-ceiling (nth 3 a))))
2522 ((Math-vectorp a) 2522 ((Math-vectorp a)
2523 (math-map-vec (function (lambda (x) (math-ceiling x prec))) a)) 2523 (math-map-vec (lambda (x) (math-ceiling x prec)) a))
2524 ((math-infinitep a) 2524 ((math-infinitep a)
2525 (if (or (math-posp a) (math-negp a)) 2525 (if (or (math-posp a) (math-negp a))
2526 a 2526 a
@@ -2573,7 +2573,7 @@
2573 ((eq (car a) 'intv) 2573 ((eq (car a) 'intv)
2574 (math-floor (math-add a '(frac 1 2)))) 2574 (math-floor (math-add a '(frac 1 2))))
2575 ((Math-vectorp a) 2575 ((Math-vectorp a)
2576 (math-map-vec (function (lambda (x) (math-round x prec))) a)) 2576 (math-map-vec (lambda (x) (math-round x prec)) a))
2577 ((math-infinitep a) 2577 ((math-infinitep a)
2578 (if (or (math-posp a) (math-negp a)) 2578 (if (or (math-posp a) (math-negp a))
2579 a 2579 a
@@ -2656,7 +2656,7 @@
2656 (calcFunc-scf (nth 2 x) n) 2656 (calcFunc-scf (nth 2 x) n)
2657 (calcFunc-scf (nth 3 x) n)))) 2657 (calcFunc-scf (nth 3 x) n))))
2658 ((eq (car x) 'vec) 2658 ((eq (car x) 'vec)
2659 (math-map-vec (function (lambda (x) (calcFunc-scf x n))) x)) 2659 (math-map-vec (lambda (x) (calcFunc-scf x n)) x))
2660 ((math-infinitep x) 2660 ((math-infinitep x)
2661 x) 2661 x)
2662 (t 2662 (t
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 23248ce1bd5..4877fa6e08c 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -678,14 +678,13 @@
678 678
679 (calc-init-prefixes) 679 (calc-init-prefixes)
680 680
681 (mapc (function 681 (mapc (lambda (x)
682 (lambda (x)
683 (define-key calc-mode-map (format "c%c" x) 'calc-clean-num) 682 (define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
684 (define-key calc-mode-map (format "j%c" x) 'calc-select-part) 683 (define-key calc-mode-map (format "j%c" x) 'calc-select-part)
685 (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) 684 (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
686 (define-key calc-mode-map (format "s%c" x) 'calc-store-quick) 685 (define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
687 (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) 686 (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
688 (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) 687 (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))
689 "0123456789") 688 "0123456789")
690 689
691 (let ((i ?A)) 690 (let ((i ?A))
@@ -711,9 +710,9 @@
711 (define-key calc-alg-map "\e\177" 'calc-pop-above) 710 (define-key calc-alg-map "\e\177" 'calc-pop-above)
712 711
713;;;; (Autoloads here) 712;;;; (Autoloads here)
714 (mapc (function (lambda (x) 713 (mapc (lambda (x)
715 (mapcar (function (lambda (func) (autoload func (car x)))) 714 (mapcar (lambda (func) (autoload func (car x)))
716 (cdr x)))) 715 (cdr x)))
717 '( 716 '(
718 717
719 ("calc-alg" calc-has-rules math-defsimplify 718 ("calc-alg" calc-has-rules math-defsimplify
@@ -980,9 +979,9 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
980 979
981)) 980))
982 981
983 (mapcar (function (lambda (x) 982 (mapcar (lambda (x)
984 (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t))) 983 (mapcar (lambda (cmd) (autoload cmd (car x) nil t))
985 (cdr x)))) 984 (cdr x)))
986 '( 985 '(
987 986
988 ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand 987 ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@@ -1358,7 +1357,7 @@ calc-kill calc-kill-region calc-yank))))
1358 calc-redo-list nil) 1357 calc-redo-list nil)
1359 (let (calc-stack calc-user-parse-tables calc-standard-date-formats 1358 (let (calc-stack calc-user-parse-tables calc-standard-date-formats
1360 calc-invocation-macro) 1359 calc-invocation-macro)
1361 (mapc (function (lambda (v) (set v nil))) calc-local-var-list) 1360 (mapc (lambda (v) (set v nil)) calc-local-var-list)
1362 (if (and arg (<= arg 0)) 1361 (if (and arg (<= arg 0))
1363 (calc-mode-var-list-restore-default-values) 1362 (calc-mode-var-list-restore-default-values)
1364 (calc-mode-var-list-restore-saved-values))) 1363 (calc-mode-var-list-restore-saved-values)))
@@ -1658,7 +1657,7 @@ calc-kill calc-kill-region calc-yank))))
1658 (calc-pop-stack n 1 t) 1657 (calc-pop-stack n 1 t)
1659 (calc-push-list (mapcar #'car entries) 1658 (calc-push-list (mapcar #'car entries)
1660 1 1659 1
1661 (mapcar (function (lambda (x) (nth 2 x))) 1660 (mapcar (lambda (x) (nth 2 x))
1662 entries))))))) 1661 entries)))))))
1663 1662
1664(defvar calc-refreshing-evaltos nil) 1663(defvar calc-refreshing-evaltos nil)
@@ -1924,11 +1923,10 @@ calc-kill calc-kill-region calc-yank))))
1924 (let* ((calc-z-prefix-msgs nil) 1923 (let* ((calc-z-prefix-msgs nil)
1925 (calc-z-prefix-buf "") 1924 (calc-z-prefix-buf "")
1926 (kmap (sort (copy-sequence (calc-user-key-map)) 1925 (kmap (sort (copy-sequence (calc-user-key-map))
1927 (function (lambda (x y) (< (car x) (car y)))))) 1926 (lambda (x y) (< (car x) (car y)))))
1928 (flags (apply #'logior 1927 (flags (apply #'logior
1929 (mapcar (function 1928 (mapcar (lambda (k)
1930 (lambda (k) 1929 (calc-user-function-classify (car k)))
1931 (calc-user-function-classify (car k))))
1932 kmap)))) 1930 kmap))))
1933 (if (= (logand flags 8) 0) 1931 (if (= (logand flags 8) 0)
1934 (calc-user-function-list kmap 7) 1932 (calc-user-function-list kmap 7)
@@ -2633,9 +2631,8 @@ If X is not an error form, return 1."
2633 (let ((rhs (calc-top-n 1))) 2631 (let ((rhs (calc-top-n 1)))
2634 (calc-enter-result (- 1 n) 2632 (calc-enter-result (- 1 n)
2635 name 2633 name
2636 (mapcar (function 2634 (mapcar (lambda (x)
2637 (lambda (x) 2635 (list func x rhs))
2638 (list func x rhs)))
2639 (calc-top-list-n (- n) 2)))))))) 2636 (calc-top-list-n (- n) 2))))))))
2640 2637
2641(defun calc-unary-op-fancy (name func arg) 2638(defun calc-unary-op-fancy (name func arg)
@@ -2644,9 +2641,8 @@ If X is not an error form, return 1."
2644 (cond ((> n 0) 2641 (cond ((> n 0)
2645 (calc-enter-result n 2642 (calc-enter-result n
2646 name 2643 name
2647 (mapcar (function 2644 (mapcar (lambda (x)
2648 (lambda (x) 2645 (list func x))
2649 (list func x)))
2650 (calc-top-list-n n)))) 2646 (calc-top-list-n n))))
2651 ((< n 0) 2647 ((< n 0)
2652 (calc-enter-result 1 2648 (calc-enter-result 1
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 465d4520b05..39116bfde99 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -2129,7 +2129,7 @@ and ends on the last Sunday of October at 2 a.m."
2129 ((memq (car n) '(+ - / vec neg)) 2129 ((memq (car n) '(+ - / vec neg))
2130 (math-normalize 2130 (math-normalize
2131 (cons (car n) 2131 (cons (car n)
2132 (mapcar (function (lambda (x) (math-make-mod x m))) 2132 (mapcar (lambda (x) (math-make-mod x m))
2133 (cdr n))))) 2133 (cdr n)))))
2134 ((and (eq (car n) '*) (Math-anglep (nth 1 n))) 2134 ((and (eq (car n) '*) (Math-anglep (nth 1 n)))
2135 (math-mul (math-make-mod (nth 1 n) m) (nth 2 n))) 2135 (math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index 86a4808c5ad..1d6895caa3a 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -132,9 +132,8 @@
132 (cond ((Math-ratp a) 132 (cond ((Math-ratp a)
133 a) 133 a)
134 ((memq (car a) '(cplx polar vec hms date sdev intv mod)) 134 ((memq (car a) '(cplx polar vec hms date sdev intv mod))
135 (cons (car a) (mapcar (function 135 (cons (car a) (mapcar (lambda (x)
136 (lambda (x) 136 (calcFunc-frac x tol))
137 (calcFunc-frac x tol)))
138 (cdr a)))) 137 (cdr a))))
139 ((Math-messy-integerp a) 138 ((Math-messy-integerp a)
140 (math-trunc a)) 139 (math-trunc a))
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index 5c179ff05d4..9ee86e755ea 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -797,12 +797,11 @@
797 (math-reduce-vec 797 (math-reduce-vec
798 'math-add 798 'math-add
799 (cons 'vec 799 (cons 'vec
800 (mapcar (function 800 (mapcar (lambda (c)
801 (lambda (c) 801 (setq k (1+ k))
802 (setq k (1+ k)) 802 (math-mul (math-mul fac c)
803 (math-mul (math-mul fac c) 803 (math-sub (math-pow x1 k)
804 (math-sub (math-pow x1 k) 804 (math-pow x2 k))))
805 (math-pow x2 k)))))
806 coefs))) 805 coefs)))
807 x))) 806 x)))
808 (math-mul (math-pow 2 n) 807 (math-mul (math-pow 2 n)
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 0b327e8d0f6..06b4b9684e3 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -402,32 +402,32 @@ C-w Describe how there is no warranty for Calc."
402 "Or type `h i' to read the full Calc manual on-line.\n\n")) 402 "Or type `h i' to read the full Calc manual on-line.\n\n"))
403 (princ "Basic keys:\n") 403 (princ "Basic keys:\n")
404 (let* ((calc-full-help-flag t)) 404 (let* ((calc-full-help-flag t))
405 (mapc (function (lambda (x) (princ (format 405 (mapc (lambda (x)
406 " %s\n" 406 (princ (format
407 (substitute-command-keys x))))) 407 " %s\n"
408 (substitute-command-keys x))))
408 (nreverse (cdr (reverse (cdr (calc-help)))))) 409 (nreverse (cdr (reverse (cdr (calc-help))))))
409 (mapc (function (lambda (prefix) 410 (mapc (lambda (prefix)
410 (let ((msgs (ignore-errors (funcall prefix)))) 411 (let ((msgs (ignore-errors (funcall prefix))))
411 (if (car msgs) 412 (if (car msgs)
412 (princ 413 (princ
413 (if (eq (nth 2 msgs) ?v) 414 (if (eq (nth 2 msgs) ?v)
414 (format-message 415 (format-message
415 "\n`v' or `V' prefix (vector/matrix) keys: \n") 416 "\n`v' or `V' prefix (vector/matrix) keys: \n")
416 (if (nth 2 msgs) 417 (if (nth 2 msgs)
417 (format-message 418 (format-message
418 "\n`%c' prefix (%s) keys:\n" 419 "\n`%c' prefix (%s) keys:\n"
419 (nth 2 msgs) 420 (nth 2 msgs)
420 (or (cdr (assq (nth 2 msgs) 421 (or (cdr (assq (nth 2 msgs)
421 calc-help-long-names)) 422 calc-help-long-names))
422 (nth 1 msgs))) 423 (nth 1 msgs)))
423 (format "\n%s-modified keys:\n" 424 (format "\n%s-modified keys:\n"
424 (capitalize (nth 1 msgs))))))) 425 (capitalize (nth 1 msgs)))))))
425 (mapcar (function 426 (mapcar (lambda (x)
426 (lambda (x) 427 (princ (format
427 (princ (format 428 " %s\n"
428 " %s\n" 429 (substitute-command-keys x))))
429 (substitute-command-keys x))))) 430 (car msgs))))
430 (car msgs)))))
431 '(calc-inverse-prefix-help 431 '(calc-inverse-prefix-help
432 calc-hyperbolic-prefix-help 432 calc-hyperbolic-prefix-help
433 calc-inv-hyp-prefix-help 433 calc-inv-hyp-prefix-help
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index bde5abe649f..283069446e0 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -175,20 +175,19 @@
175(put 'c 'math-vector-brackets "{}") 175(put 'c 'math-vector-brackets "{}")
176 176
177(put 'c 'math-radix-formatter 177(put 'c 'math-radix-formatter
178 (function (lambda (r s) 178 (lambda (r s)
179 (if (= r 16) (format "0x%s" s) 179 (if (= r 16) (format "0x%s" s)
180 (if (= r 8) (format "0%s" s) 180 (if (= r 8) (format "0%s" s)
181 (format "%d#%s" r s)))))) 181 (format "%d#%s" r s)))))
182 182
183(put 'c 'math-compose-subscr 183(put 'c 'math-compose-subscr
184 (function 184 (lambda (a)
185 (lambda (a) 185 (let ((args (cdr (cdr a))))
186 (let ((args (cdr (cdr a)))) 186 (list 'horiz
187 (list 'horiz 187 (math-compose-expr (nth 1 a) 1000)
188 (math-compose-expr (nth 1 a) 1000) 188 "["
189 "[" 189 (math-compose-vector args ", " 0)
190 (math-compose-vector args ", " 0) 190 "]"))))
191 "]")))))
192 191
193(add-to-list 'calc-lang-slash-idiv 'c) 192(add-to-list 'calc-lang-slash-idiv 'c)
194(add-to-list 'calc-lang-allow-underscores 'c) 193(add-to-list 'calc-lang-allow-underscores 'c)
@@ -238,9 +237,9 @@
238(put 'pascal 'math-output-filter 'calc-output-case-filter) 237(put 'pascal 'math-output-filter 'calc-output-case-filter)
239 238
240(put 'pascal 'math-radix-formatter 239(put 'pascal 'math-radix-formatter
241 (function (lambda (r s) 240 (lambda (r s)
242 (if (= r 16) (format "$%s" s) 241 (if (= r 16) (format "$%s" s)
243 (format "%d#%s" r s))))) 242 (format "%d#%s" r s))))
244 243
245(put 'pascal 'math-lang-read-symbol 244(put 'pascal 'math-lang-read-symbol
246 '((?\$ 245 '((?\$
@@ -253,17 +252,16 @@
253 math-exp-pos (match-end 1))))) 252 math-exp-pos (match-end 1)))))
254 253
255(put 'pascal 'math-compose-subscr 254(put 'pascal 'math-compose-subscr
256 (function 255 (lambda (a)
257 (lambda (a) 256 (let ((args (cdr (cdr a))))
258 (let ((args (cdr (cdr a)))) 257 (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
259 (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) 258 (setq args (append (cdr (cdr (nth 1 a))) args)
260 (setq args (append (cdr (cdr (nth 1 a))) args) 259 a (nth 1 a)))
261 a (nth 1 a))) 260 (list 'horiz
262 (list 'horiz 261 (math-compose-expr (nth 1 a) 1000)
263 (math-compose-expr (nth 1 a) 1000) 262 "["
264 "[" 263 (math-compose-vector args ", " 0)
265 (math-compose-vector args ", " 0) 264 "]"))))
266 "]")))))
267 265
268(add-to-list 'calc-lang-allow-underscores 'pascal) 266(add-to-list 'calc-lang-allow-underscores 'pascal)
269(add-to-list 'calc-lang-brackets-are-subscripts 'pascal) 267(add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
@@ -350,17 +348,16 @@
350 math-exp-pos (match-end 0))))) 348 math-exp-pos (match-end 0)))))
351 349
352(put 'fortran 'math-compose-subscr 350(put 'fortran 'math-compose-subscr
353 (function 351 (lambda (a)
354 (lambda (a) 352 (let ((args (cdr (cdr a))))
355 (let ((args (cdr (cdr a)))) 353 (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
356 (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) 354 (setq args (append (cdr (cdr (nth 1 a))) args)
357 (setq args (append (cdr (cdr (nth 1 a))) args) 355 a (nth 1 a)))
358 a (nth 1 a))) 356 (list 'horiz
359 (list 'horiz 357 (math-compose-expr (nth 1 a) 1000)
360 (math-compose-expr (nth 1 a) 1000) 358 "("
361 "(" 359 (math-compose-vector args ", " 0)
362 (math-compose-vector args ", " 0) 360 ")"))))
363 ")")))))
364 361
365(add-to-list 'calc-lang-slash-idiv 'fortran) 362(add-to-list 'calc-lang-slash-idiv 'fortran)
366(add-to-list 'calc-lang-allow-underscores 'fortran) 363(add-to-list 'calc-lang-allow-underscores 'fortran)
@@ -598,18 +595,17 @@
598(put 'tex 'math-input-filter 'math-tex-input-filter) 595(put 'tex 'math-input-filter 'math-tex-input-filter)
599 596
600(put 'tex 'math-matrix-formatter 597(put 'tex 'math-matrix-formatter
601 (function 598 (lambda (a)
602 (lambda (a) 599 (if (and (integerp calc-language-option)
603 (if (and (integerp calc-language-option) 600 (or (= calc-language-option 0)
604 (or (= calc-language-option 0) 601 (> calc-language-option 1)
605 (> calc-language-option 1) 602 (< calc-language-option -1)))
606 (< calc-language-option -1))) 603 (append '(vleft 0 "\\matrix{")
607 (append '(vleft 0 "\\matrix{") 604 (math-compose-tex-matrix (cdr a))
608 (math-compose-tex-matrix (cdr a)) 605 '("}"))
609 '("}")) 606 (append '(horiz "\\matrix{ ")
610 (append '(horiz "\\matrix{ ") 607 (math-compose-tex-matrix (cdr a))
611 (math-compose-tex-matrix (cdr a)) 608 '(" }")))))
612 '(" }"))))))
613 609
614(put 'tex 'math-var-formatter 'math-compose-tex-var) 610(put 'tex 'math-var-formatter 'math-compose-tex-var)
615 611
@@ -839,18 +835,17 @@
839(put 'latex 'math-complex-format 'i) 835(put 'latex 'math-complex-format 'i)
840 836
841(put 'latex 'math-matrix-formatter 837(put 'latex 'math-matrix-formatter
842 (function 838 (lambda (a)
843 (lambda (a) 839 (if (and (integerp calc-language-option)
844 (if (and (integerp calc-language-option) 840 (or (= calc-language-option 0)
845 (or (= calc-language-option 0) 841 (> calc-language-option 1)
846 (> calc-language-option 1) 842 (< calc-language-option -1)))
847 (< calc-language-option -1))) 843 (append '(vleft 0 "\\begin{pmatrix}")
848 (append '(vleft 0 "\\begin{pmatrix}") 844 (math-compose-tex-matrix (cdr a) t)
849 (math-compose-tex-matrix (cdr a) t) 845 '("\\end{pmatrix}"))
850 '("\\end{pmatrix}")) 846 (append '(horiz "\\begin{pmatrix} ")
851 (append '(horiz "\\begin{pmatrix} ") 847 (math-compose-tex-matrix (cdr a) t)
852 (math-compose-tex-matrix (cdr a) t) 848 '(" \\end{pmatrix}")))))
853 '(" \\end{pmatrix}"))))))
854 849
855(put 'latex 'math-var-formatter 'math-compose-tex-var) 850(put 'latex 'math-var-formatter 'math-compose-tex-var)
856 851
@@ -1023,36 +1018,34 @@
1023(put 'eqn 'math-evalto '("evalto " . " -> ")) 1018(put 'eqn 'math-evalto '("evalto " . " -> "))
1024 1019
1025(put 'eqn 'math-matrix-formatter 1020(put 'eqn 'math-matrix-formatter
1026 (function 1021 (lambda (a)
1027 (lambda (a) 1022 (append '(horiz "matrix { ")
1028 (append '(horiz "matrix { ") 1023 (math-compose-eqn-matrix
1029 (math-compose-eqn-matrix 1024 (cdr (math-transpose a)))
1030 (cdr (math-transpose a))) 1025 '("}"))))
1031 '("}")))))
1032 1026
1033(put 'eqn 'math-var-formatter 1027(put 'eqn 'math-var-formatter
1034 (function 1028 (lambda (a prec)
1035 (lambda (a prec) 1029 (let (v)
1036 (let (v) 1030 (if (and math-compose-hash-args
1037 (if (and math-compose-hash-args 1031 (let ((p calc-arg-values))
1038 (let ((p calc-arg-values)) 1032 (setq v 1)
1039 (setq v 1) 1033 (while (and p (not (equal (car p) a)))
1040 (while (and p (not (equal (car p) a))) 1034 (setq p (and (eq math-compose-hash-args t) (cdr p))
1041 (setq p (and (eq math-compose-hash-args t) (cdr p)) 1035 v (1+ v)))
1042 v (1+ v))) 1036 p))
1043 p)) 1037 (if (eq math-compose-hash-args 1)
1044 (if (eq math-compose-hash-args 1) 1038 "#"
1045 "#" 1039 (format "#%d" v))
1046 (format "#%d" v)) 1040 (if (string-match ".'\\'" (symbol-name (nth 2 a)))
1047 (if (string-match ".'\\'" (symbol-name (nth 2 a))) 1041 (math-compose-expr
1048 (math-compose-expr 1042 (list 'calcFunc-Prime
1049 (list 'calcFunc-Prime 1043 (list
1050 (list 1044 'var
1051 'var 1045 (intern (substring (symbol-name (nth 1 a)) 0 -1))
1052 (intern (substring (symbol-name (nth 1 a)) 0 -1)) 1046 (intern (substring (symbol-name (nth 2 a)) 0 -1))))
1053 (intern (substring (symbol-name (nth 2 a)) 0 -1)))) 1047 prec)
1054 prec) 1048 (symbol-name (nth 1 a)))))))
1055 (symbol-name (nth 1 a))))))))
1056 1049
1057(defconst math-eqn-special-funcs 1050(defconst math-eqn-special-funcs
1058 '( calcFunc-log 1051 '( calcFunc-log
@@ -1065,31 +1058,30 @@
1065 calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) 1058 calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
1066 1059
1067(put 'eqn 'math-func-formatter 1060(put 'eqn 'math-func-formatter
1068 (function 1061 (lambda (func a)
1069 (lambda (func a) 1062 (let (left right)
1070 (let (left right) 1063 (if (string-match "[^']'+\\'" func)
1071 (if (string-match "[^']'+\\'" func) 1064 (let ((n (- (length func) (match-beginning 0) 1)))
1072 (let ((n (- (length func) (match-beginning 0) 1))) 1065 (setq func (substring func 0 (- n)))
1073 (setq func (substring func 0 (- n))) 1066 (while (>= (setq n (1- n)) 0)
1074 (while (>= (setq n (1- n)) 0) 1067 (setq func (concat func " prime")))))
1075 (setq func (concat func " prime"))))) 1068 (cond ((or (> (length a) 2)
1076 (cond ((or (> (length a) 2) 1069 (not (math-tex-expr-is-flat (nth 1 a))))
1077 (not (math-tex-expr-is-flat (nth 1 a)))) 1070 (setq left "{left ( "
1078 (setq left "{left ( " 1071 right " right )}"))
1079 right " right )}")) 1072
1080 1073 ((and
1081 ((and 1074 (memq (car a) math-eqn-special-funcs)
1082 (memq (car a) math-eqn-special-funcs) 1075 (= (length a) 2)
1083 (= (length a) 2) 1076 (or (Math-realp (nth 1 a))
1084 (or (Math-realp (nth 1 a)) 1077 (memq (car (nth 1 a)) '(var *))))
1085 (memq (car (nth 1 a)) '(var *)))) 1078 (setq left "~{" right "}"))
1086 (setq left "~{" right "}")) 1079 (t
1087 (t 1080 (setq left " ( "
1088 (setq left " ( " 1081 right " )")))
1089 right " )"))) 1082 (list 'horiz func left
1090 (list 'horiz func left 1083 (math-compose-vector (cdr a) " , " 0)
1091 (math-compose-vector (cdr a) " , " 0) 1084 right))))
1092 right)))))
1093 1085
1094(put 'eqn 'math-lang-read-symbol 1086(put 'eqn 'math-lang-read-symbol
1095 '((?\" 1087 '((?\"
@@ -1111,23 +1103,22 @@
1111 ("above" punc ","))) 1103 ("above" punc ",")))
1112 1104
1113(put 'eqn 'math-lang-adjust-words 1105(put 'eqn 'math-lang-adjust-words
1114 (function 1106 (lambda ()
1115 (lambda () 1107 (let ((code (assoc math-expr-data math-eqn-ignore-words)))
1116 (let ((code (assoc math-expr-data math-eqn-ignore-words))) 1108 (cond ((null code))
1117 (cond ((null code)) 1109 ((null (cdr code))
1118 ((null (cdr code)) 1110 (math-read-token))
1119 (math-read-token)) 1111 ((consp (nth 1 code))
1120 ((consp (nth 1 code)) 1112 (math-read-token)
1121 (math-read-token) 1113 (if (assoc math-expr-data (cdr code))
1122 (if (assoc math-expr-data (cdr code)) 1114 (setq math-expr-data (format "%s %s"
1123 (setq math-expr-data (format "%s %s" 1115 (car code) math-expr-data))))
1124 (car code) math-expr-data)))) 1116 ((eq (nth 1 code) 'punc)
1125 ((eq (nth 1 code) 'punc) 1117 (setq math-exp-token 'punc
1126 (setq math-exp-token 'punc 1118 math-expr-data (nth 2 code)))
1127 math-expr-data (nth 2 code))) 1119 (t
1128 (t 1120 (math-read-token)
1129 (math-read-token) 1121 (math-read-token))))))
1130 (math-read-token)))))))
1131 1122
1132(put 'eqn 'math-lang-read 1123(put 'eqn 'math-lang-read
1133 '((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^" 1124 '((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^"
@@ -1357,14 +1348,13 @@
1357 ( calcFunc-in . (math-lang-compose-switch-args "Contains")))) 1348 ( calcFunc-in . (math-lang-compose-switch-args "Contains"))))
1358 1349
1359(put 'yacas 'math-compose-subscr 1350(put 'yacas 'math-compose-subscr
1360 (function 1351 (lambda (a)
1361 (lambda (a) 1352 (let ((args (cdr (cdr a))))
1362 (let ((args (cdr (cdr a)))) 1353 (list 'horiz
1363 (list 'horiz 1354 (math-compose-expr (nth 1 a) 1000)
1364 (math-compose-expr (nth 1 a) 1000) 1355 "["
1365 "[" 1356 (math-compose-vector args ", " 0)
1366 (math-compose-vector args ", " 0) 1357 "]"))))
1367 "]")))))
1368 1358
1369(defun math-yacas-parse-Sum (f _val) 1359(defun math-yacas-parse-Sum (f _val)
1370 "Read in the arguments to \"Sum\" in Calc's Yacas mode." 1360 "Read in the arguments to \"Sum\" in Calc's Yacas mode."
@@ -1600,24 +1590,22 @@
1600(add-to-list 'calc-lang-brackets-are-subscripts 'maxima) 1590(add-to-list 'calc-lang-brackets-are-subscripts 'maxima)
1601 1591
1602(put 'maxima 'math-compose-subscr 1592(put 'maxima 'math-compose-subscr
1603 (function 1593 (lambda (a)
1604 (lambda (a) 1594 (let ((args (cdr (cdr a))))
1605 (let ((args (cdr (cdr a)))) 1595 (list 'horiz
1606 (list 'horiz 1596 (math-compose-expr (nth 1 a) 1000)
1607 (math-compose-expr (nth 1 a) 1000) 1597 "["
1608 "[" 1598 (math-compose-vector args ", " 0)
1609 (math-compose-vector args ", " 0) 1599 "]"))))
1610 "]")))))
1611 1600
1612(put 'maxima 'math-matrix-formatter 1601(put 'maxima 'math-matrix-formatter
1613 (function 1602 (lambda (a)
1614 (lambda (a) 1603 (list 'horiz
1615 (list 'horiz 1604 "matrix("
1616 "matrix(" 1605 (math-compose-vector (cdr a)
1617 (math-compose-vector (cdr a) 1606 (concat math-comp-comma " ")
1618 (concat math-comp-comma " ") 1607 math-comp-vector-prec)
1619 math-comp-vector-prec) 1608 ")")))
1620 ")"))))
1621 1609
1622 1610
1623;;; Giac 1611;;; Giac
@@ -1806,15 +1794,14 @@ order to Calc's."
1806(add-to-list 'calc-lang-allow-underscores 'giac) 1794(add-to-list 'calc-lang-allow-underscores 'giac)
1807 1795
1808(put 'giac 'math-compose-subscr 1796(put 'giac 'math-compose-subscr
1809 (function 1797 (lambda (a)
1810 (lambda (a) 1798 ;; (let ((args (cdr (cdr a))))
1811 ;; (let ((args (cdr (cdr a)))) 1799 (list 'horiz
1812 (list 'horiz 1800 (math-compose-expr (nth 1 a) 1000)
1813 (math-compose-expr (nth 1 a) 1000) 1801 "["
1814 "[" 1802 (math-compose-expr
1815 (math-compose-expr 1803 (calc-normalize (list '- (nth 2 a) 1)) 0)
1816 (calc-normalize (list '- (nth 2 a) 1)) 0) 1804 "]"))) ;;)
1817 "]")))) ;;)
1818 1805
1819(defun math-read-giac-subscr (x _op) 1806(defun math-read-giac-subscr (x _op)
1820 (let ((idx (math-read-expr-level 0))) 1807 (let ((idx (math-read-expr-level 0)))
@@ -1932,7 +1919,7 @@ order to Calc's."
1932(put 'math 'math-function-close "]") 1919(put 'math 'math-function-close "]")
1933 1920
1934(put 'math 'math-radix-formatter 1921(put 'math 'math-radix-formatter
1935 (function (lambda (r s) (format "%d^^%s" r s)))) 1922 (lambda (r s) (format "%d^^%s" r s)))
1936 1923
1937(put 'math 'math-lang-read 1924(put 'math 'math-lang-read
1938 '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) 1925 '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
@@ -1942,13 +1929,12 @@ order to Calc's."
1942 math-exp-pos (match-end 0)))) 1929 math-exp-pos (match-end 0))))
1943 1930
1944(put 'math 'math-compose-subscr 1931(put 'math 'math-compose-subscr
1945 (function 1932 (lambda (a)
1946 (lambda (a) 1933 (list 'horiz
1947 (list 'horiz 1934 (math-compose-expr (nth 1 a) 1000)
1948 (math-compose-expr (nth 1 a) 1000) 1935 "[["
1949 "[[" 1936 (math-compose-expr (nth 2 a) 0)
1950 (math-compose-expr (nth 2 a) 0) 1937 "]]")))
1951 "]]"))))
1952 1938
1953(defun math-read-math-subscr (x _op) 1939(defun math-read-math-subscr (x _op)
1954 (let ((idx (math-read-expr-level 0))) 1940 (let ((idx (math-read-expr-level 0)))
@@ -2038,26 +2024,24 @@ order to Calc's."
2038(put 'maple 'math-complex-format 'I) 2024(put 'maple 'math-complex-format 'I)
2039 2025
2040(put 'maple 'math-matrix-formatter 2026(put 'maple 'math-matrix-formatter
2041 (function 2027 (lambda (a)
2042 (lambda (a) 2028 (list 'horiz
2043 (list 'horiz 2029 "matrix("
2044 "matrix(" 2030 math-comp-left-bracket
2045 math-comp-left-bracket 2031 (math-compose-vector (cdr a)
2046 (math-compose-vector (cdr a) 2032 (concat math-comp-comma " ")
2047 (concat math-comp-comma " ") 2033 math-comp-vector-prec)
2048 math-comp-vector-prec) 2034 math-comp-right-bracket
2049 math-comp-right-bracket 2035 ")")))
2050 ")"))))
2051 2036
2052(put 'maple 'math-compose-subscr 2037(put 'maple 'math-compose-subscr
2053 (function 2038 (lambda (a)
2054 (lambda (a) 2039 (let ((args (cdr (cdr a))))
2055 (let ((args (cdr (cdr a)))) 2040 (list 'horiz
2056 (list 'horiz 2041 (math-compose-expr (nth 1 a) 1000)
2057 (math-compose-expr (nth 1 a) 1000) 2042 "["
2058 "[" 2043 (math-compose-vector args ", " 0)
2059 (math-compose-vector args ", " 0) 2044 "]"))))
2060 "]")))))
2061 2045
2062(add-to-list 'calc-lang-allow-underscores 'maple) 2046(add-to-list 'calc-lang-allow-underscores 'maple)
2063(add-to-list 'calc-lang-brackets-are-subscripts 'maple) 2047(add-to-list 'calc-lang-brackets-are-subscripts 'maple)
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 5aaa5f48d6c..06ef3ef0556 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -33,12 +33,12 @@
33 33
34 34
35(defmacro calc-wrapper (&rest body) 35(defmacro calc-wrapper (&rest body)
36 `(calc-do (function (lambda () 36 `(calc-do (lambda ()
37 ,@body)))) 37 ,@body)))
38 38
39(defmacro calc-slow-wrapper (&rest body) 39(defmacro calc-slow-wrapper (&rest body)
40 `(calc-do 40 `(calc-do
41 (function (lambda () ,@body)) (point))) 41 (lambda () ,@body) (point)))
42 42
43(defmacro math-showing-full-precision (form) 43(defmacro math-showing-full-precision (form)
44 `(let ((calc-float-format calc-full-float-format)) 44 `(let ((calc-float-format calc-full-float-format))
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 0ee82826927..3e2869d146a 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -612,14 +612,13 @@
612 "()") 612 "()")
613 minibuffer-local-map 613 minibuffer-local-map
614 t))) 614 t)))
615 (setq math-arglist (mapcar (function 615 (setq math-arglist (mapcar (lambda (x)
616 (lambda (x) 616 (list 'var
617 (list 'var 617 x
618 x 618 (intern
619 (intern 619 (concat
620 (concat 620 "var-"
621 "var-" 621 (symbol-name x)))))
622 (symbol-name x))))))
623 math-arglist)))) 622 math-arglist))))
624 (setq oper (list "$" 623 (setq oper (list "$"
625 (length math-arglist) 624 (length math-arglist)
@@ -962,12 +961,12 @@
962 (apply 'calcFunc-mapeqp func args))) 961 (apply 'calcFunc-mapeqp func args)))
963 962
964(defun calcFunc-mapeqr (func &rest args) 963(defun calcFunc-mapeqr (func &rest args)
965 (setq args (mapcar (function (lambda (x) 964 (setq args (mapcar (lambda (x)
966 (let ((func (assq (car-safe x) 965 (let ((func (assq (car-safe x)
967 calc-tweak-eqn-table))) 966 calc-tweak-eqn-table)))
968 (if func 967 (if func
969 (cons (nth 1 func) (cdr x)) 968 (cons (nth 1 func) (cdr x))
970 x)))) 969 x)))
971 args)) 970 args))
972 (apply 'calcFunc-mapeqp func args)) 971 (apply 'calcFunc-mapeqp func args))
973 972
@@ -1092,28 +1091,28 @@
1092(defun calcFunc-reducea (func vec) 1091(defun calcFunc-reducea (func vec)
1093 (if (math-matrixp vec) 1092 (if (math-matrixp vec)
1094 (cons 'vec 1093 (cons 'vec
1095 (mapcar (function (lambda (x) (calcFunc-reducer func x))) 1094 (mapcar (lambda (x) (calcFunc-reducer func x))
1096 (cdr vec))) 1095 (cdr vec)))
1097 (calcFunc-reducer func vec))) 1096 (calcFunc-reducer func vec)))
1098 1097
1099(defun calcFunc-rreducea (func vec) 1098(defun calcFunc-rreducea (func vec)
1100 (if (math-matrixp vec) 1099 (if (math-matrixp vec)
1101 (cons 'vec 1100 (cons 'vec
1102 (mapcar (function (lambda (x) (calcFunc-rreducer func x))) 1101 (mapcar (lambda (x) (calcFunc-rreducer func x))
1103 (cdr vec))) 1102 (cdr vec)))
1104 (calcFunc-rreducer func vec))) 1103 (calcFunc-rreducer func vec)))
1105 1104
1106(defun calcFunc-reduced (func vec) 1105(defun calcFunc-reduced (func vec)
1107 (if (math-matrixp vec) 1106 (if (math-matrixp vec)
1108 (cons 'vec 1107 (cons 'vec
1109 (mapcar (function (lambda (x) (calcFunc-reducer func x))) 1108 (mapcar (lambda (x) (calcFunc-reducer func x))
1110 (cdr (math-transpose vec)))) 1109 (cdr (math-transpose vec))))
1111 (calcFunc-reducer func vec))) 1110 (calcFunc-reducer func vec)))
1112 1111
1113(defun calcFunc-rreduced (func vec) 1112(defun calcFunc-rreduced (func vec)
1114 (if (math-matrixp vec) 1113 (if (math-matrixp vec)
1115 (cons 'vec 1114 (cons 'vec
1116 (mapcar (function (lambda (x) (calcFunc-rreducer func x))) 1115 (mapcar (lambda (x) (calcFunc-rreducer func x))
1117 (cdr (math-transpose vec)))) 1116 (cdr (math-transpose vec))))
1118 (calcFunc-rreducer func vec))) 1117 (calcFunc-rreducer func vec)))
1119 1118
@@ -1216,10 +1215,10 @@
1216 (let ((mat nil)) 1215 (let ((mat nil))
1217 (while (setq a (cdr a)) 1216 (while (setq a (cdr a))
1218 (setq mat (cons (cons 'vec 1217 (setq mat (cons (cons 'vec
1219 (mapcar (function (lambda (x) 1218 (mapcar (lambda (x)
1220 (math-build-call func 1219 (math-build-call func
1221 (list (car a) 1220 (list (car a)
1222 x)))) 1221 x)))
1223 (cdr b))) 1222 (cdr b)))
1224 mat))) 1223 mat)))
1225 (math-normalize (cons 'vec (nreverse mat))))) 1224 (math-normalize (cons 'vec (nreverse mat)))))
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 2db09e2b677..ada754a3979 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -176,9 +176,9 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
176 "Create another, independent Calculator buffer." 176 "Create another, independent Calculator buffer."
177 (interactive) 177 (interactive)
178 (if (eq major-mode 'calc-mode) 178 (if (eq major-mode 'calc-mode)
179 (mapc (function 179 (mapc (lambda (v)
180 (lambda (v) 180 (set-default v (symbol-value v)))
181 (set-default v (symbol-value v)))) calc-local-var-list)) 181 calc-local-var-list))
182 (set-buffer (generate-new-buffer "*Calculator*")) 182 (set-buffer (generate-new-buffer "*Calculator*"))
183 (pop-to-buffer (current-buffer)) 183 (pop-to-buffer (current-buffer))
184 (calc-mode)) 184 (calc-mode))
@@ -274,9 +274,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
274;;;###autoload 274;;;###autoload
275(defun calc-do-handle-whys () 275(defun calc-do-handle-whys ()
276 (setq calc-why (sort calc-next-why 276 (setq calc-why (sort calc-next-why
277 (function 277 (lambda (x y)
278 (lambda (x y) 278 (and (eq (car x) '*) (not (eq (car y) '*)))))
279 (and (eq (car x) '*) (not (eq (car y) '*))))))
280 calc-next-why nil) 279 calc-next-why nil)
281 (if (and calc-why (or (eq calc-auto-why t) 280 (if (and calc-why (or (eq calc-auto-why t)
282 (and (eq (car (car calc-why)) '*) 281 (and (eq (car (car calc-why)) '*)
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index e109233a825..358854bc93c 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -268,7 +268,7 @@
268 (interactive) 268 (interactive)
269 (calc-wrapper 269 (calc-wrapper
270 (let (pos 270 (let (pos
271 (vals (mapcar (function (lambda (v) (symbol-value (car v)))) 271 (vals (mapcar (lambda (v) (symbol-value (car v)))
272 calc-mode-var-list))) 272 calc-mode-var-list)))
273 (unless calc-settings-file 273 (unless calc-settings-file
274 (error "No `calc-settings-file' specified")) 274 (error "No `calc-settings-file' specified"))
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index 8deef7dc4fd..bfcd61ddcd4 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -55,7 +55,7 @@
55(defun math-col-matrix (a) 55(defun math-col-matrix (a)
56 (if (and (Math-vectorp a) 56 (if (and (Math-vectorp a)
57 (not (math-matrixp a))) 57 (not (math-matrixp a)))
58 (cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a))) 58 (cons 'vec (mapcar (lambda (x) (list 'vec x)) (cdr a)))
59 a)) 59 a))
60 60
61 61
@@ -79,8 +79,8 @@
79 (cons 'vec (nreverse mat)))) 79 (cons 'vec (nreverse mat))))
80 80
81(defun math-mul-mat-vec (a b) 81(defun math-mul-mat-vec (a b)
82 (cons 'vec (mapcar (function (lambda (row) 82 (cons 'vec (mapcar (lambda (row)
83 (math-dot-product row b))) 83 (math-dot-product row b))
84 (cdr a)))) 84 (cdr a))))
85 85
86 86
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index b3f2c96b0ca..5928a8ee47c 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -202,7 +202,7 @@
202 (if (memq (car-safe expr) '(+ -)) 202 (if (memq (car-safe expr) '(+ -))
203 (math-list-to-sum 203 (math-list-to-sum
204 (sort (math-sum-to-list expr) 204 (sort (math-sum-to-list expr)
205 (function (lambda (a b) (math-beforep (car a) (car b)))))) 205 (lambda (a b) (math-beforep (car a) (car b)))))
206 expr)) 206 expr))
207 207
208(defun math-list-to-sum (lst) 208(defun math-list-to-sum (lst)
@@ -387,7 +387,7 @@ This returns only the remainder from the pseudo-division."
387 lst 387 lst
388 (if (eq a -1) 388 (if (eq a -1)
389 (math-mul-list lst a) 389 (math-mul-list lst a)
390 (mapcar (function (lambda (x) (math-poly-div-exact x a))) lst)))) 390 (mapcar (lambda (x) (math-poly-div-exact x a)) lst))))
391 391
392(defun math-mul-list (lst a) 392(defun math-mul-list (lst a)
393 (if (eq a 1) 393 (if (eq a 1)
@@ -395,7 +395,7 @@ This returns only the remainder from the pseudo-division."
395 (if (eq a -1) 395 (if (eq a -1)
396 (mapcar 'math-neg lst) 396 (mapcar 'math-neg lst)
397 (and (not (eq a 0)) 397 (and (not (eq a 0))
398 (mapcar (function (lambda (x) (math-mul x a))) lst))))) 398 (mapcar (lambda (x) (math-mul x a)) lst)))))
399 399
400;;; Run GCD on all elements in a list. 400;;; Run GCD on all elements in a list.
401(defun math-poly-gcd-list (lst) 401(defun math-poly-gcd-list (lst)
@@ -502,10 +502,10 @@ Take the base that has the highest degree considering both a and b.
502 502
503(defun math-sort-poly-base-list (lst) 503(defun math-sort-poly-base-list (lst)
504 "Sort a list of polynomial bases." 504 "Sort a list of polynomial bases."
505 (sort lst (function (lambda (a b) 505 (sort lst (lambda (a b)
506 (or (> (nth 1 a) (nth 1 b)) 506 (or (> (nth 1 a) (nth 1 b))
507 (and (= (nth 1 a) (nth 1 b)) 507 (and (= (nth 1 a) (nth 1 b))
508 (math-beforep (car a) (car b)))))))) 508 (math-beforep (car a) (car b)))))))
509 509
510;;; Given an expression find all variables that are polynomial bases. 510;;; Given an expression find all variables that are polynomial bases.
511;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). 511;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
@@ -1033,10 +1033,9 @@ If no partial fraction representation can be found, return nil."
1033 (math-transpose 1033 (math-transpose
1034 (cons 'vec 1034 (cons 'vec
1035 (mapcar 1035 (mapcar
1036 (function 1036 (lambda (x)
1037 (lambda (x) 1037 (cons 'vec (math-padded-polynomial
1038 (cons 'vec (math-padded-polynomial 1038 x var tdeg)))
1039 x var tdeg))))
1040 (cdr eqns)))))) 1039 (cdr eqns))))))
1041 (and (math-vectorp eqns) 1040 (and (math-vectorp eqns)
1042 (let ((res 0) 1041 (let ((res 0)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index ea9c49748e2..781ba5c8b66 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -182,7 +182,7 @@
182 odef key keyname cmd cmd-base cmd-base-default 182 odef key keyname cmd cmd-base cmd-base-default
183 func calc-user-formula-alist is-symb) 183 func calc-user-formula-alist is-symb)
184 (if is-lambda 184 (if is-lambda
185 (setq math-arglist (mapcar (function (lambda (x) (nth 1 x))) 185 (setq math-arglist (mapcar (lambda (x) (nth 1 x))
186 (nreverse (cdr (reverse (cdr form))))) 186 (nreverse (cdr (reverse (cdr form)))))
187 form (nth (1- (length form)) form)) 187 form (nth (1- (length form)) form))
188 (calc-default-formula-arglist form) 188 (calc-default-formula-arglist form)
@@ -290,10 +290,10 @@
290 (y-or-n-p 290 (y-or-n-p
291 "Leave it symbolic for non-constant arguments? "))) 291 "Leave it symbolic for non-constant arguments? ")))
292 (setq calc-user-formula-alist 292 (setq calc-user-formula-alist
293 (mapcar (function (lambda (x) 293 (mapcar (lambda (x)
294 (or (cdr (assq x '((nil . arg-nil) 294 (or (cdr (assq x '((nil . arg-nil)
295 (t . arg-t)))) 295 (t . arg-t))))
296 x))) calc-user-formula-alist)) 296 x)) calc-user-formula-alist))
297 (if cmd 297 (if cmd
298 (progn 298 (progn
299 (require 'calc-macs) 299 (require 'calc-macs)
@@ -319,8 +319,8 @@
319 (append 319 (append
320 (list 'lambda calc-user-formula-alist) 320 (list 'lambda calc-user-formula-alist)
321 (and is-symb 321 (and is-symb
322 (mapcar (function (lambda (v) 322 (mapcar (lambda (v)
323 (list 'math-check-const v t))) 323 (list 'math-check-const v t))
324 calc-user-formula-alist)) 324 calc-user-formula-alist))
325 (list body)))) 325 (list body))))
326 (put func 'calc-user-defn form) 326 (put func 'calc-user-defn form)
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index 2cc7b6beef0..1528e12ae0e 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -181,19 +181,18 @@
181 (calc-line-numbering nil) 181 (calc-line-numbering nil)
182 (calc-show-selections t) 182 (calc-show-selections t)
183 (calc-why nil) 183 (calc-why nil)
184 (math-mt-func (function 184 (math-mt-func (lambda (x)
185 (lambda (x) 185 (let ((result (math-apply-rewrites x (cdr crules)
186 (let ((result (math-apply-rewrites x (cdr crules) 186 heads crules)))
187 heads crules))) 187 (if result
188 (if result 188 (progn
189 (progn 189 (if trace-buffer
190 (if trace-buffer 190 (let ((fmt (math-format-stack-value
191 (let ((fmt (math-format-stack-value 191 (list result nil nil))))
192 (list result nil nil)))) 192 (with-current-buffer trace-buffer
193 (with-current-buffer trace-buffer 193 (insert "\nrewrite to\n" fmt "\n"))))
194 (insert "\nrewrite to\n" fmt "\n")))) 194 (setq heads (math-rewrite-heads result heads t))))
195 (setq heads (math-rewrite-heads result heads t)))) 195 result))))
196 result)))))
197 (if trace-buffer 196 (if trace-buffer
198 (let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil)))) 197 (let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
199 (with-current-buffer trace-buffer 198 (with-current-buffer trace-buffer
@@ -485,8 +484,8 @@
485 (let ((math-rewrite-whole t)) 484 (let ((math-rewrite-whole t))
486 (cdr (math-compile-rewrites (cons 485 (cdr (math-compile-rewrites (cons
487 'vec 486 'vec
488 (mapcar (function (lambda (x) 487 (mapcar (lambda (x)
489 (list 'vec x t))) 488 (list 'vec x t))
490 (if (eq (car-safe pats) 'vec) 489 (if (eq (car-safe pats) 'vec)
491 (cdr pats) 490 (cdr pats)
492 (list pats))))))))) 491 (list pats)))))))))
@@ -656,15 +655,14 @@
656 nil 655 nil
657 (nreverse 656 (nreverse
658 (mapcar 657 (mapcar
659 (function 658 (lambda (v)
660 (lambda (v) 659 (and (car v)
661 (and (car v) 660 (list
662 (list 661 'calcFunc-assign
663 'calcFunc-assign 662 (math-build-var-name
664 (math-build-var-name 663 (car v))
665 (car v)) 664 (math-rwcomp-register-expr
666 (math-rwcomp-register-expr 665 (nth 1 v)))))
667 (nth 1 v))))))
668 math-regs)))) 666 math-regs))))
669 (math-rwcomp-match-vars math-rhs)) 667 (math-rwcomp-match-vars math-rhs))
670 math-remembering) 668 math-remembering)
@@ -672,7 +670,7 @@
672 (let* ((heads (math-rewrite-heads math-pattern)) 670 (let* ((heads (math-rewrite-heads math-pattern))
673 (rule (list (vconcat 671 (rule (list (vconcat
674 (nreverse 672 (nreverse
675 (mapcar (function (lambda (x) (nth 3 x))) 673 (mapcar (lambda (x) (nth 3 x))
676 math-regs))) 674 math-regs)))
677 math-prog 675 math-prog
678 heads 676 heads
@@ -724,10 +722,9 @@
724 (setq rules (cdr rules))) 722 (setq rules (cdr rules)))
725 (if nil-rules 723 (if nil-rules
726 (setq rule-set (cons (cons nil nil-rules) rule-set))) 724 (setq rule-set (cons (cons nil nil-rules) rule-set)))
727 (setq all-heads (mapcar 'car 725 (setq all-heads (mapcar #'car
728 (sort all-heads (function 726 (sort all-heads (lambda (x y)
729 (lambda (x y) 727 (< (cdr x) (cdr y))))))
730 (< (cdr x) (cdr y)))))))
731 (let ((set rule-set) 728 (let ((set rule-set)
732 rule heads ptr) 729 rule heads ptr)
733 (while set 730 (while set
@@ -790,15 +787,14 @@
790 (math-rewrite-heads-rec (car expr))))))) 787 (math-rewrite-heads-rec (car expr)))))))
791 788
792(defun math-parse-schedule (sched) 789(defun math-parse-schedule (sched)
793 (mapcar (function 790 (mapcar (lambda (s)
794 (lambda (s) 791 (if (integerp s)
795 (if (integerp s) 792 s
796 s 793 (if (math-vectorp s)
797 (if (math-vectorp s) 794 (math-parse-schedule (cdr s))
798 (math-parse-schedule (cdr s)) 795 (if (eq (car-safe s) 'var)
799 (if (eq (car-safe s) 'var) 796 (math-var-to-calcFunc s)
800 (math-var-to-calcFunc s) 797 (error "Improper component in rewrite schedule")))))
801 (error "Improper component in rewrite schedule"))))))
802 sched)) 798 sched))
803 799
804(defun math-rwcomp-match-vars (expr) 800(defun math-rwcomp-match-vars (expr)
@@ -1180,9 +1176,8 @@
1180 (list 'calcFunc-register 1176 (list 'calcFunc-register
1181 reg2)))) 1177 reg2))))
1182 (math-rwcomp-pattern (car arg2) (cdr arg2)))) 1178 (math-rwcomp-pattern (car arg2) (cdr arg2))))
1183 (let* ((args (mapcar (function 1179 (let* ((args (mapcar (lambda (x)
1184 (lambda (x) 1180 (cons x (math-rwcomp-best-reg x)))
1185 (cons x (math-rwcomp-best-reg x))))
1186 (cdr expr))) 1181 (cdr expr)))
1187 (args2 (copy-sequence args)) 1182 (args2 (copy-sequence args))
1188 (argp (reverse args2)) 1183 (argp (reverse args2))
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index a1e385cb406..8f83f34d748 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -168,15 +168,13 @@
168 () 168 ()
169 (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) 169 (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
170 (define-key calc-var-name-map " " 'self-insert-command) 170 (define-key calc-var-name-map " " 'self-insert-command)
171 (mapc (function 171 (mapc (lambda (x)
172 (lambda (x)
173 (define-key calc-var-name-map (char-to-string x) 172 (define-key calc-var-name-map (char-to-string x)
174 'calcVar-digit))) 173 'calcVar-digit))
175 "0123456789") 174 "0123456789")
176 (mapc (function 175 (mapc (lambda (x)
177 (lambda (x)
178 (define-key calc-var-name-map (char-to-string x) 176 (define-key calc-var-name-map (char-to-string x)
179 'calcVar-oper))) 177 'calcVar-oper))
180 "+-*/^|")) 178 "+-*/^|"))
181 179
182(defvar calc-store-opers) 180(defvar calc-store-opers)
@@ -324,10 +322,9 @@
324 (calc-pop-push-record 322 (calc-pop-push-record
325 (1+ calc-given-value-flag) 323 (1+ calc-given-value-flag)
326 (concat "=" (calc-var-name (car (car var)))) 324 (concat "=" (calc-var-name (car (car var))))
327 (let ((saved-val (mapcar (function 325 (let ((saved-val (mapcar (lambda (v)
328 (lambda (v) 326 (and (boundp (car v))
329 (and (boundp (car v)) 327 (symbol-value (car v))))
330 (symbol-value (car v)))))
331 var))) 328 var)))
332 (unwind-protect 329 (unwind-protect
333 (let ((vv var)) 330 (let ((vv var))
@@ -597,13 +594,12 @@
597 calc-settings-file))) 594 calc-settings-file)))
598 (if var 595 (if var
599 (calc-insert-permanent-variable var) 596 (calc-insert-permanent-variable var)
600 (mapatoms (function 597 (mapatoms (lambda (x)
601 (lambda (x) 598 (and (string-match "\\`var-" (symbol-name x))
602 (and (string-match "\\`var-" (symbol-name x)) 599 (not (memq x calc-dont-insert-variables))
603 (not (memq x calc-dont-insert-variables)) 600 (calc-var-value x)
604 (calc-var-value x) 601 (not (eq (car-safe (symbol-value x)) 'special-const))
605 (not (eq (car-safe (symbol-value x)) 'special-const)) 602 (calc-insert-permanent-variable x)))))
606 (calc-insert-permanent-variable x))))))
607 (save-buffer)))) 603 (save-buffer))))
608 604
609 605
@@ -638,27 +634,26 @@
638(defun calc-insert-variables (buf) 634(defun calc-insert-variables (buf)
639 (interactive "bBuffer in which to save variable values: ") 635 (interactive "bBuffer in which to save variable values: ")
640 (with-current-buffer buf 636 (with-current-buffer buf
641 (mapatoms (function 637 (mapatoms (lambda (x)
642 (lambda (x) 638 (and (string-match "\\`var-" (symbol-name x))
643 (and (string-match "\\`var-" (symbol-name x)) 639 (not (memq x calc-dont-insert-variables))
644 (not (memq x calc-dont-insert-variables)) 640 (calc-var-value x)
645 (calc-var-value x) 641 (not (eq (car-safe (symbol-value x)) 'special-const))
646 (not (eq (car-safe (symbol-value x)) 'special-const)) 642 (or (not (eq x 'var-Decls))
647 (or (not (eq x 'var-Decls)) 643 (not (equal var-Decls '(vec))))
648 (not (equal var-Decls '(vec)))) 644 (or (not (eq x 'var-Holidays))
649 (or (not (eq x 'var-Holidays)) 645 (not (equal var-Holidays '(vec (var sat var-sat)
650 (not (equal var-Holidays '(vec (var sat var-sat) 646 (var sun var-sun)))))
651 (var sun var-sun))))) 647 (insert "(setq "
652 (insert "(setq " 648 (symbol-name x)
653 (symbol-name x) 649 " "
654 " " 650 (prin1-to-string
655 (prin1-to-string 651 (let ((calc-language
656 (let ((calc-language 652 (if (memq calc-language '(nil big))
657 (if (memq calc-language '(nil big)) 653 'flat
658 'flat 654 calc-language)))
659 calc-language))) 655 (math-format-value (symbol-value x) 100000)))
660 (math-format-value (symbol-value x) 100000))) 656 ")\n"))))))
661 ")\n")))))))
662 657
663(defun calc-assign (arg) 658(defun calc-assign (arg)
664 (interactive "P") 659 (interactive "P")
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el
index 58b81faee50..8df2ed905aa 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -182,7 +182,7 @@ With a prefix, push that prefix as a number onto the stack."
182 math-eval-rules-cache-tag t 182 math-eval-rules-cache-tag t
183 math-format-date-cache nil 183 math-format-date-cache nil
184 math-holidays-cache-tag t) 184 math-holidays-cache-tag t)
185 (mapc (function (lambda (x) (set x -100))) math-cache-list) 185 (mapc (lambda (x) (set x -100)) math-cache-list)
186 (unless inhibit-msg 186 (unless inhibit-msg
187 (message "All internal calculator caches have been reset")))) 187 (message "All internal calculator caches have been reset"))))
188 188
@@ -258,14 +258,14 @@ With a prefix, push that prefix as a number onto the stack."
258 (t (list 'calcFunc-clean a))))) 258 (t (list 'calcFunc-clean a)))))
259 259
260(defun calcFunc-pclean (a &optional prec) 260(defun calcFunc-pclean (a &optional prec)
261 (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec))) 261 (math-map-over-constants (lambda (x) (calcFunc-clean x prec))
262 a)) 262 a))
263 263
264(defun calcFunc-pfloat (a) 264(defun calcFunc-pfloat (a)
265 (math-map-over-constants 'math-float a)) 265 (math-map-over-constants 'math-float a))
266 266
267(defun calcFunc-pfrac (a &optional tol) 267(defun calcFunc-pfrac (a &optional tol)
268 (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol))) 268 (math-map-over-constants (lambda (x) (calcFunc-frac x tol))
269 a)) 269 a))
270 270
271;; The variable math-moc-func is local to math-map-over-constants, 271;; The variable math-moc-func is local to math-map-over-constants,
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 709c09ea099..742b2bb8728 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -860,23 +860,22 @@ If COMP or STD is non-nil, put that in the units table instead."
860 tab) 860 tab)
861 (message "Building units table...") 861 (message "Building units table...")
862 (setq math-units-table-buffer-valid nil) 862 (setq math-units-table-buffer-valid nil)
863 (setq tab (mapcar (function 863 (setq tab (mapcar (lambda (x)
864 (lambda (x) 864 (list (car x)
865 (list (car x) 865 (and (nth 1 x)
866 (and (nth 1 x) 866 (if (stringp (nth 1 x))
867 (if (stringp (nth 1 x)) 867 (let ((exp (math-read-plain-expr
868 (let ((exp (math-read-plain-expr 868 (nth 1 x))))
869 (nth 1 x)))) 869 (if (eq (car-safe exp) 'error)
870 (if (eq (car-safe exp) 'error) 870 (error "Format error in definition of %s in units table: %s"
871 (error "Format error in definition of %s in units table: %s" 871 (car x) (nth 2 exp))
872 (car x) (nth 2 exp)) 872 exp))
873 exp)) 873 (nth 1 x)))
874 (nth 1 x))) 874 (nth 2 x)
875 (nth 2 x) 875 (nth 3 x)
876 (nth 3 x) 876 (and (not (nth 1 x))
877 (and (not (nth 1 x)) 877 (list (cons (car x) 1)))
878 (list (cons (car x) 1))) 878 (nth 4 x)))
879 (nth 4 x))))
880 combined-units)) 879 combined-units))
881 (let ((math-units-table tab)) 880 (let ((math-units-table tab))
882 (mapc #'math-find-base-units tab)) 881 (mapc #'math-find-base-units tab))
@@ -1100,10 +1099,9 @@ If COMP or STD is non-nil, put that in the units table instead."
1100 (setq math-decompose-units-cache 1099 (setq math-decompose-units-cache
1101 (cons entry 1100 (cons entry
1102 (sort ulist 1101 (sort ulist
1103 (function 1102 (lambda (x y)
1104 (lambda (x y) 1103 (not (Math-lessp (nth 1 x)
1105 (not (Math-lessp (nth 1 x) 1104 (nth 1 y)))))))))
1106 (nth 1 y))))))))))
1107 (cdr math-decompose-units-cache)))) 1105 (cdr math-decompose-units-cache))))
1108 1106
1109(defun math-decompose-unit-part (unit) 1107(defun math-decompose-unit-part (unit)
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 875414595cf..036f08e276d 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -744,7 +744,7 @@
744;;; Get the Nth row of a matrix. 744;;; Get the Nth row of a matrix.
745(defun calcFunc-mrow (mat n) ; [Public] 745(defun calcFunc-mrow (mat n) ; [Public]
746 (if (Math-vectorp n) 746 (if (Math-vectorp n)
747 (math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n) 747 (math-map-vec (lambda (x) (calcFunc-mrow mat x)) n)
748 (if (and (eq (car-safe n) 'intv) (math-constp n)) 748 (if (and (eq (car-safe n) 'intv) (math-constp n))
749 (calcFunc-subvec mat 749 (calcFunc-subvec mat
750 (math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1)) 750 (math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
@@ -768,15 +768,15 @@
768 768
769;;; Get the Nth column of a matrix. 769;;; Get the Nth column of a matrix.
770(defun math-mat-col (mat n) 770(defun math-mat-col (mat n)
771 (cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat)))) 771 (cons 'vec (mapcar (lambda (x) (elt x n)) (cdr mat))))
772 772
773(defun calcFunc-mcol (mat n) ; [Public] 773(defun calcFunc-mcol (mat n) ; [Public]
774 (if (Math-vectorp n) 774 (if (Math-vectorp n)
775 (calcFunc-trn 775 (calcFunc-trn
776 (math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n)) 776 (math-map-vec (lambda (x) (calcFunc-mcol mat x)) n))
777 (if (and (eq (car-safe n) 'intv) (math-constp n)) 777 (if (and (eq (car-safe n) 'intv) (math-constp n))
778 (if (math-matrixp mat) 778 (if (math-matrixp mat)
779 (math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat) 779 (math-map-vec (lambda (x) (calcFunc-mrow x n)) mat)
780 (calcFunc-mrow mat n)) 780 (calcFunc-mrow mat n))
781 (or (and (integerp (setq n (math-check-integer n))) 781 (or (and (integerp (setq n (math-check-integer n)))
782 (> n 0)) 782 (> n 0))
@@ -804,7 +804,7 @@
804 804
805;;; Remove the Nth column from a matrix. 805;;; Remove the Nth column from a matrix.
806(defun math-mat-less-col (mat n) 806(defun math-mat-less-col (mat n)
807 (cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n))) 807 (cons 'vec (mapcar (lambda (x) (math-mat-less-row x n))
808 (cdr mat)))) 808 (cdr mat))))
809 809
810(defun calcFunc-mrcol (mat n) ; [Public] 810(defun calcFunc-mrcol (mat n) ; [Public]
@@ -939,10 +939,10 @@
939 (calcFunc-idn a (1- (length m))) 939 (calcFunc-idn a (1- (length m)))
940 (if (math-vectorp m) 940 (if (math-vectorp m)
941 (if (math-zerop a) 941 (if (math-zerop a)
942 (cons 'vec (mapcar (function (lambda (x) 942 (cons 'vec (mapcar (lambda (x)
943 (if (math-vectorp x) 943 (if (math-vectorp x)
944 (math-mimic-ident a x) 944 (math-mimic-ident a x)
945 a))) 945 a))
946 (cdr m))) 946 (cdr m)))
947 (math-dimension-error)) 947 (math-dimension-error))
948 (calcFunc-idn a)))) 948 (calcFunc-idn a))))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index e03c00243c4..6186df718db 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -643,12 +643,11 @@ Interactively, reads the register using `register-read-with-preview'."
643 (allow-ret (> n 1)) 643 (allow-ret (> n 1))
644 (list (math-showing-full-precision 644 (list (math-showing-full-precision
645 (mapcar (if (> n 1) 645 (mapcar (if (> n 1)
646 (function (lambda (x) 646 (lambda (x)
647 (math-format-flat-expr x 0))) 647 (math-format-flat-expr x 0))
648 (function 648 (lambda (x)
649 (lambda (x) 649 (if (math-vectorp x) (setq allow-ret t))
650 (if (math-vectorp x) (setq allow-ret t)) 650 (math-format-nice-expr x (frame-width))))
651 (math-format-nice-expr x (frame-width)))))
652 (if (> n 0) 651 (if (> n 0)
653 (calc-top-list n) 652 (calc-top-list n)
654 (calc-top-list 1 (- n))))))) 653 (calc-top-list 1 (- n)))))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 5716189b342..9d869f359bc 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -506,7 +506,7 @@ The variable VAR will be added to `calc-mode-var-list'."
506 506
507(defun calc-mode-var-list-restore-default-values () 507(defun calc-mode-var-list-restore-default-values ()
508 "Restore the default values of the variables in `calc-mode-var-list'." 508 "Restore the default values of the variables in `calc-mode-var-list'."
509 (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) 509 (mapcar (lambda (v) (set (car v) (nth 1 v)))
510 calc-mode-var-list)) 510 calc-mode-var-list))
511 511
512(defun calc-mode-var-list-restore-saved-values () 512(defun calc-mode-var-list-restore-saved-values ()
@@ -535,7 +535,7 @@ The variable VAR will be added to `calc-mode-var-list'."
535 newvarlist))) 535 newvarlist)))
536 (setq varlist (cdr varlist))))))) 536 (setq varlist (cdr varlist)))))))
537 (if newvarlist 537 (if newvarlist
538 (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) 538 (mapcar (lambda (v) (set (car v) (nth 1 v)))
539 newvarlist) 539 newvarlist)
540 (calc-mode-var-list-restore-default-values)))) 540 (calc-mode-var-list-restore-default-values))))
541 541
@@ -1315,8 +1315,9 @@ Notations: 3.14e6 3.14 * 10^6
1315\\{calc-mode-map} 1315\\{calc-mode-map}
1316" 1316"
1317 (interactive) 1317 (interactive)
1318 (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? 1318 (mapc (lambda (v)
1319 (lambda (v) (set-default v (symbol-value v)))) 1319 ;; FIXME: Why (set-default v (symbol-value v)) ?!?!?
1320 (set-default v (symbol-value v)))
1320 calc-local-var-list) 1321 calc-local-var-list)
1321 (kill-all-local-variables) 1322 (kill-all-local-variables)
1322 (use-local-map (if (eq calc-algebraic-mode 'total) 1323 (use-local-map (if (eq calc-algebraic-mode 'total)
@@ -1537,7 +1538,7 @@ See `window-dedicated-p' for what that means."
1537 (let ((tail (nthcdr (1- calc-undo-length) calc-undo-list))) 1538 (let ((tail (nthcdr (1- calc-undo-length) calc-undo-list)))
1538 (if tail (setcdr tail nil))) 1539 (if tail (setcdr tail nil)))
1539 (setq calc-redo-list nil)))) 1540 (setq calc-redo-list nil))))
1540 (mapc (function (lambda (v) (set-default v (symbol-value v)))) 1541 (mapc (lambda (v) (set-default v (symbol-value v)))
1541 calc-local-var-list) 1542 calc-local-var-list)
1542 (let ((buf (current-buffer)) 1543 (let ((buf (current-buffer))
1543 (win (get-buffer-window (current-buffer))) 1544 (win (get-buffer-window (current-buffer)))
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 7894bd93015..bf4d6261910 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -361,175 +361,175 @@
361 res)))) 361 res))))
362 362
363(put 'calcFunc-inv\' 'math-derivative-1 363(put 'calcFunc-inv\' 'math-derivative-1
364 (function (lambda (u) (math-neg (math-div 1 (math-sqr u)))))) 364 (lambda (u) (math-neg (math-div 1 (math-sqr u)))))
365 365
366(put 'calcFunc-sqrt\' 'math-derivative-1 366(put 'calcFunc-sqrt\' 'math-derivative-1
367 (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))) 367 (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))
368 368
369(put 'calcFunc-deg\' 'math-derivative-1 369(put 'calcFunc-deg\' 'math-derivative-1
370 (function (lambda (_) (math-div-float '(float 18 1) (math-pi))))) 370 (lambda (_) (math-div-float '(float 18 1) (math-pi))))
371 371
372(put 'calcFunc-rad\' 'math-derivative-1 372(put 'calcFunc-rad\' 'math-derivative-1
373 (function (lambda (_) (math-pi-over-180)))) 373 (lambda (_) (math-pi-over-180)))
374 374
375(put 'calcFunc-ln\' 'math-derivative-1 375(put 'calcFunc-ln\' 'math-derivative-1
376 (function (lambda (u) (math-div 1 u)))) 376 (lambda (u) (math-div 1 u)))
377 377
378(put 'calcFunc-log10\' 'math-derivative-1 378(put 'calcFunc-log10\' 'math-derivative-1
379 (function (lambda (u) 379 (lambda (u)
380 (math-div (math-div 1 (math-normalize '(calcFunc-ln 10))) 380 (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
381 u)))) 381 u)))
382 382
383(put 'calcFunc-lnp1\' 'math-derivative-1 383(put 'calcFunc-lnp1\' 'math-derivative-1
384 (function (lambda (u) (math-div 1 (math-add u 1))))) 384 (lambda (u) (math-div 1 (math-add u 1))))
385 385
386(put 'calcFunc-log\' 'math-derivative-2 386(put 'calcFunc-log\' 'math-derivative-2
387 (function (lambda (x b) 387 (lambda (x b)
388 (and (not (Math-zerop b)) 388 (and (not (Math-zerop b))
389 (let ((lnv (math-normalize 389 (let ((lnv (math-normalize
390 (list 'calcFunc-ln b)))) 390 (list 'calcFunc-ln b))))
391 (math-div 1 (math-mul lnv x))))))) 391 (math-div 1 (math-mul lnv x))))))
392 392
393(put 'calcFunc-log\'2 'math-derivative-2 393(put 'calcFunc-log\'2 'math-derivative-2
394 (function (lambda (x b) 394 (lambda (x b)
395 (let ((lnv (list 'calcFunc-ln b))) 395 (let ((lnv (list 'calcFunc-ln b)))
396 (math-neg (math-div (list 'calcFunc-log x b) 396 (math-neg (math-div (list 'calcFunc-log x b)
397 (math-mul lnv b))))))) 397 (math-mul lnv b))))))
398 398
399(put 'calcFunc-exp\' 'math-derivative-1 399(put 'calcFunc-exp\' 'math-derivative-1
400 (function (lambda (u) (math-normalize (list 'calcFunc-exp u))))) 400 (lambda (u) (math-normalize (list 'calcFunc-exp u))))
401 401
402(put 'calcFunc-expm1\' 'math-derivative-1 402(put 'calcFunc-expm1\' 'math-derivative-1
403 (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u))))) 403 (lambda (u) (math-normalize (list 'calcFunc-expm1 u))))
404 404
405(put 'calcFunc-sin\' 'math-derivative-1 405(put 'calcFunc-sin\' 'math-derivative-1
406 (function (lambda (u) (math-to-radians-2 (math-normalize 406 (lambda (u) (math-to-radians-2 (math-normalize
407 (list 'calcFunc-cos u)) t)))) 407 (list 'calcFunc-cos u)) t)))
408 408
409(put 'calcFunc-cos\' 'math-derivative-1 409(put 'calcFunc-cos\' 'math-derivative-1
410 (function (lambda (u) (math-neg (math-to-radians-2 410 (lambda (u) (math-neg (math-to-radians-2
411 (math-normalize 411 (math-normalize
412 (list 'calcFunc-sin u)) t))))) 412 (list 'calcFunc-sin u)) t))))
413 413
414(put 'calcFunc-tan\' 'math-derivative-1 414(put 'calcFunc-tan\' 'math-derivative-1
415 (function (lambda (u) (math-to-radians-2 415 (lambda (u) (math-to-radians-2
416 (math-sqr 416 (math-sqr
417 (math-normalize 417 (math-normalize
418 (list 'calcFunc-sec u))) t)))) 418 (list 'calcFunc-sec u))) t)))
419 419
420(put 'calcFunc-sec\' 'math-derivative-1 420(put 'calcFunc-sec\' 'math-derivative-1
421 (function (lambda (u) (math-to-radians-2 421 (lambda (u) (math-to-radians-2
422 (math-mul 422 (math-mul
423 (math-normalize 423 (math-normalize
424 (list 'calcFunc-sec u)) 424 (list 'calcFunc-sec u))
425 (math-normalize 425 (math-normalize
426 (list 'calcFunc-tan u))) t)))) 426 (list 'calcFunc-tan u))) t)))
427 427
428(put 'calcFunc-csc\' 'math-derivative-1 428(put 'calcFunc-csc\' 'math-derivative-1
429 (function (lambda (u) (math-neg 429 (lambda (u) (math-neg
430 (math-to-radians-2 430 (math-to-radians-2
431 (math-mul 431 (math-mul
432 (math-normalize 432 (math-normalize
433 (list 'calcFunc-csc u)) 433 (list 'calcFunc-csc u))
434 (math-normalize 434 (math-normalize
435 (list 'calcFunc-cot u))) t))))) 435 (list 'calcFunc-cot u))) t))))
436 436
437(put 'calcFunc-cot\' 'math-derivative-1 437(put 'calcFunc-cot\' 'math-derivative-1
438 (function (lambda (u) (math-neg 438 (lambda (u) (math-neg
439 (math-to-radians-2 439 (math-to-radians-2
440 (math-sqr 440 (math-sqr
441 (math-normalize 441 (math-normalize
442 (list 'calcFunc-csc u))) t))))) 442 (list 'calcFunc-csc u))) t))))
443 443
444(put 'calcFunc-arcsin\' 'math-derivative-1 444(put 'calcFunc-arcsin\' 'math-derivative-1
445 (function (lambda (u) 445 (lambda (u)
446 (math-from-radians-2 446 (math-from-radians-2
447 (math-div 1 (math-normalize 447 (math-div 1 (math-normalize
448 (list 'calcFunc-sqrt 448 (list 'calcFunc-sqrt
449 (math-sub 1 (math-sqr u))))) t)))) 449 (math-sub 1 (math-sqr u))))) t)))
450 450
451(put 'calcFunc-arccos\' 'math-derivative-1 451(put 'calcFunc-arccos\' 'math-derivative-1
452 (function (lambda (u) 452 (lambda (u)
453 (math-from-radians-2 453 (math-from-radians-2
454 (math-div -1 (math-normalize 454 (math-div -1 (math-normalize
455 (list 'calcFunc-sqrt 455 (list 'calcFunc-sqrt
456 (math-sub 1 (math-sqr u))))) t)))) 456 (math-sub 1 (math-sqr u))))) t)))
457 457
458(put 'calcFunc-arctan\' 'math-derivative-1 458(put 'calcFunc-arctan\' 'math-derivative-1
459 (function (lambda (u) (math-from-radians-2 459 (lambda (u) (math-from-radians-2
460 (math-div 1 (math-add 1 (math-sqr u))) t)))) 460 (math-div 1 (math-add 1 (math-sqr u))) t)))
461 461
462(put 'calcFunc-sinh\' 'math-derivative-1 462(put 'calcFunc-sinh\' 'math-derivative-1
463 (function (lambda (u) (math-normalize (list 'calcFunc-cosh u))))) 463 (lambda (u) (math-normalize (list 'calcFunc-cosh u))))
464 464
465(put 'calcFunc-cosh\' 'math-derivative-1 465(put 'calcFunc-cosh\' 'math-derivative-1
466 (function (lambda (u) (math-normalize (list 'calcFunc-sinh u))))) 466 (lambda (u) (math-normalize (list 'calcFunc-sinh u))))
467 467
468(put 'calcFunc-tanh\' 'math-derivative-1 468(put 'calcFunc-tanh\' 'math-derivative-1
469 (function (lambda (u) (math-sqr 469 (lambda (u) (math-sqr
470 (math-normalize 470 (math-normalize
471 (list 'calcFunc-sech u)))))) 471 (list 'calcFunc-sech u)))))
472 472
473(put 'calcFunc-sech\' 'math-derivative-1 473(put 'calcFunc-sech\' 'math-derivative-1
474 (function (lambda (u) (math-neg 474 (lambda (u) (math-neg
475 (math-mul 475 (math-mul
476 (math-normalize (list 'calcFunc-sech u)) 476 (math-normalize (list 'calcFunc-sech u))
477 (math-normalize (list 'calcFunc-tanh u))))))) 477 (math-normalize (list 'calcFunc-tanh u))))))
478 478
479(put 'calcFunc-csch\' 'math-derivative-1 479(put 'calcFunc-csch\' 'math-derivative-1
480 (function (lambda (u) (math-neg 480 (lambda (u) (math-neg
481 (math-mul 481 (math-mul
482 (math-normalize (list 'calcFunc-csch u)) 482 (math-normalize (list 'calcFunc-csch u))
483 (math-normalize (list 'calcFunc-coth u))))))) 483 (math-normalize (list 'calcFunc-coth u))))))
484 484
485(put 'calcFunc-coth\' 'math-derivative-1 485(put 'calcFunc-coth\' 'math-derivative-1
486 (function (lambda (u) (math-neg 486 (lambda (u) (math-neg
487 (math-sqr 487 (math-sqr
488 (math-normalize 488 (math-normalize
489 (list 'calcFunc-csch u))))))) 489 (list 'calcFunc-csch u))))))
490 490
491(put 'calcFunc-arcsinh\' 'math-derivative-1 491(put 'calcFunc-arcsinh\' 'math-derivative-1
492 (function (lambda (u) 492 (lambda (u)
493 (math-div 1 (math-normalize 493 (math-div 1 (math-normalize
494 (list 'calcFunc-sqrt 494 (list 'calcFunc-sqrt
495 (math-add (math-sqr u) 1))))))) 495 (math-add (math-sqr u) 1))))))
496 496
497(put 'calcFunc-arccosh\' 'math-derivative-1 497(put 'calcFunc-arccosh\' 'math-derivative-1
498 (function (lambda (u) 498 (lambda (u)
499 (math-div 1 (math-normalize 499 (math-div 1 (math-normalize
500 (list 'calcFunc-sqrt 500 (list 'calcFunc-sqrt
501 (math-add (math-sqr u) -1))))))) 501 (math-add (math-sqr u) -1))))))
502 502
503(put 'calcFunc-arctanh\' 'math-derivative-1 503(put 'calcFunc-arctanh\' 'math-derivative-1
504 (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))) 504 (lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))
505 505
506(put 'calcFunc-bern\'2 'math-derivative-2 506(put 'calcFunc-bern\'2 'math-derivative-2
507 (function (lambda (n x) 507 (lambda (n x)
508 (math-mul n (list 'calcFunc-bern (math-add n -1) x))))) 508 (math-mul n (list 'calcFunc-bern (math-add n -1) x))))
509 509
510(put 'calcFunc-euler\'2 'math-derivative-2 510(put 'calcFunc-euler\'2 'math-derivative-2
511 (function (lambda (n x) 511 (lambda (n x)
512 (math-mul n (list 'calcFunc-euler (math-add n -1) x))))) 512 (math-mul n (list 'calcFunc-euler (math-add n -1) x))))
513 513
514(put 'calcFunc-gammag\'2 'math-derivative-2 514(put 'calcFunc-gammag\'2 'math-derivative-2
515 (function (lambda (a x) (math-deriv-gamma a x 1)))) 515 (lambda (a x) (math-deriv-gamma a x 1)))
516 516
517(put 'calcFunc-gammaG\'2 'math-derivative-2 517(put 'calcFunc-gammaG\'2 'math-derivative-2
518 (function (lambda (a x) (math-deriv-gamma a x -1)))) 518 (lambda (a x) (math-deriv-gamma a x -1)))
519 519
520(put 'calcFunc-gammaP\'2 'math-derivative-2 520(put 'calcFunc-gammaP\'2 'math-derivative-2
521 (function (lambda (a x) (math-deriv-gamma a x 521 (lambda (a x) (math-deriv-gamma a x
522 (math-div 522 (math-div
523 1 (math-normalize 523 1 (math-normalize
524 (list 'calcFunc-gamma 524 (list 'calcFunc-gamma
525 a))))))) 525 a))))))
526 526
527(put 'calcFunc-gammaQ\'2 'math-derivative-2 527(put 'calcFunc-gammaQ\'2 'math-derivative-2
528 (function (lambda (a x) (math-deriv-gamma a x 528 (lambda (a x) (math-deriv-gamma a x
529 (math-div 529 (math-div
530 -1 (math-normalize 530 -1 (math-normalize
531 (list 'calcFunc-gamma 531 (list 'calcFunc-gamma
532 a))))))) 532 a))))))
533 533
534(defun math-deriv-gamma (a x scale) 534(defun math-deriv-gamma (a x scale)
535 (math-mul scale 535 (math-mul scale
@@ -537,13 +537,13 @@
537 (list 'calcFunc-exp (math-neg x))))) 537 (list 'calcFunc-exp (math-neg x)))))
538 538
539(put 'calcFunc-betaB\' 'math-derivative-3 539(put 'calcFunc-betaB\' 'math-derivative-3
540 (function (lambda (x a b) (math-deriv-beta x a b 1)))) 540 (lambda (x a b) (math-deriv-beta x a b 1)))
541 541
542(put 'calcFunc-betaI\' 'math-derivative-3 542(put 'calcFunc-betaI\' 'math-derivative-3
543 (function (lambda (x a b) (math-deriv-beta x a b 543 (lambda (x a b) (math-deriv-beta x a b
544 (math-div 544 (math-div
545 1 (list 'calcFunc-beta 545 1 (list 'calcFunc-beta
546 a b)))))) 546 a b)))))
547 547
548(defun math-deriv-beta (x a b scale) 548(defun math-deriv-beta (x a b scale)
549 (math-mul (math-mul (math-pow x (math-add a -1)) 549 (math-mul (math-mul (math-pow x (math-add a -1))
@@ -551,101 +551,96 @@
551 scale)) 551 scale))
552 552
553(put 'calcFunc-erf\' 'math-derivative-1 553(put 'calcFunc-erf\' 'math-derivative-1
554 (function (lambda (x) (math-div 2 554 (lambda (x) (math-div 2
555 (math-mul (list 'calcFunc-exp 555 (math-mul (list 'calcFunc-exp
556 (math-sqr x)) 556 (math-sqr x))
557 (if calc-symbolic-mode 557 (if calc-symbolic-mode
558 '(calcFunc-sqrt 558 '(calcFunc-sqrt
559 (var pi var-pi)) 559 (var pi var-pi))
560 (math-sqrt-pi))))))) 560 (math-sqrt-pi))))))
561 561
562(put 'calcFunc-erfc\' 'math-derivative-1 562(put 'calcFunc-erfc\' 'math-derivative-1
563 (function (lambda (x) (math-div -2 563 (lambda (x) (math-div -2
564 (math-mul (list 'calcFunc-exp 564 (math-mul (list 'calcFunc-exp
565 (math-sqr x)) 565 (math-sqr x))
566 (if calc-symbolic-mode 566 (if calc-symbolic-mode
567 '(calcFunc-sqrt 567 '(calcFunc-sqrt
568 (var pi var-pi)) 568 (var pi var-pi))
569 (math-sqrt-pi))))))) 569 (math-sqrt-pi))))))
570 570
571(put 'calcFunc-besJ\'2 'math-derivative-2 571(put 'calcFunc-besJ\'2 'math-derivative-2
572 (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ 572 (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
573 (math-add v -1) 573 (math-add v -1)
574 z) 574 z)
575 (list 'calcFunc-besJ 575 (list 'calcFunc-besJ
576 (math-add v 1) 576 (math-add v 1)
577 z)) 577 z))
578 2)))) 578 2)))
579 579
580(put 'calcFunc-besY\'2 'math-derivative-2 580(put 'calcFunc-besY\'2 'math-derivative-2
581 (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY 581 (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
582 (math-add v -1) 582 (math-add v -1)
583 z) 583 z)
584 (list 'calcFunc-besY 584 (list 'calcFunc-besY
585 (math-add v 1) 585 (math-add v 1)
586 z)) 586 z))
587 2)))) 587 2)))
588 588
589(put 'calcFunc-sum 'math-derivative-n 589(put 'calcFunc-sum 'math-derivative-n
590 (function 590 (lambda (expr)
591 (lambda (expr) 591 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
592 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var) 592 (throw 'math-deriv nil)
593 (throw 'math-deriv nil) 593 (cons 'calcFunc-sum
594 (cons 'calcFunc-sum 594 (cons (math-derivative (nth 1 expr))
595 (cons (math-derivative (nth 1 expr)) 595 (cdr (cdr expr)))))))
596 (cdr (cdr expr))))))))
597 596
598(put 'calcFunc-prod 'math-derivative-n 597(put 'calcFunc-prod 'math-derivative-n
599 (function 598 (lambda (expr)
600 (lambda (expr) 599 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
601 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var) 600 (throw 'math-deriv nil)
602 (throw 'math-deriv nil) 601 (math-mul expr
603 (math-mul expr 602 (cons 'calcFunc-sum
604 (cons 'calcFunc-sum 603 (cons (math-div (math-derivative (nth 1 expr))
605 (cons (math-div (math-derivative (nth 1 expr)) 604 (nth 1 expr))
606 (nth 1 expr)) 605 (cdr (cdr expr))))))))
607 (cdr (cdr expr)))))))))
608 606
609(put 'calcFunc-integ 'math-derivative-n 607(put 'calcFunc-integ 'math-derivative-n
610 (function 608 (lambda (expr)
611 (lambda (expr) 609 (if (= (length expr) 3)
612 (if (= (length expr) 3) 610 (if (equal (nth 2 expr) math-deriv-var)
613 (if (equal (nth 2 expr) math-deriv-var) 611 (nth 1 expr)
614 (nth 1 expr) 612 (math-normalize
615 (math-normalize 613 (list 'calcFunc-integ
616 (list 'calcFunc-integ 614 (math-derivative (nth 1 expr))
617 (math-derivative (nth 1 expr)) 615 (nth 2 expr))))
618 (nth 2 expr)))) 616 (if (= (length expr) 5)
619 (if (= (length expr) 5) 617 (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
620 (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr) 618 (nth 3 expr)))
621 (nth 3 expr))) 619 (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
622 (upper (math-expr-subst (nth 1 expr) (nth 2 expr) 620 (nth 4 expr))))
623 (nth 4 expr)))) 621 (math-add (math-sub (math-mul upper
624 (math-add (math-sub (math-mul upper 622 (math-derivative (nth 4 expr)))
625 (math-derivative (nth 4 expr))) 623 (math-mul lower
626 (math-mul lower 624 (math-derivative (nth 3 expr))))
627 (math-derivative (nth 3 expr)))) 625 (if (equal (nth 2 expr) math-deriv-var)
628 (if (equal (nth 2 expr) math-deriv-var) 626 0
629 0 627 (math-normalize
630 (math-normalize 628 (list 'calcFunc-integ
631 (list 'calcFunc-integ 629 (math-derivative (nth 1 expr)) (nth 2 expr)
632 (math-derivative (nth 1 expr)) (nth 2 expr) 630 (nth 3 expr) (nth 4 expr))))))))))
633 (nth 3 expr) (nth 4 expr)))))))))))
634 631
635(put 'calcFunc-if 'math-derivative-n 632(put 'calcFunc-if 'math-derivative-n
636 (function 633 (lambda (expr)
637 (lambda (expr) 634 (and (= (length expr) 4)
638 (and (= (length expr) 4) 635 (list 'calcFunc-if (nth 1 expr)
639 (list 'calcFunc-if (nth 1 expr) 636 (math-derivative (nth 2 expr))
640 (math-derivative (nth 2 expr)) 637 (math-derivative (nth 3 expr))))))
641 (math-derivative (nth 3 expr)))))))
642 638
643(put 'calcFunc-subscr 'math-derivative-n 639(put 'calcFunc-subscr 'math-derivative-n
644 (function 640 (lambda (expr)
645 (lambda (expr) 641 (and (= (length expr) 3)
646 (and (= (length expr) 3) 642 (list 'calcFunc-subscr (nth 1 expr)
647 (list 'calcFunc-subscr (nth 1 expr) 643 (math-derivative (nth 2 expr))))))
648 (math-derivative (nth 2 expr)))))))
649 644
650 645
651(defvar math-integ-var '(var X ---)) 646(defvar math-integ-var '(var X ---))
@@ -1015,11 +1010,10 @@
1015 res '(calcFunc-integsubst))) 1010 res '(calcFunc-integsubst)))
1016 (and (memq (length part) '(3 4 5)) 1011 (and (memq (length part) '(3 4 5))
1017 (let ((parts (mapcar 1012 (let ((parts (mapcar
1018 (function 1013 (lambda (x)
1019 (lambda (x) 1014 (math-expr-subst
1020 (math-expr-subst 1015 x (nth 2 part)
1021 x (nth 2 part) 1016 math-integ-var))
1022 math-integ-var)))
1023 (cdr part)))) 1017 (cdr part))))
1024 (math-integrate-by-substitution 1018 (math-integrate-by-substitution
1025 expr (car parts) t 1019 expr (car parts) t
@@ -1516,7 +1510,7 @@
1516 var low high) 1510 var low high)
1517 (nth 2 (nth 2 expr)))) 1511 (nth 2 (nth 2 expr))))
1518 ((eq (car-safe expr) 'vec) 1512 ((eq (car-safe expr) 'vec)
1519 (cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high))) 1513 (cons 'vec (mapcar (lambda (x) (calcFunc-integ x var low high))
1520 (cdr expr)))) 1514 (cdr expr))))
1521 (t 1515 (t
1522 (let ((state (list calc-angle-mode 1516 (let ((state (list calc-angle-mode
@@ -2742,28 +2736,27 @@
2742 math-t1 math-t2 math-t3) 2736 math-t1 math-t2 math-t3)
2743 (setq math-t2 (math-polynomial-base 2737 (setq math-t2 (math-polynomial-base
2744 math-solve-lhs 2738 math-solve-lhs
2745 (function 2739 (lambda (solve-b)
2746 (lambda (solve-b) 2740 (let ((math-solve-b solve-b)
2747 (let ((math-solve-b solve-b) 2741 (math-poly-neg-powers '(1))
2748 (math-poly-neg-powers '(1)) 2742 (math-poly-mult-powers nil)
2749 (math-poly-mult-powers nil) 2743 (math-poly-frac-powers 1)
2750 (math-poly-frac-powers 1) 2744 (math-poly-exp-base t))
2751 (math-poly-exp-base t)) 2745 (and (not (equal math-solve-b math-solve-lhs))
2752 (and (not (equal math-solve-b math-solve-lhs)) 2746 (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
2753 (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs) 2747 (setq math-t3 '(1 0) math-t2 1
2754 (setq math-t3 '(1 0) math-t2 1 2748 math-t1 (math-is-polynomial math-solve-lhs
2755 math-t1 (math-is-polynomial math-solve-lhs 2749 math-solve-b 50))
2756 math-solve-b 50)) 2750 (if (and (equal math-poly-neg-powers '(1))
2757 (if (and (equal math-poly-neg-powers '(1)) 2751 (memq math-poly-mult-powers '(nil 1))
2758 (memq math-poly-mult-powers '(nil 1)) 2752 (eq math-poly-frac-powers 1)
2759 (eq math-poly-frac-powers 1) 2753 sub-rhs)
2760 sub-rhs) 2754 (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
2761 (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs) 2755 (cdr math-t1)))
2762 (cdr math-t1))) 2756 (math-solve-poly-funny-powers sub-rhs))
2763 (math-solve-poly-funny-powers sub-rhs)) 2757 (math-solve-crunch-poly degree)
2764 (math-solve-crunch-poly degree) 2758 (or (math-expr-contains math-solve-b math-solve-var)
2765 (or (math-expr-contains math-solve-b math-solve-var) 2759 (math-expr-contains (car math-t3) math-solve-var)))))))
2766 (math-expr-contains (car math-t3) math-solve-var))))))))
2767 (if math-t2 2760 (if math-t2
2768 (list (math-pow math-t2 (car math-t3)) 2761 (list (math-pow math-t2 (car math-t3))
2769 (cons 'vec math-t1) 2762 (cons 'vec math-t1)
@@ -3326,12 +3319,11 @@
3326 (delq (car v) (copy-sequence var-list)) 3319 (delq (car v) (copy-sequence var-list))
3327 (let ((math-solve-simplifying nil) 3320 (let ((math-solve-simplifying nil)
3328 (s (mapcar 3321 (s (mapcar
3329 (function 3322 (lambda (x)
3330 (lambda (x) 3323 (cons
3331 (cons 3324 (car x)
3332 (car x) 3325 (math-solve-system-subst
3333 (math-solve-system-subst 3326 (cdr x))))
3334 (cdr x)))))
3335 solns))) 3327 solns)))
3336 (if elim 3328 (if elim
3337 s 3329 s
@@ -3347,35 +3339,33 @@
3347 3339
3348 ;; Eliminated all variables, so now put solution into the proper format. 3340 ;; Eliminated all variables, so now put solution into the proper format.
3349 (setq solns (sort solns 3341 (setq solns (sort solns
3350 (function 3342 (lambda (x y)
3351 (lambda (x y) 3343 (not (memq (car x) (memq (car y) math-solve-vars))))))
3352 (not (memq (car x) (memq (car y) math-solve-vars)))))))
3353 (if (eq math-solve-full 'all) 3344 (if (eq math-solve-full 'all)
3354 (math-transpose 3345 (math-transpose
3355 (math-normalize 3346 (math-normalize
3356 (cons 'vec 3347 (cons 'vec
3357 (if solns 3348 (if solns
3358 (mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns) 3349 (mapcar (lambda (x) (cons 'vec (cdr x))) solns)
3359 (mapcar (function (lambda (x) (cons 'vec x))) eqn-list))))) 3350 (mapcar (lambda (x) (cons 'vec x)) eqn-list)))))
3360 (math-normalize 3351 (math-normalize
3361 (cons 'vec 3352 (cons 'vec
3362 (if solns 3353 (if solns
3363 (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns) 3354 (mapcar (lambda (x) (cons 'calcFunc-eq x)) solns)
3364 (mapcar 'car eqn-list))))))) 3355 (mapcar #'car eqn-list)))))))
3365 3356
3366(defun math-solve-system-subst (x) ; uses "res" and "v" 3357(defun math-solve-system-subst (x) ; uses "res" and "v"
3367 (let ((accum nil) 3358 (let ((accum nil)
3368 (res2 math-solve-system-res)) 3359 (res2 math-solve-system-res))
3369 (while x 3360 (while x
3370 (setq accum (nconc accum 3361 (setq accum (nconc accum
3371 (mapcar (function 3362 (mapcar (lambda (r)
3372 (lambda (r) 3363 (if math-solve-simplifying
3373 (if math-solve-simplifying 3364 (math-simplify
3374 (math-simplify 3365 (math-expr-subst
3375 (math-expr-subst 3366 (car x) math-solve-system-vv r))
3376 (car x) math-solve-system-vv r)) 3367 (math-expr-subst
3377 (math-expr-subst 3368 (car x) math-solve-system-vv r)))
3378 (car x) math-solve-system-vv r))))
3379 (car res2))) 3369 (car res2)))
3380 x (cdr x) 3370 x (cdr x)
3381 res2 (cdr res2))) 3371 res2 (cdr res2)))
@@ -3471,11 +3461,10 @@
3471 (let ((old-len (length res)) 3461 (let ((old-len (length res))
3472 new-len) 3462 new-len)
3473 (setq res (delq nil 3463 (setq res (delq nil
3474 (mapcar (function 3464 (mapcar (lambda (x)
3475 (lambda (x) 3465 (and (not (memq (car-safe x)
3476 (and (not (memq (car-safe x) 3466 '(cplx polar)))
3477 '(cplx polar))) 3467 x))
3478 x)))
3479 res)) 3468 res))
3480 new-len (length res)) 3469 new-len (length res))
3481 (if (< new-len old-len) 3470 (if (< new-len old-len)
@@ -3545,119 +3534,119 @@
3545 3534
3546 3535
3547(put 'calcFunc-inv 'math-inverse 3536(put 'calcFunc-inv 'math-inverse
3548 (function (lambda (x) (math-div 1 x)))) 3537 (lambda (x) (math-div 1 x)))
3549(put 'calcFunc-inv 'math-inverse-sign -1) 3538(put 'calcFunc-inv 'math-inverse-sign -1)
3550 3539
3551(put 'calcFunc-sqrt 'math-inverse 3540(put 'calcFunc-sqrt 'math-inverse
3552 (function (lambda (x) (math-sqr x)))) 3541 (lambda (x) (math-sqr x)))
3553 3542
3554(put 'calcFunc-conj 'math-inverse 3543(put 'calcFunc-conj 'math-inverse
3555 (function (lambda (x) (list 'calcFunc-conj x)))) 3544 (lambda (x) (list 'calcFunc-conj x)))
3556 3545
3557(put 'calcFunc-abs 'math-inverse 3546(put 'calcFunc-abs 'math-inverse
3558 (function (lambda (x) (math-solve-get-sign x)))) 3547 (lambda (x) (math-solve-get-sign x)))
3559 3548
3560(put 'calcFunc-deg 'math-inverse 3549(put 'calcFunc-deg 'math-inverse
3561 (function (lambda (x) (list 'calcFunc-rad x)))) 3550 (lambda (x) (list 'calcFunc-rad x)))
3562(put 'calcFunc-deg 'math-inverse-sign 1) 3551(put 'calcFunc-deg 'math-inverse-sign 1)
3563 3552
3564(put 'calcFunc-rad 'math-inverse 3553(put 'calcFunc-rad 'math-inverse
3565 (function (lambda (x) (list 'calcFunc-deg x)))) 3554 (lambda (x) (list 'calcFunc-deg x)))
3566(put 'calcFunc-rad 'math-inverse-sign 1) 3555(put 'calcFunc-rad 'math-inverse-sign 1)
3567 3556
3568(put 'calcFunc-ln 'math-inverse 3557(put 'calcFunc-ln 'math-inverse
3569 (function (lambda (x) (list 'calcFunc-exp x)))) 3558 (lambda (x) (list 'calcFunc-exp x)))
3570(put 'calcFunc-ln 'math-inverse-sign 1) 3559(put 'calcFunc-ln 'math-inverse-sign 1)
3571 3560
3572(put 'calcFunc-log10 'math-inverse 3561(put 'calcFunc-log10 'math-inverse
3573 (function (lambda (x) (list 'calcFunc-exp10 x)))) 3562 (lambda (x) (list 'calcFunc-exp10 x)))
3574(put 'calcFunc-log10 'math-inverse-sign 1) 3563(put 'calcFunc-log10 'math-inverse-sign 1)
3575 3564
3576(put 'calcFunc-lnp1 'math-inverse 3565(put 'calcFunc-lnp1 'math-inverse
3577 (function (lambda (x) (list 'calcFunc-expm1 x)))) 3566 (lambda (x) (list 'calcFunc-expm1 x)))
3578(put 'calcFunc-lnp1 'math-inverse-sign 1) 3567(put 'calcFunc-lnp1 'math-inverse-sign 1)
3579 3568
3580(put 'calcFunc-exp 'math-inverse 3569(put 'calcFunc-exp 'math-inverse
3581 (function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x)) 3570 (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
3582 (math-mul 2 3571 (math-mul 2
3583 (math-mul '(var pi var-pi) 3572 (math-mul '(var pi var-pi)
3584 (math-solve-get-int 3573 (math-solve-get-int
3585 '(var i var-i)))))))) 3574 '(var i var-i)))))))
3586(put 'calcFunc-exp 'math-inverse-sign 1) 3575(put 'calcFunc-exp 'math-inverse-sign 1)
3587 3576
3588(put 'calcFunc-expm1 'math-inverse 3577(put 'calcFunc-expm1 'math-inverse
3589 (function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x)) 3578 (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
3590 (math-mul 2 3579 (math-mul 2
3591 (math-mul '(var pi var-pi) 3580 (math-mul '(var pi var-pi)
3592 (math-solve-get-int 3581 (math-solve-get-int
3593 '(var i var-i)))))))) 3582 '(var i var-i)))))))
3594(put 'calcFunc-expm1 'math-inverse-sign 1) 3583(put 'calcFunc-expm1 'math-inverse-sign 1)
3595 3584
3596(put 'calcFunc-sin 'math-inverse 3585(put 'calcFunc-sin 'math-inverse
3597 (function (lambda (x) (let ((n (math-solve-get-int 1))) 3586 (lambda (x) (let ((n (math-solve-get-int 1)))
3598 (math-add (math-mul (math-normalize 3587 (math-add (math-mul (math-normalize
3599 (list 'calcFunc-arcsin x)) 3588 (list 'calcFunc-arcsin x))
3600 (math-pow -1 n)) 3589 (math-pow -1 n))
3601 (math-mul (math-half-circle t) 3590 (math-mul (math-half-circle t)
3602 n)))))) 3591 n)))))
3603 3592
3604(put 'calcFunc-cos 'math-inverse 3593(put 'calcFunc-cos 'math-inverse
3605 (function (lambda (x) (math-add (math-solve-get-sign 3594 (lambda (x) (math-add (math-solve-get-sign
3606 (math-normalize 3595 (math-normalize
3607 (list 'calcFunc-arccos x))) 3596 (list 'calcFunc-arccos x)))
3608 (math-solve-get-int 3597 (math-solve-get-int
3609 (math-full-circle t)))))) 3598 (math-full-circle t)))))
3610 3599
3611(put 'calcFunc-tan 'math-inverse 3600(put 'calcFunc-tan 'math-inverse
3612 (function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x)) 3601 (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
3613 (math-solve-get-int 3602 (math-solve-get-int
3614 (math-half-circle t)))))) 3603 (math-half-circle t)))))
3615 3604
3616(put 'calcFunc-arcsin 'math-inverse 3605(put 'calcFunc-arcsin 'math-inverse
3617 (function (lambda (x) (math-normalize (list 'calcFunc-sin x))))) 3606 (lambda (x) (math-normalize (list 'calcFunc-sin x))))
3618 3607
3619(put 'calcFunc-arccos 'math-inverse 3608(put 'calcFunc-arccos 'math-inverse
3620 (function (lambda (x) (math-normalize (list 'calcFunc-cos x))))) 3609 (lambda (x) (math-normalize (list 'calcFunc-cos x))))
3621 3610
3622(put 'calcFunc-arctan 'math-inverse 3611(put 'calcFunc-arctan 'math-inverse
3623 (function (lambda (x) (math-normalize (list 'calcFunc-tan x))))) 3612 (lambda (x) (math-normalize (list 'calcFunc-tan x))))
3624 3613
3625(put 'calcFunc-sinh 'math-inverse 3614(put 'calcFunc-sinh 'math-inverse
3626 (function (lambda (x) (let ((n (math-solve-get-int 1))) 3615 (lambda (x) (let ((n (math-solve-get-int 1)))
3627 (math-add (math-mul (math-normalize 3616 (math-add (math-mul (math-normalize
3628 (list 'calcFunc-arcsinh x)) 3617 (list 'calcFunc-arcsinh x))
3629 (math-pow -1 n)) 3618 (math-pow -1 n))
3630 (math-mul (math-half-circle t) 3619 (math-mul (math-half-circle t)
3631 (math-mul 3620 (math-mul
3632 '(var i var-i) 3621 '(var i var-i)
3633 n))))))) 3622 n))))))
3634(put 'calcFunc-sinh 'math-inverse-sign 1) 3623(put 'calcFunc-sinh 'math-inverse-sign 1)
3635 3624
3636(put 'calcFunc-cosh 'math-inverse 3625(put 'calcFunc-cosh 'math-inverse
3637 (function (lambda (x) (math-add (math-solve-get-sign 3626 (lambda (x) (math-add (math-solve-get-sign
3638 (math-normalize 3627 (math-normalize
3639 (list 'calcFunc-arccosh x))) 3628 (list 'calcFunc-arccosh x)))
3640 (math-mul (math-full-circle t) 3629 (math-mul (math-full-circle t)
3641 (math-solve-get-int 3630 (math-solve-get-int
3642 '(var i var-i))))))) 3631 '(var i var-i))))))
3643 3632
3644(put 'calcFunc-tanh 'math-inverse 3633(put 'calcFunc-tanh 'math-inverse
3645 (function (lambda (x) (math-add (math-normalize 3634 (lambda (x) (math-add (math-normalize
3646 (list 'calcFunc-arctanh x)) 3635 (list 'calcFunc-arctanh x))
3647 (math-mul (math-half-circle t) 3636 (math-mul (math-half-circle t)
3648 (math-solve-get-int 3637 (math-solve-get-int
3649 '(var i var-i))))))) 3638 '(var i var-i))))))
3650(put 'calcFunc-tanh 'math-inverse-sign 1) 3639(put 'calcFunc-tanh 'math-inverse-sign 1)
3651 3640
3652(put 'calcFunc-arcsinh 'math-inverse 3641(put 'calcFunc-arcsinh 'math-inverse
3653 (function (lambda (x) (math-normalize (list 'calcFunc-sinh x))))) 3642 (lambda (x) (math-normalize (list 'calcFunc-sinh x))))
3654(put 'calcFunc-arcsinh 'math-inverse-sign 1) 3643(put 'calcFunc-arcsinh 'math-inverse-sign 1)
3655 3644
3656(put 'calcFunc-arccosh 'math-inverse 3645(put 'calcFunc-arccosh 'math-inverse
3657 (function (lambda (x) (math-normalize (list 'calcFunc-cosh x))))) 3646 (lambda (x) (math-normalize (list 'calcFunc-cosh x))))
3658 3647
3659(put 'calcFunc-arctanh 'math-inverse 3648(put 'calcFunc-arctanh 'math-inverse
3660 (function (lambda (x) (math-normalize (list 'calcFunc-tanh x))))) 3649 (lambda (x) (math-normalize (list 'calcFunc-tanh x))))
3661(put 'calcFunc-arctanh 'math-inverse-sign 1) 3650(put 'calcFunc-arctanh 'math-inverse-sign 1)
3662 3651
3663 3652
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index f1f67211b84..fdcde95dae7 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -480,13 +480,13 @@
480 "Fitting variables" 480 "Fitting variables"
481 (format "%s; %s" 481 (format "%s; %s"
482 (mapconcat 'symbol-name 482 (mapconcat 'symbol-name
483 (mapcar (function (lambda (v) 483 (mapcar (lambda (v)
484 (nth 1 v))) 484 (nth 1 v))
485 defv) 485 defv)
486 ",") 486 ",")
487 (mapconcat 'symbol-name 487 (mapconcat 'symbol-name
488 (mapcar (function (lambda (v) 488 (mapcar (lambda (v)
489 (nth 1 v))) 489 (nth 1 v))
490 defc) 490 defc)
491 ","))))) 491 ",")))))
492 (coefs nil)) 492 (coefs nil))
@@ -1336,7 +1336,7 @@
1336 (or (> (length (nth 1 data)) 2) 1336 (or (> (length (nth 1 data)) 2)
1337 (math-reject-arg data "*Too few data points")) 1337 (math-reject-arg data "*Too few data points"))
1338 (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas)) 1338 (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
1339 (cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x))) 1339 (cons 'vec (mapcar (lambda (x) (calcFunc-polint data x))
1340 (cdr x))) 1340 (cdr x)))
1341 (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) 1341 (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
1342 (math-with-extra-prec 2 1342 (math-with-extra-prec 2
@@ -1352,7 +1352,7 @@
1352 (or (> (length (nth 1 data)) 2) 1352 (or (> (length (nth 1 data)) 2)
1353 (math-reject-arg data "*Too few data points")) 1353 (math-reject-arg data "*Too few data points"))
1354 (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas)) 1354 (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
1355 (cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x))) 1355 (cons 'vec (mapcar (lambda (x) (calcFunc-ratint data x))
1356 (cdr x))) 1356 (cdr x)))
1357 (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) 1357 (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
1358 (math-with-extra-prec 2 1358 (math-with-extra-prec 2
@@ -1910,8 +1910,8 @@
1910 (while p 1910 (while p
1911 (setq vars (delq (assoc (car-safe p) vars) vars) 1911 (setq vars (delq (assoc (car-safe p) vars) vars)
1912 p (cdr p))) 1912 p (cdr p)))
1913 (sort (mapcar 'car vars) 1913 (sort (mapcar #'car vars)
1914 (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))) 1914 (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
1915 1915
1916;; The variables math-all-vars-vars (the vars for math-all-vars) and 1916;; The variables math-all-vars-vars (the vars for math-all-vars) and
1917;; math-all-vars-found are local to math-all-vars-in, but are used by 1917;; math-all-vars-found are local to math-all-vars-in, but are used by
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 1f3ae842638..e4f6e989ecf 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -464,14 +464,13 @@
464 (math-compose-vector (cdr (nth 1 a)) 464 (math-compose-vector (cdr (nth 1 a))
465 (math-vector-to-string sep nil) 465 (math-vector-to-string sep nil)
466 (or cprec prec)) 466 (or cprec prec))
467 (cons 'horiz (mapcar (function 467 (cons 'horiz (mapcar (lambda (x)
468 (lambda (x) 468 (if (eq (car-safe x) 'calcFunc-bstring)
469 (if (eq (car-safe x) 'calcFunc-bstring) 469 (prog1
470 (prog1 470 (math-compose-expr
471 (math-compose-expr 471 x (or bprec cprec prec))
472 x (or bprec cprec prec)) 472 (setq bprec -123))
473 (setq bprec -123)) 473 (math-compose-expr x (or cprec prec))))
474 (math-compose-expr x (or cprec prec)))))
475 (cdr (nth 1 a))))))) 474 (cdr (nth 1 a)))))))
476 ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert)) 475 ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
477 (not (eq calc-language 'unform)) 476 (not (eq calc-language 'unform))
@@ -482,47 +481,46 @@
482 (let* ((base 0) 481 (let* ((base 0)
483 (v 0) 482 (v 0)
484 (prec (or (nth 2 a) prec)) 483 (prec (or (nth 2 a) prec))
485 (c (mapcar (function 484 (c (mapcar (lambda (x)
486 (lambda (x) 485 (let ((b nil) (cc nil) a d)
487 (let ((b nil) (cc nil) a d) 486 (if (and (memq (car-safe x) '(calcFunc-cbase
488 (if (and (memq (car-safe x) '(calcFunc-cbase 487 calcFunc-ctbase
489 calcFunc-ctbase 488 calcFunc-cbbase))
490 calcFunc-cbbase)) 489 (memq (length x) '(1 2)))
491 (memq (length x) '(1 2))) 490 (setq b (car x)
492 (setq b (car x) 491 x (nth 1 x)))
493 x (nth 1 x))) 492 (if (and (eq (car-safe x) 'calcFunc-crule)
494 (if (and (eq (car-safe x) 'calcFunc-crule) 493 (memq (length x) '(1 2))
495 (memq (length x) '(1 2)) 494 (or (null (nth 1 x))
496 (or (null (nth 1 x)) 495 (and (math-vectorp (nth 1 x))
497 (and (math-vectorp (nth 1 x)) 496 (= (length (nth 1 x)) 2)
498 (= (length (nth 1 x)) 2) 497 (math-vector-is-string
499 (math-vector-is-string 498 (nth 1 x)))
500 (nth 1 x))) 499 (and (natnump (nth 1 x))
501 (and (natnump (nth 1 x)) 500 (<= (nth 1 x) 255))))
502 (<= (nth 1 x) 255)))) 501 (setq cc (list
503 (setq cc (list 502 'rule
504 'rule 503 (if (math-vectorp (nth 1 x))
505 (if (math-vectorp (nth 1 x)) 504 (aref (math-vector-to-string
506 (aref (math-vector-to-string 505 (nth 1 x) nil) 0)
507 (nth 1 x) nil) 0) 506 (or (nth 1 x) ?-))))
508 (or (nth 1 x) ?-)))) 507 (or (and (memq (car-safe x) '(calcFunc-cvspace
509 (or (and (memq (car-safe x) '(calcFunc-cvspace 508 calcFunc-ctspace
510 calcFunc-ctspace 509 calcFunc-cbspace))
511 calcFunc-cbspace)) 510 (memq (length x) '(2 3))
512 (memq (length x) '(2 3)) 511 (eq (nth 1 x) 0))
513 (eq (nth 1 x) 0)) 512 (null x)
514 (null x) 513 (setq cc (math-compose-expr x prec))))
515 (setq cc (math-compose-expr x prec)))) 514 (setq a (if cc (math-comp-ascent cc) 0)
516 (setq a (if cc (math-comp-ascent cc) 0) 515 d (if cc (math-comp-descent cc) 0))
517 d (if cc (math-comp-descent cc) 0)) 516 (if (eq b 'calcFunc-cbase)
518 (if (eq b 'calcFunc-cbase) 517 (setq base (+ v a -1))
519 (setq base (+ v a -1)) 518 (if (eq b 'calcFunc-ctbase)
520 (if (eq b 'calcFunc-ctbase) 519 (setq base v)
521 (setq base v) 520 (if (eq b 'calcFunc-cbbase)
522 (if (eq b 'calcFunc-cbbase) 521 (setq base (+ v a d -1)))))
523 (setq base (+ v a d -1))))) 522 (setq v (+ v a d))
524 (setq v (+ v a d)) 523 cc))
525 cc)))
526 (cdr (nth 1 a))))) 524 (cdr (nth 1 a)))))
527 (setq c (delq nil c)) 525 (setq c (delq nil c))
528 (if c 526 (if c
@@ -865,16 +863,15 @@
865 (while (<= (setq col (1+ col)) cols) 863 (while (<= (setq col (1+ col)) cols)
866 (setq res (cons (cons math-comp-just 864 (setq res (cons (cons math-comp-just
867 (cons base 865 (cons base
868 (mapcar (function 866 (mapcar (lambda (r)
869 (lambda (r) 867 (list 'horiz
870 (list 'horiz 868 (math-compose-expr
871 (math-compose-expr 869 (nth col r)
872 (nth col r) 870 math-comp-vector-prec)
873 math-comp-vector-prec) 871 (if (= col cols)
874 (if (= col cols) 872 ""
875 "" 873 (concat
876 (concat 874 math-comp-comma-spc " "))))
877 math-comp-comma-spc " ")))))
878 a))) 875 a)))
879 res))) 876 res)))
880 (nreverse res))) 877 (nreverse res)))
@@ -923,7 +920,7 @@
923 ( ?\^? . "\\^?" ))) 920 ( ?\^? . "\\^?" )))
924 921
925(defun math-vector-to-string (a &optional quoted) 922(defun math-vector-to-string (a &optional quoted)
926 (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x))) 923 (setq a (concat (mapcar (lambda (x) (if (consp x) (nth 1 x) x))
927 (cdr a)))) 924 (cdr a))))
928 (if (string-match "[\000-\037\177\\\"]" a) 925 (if (string-match "[\000-\037\177\\\"]" a)
929 (let ((p 0) 926 (let ((p 0)
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
index d47701d5a8b..113f4056e2c 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -349,7 +349,11 @@ Optional argument RESERVED is saved for later use."
349;;;###autoload 349;;;###autoload
350(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver) 350(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver)
351 "Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver. 351 "Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
352Only checks one based on which kind of Emacs is being run." 352Only checks one based on which kind of Emacs is being run.
353
354This function is obsolete; do this instead:
355 (when (version<= \"28.1\" emacs-version) ...)"
356 (declare (obsolete nil "28.1"))
353 (let ((err (inversion-test 'emacs 357 (let ((err (inversion-test 'emacs
354 (cond ((featurep 'sxemacs) 358 (cond ((featurep 'sxemacs)
355 sxemacs-ver) 359 sxemacs-ver)
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index bbed1d94f20..2f05b99e467 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -464,27 +464,11 @@ Return a bovination list to use."
464(define-mode-local-override semantic-dependency-tag-file 464(define-mode-local-override semantic-dependency-tag-file
465 emacs-lisp-mode (tag) 465 emacs-lisp-mode (tag)
466 "Find the file BUFFER depends on described by TAG." 466 "Find the file BUFFER depends on described by TAG."
467 (if (fboundp 'find-library-name) 467 (condition-case nil
468 (condition-case nil 468 (find-library-name (semantic-tag-name tag))
469 ;; Try an Emacs 22 fcn. This throws errors. 469 (error
470 (find-library-name (semantic-tag-name tag)) 470 (message "semantic: cannot find source file %s"
471 (error 471 (semantic-tag-name tag)))))
472 (message "semantic: cannot find source file %s"
473 (semantic-tag-name tag))))
474 ;; No handy function available. (Older Emacsen)
475 (let* ((lib (locate-library (semantic-tag-name tag)))
476 (name (if lib (file-name-sans-extension lib) nil))
477 (nameel (concat name ".el")))
478 (cond
479 ((and name (file-exists-p nameel)) nameel)
480 ((and name (file-exists-p (concat name ".el.gz")))
481 ;; This is the linux distro case.
482 (concat name ".el.gz"))
483 ;; Source file does not exist.
484 (name
485 (message "semantic: cannot find source file %s" (concat name ".el")))
486 (t
487 nil)))))
488 472
489;;; DOC Strings 473;;; DOC Strings
490;; 474;;
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index bb2954be561..e972015c6bf 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -32,7 +32,6 @@
32;; 32;;
33 33
34;;; Code: 34;;; Code:
35(eval-when-compile (require 'font-lock))
36(require 'semantic) 35(require 'semantic)
37(require 'semantic/tag-ls) 36(require 'semantic/tag-ls)
38(require 'ezimage) 37(require 'ezimage)
@@ -119,12 +118,10 @@ be used unless font lock is a feature.")
119 "Apply onto TEXT a color associated with FACE-CLASS. 118 "Apply onto TEXT a color associated with FACE-CLASS.
120FACE-CLASS is a tag type found in `semantic-format-face-alist'. 119FACE-CLASS is a tag type found in `semantic-format-face-alist'.
121See that variable for details on adding new types." 120See that variable for details on adding new types."
122 (if (featurep 'font-lock) 121 (let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
123 (let ((face (cdr-safe (assoc face-class semantic-format-face-alist))) 122 (newtext (concat text)))
124 (newtext (concat text))) 123 (put-text-property 0 (length text) 'face face newtext)
125 (put-text-property 0 (length text) 'face face newtext) 124 newtext))
126 newtext)
127 text))
128 125
129(defun semantic--format-colorize-merge-text (precoloredtext face-class) 126(defun semantic--format-colorize-merge-text (precoloredtext face-class)
130 "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS. 127 "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 4a129aae74e..e6711608386 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -79,15 +79,14 @@
79 (insert "(")) 79 (insert "("))
80 (t nil)))) 80 (t nil))))
81 81
82(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated 82(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated)
83 "`Semantic-ia-get-completions' is obsolete. 83(make-obsolete 'semantic-ia-get-completions
84Use `semantic-analyze-possible-completions' instead.") 84 #'semantic-analyze-possible-completions "28.1")
85 85
86(defun semantic-ia-get-completions-deprecated (context point) 86(defun semantic-ia-get-completions-deprecated (context point)
87 "A function to help transition away from `semantic-ia-get-completions'. 87 "A function to help transition away from `semantic-ia-get-completions'.
88Return completions based on CONTEXT at POINT. 88Return completions based on CONTEXT at POINT."
89You should not use this, nor the aliased version. 89 (declare (obsolete semantic-analyze-possible-completions "28.1"))
90Use `semantic-analyze-possible-completions' instead."
91 (semantic-analyze-possible-completions context)) 90 (semantic-analyze-possible-completions context))
92 91
93;;;###autoload 92;;;###autoload
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index 89fc917e0c7..a565d878f15 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -46,11 +46,7 @@
46(defun semantic-string-lessp-ci (s1 s2) 46(defun semantic-string-lessp-ci (s1 s2)
47 "Case insensitive version of `string-lessp'. 47 "Case insensitive version of `string-lessp'.
48Argument S1 and S2 are the strings to compare." 48Argument S1 and S2 are the strings to compare."
49 ;; Use downcase instead of upcase because an average name 49 (eq (compare-strings s1 0 nil s2 0 nil t) -1))
50 ;; has more lower case characters.
51 (if (fboundp 'compare-strings)
52 (eq (compare-strings s1 0 nil s2 0 nil t) -1)
53 (string-lessp (downcase s1) (downcase s2))))
54 50
55(defun semantic-sort-tag-type (tag) 51(defun semantic-sort-tag-type (tag)
56 "Return a type string for TAG guaranteed to be a string." 52 "Return a type string for TAG guaranteed to be a string."
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index d8de8ead4e9..29e88cda125 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -167,24 +167,10 @@ This shell should support pipe redirect syntax."
167 (with-current-buffer b 167 (with-current-buffer b
168 (erase-buffer) 168 (erase-buffer)
169 (setq default-directory rootdir) 169 (setq default-directory rootdir)
170 170 (let ((cmd (semantic-symref-grep-use-template
171 (if (not (fboundp 'grep-compute-defaults)) 171 (file-local-name rootdir) filepattern grepflags greppat)))
172 172 (process-file semantic-symref-grep-shell nil b nil
173 ;; find . -type f -print0 | xargs -0 -e grep -nH -e 173 shell-command-switch cmd)))
174 ;; Note : I removed -e as it is not posix, nor necessary it seems.
175
176 (let ((cmd (concat "find " (file-local-name rootdir)
177 " -type f " filepattern " -print0 "
178 "| xargs -0 grep -H " grepflags "-e " greppat)))
179 ;;(message "Old command: %s" cmd)
180 (process-file semantic-symref-grep-shell nil b nil
181 shell-command-switch cmd)
182 )
183 (let ((cmd (semantic-symref-grep-use-template
184 (file-local-name rootdir) filepattern grepflags greppat)))
185 (process-file semantic-symref-grep-shell nil b nil
186 shell-command-switch cmd))
187 ))
188 (setq ans (semantic-symref-parse-tool-output tool b)) 174 (setq ans (semantic-symref-parse-tool-output tool b))
189 ;; Return the answer 175 ;; Return the answer
190 ans)) 176 ans))
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index e677264c5a9..3dadf347736 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -53,6 +53,11 @@
53(declare-function semantic-clear-toplevel-cache "semantic") 53(declare-function semantic-clear-toplevel-cache "semantic")
54(declare-function semantic-tag-similar-p "semantic/tag-ls") 54(declare-function semantic-tag-similar-p "semantic/tag-ls")
55 55
56(define-obsolete-variable-alias 'semantic-token-version
57 'semantic-tag-version "28.1")
58(define-obsolete-variable-alias 'semantic-token-incompatible-version
59 'semantic-tag-incompatible-version "28.1")
60
56(defconst semantic-tag-version "2.0" 61(defconst semantic-tag-version "2.0"
57 "Version string of semantic tags made with this code.") 62 "Version string of semantic tags made with this code.")
58 63
@@ -1321,12 +1326,6 @@ This function is overridable with the symbol `insert-foreign-tag'."
1321 "Insert foreign tags into log-edit mode." 1326 "Insert foreign tags into log-edit mode."
1322 (insert (concat "(" (semantic-format-tag-name foreign-tag) "): "))) 1327 (insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
1323 1328
1324;;; Compatibility
1325;;
1326(defconst semantic-token-version
1327 semantic-tag-version)
1328(defconst semantic-token-incompatible-version
1329 semantic-tag-incompatible-version)
1330 1329
1331(provide 'semantic/tag) 1330(provide 'semantic/tag)
1332 1331
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 0eb4dbf9e5f..01b804974d4 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -205,7 +205,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
205 (setq where (get symbol 'custom-where)) 205 (setq where (get symbol 'custom-where))
206 (when where 206 (when where
207 (if (or (custom-variable-p symbol) 207 (if (or (custom-variable-p symbol)
208 (custom-facep symbol)) 208 (facep symbol))
209 ;; This means it's a variable or a face. 209 ;; This means it's a variable or a face.
210 (progn 210 (progn
211 (if (assoc version version-alist) 211 (if (assoc version version-alist)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index d1077d367d5..eceba8fa4d6 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1295,10 +1295,11 @@ that were added or redefined since that version."
1295 (push (list symbol 'custom-group) found)) 1295 (push (list symbol 'custom-group) found))
1296 (if (custom-variable-p symbol) 1296 (if (custom-variable-p symbol)
1297 (push (list symbol 'custom-variable) found)) 1297 (push (list symbol 'custom-variable) found))
1298 (if (custom-facep symbol) 1298 (if (facep symbol)
1299 (push (list symbol 'custom-face) found))))))) 1299 (push (list symbol 'custom-face) found)))))))
1300 (if found 1300 (if found
1301 (custom-buffer-create (custom-sort-items found t 'first) 1301 (custom-buffer-create (custom--filter-obsolete-variables
1302 (custom-sort-items found t 'first))
1302 "*Customize Changed Options*") 1303 "*Customize Changed Options*")
1303 (user-error "No user option defaults have been changed since Emacs %s" 1304 (user-error "No user option defaults have been changed since Emacs %s"
1304 since-version)))) 1305 since-version))))
@@ -1405,7 +1406,7 @@ symbols `custom-face' or `custom-variable'."
1405 (mapatoms (lambda (symbol) 1406 (mapatoms (lambda (symbol)
1406 (and (or (get symbol 'customized-face) 1407 (and (or (get symbol 'customized-face)
1407 (get symbol 'customized-face-comment)) 1408 (get symbol 'customized-face-comment))
1408 (custom-facep symbol) 1409 (facep symbol)
1409 (push (list symbol 'custom-face) found)) 1410 (push (list symbol 'custom-face) found))
1410 (and (or (get symbol 'customized-value) 1411 (and (or (get symbol 'customized-value)
1411 (get symbol 'customized-variable-comment)) 1412 (get symbol 'customized-variable-comment))
@@ -1452,7 +1453,7 @@ symbols `custom-face' or `custom-variable'."
1452 (mapatoms (lambda (symbol) 1453 (mapatoms (lambda (symbol)
1453 (and (or (get symbol 'saved-face) 1454 (and (or (get symbol 'saved-face)
1454 (get symbol 'saved-face-comment)) 1455 (get symbol 'saved-face-comment))
1455 (custom-facep symbol) 1456 (facep symbol)
1456 (push (list symbol 'custom-face) found)) 1457 (push (list symbol 'custom-face) found))
1457 (and (or (get symbol 'saved-value) 1458 (and (or (get symbol 'saved-value)
1458 (get symbol 'saved-variable-comment)) 1459 (get symbol 'saved-variable-comment))
@@ -1490,7 +1491,7 @@ If TYPE is `groups', include only groups."
1490 (if (get symbol 'custom-group) 1491 (if (get symbol 'custom-group)
1491 (push (list symbol 'custom-group) found))) 1492 (push (list symbol 'custom-group) found)))
1492 (if (memq type '(nil faces)) 1493 (if (memq type '(nil faces))
1493 (if (custom-facep symbol) 1494 (if (facep symbol)
1494 (push (list symbol 'custom-face) found))) 1495 (push (list symbol 'custom-face) found)))
1495 (if (memq type '(nil options)) 1496 (if (memq type '(nil options))
1496 (if (and (boundp symbol) 1497 (if (and (boundp symbol)
@@ -1504,7 +1505,8 @@ If TYPE is `groups', include only groups."
1504 (symbol-name type)) 1505 (symbol-name type))
1505 pattern)) 1506 pattern))
1506 (custom-buffer-create 1507 (custom-buffer-create
1507 (custom-sort-items found t custom-buffer-order-groups) 1508 (custom--filter-obsolete-variables
1509 (custom-sort-items found t custom-buffer-order-groups))
1508 "*Customize Apropos*"))) 1510 "*Customize Apropos*")))
1509 1511
1510;;;###autoload 1512;;;###autoload
@@ -4232,6 +4234,13 @@ and so forth. The remaining group tags are shown with `custom-group-tag'."
4232 (insert "--------"))) 4234 (insert "--------")))
4233 (widget-default-create widget)) 4235 (widget-default-create widget))
4234 4236
4237(defun custom--filter-obsolete-variables (items)
4238 "Filter obsolete variables from ITEMS."
4239 (seq-remove (lambda (item)
4240 (and (eq (nth 1 item) 'custom-variable)
4241 (get (nth 0 item) 'byte-obsolete-variable)))
4242 items))
4243
4235(defun custom-group-members (symbol groups-only) 4244(defun custom-group-members (symbol groups-only)
4236 "Return SYMBOL's custom group members. 4245 "Return SYMBOL's custom group members.
4237If GROUPS-ONLY is non-nil, return only those members that are groups." 4246If GROUPS-ONLY is non-nil, return only those members that are groups."
@@ -4437,12 +4446,13 @@ This works for both graphical and text displays."
4437 ?\s)) 4446 ?\s))
4438 ;; Members. 4447 ;; Members.
4439 (message "Creating group...") 4448 (message "Creating group...")
4440 (let* ((members (custom-sort-items 4449 (let* ((members (custom--filter-obsolete-variables
4441 members 4450 (custom-sort-items
4442 ;; Never sort the top-level custom group. 4451 members
4443 (unless (eq symbol 'emacs) 4452 ;; Never sort the top-level custom group.
4444 custom-buffer-sort-alphabetically) 4453 (unless (eq symbol 'emacs)
4445 custom-buffer-order-groups)) 4454 custom-buffer-sort-alphabetically)
4455 custom-buffer-order-groups)))
4446 (prefixes (widget-get widget :custom-prefixes)) 4456 (prefixes (widget-get widget :custom-prefixes))
4447 (custom-prefix-list (custom-prefix-add symbol prefixes)) 4457 (custom-prefix-list (custom-prefix-add symbol prefixes))
4448 (have-subtitle (and (not (eq symbol 'emacs)) 4458 (have-subtitle (and (not (eq symbol 'emacs))
@@ -4888,7 +4898,7 @@ This function does not save the buffer."
4888 (let ((spec (car-safe (get symbol 'theme-face))) 4898 (let ((spec (car-safe (get symbol 'theme-face)))
4889 (value (get symbol 'saved-face)) 4899 (value (get symbol 'saved-face))
4890 (now (not (or (get symbol 'face-defface-spec) 4900 (now (not (or (get symbol 'face-defface-spec)
4891 (and (not (custom-facep symbol)) 4901 (and (not (facep symbol))
4892 (not (get symbol 'force-face)))))) 4902 (not (get symbol 'force-face))))))
4893 (comment (get symbol 'saved-face-comment))) 4903 (comment (get symbol 'saved-face-comment)))
4894 (when (or (and spec (eq (nth 0 spec) 'user)) 4904 (when (or (and spec (eq (nth 0 spec) 'user))
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index cc766aa4509..199a76e5cc8 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -27,8 +27,6 @@
27 27
28;;; Code: 28;;; Code:
29 29
30(defalias 'custom-facep 'facep)
31
32;;; Declaring a face. 30;;; Declaring a face.
33 31
34(defun custom-declare-face (face spec doc &rest args) 32(defun custom-declare-face (face spec doc &rest args)
@@ -394,6 +392,8 @@ Each of the arguments ARGS has this form:
394This means reset FACE to its value in FROM-THEME." 392This means reset FACE to its value in FROM-THEME."
395 (apply 'custom-theme-reset-faces 'user args)) 393 (apply 'custom-theme-reset-faces 'user args))
396 394
395(define-obsolete-function-alias 'custom-facep #'facep "28.1")
396
397;;; The End. 397;;; The End.
398 398
399(provide 'cus-face) 399(provide 'cus-face)
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 1d9b4726b04..44cf5aad387 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -535,32 +535,31 @@ doubt, use whitespace."
535 (setq bind-len (1+ text))) 535 (setq bind-len (1+ text)))
536 (t 536 (t
537 (setq desc (mapconcat 537 (setq desc (mapconcat
538 (function 538 (lambda (ch)
539 (lambda (ch) 539 (cond
540 (cond 540 ((integerp ch)
541 ((integerp ch) 541 (concat
542 (concat 542 (cl-loop for pf across "ACHMsS"
543 (cl-loop for pf across "ACHMsS" 543 for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
544 for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ 544 ?\M-\^@ ?\s-\^@ ?\S-\^@)
545 ?\M-\^@ ?\s-\^@ ?\S-\^@) 545 when (/= (logand ch bit) 0)
546 when (/= (logand ch bit) 0) 546 concat (format "%c-" pf))
547 concat (format "%c-" pf)) 547 (let ((ch2 (logand ch (1- (ash 1 18)))))
548 (let ((ch2 (logand ch (1- (ash 1 18))))) 548 (cond ((<= ch2 32)
549 (cond ((<= ch2 32) 549 (pcase ch2
550 (pcase ch2 550 (0 "NUL") (9 "TAB") (10 "LFD")
551 (0 "NUL") (9 "TAB") (10 "LFD") 551 (13 "RET") (27 "ESC") (32 "SPC")
552 (13 "RET") (27 "ESC") (32 "SPC") 552 (_
553 (_ 553 (format "C-%c"
554 (format "C-%c" 554 (+ (if (<= ch2 26) 96 64)
555 (+ (if (<= ch2 26) 96 64) 555 ch2)))))
556 ch2))))) 556 ((= ch2 127) "DEL")
557 ((= ch2 127) "DEL") 557 ((<= ch2 maxkey) (char-to-string ch2))
558 ((<= ch2 maxkey) (char-to-string ch2)) 558 (t (format "\\%o" ch2))))))
559 (t (format "\\%o" ch2)))))) 559 ((symbolp ch)
560 ((symbolp ch) 560 (format "<%s>" ch))
561 (format "<%s>" ch)) 561 (t
562 (t 562 (error "Unrecognized item in macro: %s" ch))))
563 (error "Unrecognized item in macro: %s" ch)))))
564 (or fkey key) " ")))) 563 (or fkey key) " "))))
565 (if prefix 564 (if prefix
566 (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) 565 (setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index fb351879286..e16ce9fded8 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2375,28 +2375,26 @@ The assignment starts at position INDEX."
2375(defun ad-insert-argument-access-forms (definition arglist) 2375(defun ad-insert-argument-access-forms (definition arglist)
2376 "Expands arg-access text macros in DEFINITION according to ARGLIST." 2376 "Expands arg-access text macros in DEFINITION according to ARGLIST."
2377 (ad-substitute-tree 2377 (ad-substitute-tree
2378 (function 2378 (lambda (form)
2379 (lambda (form) 2379 (or (eq form 'ad-arg-bindings)
2380 (or (eq form 'ad-arg-bindings) 2380 (and (memq (car-safe form)
2381 (and (memq (car-safe form) 2381 '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
2382 '(ad-get-arg ad-get-args ad-set-arg ad-set-args)) 2382 (integerp (car-safe (cdr form))))))
2383 (integerp (car-safe (cdr form))))))) 2383 (lambda (form)
2384 (function 2384 (if (eq form 'ad-arg-bindings)
2385 (lambda (form) 2385 (ad-retrieve-args-form arglist)
2386 (if (eq form 'ad-arg-bindings) 2386 (let ((accessor (car form))
2387 (ad-retrieve-args-form arglist) 2387 (index (car (cdr form)))
2388 (let ((accessor (car form)) 2388 (val (car (cdr (ad-insert-argument-access-forms
2389 (index (car (cdr form))) 2389 (cdr form) arglist)))))
2390 (val (car (cdr (ad-insert-argument-access-forms 2390 (cond ((eq accessor 'ad-get-arg)
2391 (cdr form) arglist))))) 2391 (ad-get-argument arglist index))
2392 (cond ((eq accessor 'ad-get-arg) 2392 ((eq accessor 'ad-set-arg)
2393 (ad-get-argument arglist index)) 2393 (ad-set-argument arglist index val))
2394 ((eq accessor 'ad-set-arg) 2394 ((eq accessor 'ad-get-args)
2395 (ad-set-argument arglist index val)) 2395 (ad-get-arguments arglist index))
2396 ((eq accessor 'ad-get-args) 2396 ((eq accessor 'ad-set-args)
2397 (ad-get-arguments arglist index)) 2397 (ad-set-arguments arglist index val))))))
2398 ((eq accessor 'ad-set-args)
2399 (ad-set-arguments arglist index val)))))))
2400 definition)) 2398 definition))
2401 2399
2402;; @@@ Mapping argument lists: 2400;; @@@ Mapping argument lists:
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 2fa5a878801..8cf1f54411a 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -43,7 +43,7 @@
43;;;###autoload 43;;;###autoload
44(defmacro benchmark-run (&optional repetitions &rest forms) 44(defmacro benchmark-run (&optional repetitions &rest forms)
45 "Time execution of FORMS. 45 "Time execution of FORMS.
46If REPETITIONS is supplied as a number, run forms that many times, 46If REPETITIONS is supplied as a number, run FORMS that many times,
47accounting for the overhead of the resulting loop. Otherwise run 47accounting for the overhead of the resulting loop. Otherwise run
48FORMS once. 48FORMS once.
49Return a list of the total elapsed time for execution, the number of 49Return a list of the total elapsed time for execution, the number of
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 6d2bff103e7..532f3d1a246 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2642,7 +2642,8 @@ list that represents a doc string reference.
2642;; and similar macros cleaner. 2642;; and similar macros cleaner.
2643(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) 2643(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
2644(defun byte-compile-file-form-eval (form) 2644(defun byte-compile-file-form-eval (form)
2645 (if (eq (car-safe (nth 1 form)) 'quote) 2645 (if (and (eq (car-safe (nth 1 form)) 'quote)
2646 (equal (nth 2 form) lexical-binding))
2646 (nth 1 (nth 1 form)) 2647 (nth 1 (nth 1 form))
2647 (byte-compile-keep-pending form))) 2648 (byte-compile-keep-pending form)))
2648 2649
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index d3159a37683..a55d78de153 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -209,10 +209,10 @@ non-nil value.
209\n(fn PREDICATE SEQ...)" 209\n(fn PREDICATE SEQ...)"
210 (if (or cl-rest (nlistp cl-seq)) 210 (if (or cl-rest (nlistp cl-seq))
211 (catch 'cl-some 211 (catch 'cl-some
212 (apply 'cl-map nil 212 (apply #'cl-map nil
213 (function (lambda (&rest cl-x) 213 (lambda (&rest cl-x)
214 (let ((cl-res (apply cl-pred cl-x))) 214 (let ((cl-res (apply cl-pred cl-x)))
215 (if cl-res (throw 'cl-some cl-res))))) 215 (if cl-res (throw 'cl-some cl-res))))
216 cl-seq cl-rest) nil) 216 cl-seq cl-rest) nil)
217 (let ((cl-x nil)) 217 (let ((cl-x nil))
218 (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq)))))) 218 (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
@@ -224,9 +224,9 @@ non-nil value.
224\n(fn PREDICATE SEQ...)" 224\n(fn PREDICATE SEQ...)"
225 (if (or cl-rest (nlistp cl-seq)) 225 (if (or cl-rest (nlistp cl-seq))
226 (catch 'cl-every 226 (catch 'cl-every
227 (apply 'cl-map nil 227 (apply #'cl-map nil
228 (function (lambda (&rest cl-x) 228 (lambda (&rest cl-x)
229 (or (apply cl-pred cl-x) (throw 'cl-every nil)))) 229 (or (apply cl-pred cl-x) (throw 'cl-every nil)))
230 cl-seq cl-rest) t) 230 cl-seq cl-rest) t)
231 (while (and cl-seq (funcall cl-pred (car cl-seq))) 231 (while (and cl-seq (funcall cl-pred (car cl-seq)))
232 (setq cl-seq (cdr cl-seq))) 232 (setq cl-seq (cdr cl-seq)))
@@ -249,14 +249,13 @@ non-nil value.
249 (or cl-base 249 (or cl-base
250 (setq cl-base (copy-sequence [0]))) 250 (setq cl-base (copy-sequence [0])))
251 (map-keymap 251 (map-keymap
252 (function 252 (lambda (cl-key cl-bind)
253 (lambda (cl-key cl-bind) 253 (aset cl-base (1- (length cl-base)) cl-key)
254 (aset cl-base (1- (length cl-base)) cl-key) 254 (if (keymapp cl-bind)
255 (if (keymapp cl-bind) 255 (cl--map-keymap-recursively
256 (cl--map-keymap-recursively 256 cl-func-rec cl-bind
257 cl-func-rec cl-bind 257 (vconcat cl-base (list 0)))
258 (vconcat cl-base (list 0))) 258 (funcall cl-func-rec cl-base cl-bind)))
259 (funcall cl-func-rec cl-base cl-bind))))
260 cl-map)) 259 cl-map))
261 260
262;;;###autoload 261;;;###autoload
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 6f98e0f6d6d..f4b22ffbea2 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -819,16 +819,15 @@ final clause, and matches if no other keys match.
819 (cons 819 (cons
820 'cond 820 'cond
821 (mapcar 821 (mapcar
822 (function 822 (lambda (c)
823 (lambda (c) 823 (cons (cond ((eq (car c) 'otherwise) t)
824 (cons (cond ((eq (car c) 'otherwise) t) 824 ((eq (car c) 'cl--ecase-error-flag)
825 ((eq (car c) 'cl--ecase-error-flag) 825 `(error "cl-etypecase failed: %s, %s"
826 `(error "cl-etypecase failed: %s, %s" 826 ,temp ',(reverse type-list)))
827 ,temp ',(reverse type-list))) 827 (t
828 (t 828 (push (car c) type-list)
829 (push (car c) type-list) 829 `(cl-typep ,temp ',(car c))))
830 `(cl-typep ,temp ',(car c)))) 830 (or (cdr c) '(nil))))
831 (or (cdr c) '(nil)))))
832 clauses))))) 831 clauses)))))
833 832
834;;;###autoload 833;;;###autoload
@@ -2793,7 +2792,7 @@ Supported keywords for slots are:
2793 (unless (cl--struct-name-p name) 2792 (unless (cl--struct-name-p name)
2794 (signal 'wrong-type-argument (list 'cl-struct-name-p name 'name))) 2793 (signal 'wrong-type-argument (list 'cl-struct-name-p name 'name)))
2795 (setq descs (cons '(cl-tag-slot) 2794 (setq descs (cons '(cl-tag-slot)
2796 (mapcar (function (lambda (x) (if (consp x) x (list x)))) 2795 (mapcar (lambda (x) (if (consp x) x (list x)))
2797 descs))) 2796 descs)))
2798 (while opts 2797 (while opts
2799 (let ((opt (if (consp (car opts)) (caar opts) (car opts))) 2798 (let ((opt (if (consp (car opts)) (caar opts) (car opts)))
@@ -2820,9 +2819,8 @@ Supported keywords for slots are:
2820 ;; we include EIEIO classes rather than cl-structs! 2819 ;; we include EIEIO classes rather than cl-structs!
2821 (when include-name (error "Can't :include more than once")) 2820 (when include-name (error "Can't :include more than once"))
2822 (setq include-name (car args)) 2821 (setq include-name (car args))
2823 (setq include-descs (mapcar (function 2822 (setq include-descs (mapcar (lambda (x)
2824 (lambda (x) 2823 (if (consp x) x (list x)))
2825 (if (consp x) x (list x))))
2826 (cdr args)))) 2824 (cdr args))))
2827 ((eq opt :print-function) 2825 ((eq opt :print-function)
2828 (setq print-func (car args))) 2826 (setq print-func (car args)))
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index d34d50172df..8cfdd140f8e 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -69,10 +69,9 @@
69 (list 'or (list 'memq '(car cl-keys-temp) 69 (list 'or (list 'memq '(car cl-keys-temp)
70 (list 'quote 70 (list 'quote
71 (mapcar 71 (mapcar
72 (function 72 (lambda (x)
73 (lambda (x) 73 (if (consp x)
74 (if (consp x) 74 (car x) x))
75 (car x) x)))
76 (append kwords 75 (append kwords
77 other-keys)))) 76 other-keys))))
78 '(car (cdr (memq (quote :allow-other-keys) 77 '(car (cdr (memq (quote :allow-other-keys)
@@ -668,9 +667,9 @@ This is a destructive function; it reuses the storage of SEQ if possible.
668 (cl--parsing-keywords (:key) () 667 (cl--parsing-keywords (:key) ()
669 (if (memq cl-key '(nil identity)) 668 (if (memq cl-key '(nil identity))
670 (sort cl-seq cl-pred) 669 (sort cl-seq cl-pred)
671 (sort cl-seq (function (lambda (cl-x cl-y) 670 (sort cl-seq (lambda (cl-x cl-y)
672 (funcall cl-pred (funcall cl-key cl-x) 671 (funcall cl-pred (funcall cl-key cl-x)
673 (funcall cl-key cl-y))))))))) 672 (funcall cl-key cl-y))))))))
674 673
675;;;###autoload 674;;;###autoload
676(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys) 675(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 73dabef3fa5..b0198dbf8d5 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -514,6 +514,7 @@ completely and menu filter functions can be expected to work.
514If BEFORE is non-nil, add before the item named BEFORE. 514If BEFORE is non-nil, add before the item named BEFORE.
515If IN-MENU is non-nil, follow MENU-PATH in IN-MENU. 515If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
516This is a compatibility function; use `easy-menu-add-item'." 516This is a compatibility function; use `easy-menu-add-item'."
517 (declare (obsolete easy-menu-add-item "28.1"))
517 (easy-menu-add-item (or in-menu (current-global-map)) 518 (easy-menu-add-item (or in-menu (current-global-map))
518 (cons "menu-bar" menu-path) 519 (cons "menu-bar" menu-path)
519 submenu before)) 520 submenu before))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index e310313940f..f242e922bde 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -309,9 +309,8 @@ A lambda list keyword is a symbol that starts with `&'."
309(defun edebug-sort-alist (alist function) 309(defun edebug-sort-alist (alist function)
310 ;; Return the ALIST sorted with comparison function FUNCTION. 310 ;; Return the ALIST sorted with comparison function FUNCTION.
311 ;; This uses 'sort so the sorting is destructive. 311 ;; This uses 'sort so the sorting is destructive.
312 (sort alist (function 312 (sort alist (lambda (e1 e2)
313 (lambda (e1 e2) 313 (funcall function (car e1) (car e2)))))
314 (funcall function (car e1) (car e2))))))
315 314
316;; Not used. 315;; Not used.
317'(defmacro edebug-save-restriction (&rest body) 316'(defmacro edebug-save-restriction (&rest body)
@@ -407,14 +406,13 @@ Return the result of the last expression in BODY."
407 (if (listp window-info) 406 (if (listp window-info)
408 (mapcar (lambda (one-window-info) 407 (mapcar (lambda (one-window-info)
409 (if one-window-info 408 (if one-window-info
410 (apply (function 409 (apply (lambda (window buffer point start hscroll)
411 (lambda (window buffer point start hscroll) 410 (if (edebug-window-live-p window)
412 (if (edebug-window-live-p window) 411 (progn
413 (progn 412 (set-window-buffer window buffer)
414 (set-window-buffer window buffer) 413 (set-window-point window point)
415 (set-window-point window point) 414 (set-window-start window start)
416 (set-window-start window start) 415 (set-window-hscroll window hscroll))))
417 (set-window-hscroll window hscroll)))))
418 one-window-info))) 416 one-window-info)))
419 window-info) 417 window-info)
420 (set-window-configuration window-info))) 418 (set-window-configuration window-info)))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 35590123ee6..124900168c3 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -784,9 +784,17 @@ This command assumes point is not in a string or comment."
784 (interactive "P") 784 (interactive "P")
785 (insert-pair arg ?\( ?\))) 785 (insert-pair arg ?\( ?\)))
786 786
787(defcustom delete-pair-blink-delay blink-matching-delay
788 "Time in seconds to delay after showing a paired character to delete.
789It's used by the command `delete-pair'. The value 0 disables blinking."
790 :type 'number
791 :group 'lisp
792 :version "28.1")
793
787(defun delete-pair (&optional arg) 794(defun delete-pair (&optional arg)
788 "Delete a pair of characters enclosing ARG sexps that follow point. 795 "Delete a pair of characters enclosing ARG sexps that follow point.
789A negative ARG deletes a pair around the preceding ARG sexps instead." 796A negative ARG deletes a pair around the preceding ARG sexps instead.
797The option `delete-pair-blink-delay' can disable blinking."
790 (interactive "P") 798 (interactive "P")
791 (if arg 799 (if arg
792 (setq arg (prefix-numeric-value arg)) 800 (setq arg (prefix-numeric-value arg))
@@ -802,6 +810,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead."
802 (if (= (length p) 3) (cdr p) p)) 810 (if (= (length p) 3) (cdr p) p))
803 insert-pair-alist)) 811 insert-pair-alist))
804 (error "Not after matching pair")) 812 (error "Not after matching pair"))
813 (when (and (numberp delete-pair-blink-delay)
814 (> delete-pair-blink-delay 0))
815 (sit-for delete-pair-blink-delay))
805 (delete-char 1))) 816 (delete-char 1)))
806 (delete-char -1)) 817 (delete-char -1))
807 (save-excursion 818 (save-excursion
@@ -814,6 +825,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead."
814 (if (= (length p) 3) (cdr p) p)) 825 (if (= (length p) 3) (cdr p) p))
815 insert-pair-alist)) 826 insert-pair-alist))
816 (error "Not before matching pair")) 827 (error "Not before matching pair"))
828 (when (and (numberp delete-pair-blink-delay)
829 (> delete-pair-blink-delay 0))
830 (sit-for delete-pair-blink-delay))
817 (delete-char -1))) 831 (delete-char -1)))
818 (delete-char 1)))) 832 (delete-char 1))))
819 833
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 9264a811ced..0ee2e58d528 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2129,8 +2129,7 @@ Otherwise return nil."
2129 (when str 2129 (when str
2130 (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) 2130 (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
2131 (setq str (substring str (match-end 0)))) 2131 (setq str (substring str (match-end 0))))
2132 (ignore-errors 2132 (if (version-to-list str) str)))
2133 (if (version-to-list str) str))))
2134 2133
2135(declare-function lm-homepage "lisp-mnt" (&optional file)) 2134(declare-function lm-homepage "lisp-mnt" (&optional file))
2136 2135
@@ -2731,7 +2730,9 @@ either a full name or nil, and EMAIL is a valid email address."
2731 (define-key map "(" #'package-menu-toggle-hiding) 2730 (define-key map "(" #'package-menu-toggle-hiding)
2732 (define-key map (kbd "/ /") 'package-menu-clear-filter) 2731 (define-key map (kbd "/ /") 'package-menu-clear-filter)
2733 (define-key map (kbd "/ a") 'package-menu-filter-by-archive) 2732 (define-key map (kbd "/ a") 'package-menu-filter-by-archive)
2733 (define-key map (kbd "/ d") 'package-menu-filter-by-description)
2734 (define-key map (kbd "/ k") 'package-menu-filter-by-keyword) 2734 (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
2735 (define-key map (kbd "/ N") 'package-menu-filter-by-name-or-description)
2735 (define-key map (kbd "/ n") 'package-menu-filter-by-name) 2736 (define-key map (kbd "/ n") 'package-menu-filter-by-name)
2736 (define-key map (kbd "/ s") 'package-menu-filter-by-status) 2737 (define-key map (kbd "/ s") 'package-menu-filter-by-status)
2737 (define-key map (kbd "/ v") 'package-menu-filter-by-version) 2738 (define-key map (kbd "/ v") 'package-menu-filter-by-version)
@@ -2763,8 +2764,11 @@ either a full name or nil, and EMAIL is a valid email address."
2763 "--" 2764 "--"
2764 ("Filter Packages" 2765 ("Filter Packages"
2765 ["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"] 2766 ["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"]
2767 ["Filter by Description" package-menu-filter-by-description :help "Filter packages by description"]
2766 ["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"] 2768 ["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"]
2767 ["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"] 2769 ["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"]
2770 ["Filter by Name or Description" package-menu-filter-by-name-or-description
2771 :help "Filter packages by name or description"]
2768 ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"] 2772 ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"]
2769 ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"] 2773 ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"]
2770 ["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"] 2774 ["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"]
@@ -3792,6 +3796,23 @@ packages."
3792 (string-join archive ",") 3796 (string-join archive ",")
3793 archive))))) 3797 archive)))))
3794 3798
3799(defun package-menu-filter-by-description (description)
3800 "Filter the \"*Packages*\" buffer by DESCRIPTION regexp.
3801Display only packages with a description that matches regexp
3802DESCRIPTION.
3803
3804When called interactively, prompt for DESCRIPTION.
3805
3806If DESCRIPTION is nil or the empty string, show all packages."
3807 (interactive (list (read-regexp "Filter by description (regexp)")))
3808 (package--ensure-package-menu-mode)
3809 (if (or (not description) (string-empty-p description))
3810 (package-menu--generate t t)
3811 (package-menu--filter-by (lambda (pkg-desc)
3812 (string-match description
3813 (package-desc-summary pkg-desc)))
3814 (format "desc:%s" description))))
3815
3795(defun package-menu-filter-by-keyword (keyword) 3816(defun package-menu-filter-by-keyword (keyword)
3796 "Filter the \"*Packages*\" buffer by KEYWORD. 3817 "Filter the \"*Packages*\" buffer by KEYWORD.
3797Display only packages with specified KEYWORD. 3818Display only packages with specified KEYWORD.
@@ -3817,6 +3838,27 @@ packages."
3817(define-obsolete-function-alias 3838(define-obsolete-function-alias
3818 'package-menu-filter #'package-menu-filter-by-keyword "27.1") 3839 'package-menu-filter #'package-menu-filter-by-keyword "27.1")
3819 3840
3841(defun package-menu-filter-by-name-or-description (name-or-description)
3842 "Filter the \"*Packages*\" buffer by NAME-OR-DESCRIPTION regexp.
3843Display only packages with a name-or-description that matches regexp
3844NAME-OR-DESCRIPTION.
3845
3846When called interactively, prompt for NAME-OR-DESCRIPTION.
3847
3848If NAME-OR-DESCRIPTION is nil or the empty string, show all
3849packages."
3850 (interactive (list (read-regexp "Filter by name or description (regexp)")))
3851 (package--ensure-package-menu-mode)
3852 (if (or (not name-or-description) (string-empty-p name-or-description))
3853 (package-menu--generate t t)
3854 (package-menu--filter-by (lambda (pkg-desc)
3855 (or (string-match name-or-description
3856 (package-desc-summary pkg-desc))
3857 (string-match name-or-description
3858 (symbol-name
3859 (package-desc-name pkg-desc)))))
3860 (format "name-or-desc:%s" name-or-description))))
3861
3820(defun package-menu-filter-by-name (name) 3862(defun package-menu-filter-by-name (name)
3821 "Filter the \"*Packages*\" buffer by NAME regexp. 3863 "Filter the \"*Packages*\" buffer by NAME regexp.
3822Display only packages with name that matches regexp NAME. 3864Display only packages with name that matches regexp NAME.
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index eb2ee94be3b..458f803ffe3 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -94,27 +94,25 @@ after OUT-BUFFER-NAME."
94 ;; This function either decides not to display it at all 94 ;; This function either decides not to display it at all
95 ;; or displays it in the usual way. 95 ;; or displays it in the usual way.
96 (temp-buffer-show-function 96 (temp-buffer-show-function
97 (function 97 (lambda (buf)
98 (lambda (buf) 98 (with-current-buffer buf
99 (with-current-buffer buf 99 (goto-char (point-min))
100 (goto-char (point-min)) 100 (end-of-line 1)
101 (end-of-line 1) 101 (if (or (< (1+ (point)) (point-max))
102 (if (or (< (1+ (point)) (point-max)) 102 (>= (- (point) (point-min)) (frame-width)))
103 (>= (- (point) (point-min)) (frame-width))) 103 (let ((temp-buffer-show-function old-show-function)
104 (let ((temp-buffer-show-function old-show-function) 104 (old-selected (selected-window))
105 (old-selected (selected-window)) 105 (window (display-buffer buf)))
106 (window (display-buffer buf))) 106 (goto-char (point-min)) ; expected by some hooks ...
107 (goto-char (point-min)) ; expected by some hooks ... 107 (make-frame-visible (window-frame window))
108 (make-frame-visible (window-frame window)) 108 (unwind-protect
109 (unwind-protect 109 (progn
110 (progn 110 (select-window window)
111 (select-window window) 111 (run-hooks 'temp-buffer-show-hook))
112 (run-hooks 'temp-buffer-show-hook)) 112 (when (window-live-p old-selected)
113 (when (window-live-p old-selected) 113 (select-window old-selected))
114 (select-window old-selected)) 114 (message "See buffer %s." out-buffer-name)))
115 (message "See buffer %s." out-buffer-name))) 115 (message "%s" (buffer-substring (point-min) (point))))))))
116 (message "%s" (buffer-substring (point-min) (point)))
117 ))))))
118 (with-output-to-temp-buffer out-buffer-name 116 (with-output-to-temp-buffer out-buffer-name
119 (pp expression) 117 (pp expression)
120 (with-current-buffer standard-output 118 (with-current-buffer standard-output
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 11b28b72cf3..2e6e2b75d6a 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -163,18 +163,15 @@ useful information:
163 ;; let's find the special tags and remove them from the working 163 ;; let's find the special tags and remove them from the working
164 ;; frame. note that only the last special tag is used. 164 ;; frame. note that only the last special tag is used.
165 (mapc 165 (mapc
166 (function 166 (lambda (entry)
167 (lambda (entry) 167 (let ((pred (car entry))
168 (let ((pred (car entry)) 168 (func (car (cdr entry))))
169 (func (car (cdr entry)))) 169 (cond
170 (cond 170 ((eq pred 'begin) (setq begin-tag func))
171 ((eq pred 'begin) (setq begin-tag func)) 171 ((eq pred 'end) (setq end-tag func))
172 ((eq pred 'end) (setq end-tag func)) 172 ((eq pred 'every) (setq every-tag func))
173 ((eq pred 'every) (setq every-tag func)) 173 (t
174 (t 174 (setq working-frame (append working-frame (list entry)))))))
175 (setq working-frame (append working-frame (list entry))))
176 ) ; end-cond
177 )))
178 frame) ; end-mapcar 175 frame) ; end-mapcar
179 176
180 ;; execute the begin entry 177 ;; execute the begin entry
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index e70b44658d5..b29ad7702ef 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -2161,8 +2161,7 @@ Argument KEY is the name of a key. It can be a standard key or a function key.
2161Argument BINDING is the Emacs function to be bound to <KEY>." 2161Argument BINDING is the Emacs function to be bound to <KEY>."
2162 (define-key edt-user-global-map key binding)) 2162 (define-key edt-user-global-map key binding))
2163 2163
2164;; For backward compatibility to existing edt-user.el files. 2164(define-obsolete-function-alias 'edt-bind-standard-key #'edt-bind-key "28.1")
2165(fset 'edt-bind-standard-key (symbol-function 'edt-bind-key))
2166 2165
2167(defun edt-bind-gold-key (key gold-binding) 2166(defun edt-bind-gold-key (key gold-binding)
2168 "Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator. 2167 "Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator.
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 83e45e1cd0c..9da493d74ba 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -249,15 +249,7 @@ Otherwise return the normal value."
249 (goto-char cur-pos) 249 (goto-char cur-pos)
250 result)) 250 result))
251 251
252;; Emacs used to count each multibyte character as several positions in the buffer,
253;; so we had to use Emacs's chars-in-region to count characters. Since 20.3,
254;; Emacs counts multibyte characters as 1 position. XEmacs has always been
255;; counting each char as just one pos. So, now we can simply subtract beg from
256;; end to determine the number of characters in a region.
257(defun viper-chars-in-region (beg end &optional preserve-sign) 252(defun viper-chars-in-region (beg end &optional preserve-sign)
258 ;;(let ((count (abs (if (fboundp 'chars-in-region)
259 ;; (chars-in-region beg end)
260 ;; (- end beg)))))
261 (let ((count (abs (- end beg)))) 253 (let ((count (abs (- end beg))))
262 (if (and (< end beg) preserve-sign) 254 (if (and (< end beg) preserve-sign)
263 (- count) 255 (- count)
diff --git a/lisp/epa.el b/lisp/epa.el
index 25e055c201f..d6c7946c939 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -24,7 +24,6 @@
24;;; Dependencies 24;;; Dependencies
25 25
26(require 'epg) 26(require 'epg)
27(require 'font-lock)
28(eval-when-compile (require 'subr-x)) 27(eval-when-compile (require 'subr-x))
29(require 'derived) 28(require 'derived)
30 29
@@ -1071,9 +1070,7 @@ If no one is selected, default secret key is used. "
1071 (list 'epa-coding-system-used 1070 (list 'epa-coding-system-used
1072 epa-last-coding-system-specified 1071 epa-last-coding-system-specified
1073 'front-sticky nil 1072 'front-sticky nil
1074 'rear-nonsticky t 1073 'rear-nonsticky t)))))
1075 'start-open t
1076 'end-open t)))))
1077 1074
1078(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1") 1075(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1")
1079 1076
@@ -1148,9 +1145,7 @@ If no one is selected, symmetric encryption will be performed. ")
1148 (list 'epa-coding-system-used 1145 (list 'epa-coding-system-used
1149 epa-last-coding-system-specified 1146 epa-last-coding-system-specified
1150 'front-sticky nil 1147 'front-sticky nil
1151 'rear-nonsticky t 1148 'rear-nonsticky t)))))
1152 'start-open t
1153 'end-open t)))))
1154 1149
1155;;;; Key Management 1150;;;; Key Management
1156 1151
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index de0a16ea3f0..7eddb5f60f1 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -414,8 +414,7 @@ You can save every individual message by putting this function on
414 (or buffer (setq buffer (current-buffer))) 414 (or buffer (setq buffer (current-buffer)))
415 (when (erc-logging-enabled buffer) 415 (when (erc-logging-enabled buffer)
416 (let ((file (erc-current-logfile buffer)) 416 (let ((file (erc-current-logfile buffer))
417 (coding-system erc-log-file-coding-system) 417 (coding-system erc-log-file-coding-system))
418 (inhibit-clash-detection t)) ; needed for XEmacs
419 (save-excursion 418 (save-excursion
420 (with-current-buffer buffer 419 (with-current-buffer buffer
421 (save-restriction 420 (save-restriction
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e35ae0cfd87..94ea0de7ee7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -58,7 +58,6 @@
58(load "erc-loaddefs" nil t) 58(load "erc-loaddefs" nil t)
59 59
60(require 'cl-lib) 60(require 'cl-lib)
61(require 'font-lock)
62(require 'format-spec) 61(require 'format-spec)
63(require 'pp) 62(require 'pp)
64(require 'thingatpt) 63(require 'thingatpt)
@@ -4015,8 +4014,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
4015 ;; of the prompt, but stuff typed in front of the prompt 4014 ;; of the prompt, but stuff typed in front of the prompt
4016 ;; shall remain part of the prompt. 4015 ;; shall remain part of the prompt.
4017 (setq prompt (propertize prompt 4016 (setq prompt (propertize prompt
4018 'start-open t ; XEmacs 4017 'rear-nonsticky t
4019 'rear-nonsticky t ; Emacs
4020 'erc-prompt t 4018 'erc-prompt t
4021 'field t 4019 'field t
4022 'front-sticky t 4020 'front-sticky t
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index 6cfc89cce62..e54eab50fc9 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -90,11 +90,10 @@ or `eshell-printn' for display."
90 (car args)) 90 (car args))
91 (t 91 (t
92 (mapcar 92 (mapcar
93 (function 93 (lambda (arg)
94 (lambda (arg) 94 (if (stringp arg)
95 (if (stringp arg) 95 (set-text-properties 0 (length arg) nil arg))
96 (set-text-properties 0 (length arg) nil arg)) 96 arg)
97 arg))
98 args))))) 97 args)))))
99 (if output-newline 98 (if output-newline
100 (cond 99 (cond
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 8a444c91001..53a0cda354e 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -210,9 +210,8 @@ to writing a completion function."
210 :group 'eshell-cmpl) 210 :group 'eshell-cmpl)
211 211
212(defcustom eshell-command-completion-function 212(defcustom eshell-command-completion-function
213 (function 213 (lambda ()
214 (lambda () 214 (pcomplete-here (eshell-complete-commands-list)))
215 (pcomplete-here (eshell-complete-commands-list))))
216 (eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function) 215 (eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function)
217 :type (get 'pcomplete-command-completion-function 'custom-type) 216 :type (get 'pcomplete-command-completion-function 'custom-type)
218 :group 'eshell-cmpl) 217 :group 'eshell-cmpl)
@@ -224,12 +223,11 @@ to writing a completion function."
224 :group 'eshell-cmpl) 223 :group 'eshell-cmpl)
225 224
226(defcustom eshell-default-completion-function 225(defcustom eshell-default-completion-function
227 (function 226 (lambda ()
228 (lambda () 227 (while (pcomplete-here
229 (while (pcomplete-here 228 (pcomplete-dirs-or-entries
230 (pcomplete-dirs-or-entries 229 (cdr (assoc (funcall eshell-cmpl-command-name-function)
231 (cdr (assoc (funcall eshell-cmpl-command-name-function) 230 eshell-command-completions-alist))))))
232 eshell-command-completions-alist)))))))
233 (eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function) 231 (eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function)
234 :type (get 'pcomplete-default-completion-function 'custom-type) 232 :type (get 'pcomplete-default-completion-function 'custom-type)
235 :group 'eshell-cmpl) 233 :group 'eshell-cmpl)
@@ -308,10 +306,9 @@ to writing a completion function."
308 ;; load-hooks for any other extension modules have been run, which 306 ;; load-hooks for any other extension modules have been run, which
309 ;; is true at the time `eshell-mode-hook' is run 307 ;; is true at the time `eshell-mode-hook' is run
310 (add-hook 'eshell-mode-hook 308 (add-hook 'eshell-mode-hook
311 (function 309 (lambda ()
312 (lambda () 310 (set (make-local-variable 'comint-file-name-quote-list)
313 (set (make-local-variable 'comint-file-name-quote-list) 311 eshell-special-chars-outside-quoting))
314 eshell-special-chars-outside-quoting)))
315 nil t) 312 nil t)
316 (add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t) 313 (add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t)
317 (add-hook 'completion-at-point-functions 314 (add-hook 'completion-at-point-functions
@@ -391,19 +388,18 @@ to writing a completion function."
391 (nconc args (list "")) 388 (nconc args (list ""))
392 (nconc posns (list (point)))) 389 (nconc posns (list (point))))
393 (cons (mapcar 390 (cons (mapcar
394 (function 391 (lambda (arg)
395 (lambda (arg) 392 (let ((val
396 (let ((val 393 (if (listp arg)
397 (if (listp arg) 394 (let ((result
398 (let ((result 395 (eshell-do-eval
399 (eshell-do-eval 396 (list 'eshell-commands arg) t)))
400 (list 'eshell-commands arg) t))) 397 (cl-assert (eq (car result) 'quote))
401 (cl-assert (eq (car result) 'quote)) 398 (cadr result))
402 (cadr result)) 399 arg)))
403 arg))) 400 (if (numberp val)
404 (if (numberp val) 401 (setq val (number-to-string val)))
405 (setq val (number-to-string val))) 402 (or val "")))
406 (or val ""))))
407 args) 403 args)
408 posns))) 404 posns)))
409 405
@@ -454,9 +450,8 @@ to writing a completion function."
454 (eshell-alias-completions filename)) 450 (eshell-alias-completions filename))
455 (eshell-winnow-list 451 (eshell-winnow-list
456 (mapcar 452 (mapcar
457 (function 453 (lambda (name)
458 (lambda (name) 454 (substring name 7))
459 (substring name 7)))
460 (all-completions (concat "eshell/" filename) 455 (all-completions (concat "eshell/" filename)
461 obarray #'functionp)) 456 obarray #'functionp))
462 nil '(eshell-find-alias-function)) 457 nil '(eshell-find-alias-function))
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 51df6fa1d52..b4ed3794add 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -289,9 +289,8 @@ Thus, this does not include the current directory.")
289 (eshell-read-user-names) 289 (eshell-read-user-names)
290 (pcomplete-uniquify-list 290 (pcomplete-uniquify-list
291 (mapcar 291 (mapcar
292 (function 292 (lambda (user)
293 (lambda (user) 293 (file-name-as-directory (cdr user)))
294 (file-name-as-directory (cdr user))))
295 eshell-user-names))))))) 294 eshell-user-names)))))))
296 295
297(defun eshell/pwd (&rest _args) 296(defun eshell/pwd (&rest _args)
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index bdc21c916c6..c27e4503767 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -79,9 +79,8 @@
79 79
80(defcustom eshell-hist-unload-hook 80(defcustom eshell-hist-unload-hook
81 (list 81 (list
82 (function 82 (lambda ()
83 (lambda () 83 (remove-hook 'kill-emacs-hook 'eshell-save-some-history)))
84 (remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
85 "A hook that gets run when `eshell-hist' is unloaded." 84 "A hook that gets run when `eshell-hist' is unloaded."
86 :type 'hook) 85 :type 'hook)
87 86
@@ -250,16 +249,14 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
250 (set (make-local-variable 'search-invisible) t) 249 (set (make-local-variable 'search-invisible) t)
251 (set (make-local-variable 'search-exit-option) t) 250 (set (make-local-variable 'search-exit-option) t)
252 (add-hook 'isearch-mode-hook 251 (add-hook 'isearch-mode-hook
253 (function 252 (lambda ()
254 (lambda () 253 (if (>= (point) eshell-last-output-end)
255 (if (>= (point) eshell-last-output-end) 254 (setq overriding-terminal-local-map
256 (setq overriding-terminal-local-map 255 eshell-isearch-map)))
257 eshell-isearch-map))))
258 nil t) 256 nil t)
259 (add-hook 'isearch-mode-end-hook 257 (add-hook 'isearch-mode-end-hook
260 (function 258 (lambda ()
261 (lambda () 259 (setq overriding-terminal-local-map nil))
262 (setq overriding-terminal-local-map nil)))
263 nil t)) 260 nil t))
264 (eshell-hist-mode)) 261 (eshell-hist-mode))
265 262
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index c1a022ee521..6b306f77874 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -270,8 +270,7 @@ instead."
270 eshell-current-subjob-p 270 eshell-current-subjob-p
271 font-lock-mode) 271 font-lock-mode)
272 ;; use the fancy highlighting in `eshell-ls' rather than font-lock 272 ;; use the fancy highlighting in `eshell-ls' rather than font-lock
273 (when (and eshell-ls-use-colors 273 (when eshell-ls-use-colors
274 (featurep 'font-lock))
275 (font-lock-mode -1) 274 (font-lock-mode -1)
276 (setq font-lock-defaults nil) 275 (setq font-lock-defaults nil)
277 (if (boundp 'font-lock-buffers) 276 (if (boundp 'font-lock-buffers)
@@ -631,38 +630,37 @@ In Eshell's implementation of ls, ENTRIES is always reversed."
631 (if (eq sort-method 'unsorted) 630 (if (eq sort-method 'unsorted)
632 (nreverse entries) 631 (nreverse entries)
633 (sort entries 632 (sort entries
634 (function 633 (lambda (l r)
635 (lambda (l r) 634 (let ((result
636 (let ((result 635 (cond
637 (cond 636 ((eq sort-method 'by-atime)
638 ((eq sort-method 'by-atime) 637 (eshell-ls-compare-entries l r 4 'time-less-p))
639 (eshell-ls-compare-entries l r 4 'time-less-p)) 638 ((eq sort-method 'by-mtime)
640 ((eq sort-method 'by-mtime) 639 (eshell-ls-compare-entries l r 5 'time-less-p))
641 (eshell-ls-compare-entries l r 5 'time-less-p)) 640 ((eq sort-method 'by-ctime)
642 ((eq sort-method 'by-ctime) 641 (eshell-ls-compare-entries l r 6 'time-less-p))
643 (eshell-ls-compare-entries l r 6 'time-less-p)) 642 ((eq sort-method 'by-size)
644 ((eq sort-method 'by-size) 643 (eshell-ls-compare-entries l r 7 '<))
645 (eshell-ls-compare-entries l r 7 '<)) 644 ((eq sort-method 'by-extension)
646 ((eq sort-method 'by-extension) 645 (let ((lx (file-name-extension
647 (let ((lx (file-name-extension 646 (directory-file-name (car l))))
648 (directory-file-name (car l)))) 647 (rx (file-name-extension
649 (rx (file-name-extension 648 (directory-file-name (car r)))))
650 (directory-file-name (car r))))) 649 (cond
651 (cond 650 ((or (and (not lx) (not rx))
652 ((or (and (not lx) (not rx)) 651 (equal lx rx))
653 (equal lx rx)) 652 (string-lessp (directory-file-name (car l))
654 (string-lessp (directory-file-name (car l)) 653 (directory-file-name (car r))))
655 (directory-file-name (car r)))) 654 ((not lx) t)
656 ((not lx) t) 655 ((not rx) nil)
657 ((not rx) nil) 656 (t
658 (t 657 (string-lessp lx rx)))))
659 (string-lessp lx rx))))) 658 (t
660 (t 659 (string-lessp (directory-file-name (car l))
661 (string-lessp (directory-file-name (car l)) 660 (directory-file-name (car r)))))))
662 (directory-file-name (car r))))))) 661 (if reverse-list
663 (if reverse-list 662 (not result)
664 (not result) 663 result))))))
665 result)))))))
666 664
667(defun eshell-ls-files (files &optional size-width copy-fileinfo) 665(defun eshell-ls-files (files &optional size-width copy-fileinfo)
668 "Output a list of FILES. 666 "Output a list of FILES.
@@ -799,9 +797,8 @@ to use, and each member of which is the width of that column
799 (width 0) 797 (width 0)
800 (widths 798 (widths
801 (mapcar 799 (mapcar
802 (function 800 (lambda (file)
803 (lambda (file) 801 (+ 2 (length (car file))))
804 (+ 2 (length (car file)))))
805 files)) 802 files))
806 ;; must account for the added space... 803 ;; must account for the added space...
807 (max-width (+ (window-width) 2)) 804 (max-width (+ (window-width) 2))
@@ -846,9 +843,8 @@ to use, and each member of which is the width of that column
846 (width 0) 843 (width 0)
847 (widths 844 (widths
848 (mapcar 845 (mapcar
849 (function 846 (lambda (file)
850 (lambda (file) 847 (+ 2 (length (car file))))
851 (+ 2 (length (car file)))))
852 files)) 848 files))
853 (max-width (+ (window-width) 2)) 849 (max-width (+ (window-width) 2))
854 col-widths 850 col-widths
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 59139da10db..7b9503917c4 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -116,10 +116,9 @@ The format of each entry is
116(defcustom eshell-modifier-alist 116(defcustom eshell-modifier-alist
117 '((?E . #'(lambda (lst) 117 '((?E . #'(lambda (lst)
118 (mapcar 118 (mapcar
119 (function 119 (lambda (str)
120 (lambda (str) 120 (eshell-stringify
121 (eshell-stringify 121 (car (eshell-parse-argument str))))
122 (car (eshell-parse-argument str)))))
123 lst))) 122 lst)))
124 (?L . #'(lambda (lst) (mapcar 'downcase lst))) 123 (?L . #'(lambda (lst) (mapcar 'downcase lst)))
125 (?U . #'(lambda (lst) (mapcar 'upcase lst))) 124 (?U . #'(lambda (lst) (mapcar 'upcase lst)))
@@ -240,16 +239,14 @@ EXAMPLES:
240(defun eshell-display-predicate-help () 239(defun eshell-display-predicate-help ()
241 (interactive) 240 (interactive)
242 (with-electric-help 241 (with-electric-help
243 (function 242 (lambda ()
244 (lambda () 243 (insert eshell-predicate-help-string))))
245 (insert eshell-predicate-help-string)))))
246 244
247(defun eshell-display-modifier-help () 245(defun eshell-display-modifier-help ()
248 (interactive) 246 (interactive)
249 (with-electric-help 247 (with-electric-help
250 (function 248 (lambda ()
251 (lambda () 249 (insert eshell-modifier-help-string))))
252 (insert eshell-modifier-help-string)))))
253 250
254(define-minor-mode eshell-pred-mode 251(define-minor-mode eshell-pred-mode
255 "Minor mode for the eshell-pred module. 252 "Minor mode for the eshell-pred module.
@@ -544,20 +541,20 @@ that `ls -l' will show in the first column of its display."
544 (if repeat 541 (if repeat
545 `(lambda (lst) 542 `(lambda (lst)
546 (mapcar 543 (mapcar
547 (function 544 (lambda (str)
548 (lambda (str) 545 (let ((i 0))
549 (let ((i 0)) 546 (while (setq i (string-match ,match str i))
550 (while (setq i (string-match ,match str i)) 547 (setq str (replace-match ,replace t nil str))))
551 (setq str (replace-match ,replace t nil str)))) 548 str)
552 str)) lst)) 549 lst))
553 `(lambda (lst) 550 `(lambda (lst)
554 (mapcar 551 (mapcar
555 (function 552 (lambda (str)
556 (lambda (str) 553 (if (string-match ,match str)
557 (if (string-match ,match str) 554 (setq str (replace-match ,replace t nil str))
558 (setq str (replace-match ,replace t nil str)) 555 (error (concat str ": substitution failed")))
559 (error (concat str ": substitution failed"))) 556 str)
560 str)) lst))))) 557 lst)))))
561 558
562(defun eshell-include-members (&optional invert-p) 559(defun eshell-include-members (&optional invert-p)
563 "Include only lisp members matching a regexp." 560 "Include only lisp members matching a regexp."
@@ -598,9 +595,8 @@ that `ls -l' will show in the first column of its display."
598 (goto-char (1+ end))) 595 (goto-char (1+ end)))
599 `(lambda (lst) 596 `(lambda (lst)
600 (mapcar 597 (mapcar
601 (function 598 (lambda (str)
602 (lambda (str) 599 (split-string str ,sep)) lst))))
603 (split-string str ,sep))) lst))))
604 600
605(provide 'em-pred) 601(provide 'em-pred)
606 602
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 9ae5ae12816..dcee1e7a981 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -48,10 +48,9 @@ as is common with most shells."
48(autoload 'eshell/pwd "em-dirs") 48(autoload 'eshell/pwd "em-dirs")
49 49
50(defcustom eshell-prompt-function 50(defcustom eshell-prompt-function
51 (function 51 (lambda ()
52 (lambda () 52 (concat (abbreviate-file-name (eshell/pwd))
53 (concat (abbreviate-file-name (eshell/pwd)) 53 (if (= (user-uid) 0) " # " " $ ")))
54 (if (= (user-uid) 0) " # " " $ "))))
55 "A function that returns the Eshell prompt string. 54 "A function that returns the Eshell prompt string.
56Make sure to update `eshell-prompt-regexp' so that it will match your 55Make sure to update `eshell-prompt-regexp' so that it will match your
57prompt." 56prompt."
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index f173c8db9c1..a28bb1d6415 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -94,10 +94,9 @@ it to get a real sense of how it works."
94 94
95(defcustom eshell-smart-unload-hook 95(defcustom eshell-smart-unload-hook
96 (list 96 (list
97 (function 97 (lambda ()
98 (lambda () 98 (remove-hook 'window-configuration-change-hook
99 (remove-hook 'window-configuration-change-hook 99 'eshell-refresh-windows)))
100 'eshell-refresh-windows))))
101 "A hook that gets run when `eshell-smart' is unloaded." 100 "A hook that gets run when `eshell-smart' is unloaded."
102 :type 'hook 101 :type 'hook
103 :group 'eshell-smart) 102 :group 'eshell-smart)
@@ -186,9 +185,8 @@ The options are `begin', `after' or `end'."
186 185
187 (make-local-variable 'eshell-smart-command-done) 186 (make-local-variable 'eshell-smart-command-done)
188 (add-hook 'eshell-post-command-hook 187 (add-hook 'eshell-post-command-hook
189 (function 188 (lambda ()
190 (lambda () 189 (setq eshell-smart-command-done t))
191 (setq eshell-smart-command-done t)))
192 t t) 190 t t)
193 191
194 (unless (eq eshell-review-quick-commands t) 192 (unless (eq eshell-review-quick-commands t)
@@ -208,13 +206,12 @@ The options are `begin', `after' or `end'."
208 "Refresh all visible Eshell buffers." 206 "Refresh all visible Eshell buffers."
209 (let (affected) 207 (let (affected)
210 (walk-windows 208 (walk-windows
211 (function 209 (lambda (wind)
212 (lambda (wind) 210 (with-current-buffer (window-buffer wind)
213 (with-current-buffer (window-buffer wind) 211 (if eshell-mode
214 (if eshell-mode 212 (let (window-scroll-functions) ;;FIXME: Why?
215 (let (window-scroll-functions) ;;FIXME: Why? 213 (eshell-smart-scroll-window wind (window-start))
216 (eshell-smart-scroll-window wind (window-start)) 214 (setq affected t)))))
217 (setq affected t))))))
218 0 frame) 215 0 frame)
219 (if affected 216 (if affected
220 (let (window-scroll-functions) ;;FIXME: Why? 217 (let (window-scroll-functions) ;;FIXME: Why?
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 937b8bfa391..18818648bc4 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -419,9 +419,8 @@ Remove the DIRECTORY(ies), if they are empty.")
419 (apply 'eshell-shuffle-files 419 (apply 'eshell-shuffle-files
420 command action 420 command action
421 (mapcar 421 (mapcar
422 (function 422 (lambda (file)
423 (lambda (file) 423 (concat source "/" file))
424 (concat source "/" file)))
425 (directory-files source)) 424 (directory-files source))
426 target func t args) 425 target func t args)
427 (when (eq func 'rename-file) 426 (when (eq func 'rename-file)
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index e7b07b4208d..aefda647689 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -85,51 +85,48 @@ If POS is nil, the location of point is checked."
85 'eshell-parse-special-reference 85 'eshell-parse-special-reference
86 86
87 ;; numbers convert to numbers if they stand alone 87 ;; numbers convert to numbers if they stand alone
88 (function 88 (lambda ()
89 (lambda () 89 (when (and (not eshell-current-argument)
90 (when (and (not eshell-current-argument) 90 (not eshell-current-quoted)
91 (not eshell-current-quoted) 91 (looking-at eshell-number-regexp)
92 (looking-at eshell-number-regexp) 92 (eshell-arg-delimiter (match-end 0)))
93 (eshell-arg-delimiter (match-end 0))) 93 (goto-char (match-end 0))
94 (goto-char (match-end 0)) 94 (let ((str (match-string 0)))
95 (let ((str (match-string 0))) 95 (if (> (length str) 0)
96 (if (> (length str) 0) 96 (add-text-properties 0 (length str) '(number t) str))
97 (add-text-properties 0 (length str) '(number t) str)) 97 str)))
98 str))))
99 98
100 ;; parse any non-special characters, based on the current context 99 ;; parse any non-special characters, based on the current context
101 (function 100 (lambda ()
102 (lambda () 101 (unless eshell-inside-quote-regexp
103 (unless eshell-inside-quote-regexp 102 (setq eshell-inside-quote-regexp
104 (setq eshell-inside-quote-regexp 103 (format "[^%s]+"
105 (format "[^%s]+" 104 (apply 'string eshell-special-chars-inside-quoting))))
106 (apply 'string eshell-special-chars-inside-quoting)))) 105 (unless eshell-outside-quote-regexp
107 (unless eshell-outside-quote-regexp 106 (setq eshell-outside-quote-regexp
108 (setq eshell-outside-quote-regexp 107 (format "[^%s]+"
109 (format "[^%s]+" 108 (apply 'string eshell-special-chars-outside-quoting))))
110 (apply 'string eshell-special-chars-outside-quoting)))) 109 (when (looking-at (if eshell-current-quoted
111 (when (looking-at (if eshell-current-quoted 110 eshell-inside-quote-regexp
112 eshell-inside-quote-regexp 111 eshell-outside-quote-regexp))
113 eshell-outside-quote-regexp)) 112 (goto-char (match-end 0))
114 (goto-char (match-end 0)) 113 (let ((str (match-string 0)))
115 (let ((str (match-string 0))) 114 (if str
116 (if str 115 (set-text-properties 0 (length str) nil str))
117 (set-text-properties 0 (length str) nil str)) 116 str)))
118 str))))
119 117
120 ;; whitespace or a comment is an argument delimiter 118 ;; whitespace or a comment is an argument delimiter
121 (function 119 (lambda ()
122 (lambda () 120 (let (comment-p)
123 (let (comment-p) 121 (when (or (looking-at "[ \t]+")
124 (when (or (looking-at "[ \t]+") 122 (and (not eshell-current-argument)
125 (and (not eshell-current-argument) 123 (looking-at "#\\([^<'].*\\|$\\)")
126 (looking-at "#\\([^<'].*\\|$\\)") 124 (setq comment-p t)))
127 (setq comment-p t))) 125 (if comment-p
128 (if comment-p 126 (add-text-properties (match-beginning 0) (match-end 0)
129 (add-text-properties (match-beginning 0) (match-end 0) 127 '(comment t)))
130 '(comment t))) 128 (goto-char (match-end 0))
131 (goto-char (match-end 0)) 129 (eshell-finish-arg))))
132 (eshell-finish-arg)))))
133 130
134 ;; parse backslash and the character after 131 ;; parse backslash and the character after
135 'eshell-parse-backslash 132 'eshell-parse-backslash
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index e0348ba5013..68b34837a23 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -304,10 +304,9 @@ otherwise t.")
304 ;; situation can occur, for example, if a Lisp function results in 304 ;; situation can occur, for example, if a Lisp function results in
305 ;; `debug' being called, and the user then types \\[top-level] 305 ;; `debug' being called, and the user then types \\[top-level]
306 (add-hook 'eshell-post-command-hook 306 (add-hook 'eshell-post-command-hook
307 (function 307 (lambda ()
308 (lambda () 308 (setq eshell-current-command nil
309 (setq eshell-current-command nil 309 eshell-last-async-proc nil))
310 eshell-last-async-proc nil)))
311 nil t) 310 nil t)
312 311
313 (add-hook 'eshell-parse-argument-hook 312 (add-hook 'eshell-parse-argument-hook
@@ -355,18 +354,17 @@ hooks should be run before and after the command."
355 args)) 354 args))
356 (commands 355 (commands
357 (mapcar 356 (mapcar
358 (function 357 (lambda (cmd)
359 (lambda (cmd) 358 (setq cmd
360 (setq cmd 359 (if (or (not (car eshell--sep-terms))
361 (if (or (not (car eshell--sep-terms)) 360 (string= (car eshell--sep-terms) ";"))
362 (string= (car eshell--sep-terms) ";")) 361 (eshell-parse-pipeline cmd)
363 (eshell-parse-pipeline cmd) 362 `(eshell-do-subjob
364 `(eshell-do-subjob 363 (list ,(eshell-parse-pipeline cmd)))))
365 (list ,(eshell-parse-pipeline cmd))))) 364 (setq eshell--sep-terms (cdr eshell--sep-terms))
366 (setq eshell--sep-terms (cdr eshell--sep-terms)) 365 (if eshell-in-pipeline-p
367 (if eshell-in-pipeline-p 366 cmd
368 cmd 367 `(eshell-trap-errors ,cmd)))
369 `(eshell-trap-errors ,cmd))))
370 (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms)))) 368 (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
371 (let ((cmd commands)) 369 (let ((cmd commands))
372 (while cmd 370 (while cmd
@@ -920,7 +918,7 @@ at the moment are:
920 (funcall pred name)) 918 (funcall pred name))
921 (throw 'simple nil))) 919 (throw 'simple nil)))
922 t)) 920 t))
923 (fboundp (intern-soft (concat "eshell/" name)))))) 921 (eshell-find-alias-function name))))
924 922
925(defun eshell-eval-command (command &optional input) 923(defun eshell-eval-command (command &optional input)
926 "Evaluate the given COMMAND iteratively." 924 "Evaluate the given COMMAND iteratively."
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index e0e86348bd8..a80c2fc60d9 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -742,13 +742,12 @@ This function should be a pre-command hook."
742 (if (eq scroll 'this) 742 (if (eq scroll 'this)
743 (goto-char (point-max)) 743 (goto-char (point-max))
744 (walk-windows 744 (walk-windows
745 (function 745 (lambda (window)
746 (lambda (window) 746 (when (and (eq (window-buffer window) current)
747 (when (and (eq (window-buffer window) current) 747 (or (eq scroll t) (eq scroll 'all)))
748 (or (eq scroll t) (eq scroll 'all))) 748 (select-window window)
749 (select-window window) 749 (goto-char (point-max))
750 (goto-char (point-max)) 750 (select-window selected)))
751 (select-window selected))))
752 nil t)))))) 751 nil t))))))
753 752
754;;; jww (1999-10-23): this needs testing 753;;; jww (1999-10-23): this needs testing
@@ -764,29 +763,28 @@ This function should be in the list `eshell-output-filter-functions'."
764 (scroll eshell-scroll-to-bottom-on-output)) 763 (scroll eshell-scroll-to-bottom-on-output))
765 (unwind-protect 764 (unwind-protect
766 (walk-windows 765 (walk-windows
767 (function 766 (lambda (window)
768 (lambda (window) 767 (if (eq (window-buffer window) current)
769 (if (eq (window-buffer window) current) 768 (progn
770 (progn 769 (select-window window)
771 (select-window window) 770 (if (and (< (point) eshell-last-output-end)
772 (if (and (< (point) eshell-last-output-end) 771 (or (eq scroll t) (eq scroll 'all)
773 (or (eq scroll t) (eq scroll 'all) 772 ;; Maybe user wants point to jump to end.
774 ;; Maybe user wants point to jump to end. 773 (and (eq scroll 'this)
775 (and (eq scroll 'this) 774 (eq selected window))
776 (eq selected window)) 775 (and (eq scroll 'others)
777 (and (eq scroll 'others) 776 (not (eq selected window)))
778 (not (eq selected window))) 777 ;; If point was at the end, keep it at end.
779 ;; If point was at the end, keep it at end. 778 (>= (point) eshell-last-output-start)))
780 (>= (point) eshell-last-output-start))) 779 (goto-char eshell-last-output-end))
781 (goto-char eshell-last-output-end)) 780 ;; Optionally scroll so that the text
782 ;; Optionally scroll so that the text 781 ;; ends at the bottom of the window.
783 ;; ends at the bottom of the window. 782 (if (and eshell-scroll-show-maximum-output
784 (if (and eshell-scroll-show-maximum-output 783 (>= (point) eshell-last-output-end))
785 (>= (point) eshell-last-output-end)) 784 (save-excursion
786 (save-excursion 785 (goto-char (point-max))
787 (goto-char (point-max)) 786 (recenter -1)))
788 (recenter -1))) 787 (select-window selected))))
789 (select-window selected)))))
790 nil t) 788 nil t)
791 (set-buffer current)))) 789 (set-buffer current))))
792 790
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 45c4c9e13c0..10994ba3010 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -65,16 +65,15 @@ Changes will only take effect in future Eshell buffers."
65 :type (append 65 :type (append
66 (list 'set ':tag "Supported modules") 66 (list 'set ':tag "Supported modules")
67 (mapcar 67 (mapcar
68 (function 68 (lambda (modname)
69 (lambda (modname) 69 (let ((modsym (intern modname)))
70 (let ((modsym (intern modname))) 70 (list 'const
71 (list 'const 71 ':tag (format "%s -- %s" modname
72 ':tag (format "%s -- %s" modname 72 (get modsym 'custom-tag))
73 (get modsym 'custom-tag)) 73 ':link (caar (get modsym 'custom-links))
74 ':link (caar (get modsym 'custom-links)) 74 ':doc (concat "\n" (get modsym 'group-documentation)
75 ':doc (concat "\n" (get modsym 'group-documentation) 75 "\n ")
76 "\n ") 76 modsym)))
77 modsym))))
78 (sort (mapcar 'symbol-name 77 (sort (mapcar 'symbol-name
79 (eshell-subgroups 'eshell-module)) 78 (eshell-subgroups 'eshell-module))
80 'string-lessp)) 79 'string-lessp))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index db1b258c8f5..4a1001bf058 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -215,9 +215,8 @@ and signal names."
215The prompt will be set to PROMPT." 215The prompt will be set to PROMPT."
216 (completing-read prompt 216 (completing-read prompt
217 (mapcar 217 (mapcar
218 (function 218 (lambda (proc)
219 (lambda (proc) 219 (cons (process-name proc) t))
220 (cons (process-name proc) t)))
221 (process-list)) 220 (process-list))
222 nil t)) 221 nil t))
223 222
@@ -499,9 +498,8 @@ See the variable `eshell-kill-processes-on-exit'."
499 (let ((sigs eshell-kill-process-signals)) 498 (let ((sigs eshell-kill-process-signals))
500 (while sigs 499 (while sigs
501 (eshell-process-interact 500 (eshell-process-interact
502 (function 501 (lambda (proc)
503 (lambda (proc) 502 (signal-process (process-id proc) (car sigs))) t query)
504 (signal-process (process-id proc) (car sigs)))) t query)
505 (setq query nil) 503 (setq query nil)
506 (if (not eshell-process-list) 504 (if (not eshell-process-list)
507 (setq sigs nil) 505 (setq sigs nil)
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 7388279f157..f91fb89412e 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -382,9 +382,8 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
382 382
383(defun eshell-envvar-names (&optional environment) 383(defun eshell-envvar-names (&optional environment)
384 "Return a list of currently visible environment variable names." 384 "Return a list of currently visible environment variable names."
385 (mapcar (function 385 (mapcar (lambda (x)
386 (lambda (x) 386 (substring x 0 (string-match "=" x)))
387 (substring x 0 (string-match "=" x))))
388 (or environment process-environment))) 387 (or environment process-environment)))
389 388
390(defun eshell-environment-variables () 389(defun eshell-environment-variables ()
@@ -618,14 +617,13 @@ For example, to retrieve the second element of a user's record in
618 (sort 617 (sort
619 (append 618 (append
620 (mapcar 619 (mapcar
621 (function 620 (lambda (varname)
622 (lambda (varname) 621 (let ((value (eshell-get-variable varname)))
623 (let ((value (eshell-get-variable varname))) 622 (if (and value
624 (if (and value 623 (stringp value)
625 (stringp value) 624 (file-directory-p value))
626 (file-directory-p value)) 625 (concat varname "/")
627 (concat varname "/") 626 varname)))
628 varname))))
629 (eshell-envvar-names (eshell-environment-variables))) 627 (eshell-envvar-names (eshell-environment-variables)))
630 (all-completions argname obarray 'boundp) 628 (all-completions argname obarray 'boundp)
631 completions) 629 completions)
diff --git a/lisp/ffap.el b/lisp/ffap.el
index bf035886006..d4bddd0574f 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -301,15 +301,14 @@ disable ffap most of the time."
301 :version "20.3") 301 :version "20.3")
302 302
303 303
304;;; Compatibility: 304;;; Obsolete:
305;;
306;; This version of ffap supports only the Emacs it is distributed in.
307;; See the ftp site for a more general version. The following
308;; functions are necessary "leftovers" from the more general version.
309 305
310(defun ffap-mouse-event () ; current mouse event, or nil 306(defun ffap-mouse-event () ; current mouse event, or nil
307 (declare (obsolete nil "28.1"))
311 (and (listp last-nonmenu-event) last-nonmenu-event)) 308 (and (listp last-nonmenu-event) last-nonmenu-event))
309
312(defun ffap-event-buffer (event) 310(defun ffap-event-buffer (event)
311 (declare (obsolete nil "28.1"))
313 (window-buffer (car (event-start event)))) 312 (window-buffer (car (event-start event))))
314 313
315 314
@@ -690,14 +689,13 @@ Optional DEPTH limits search depth."
690 (setq depth (1- depth)) 689 (setq depth (1- depth))
691 (cons dir 690 (cons dir
692 (and (not (eq depth -1)) 691 (and (not (eq depth -1))
693 (apply 'nconc 692 (apply #'nconc
694 (mapcar 693 (mapcar
695 (function 694 (lambda (d)
696 (lambda (d) 695 (cond
697 (cond 696 ((not (file-directory-p d)) nil)
698 ((not (file-directory-p d)) nil) 697 ((file-symlink-p d) (list d))
699 ((file-symlink-p d) (list d)) 698 (t (ffap-all-subdirs-loop d depth))))
700 (t (ffap-all-subdirs-loop d depth)))))
701 (directory-files dir t "\\`[^.]") 699 (directory-files dir t "\\`[^.]")
702 ))))) 700 )))))
703 701
@@ -710,13 +708,12 @@ Set to 0 to avoid all searching, or nil for no limit.")
710The subdirs begin with the original directory, and the depth of the 708The subdirs begin with the original directory, and the depth of the
711search is bounded by `ffap-kpathsea-depth'. This is intended to mimic 709search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
712kpathsea, a library used by some versions of TeX." 710kpathsea, a library used by some versions of TeX."
713 (apply 'nconc 711 (apply #'nconc
714 (mapcar 712 (mapcar
715 (function 713 (lambda (dir)
716 (lambda (dir) 714 (if (string-match "[^/]//\\'" dir)
717 (if (string-match "[^/]//\\'" dir) 715 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
718 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth) 716 (list dir)))
719 (list dir))))
720 path))) 717 path)))
721 718
722(defun ffap-locate-file (file nosuffix path) 719(defun ffap-locate-file (file nosuffix path)
@@ -1738,7 +1735,9 @@ Function CONT is applied to the entry chosen by the user."
1738 (let (choice) 1735 (let (choice)
1739 (cond 1736 (cond
1740 ;; Emacs mouse: 1737 ;; Emacs mouse:
1741 ((and (fboundp 'x-popup-menu) (ffap-mouse-event)) 1738 ((and (fboundp 'x-popup-menu)
1739 (listp last-nonmenu-event)
1740 last-nonmenu-event)
1742 (setq choice 1741 (setq choice
1743 (x-popup-menu 1742 (x-popup-menu
1744 t 1743 t
@@ -1793,8 +1792,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
1793 ;; Remove duplicates. 1792 ;; Remove duplicates.
1794 (setq ffap-menu-alist ; sort by item 1793 (setq ffap-menu-alist ; sort by item
1795 (sort ffap-menu-alist 1794 (sort ffap-menu-alist
1796 (function 1795 (lambda (a b) (string-lessp (car a) (car b)))))
1797 (lambda (a b) (string-lessp (car a) (car b))))))
1798 (let ((ptr ffap-menu-alist)) ; remove duplicates 1796 (let ((ptr ffap-menu-alist)) ; remove duplicates
1799 (while (cdr ptr) 1797 (while (cdr ptr)
1800 (if (equal (car (car ptr)) (car (car (cdr ptr)))) 1798 (if (equal (car (car ptr)) (car (car (cdr ptr))))
@@ -1802,8 +1800,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
1802 (setq ptr (cdr ptr))))) 1800 (setq ptr (cdr ptr)))))
1803 (setq ffap-menu-alist ; sort by position 1801 (setq ffap-menu-alist ; sort by position
1804 (sort ffap-menu-alist 1802 (sort ffap-menu-alist
1805 (function 1803 (lambda (a b) (< (cdr a) (cdr b))))))
1806 (lambda (a b) (< (cdr a) (cdr b)))))))
1807 1804
1808 1805
1809;;; Mouse Support (`ffap-at-mouse'): 1806;;; Mouse Support (`ffap-at-mouse'):
@@ -1833,7 +1830,7 @@ Return value:
1833 (ffap-guesser)))) 1830 (ffap-guesser))))
1834 (cond 1831 (cond
1835 (guess 1832 (guess
1836 (set-buffer (ffap-event-buffer e)) 1833 (set-buffer (window-buffer (car (event-start e))))
1837 (ffap-highlight) 1834 (ffap-highlight)
1838 (unwind-protect 1835 (unwind-protect
1839 (progn 1836 (progn
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 911e7ba9e3d..620a2e23f56 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -730,6 +730,16 @@ Execute BODY, and unwind connection-local variables."
730 ;; No connection-local variables to apply. 730 ;; No connection-local variables to apply.
731 ,@body)) 731 ,@body))
732 732
733;;;###autoload
734(defun path-separator ()
735 "The connection-local value of `path-separator'."
736 (with-connection-local-variables path-separator))
737
738;;;###autoload
739(defun null-device ()
740 "The connection-local value of `null-device'."
741 (with-connection-local-variables null-device))
742
733 743
734 744
735(provide 'files-x) 745(provide 'files-x)
diff --git a/lisp/files.el b/lisp/files.el
index 92c9a63ef18..777725903fa 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2315,53 +2315,52 @@ the various files."
2315 ;; hexl-mode or image-mode. 2315 ;; hexl-mode or image-mode.
2316 (memq major-mode '(hexl-mode image-mode))) 2316 (memq major-mode '(hexl-mode image-mode)))
2317 (if (buffer-modified-p) 2317 (if (buffer-modified-p)
2318 (if (y-or-n-p 2318 (if (let ((help-form
2319 (format 2319 (format-message
2320 (if rawfile 2320 (if rawfile "\
2321 "The file %s is already visited normally, 2321The file %s is already visited normally,
2322and you have edited the buffer. Now you have asked to visit it literally, 2322and you have edited the buffer. Now you have asked to visit it literally,
2323meaning no coding system handling, format conversion, or local variables. 2323meaning no coding system handling, format conversion, or local variables.
2324Emacs can visit a file in only one way at a time. 2324Emacs can visit a file in only one way at a time."
2325 2325 "\
2326Do you want to save the file, and visit it literally instead? " 2326The file %s is already visited literally,
2327 "The file %s is already visited literally,
2328meaning no coding system handling, format conversion, or local variables. 2327meaning no coding system handling, format conversion, or local variables.
2329You have edited the buffer. Now you have asked to visit the file normally, 2328You have edited the buffer. Now you have asked to visit the file normally,
2330but Emacs can visit a file in only one way at a time. 2329but Emacs can visit a file in only one way at a time.")
2331 2330 (file-name-nondirectory filename))))
2332Do you want to save the file, and visit it normally instead? ") 2331 (y-or-n-p
2333 (file-name-nondirectory filename))) 2332 (if rawfile "\
2333Do you want to save the file, and visit it literally instead? " "\
2334Do you want to save the file, and visit it normally instead? ")))
2334 (progn 2335 (progn
2335 (save-buffer) 2336 (save-buffer)
2336 (find-file-noselect-1 buf filename nowarn 2337 (find-file-noselect-1 buf filename nowarn
2337 rawfile truename number)) 2338 rawfile truename number))
2338 (if (y-or-n-p 2339 (if (y-or-n-p
2339 (format 2340 (if rawfile "\
2340 (if rawfile 2341Do you want to discard your changes, and visit the file literally now? " "\
2341 "\ 2342Do you want to discard your changes, and visit the file normally now? "))
2342Do you want to discard your changes, and visit the file literally now? "
2343 "\
2344Do you want to discard your changes, and visit the file normally now? ")))
2345 (find-file-noselect-1 buf filename nowarn 2343 (find-file-noselect-1 buf filename nowarn
2346 rawfile truename number) 2344 rawfile truename number)
2347 (error (if rawfile "File already visited non-literally" 2345 (error (if rawfile "File already visited non-literally"
2348 "File already visited literally")))) 2346 "File already visited literally"))))
2349 (if (y-or-n-p 2347 (if (let ((help-form
2350 (format 2348 (format-message
2351 (if rawfile 2349 (if rawfile "\
2352 "The file %s is already visited normally. 2350The file %s is already visited normally.
2353You have asked to visit it literally, 2351You have asked to visit it literally,
2354meaning no coding system decoding, format conversion, or local variables. 2352meaning no coding system decoding, format conversion, or local variables.
2355But Emacs can visit a file in only one way at a time. 2353But Emacs can visit a file in only one way at a time."
2356 2354 "\
2357Do you want to revisit the file literally now? " 2355The file %s is already visited literally,
2358 "The file %s is already visited literally,
2359meaning no coding system decoding, format conversion, or local variables. 2356meaning no coding system decoding, format conversion, or local variables.
2360You have asked to visit it normally, 2357You have asked to visit it normally,
2361but Emacs can visit a file in only one way at a time. 2358but Emacs can visit a file in only one way at a time.")
2362 2359 (file-name-nondirectory filename))))
2363Do you want to revisit the file normally now? ") 2360 (y-or-n-p
2364 (file-name-nondirectory filename))) 2361 (if rawfile "\
2362Do you want to revisit the file literally now? " "\
2363Do you want to revisit the file normally now? ")))
2365 (find-file-noselect-1 buf filename nowarn 2364 (find-file-noselect-1 buf filename nowarn
2366 rawfile truename number) 2365 rawfile truename number)
2367 (error (if rawfile "File already visited non-literally" 2366 (error (if rawfile "File already visited non-literally"
@@ -7375,9 +7374,9 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
7375 (save-some-buffers arg t) 7374 (save-some-buffers arg t)
7376 (let ((confirm confirm-kill-emacs)) 7375 (let ((confirm confirm-kill-emacs))
7377 (and 7376 (and
7378 (or (not (memq t (mapcar (function 7377 (or (not (memq t (mapcar (lambda (buf)
7379 (lambda (buf) (and (buffer-file-name buf) 7378 (and (buffer-file-name buf)
7380 (buffer-modified-p buf)))) 7379 (buffer-modified-p buf)))
7381 (buffer-list)))) 7380 (buffer-list))))
7382 (progn (setq confirm nil) 7381 (progn (setq confirm nil)
7383 (yes-or-no-p "Modified buffers exist; exit anyway? "))) 7382 (yes-or-no-p "Modified buffers exist; exit anyway? ")))
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 2cad2023b85..c7ec3f77f43 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -89,6 +89,7 @@
89;;; Code: 89;;; Code:
90 90
91(eval-when-compile (require 'cl-lib)) 91(eval-when-compile (require 'cl-lib))
92(require 'easymenu)
92 93
93;;; Some variables 94;;; Some variables
94 95
@@ -308,7 +309,7 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with
308 309
309(defcustom filesets-menu-path '("File") ; cf recentf-menu-path 310(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
310 "The menu under which the filesets menu should be inserted. 311 "The menu under which the filesets menu should be inserted.
311See `add-submenu' for documentation." 312See `easy-menu-add-item' for documentation."
312 :set (function filesets-set-default) 313 :set (function filesets-set-default)
313 :type '(choice (const :tag "Top Level" nil) 314 :type '(choice (const :tag "Top Level" nil)
314 (sexp :tag "Menu Path")) 315 (sexp :tag "Menu Path"))
@@ -317,7 +318,7 @@ See `add-submenu' for documentation."
317 318
318(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before 319(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
319 "The name of a menu before which this menu should be added. 320 "The name of a menu before which this menu should be added.
320See `add-submenu' for documentation." 321See `easy-menu-add-item' for documentation."
321 :set (function filesets-set-default) 322 :set (function filesets-set-default)
322 :type '(choice (string :tag "Name") 323 :type '(choice (string :tag "Name")
323 (const :tag "Last" nil)) 324 (const :tag "Last" nil))
@@ -326,7 +327,7 @@ See `add-submenu' for documentation."
326 327
327(defcustom filesets-menu-in-menu nil 328(defcustom filesets-menu-in-menu nil
328 "Use that instead of `current-menubar' as the menu to change. 329 "Use that instead of `current-menubar' as the menu to change.
329See `add-submenu' for documentation." 330See `easy-menu-add-item' for documentation."
330 :set (function filesets-set-default) 331 :set (function filesets-set-default)
331 :type 'sexp 332 :type 'sexp
332 :group 'filesets) 333 :group 'filesets)
@@ -1075,18 +1076,6 @@ defined in `filesets-ingroup-patterns'."
1075 :type 'integer 1076 :type 'integer
1076 :group 'filesets) 1077 :group 'filesets)
1077 1078
1078;;; Emacs compatibility
1079(eval-and-compile
1080 (if (featurep 'xemacs)
1081 (fset 'filesets-error 'error)
1082
1083 (require 'easymenu)
1084
1085 (defun filesets-error (_class &rest args)
1086 "`error' wrapper."
1087 (error "%s" (mapconcat 'identity args " ")))
1088
1089 ))
1090 1079
1091(defun filesets-filter-dir-names (lst &optional negative) 1080(defun filesets-filter-dir-names (lst &optional negative)
1092 "Remove non-directory names from a list of strings. 1081 "Remove non-directory names from a list of strings.
@@ -1160,7 +1149,7 @@ Return full path if FULL-FLAG is non-nil."
1160 (filesets-message 1 "Filesets: %S doesn't exist" dir) 1149 (filesets-message 1 "Filesets: %S doesn't exist" dir)
1161 nil) 1150 nil)
1162 (t 1151 (t
1163 (filesets-error 'error "Filesets: " dir " does not exist")))) 1152 (error "Filesets: %s does not exist" dir))))
1164 1153
1165(defun filesets-quote (txt) 1154(defun filesets-quote (txt)
1166 "Return TXT in quotes." 1155 "Return TXT in quotes."
@@ -1172,7 +1161,7 @@ Return full path if FULL-FLAG is non-nil."
1172 (p (point))) 1161 (p (point)))
1173 (if m 1162 (if m
1174 (buffer-substring (min m p) (max m p)) 1163 (buffer-substring (min m p) (max m p))
1175 (filesets-error 'error "No selection.")))) 1164 (error "No selection"))))
1176 1165
1177(defun filesets-get-quoted-selection () 1166(defun filesets-get-quoted-selection ()
1178 "Return the currently selected text in quotes." 1167 "Return the currently selected text in quotes."
@@ -1357,8 +1346,7 @@ Use the viewer defined in EV-ENTRY (a valid element of
1357 (goto-char (point-min))) 1346 (goto-char (point-min)))
1358 (when oh 1347 (when oh
1359 (run-hooks 'oh)))) 1348 (run-hooks 'oh))))
1360 (filesets-error 'error 1349 (error "Filesets: general error when spawning external viewer"))))
1361 "Filesets: general error when spawning external viewer"))))
1362 1350
1363(defun filesets-find-file (file) 1351(defun filesets-find-file (file)
1364 "Call `find-file' after a possible delay (see `filesets-find-file-delay'). 1352 "Call `find-file' after a possible delay (see `filesets-find-file-delay').
@@ -1741,8 +1729,7 @@ Assume MODE (see `filesets-entry-mode'), if provided."
1741 ;;(filesets-message 3 "Filesets: scanning %s" dirpatt) 1729 ;;(filesets-message 3 "Filesets: scanning %s" dirpatt)
1742 (filesets-directory-files dir patt ':files t)) 1730 (filesets-directory-files dir patt ':files t))
1743 ;; (message "Filesets: malformed entry: %s" entry))))))) 1731 ;; (message "Filesets: malformed entry: %s" entry)))))))
1744 (filesets-error 'error "Filesets: malformed entry: " 1732 (error "Filesets: malformed entry: %s" entry)))))))
1745 entry)))))))
1746 (filesets-filter-list fl 1733 (filesets-filter-list fl
1747 (lambda (file) 1734 (lambda (file)
1748 (not (filesets-filetype-property file event)))))) 1735 (not (filesets-filetype-property file event))))))
@@ -1768,7 +1755,7 @@ Use LOOKUP-NAME for searching additional data if provided."
1768 (dolist (this files nil) 1755 (dolist (this files nil)
1769 (filesets-file-open open-function this)) 1756 (filesets-file-open open-function this))
1770 (message "Filesets: canceled"))) 1757 (message "Filesets: canceled")))
1771 (filesets-error 'error "Filesets: Unknown fileset: " name)))) 1758 (error "Filesets: Unknown fileset: %s" name))))
1772 1759
1773(defun filesets-close (&optional mode name lookup-name) 1760(defun filesets-close (&optional mode name lookup-name)
1774 "Close all buffers belonging to the fileset called NAME. 1761 "Close all buffers belonging to the fileset called NAME.
@@ -1789,7 +1776,7 @@ Use LOOKUP-NAME for deducing the save-function, if provided."
1789 (if buffer 1776 (if buffer
1790 (filesets-file-close save-function buffer))))) 1777 (filesets-file-close save-function buffer)))))
1791; (message "Filesets: Unknown fileset: `%s'" name)))) 1778; (message "Filesets: Unknown fileset: `%s'" name))))
1792 (filesets-error 'error "Filesets: Unknown fileset: " name)))) 1779 (error "Filesets: Unknown fileset: %s" name))))
1793 1780
1794(defun filesets-add-buffer (&optional name buffer) 1781(defun filesets-add-buffer (&optional name buffer)
1795 "Add BUFFER (or current buffer) to the fileset called NAME. 1782 "Add BUFFER (or current buffer) to the fileset called NAME.
@@ -1997,7 +1984,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
1997 `(["Rebuild this submenu" 1984 `(["Rebuild this submenu"
1998 (filesets-rebuild-this-submenu ',lookup-name)])))) 1985 (filesets-rebuild-this-submenu ',lookup-name)]))))
1999 (_ 1986 (_
2000 (filesets-error 'error "Filesets: malformed definition of " something)))) 1987 (error "Filesets: malformed definition of %s" something))))
2001 1988
2002(defun filesets-ingroup-get-data (master pos &optional fun) 1989(defun filesets-ingroup-get-data (master pos &optional fun)
2003 "Access to `filesets-ingroup-patterns'. Extract data section." 1990 "Access to `filesets-ingroup-patterns'. Extract data section."
@@ -2070,8 +2057,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
2070 (lst nil)) 2057 (lst nil))
2071 (cond 2058 (cond
2072 ((not this-patt) 2059 ((not this-patt)
2073 (filesets-error 'error "Filesets: malformed :ingroup definition " 2060 (error "Filesets: malformed :ingroup definition %s" this-def))
2074 this-def))
2075 ((< this-sd 0) 2061 ((< this-sd 0)
2076 nil) 2062 nil)
2077 (t 2063 (t
@@ -2174,7 +2160,7 @@ FS is a fileset's name. FLIST is a list returned by
2174 (progn 2160 (progn
2175 (message "Filesets: can't parse %s" master) 2161 (message "Filesets: can't parse %s" master)
2176 nil) 2162 nil)
2177 (filesets-error 'error "Filesets: can't parse " master)))) 2163 (error "Filesets: can't parse %s" master))))
2178 2164
2179(defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd 2165(defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd
2180 &optional rebuild-flag) 2166 &optional rebuild-flag)
@@ -2349,21 +2335,20 @@ bottom up, set `filesets-submenus' to nil, first.)"
2349 (filesets-menu-cache-file-save-maybe))) 2335 (filesets-menu-cache-file-save-maybe)))
2350 (let ((cb (current-buffer))) 2336 (let ((cb (current-buffer)))
2351 (when (not (member cb filesets-updated-buffers)) 2337 (when (not (member cb filesets-updated-buffers))
2352 (add-submenu 2338 (easy-menu-add-item (or filesets-menu-in-menu (current-global-map))
2353 filesets-menu-path 2339 (cons "menu-bar" filesets-menu-path)
2354 `(,filesets-menu-name 2340 `(,filesets-menu-name
2355 ("# Filesets" 2341 ("# Filesets"
2356 ["Edit Filesets" filesets-edit] 2342 ["Edit Filesets" filesets-edit]
2357 ["Save Filesets" filesets-save-config] 2343 ["Save Filesets" filesets-save-config]
2358 ["Save Menu Cache" filesets-menu-cache-file-save] 2344 ["Save Menu Cache" filesets-menu-cache-file-save]
2359 ["Rebuild Menu" filesets-build-menu] 2345 ["Rebuild Menu" filesets-build-menu]
2360 ["Customize" filesets-customize] 2346 ["Customize" filesets-customize]
2361 ["About" filesets-info]) 2347 ["About" filesets-info])
2362 ,(filesets-get-cmd-menu) 2348 ,(filesets-get-cmd-menu)
2363 "---" 2349 "---"
2364 ,@filesets-menu-cache) 2350 ,@filesets-menu-cache)
2365 filesets-menu-before 2351 filesets-menu-before)
2366 filesets-menu-in-menu)
2367 (setq filesets-updated-buffers 2352 (setq filesets-updated-buffers
2368 (cons cb filesets-updated-buffers)) 2353 (cons cb filesets-updated-buffers))
2369 ;; This wipes out other messages in the echo area. 2354 ;; This wipes out other messages in the echo area.
@@ -2474,7 +2459,7 @@ We apologize for the inconvenience.")))
2474 (insert msg) 2459 (insert msg)
2475 (when (y-or-n-p (format "Edit startup (%s) file now? " cf)) 2460 (when (y-or-n-p (format "Edit startup (%s) file now? " cf))
2476 (find-file-other-window cf)) 2461 (find-file-other-window cf))
2477 (filesets-error 'error msg)))) 2462 (error msg))))
2478 2463
2479(defun filesets-update (cached-version) 2464(defun filesets-update (cached-version)
2480 "Do some cleanup after updating filesets.el." 2465 "Do some cleanup after updating filesets.el."
@@ -2510,8 +2495,7 @@ We apologize for the inconvenience.")))
2510(defun filesets-init () 2495(defun filesets-init ()
2511 "Filesets initialization. 2496 "Filesets initialization.
2512Set up hooks, load the cache file -- if existing -- and build the menu." 2497Set up hooks, load the cache file -- if existing -- and build the menu."
2513 (add-hook (if (featurep 'xemacs) 'activate-menubar-hook 'menu-bar-update-hook) 2498 (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
2514 (function filesets-build-menu-maybe))
2515 (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl)) 2499 (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
2516 (add-hook 'first-change-hook (function filesets-reset-filename-on-change)) 2500 (add-hook 'first-change-hook (function filesets-reset-filename-on-change))
2517 (add-hook 'kill-emacs-hook (function filesets-exit)) 2501 (add-hook 'kill-emacs-hook (function filesets-exit))
@@ -2525,6 +2509,10 @@ Set up hooks, load the cache file -- if existing -- and build the menu."
2525 (setq filesets-menu-use-cached-flag t))) 2509 (setq filesets-menu-use-cached-flag t)))
2526 (filesets-build-menu))) 2510 (filesets-build-menu)))
2527 2511
2512(defun filesets-error (_class &rest args)
2513 "`error' wrapper."
2514 (declare (obsolete error "28.1"))
2515 (error "%s" (mapconcat 'identity args " ")))
2528 2516
2529(provide 'filesets) 2517(provide 'filesets)
2530 2518
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index 352720412a5..c1be5ff403d 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -221,15 +221,12 @@ It is a function which takes two arguments, the directory and its parent."
221 221
222 (make-local-variable 'revert-buffer-function) 222 (make-local-variable 'revert-buffer-function)
223 (setq revert-buffer-function 223 (setq revert-buffer-function
224 (function 224 (lambda (_ignore1 _ignore2)
225 (lambda (_ignore1 _ignore2) 225 (find-lisp-insert-directory
226 (find-lisp-insert-directory 226 default-directory
227 default-directory 227 find-lisp-file-predicate
228 find-lisp-file-predicate 228 find-lisp-directory-predicate
229 find-lisp-directory-predicate 229 'ignore)))
230 'ignore)
231 )
232 ))
233 230
234 ;; Set subdir-alist so that Tree Dired will work: 231 ;; Set subdir-alist so that Tree Dired will work:
235 (if (fboundp 'dired-simple-subdir-alist) 232 (if (fboundp 'dired-simple-subdir-alist)
@@ -267,11 +264,10 @@ It is a function which takes two arguments, the directory and its parent."
267 (insert find-lisp-line-indent "\n") 264 (insert find-lisp-line-indent "\n")
268 ;; Run the find function 265 ;; Run the find function
269 (mapc 266 (mapc
270 (function 267 (lambda (file)
271 (lambda (file) 268 (find-lisp-find-dired-insert-file
272 (find-lisp-find-dired-insert-file 269 (substring file len)
273 (substring file len) 270 (current-buffer)))
274 (current-buffer))))
275 (sort files 'string-lessp)) 271 (sort files 'string-lessp))
276 ;; FIXME: Sort function is ignored for now 272 ;; FIXME: Sort function is ignored for now
277 ;; (funcall sort-function files)) 273 ;; (funcall sort-function files))
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 48ac1232051..5875dce5f03 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -107,8 +107,6 @@
107 107
108;;; Code: 108;;; Code:
109 109
110(eval-when-compile (require 'font-lock))
111
112(defgroup generic-x nil 110(defgroup generic-x nil
113 "A collection of generic modes." 111 "A collection of generic modes."
114 :prefix "generic-" 112 :prefix "generic-"
@@ -280,12 +278,11 @@ your changes into effect."
280 ("^\\s-*\\(\\sw+\\)\\s-" 1 font-lock-variable-name-face)) 278 ("^\\s-*\\(\\sw+\\)\\s-" 1 font-lock-variable-name-face))
281 '("srm\\.conf\\'" "httpd\\.conf\\'" "access\\.conf\\'") 279 '("srm\\.conf\\'" "httpd\\.conf\\'" "access\\.conf\\'")
282 (list 280 (list
283 (function 281 (lambda ()
284 (lambda () 282 (setq imenu-generic-expression
285 (setq imenu-generic-expression 283 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)
286 '((nil "^\\([-A-Za-z0-9_]+\\)" 1) 284 ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
287 ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) 285 ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
288 ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))))
289 "Generic mode for Apache or HTTPD configuration files.")) 286 "Generic mode for Apache or HTTPD configuration files."))
290 287
291(when (memq 'apache-log-generic-mode generic-extras-enable-list) 288(when (memq 'apache-log-generic-mode generic-extras-enable-list)
@@ -401,11 +398,10 @@ your changes into effect."
401 (2 font-lock-variable-name-face))) 398 (2 font-lock-variable-name-face)))
402 '("\\.[iI][nN][iI]\\'") 399 '("\\.[iI][nN][iI]\\'")
403 (list 400 (list
404 (function 401 (lambda ()
405 (lambda () 402 (setq imenu-generic-expression
406 (setq imenu-generic-expression 403 '((nil "^\\[\\(.*\\)\\]" 1)
407 '((nil "^\\[\\(.*\\)\\]" 1) 404 ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1)))))
408 ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1))))))
409 "Generic mode for MS-Windows INI files. 405 "Generic mode for MS-Windows INI files.
410You can use `ini-generic-mode-find-file-hook' to enter this mode 406You can use `ini-generic-mode-find-file-hook' to enter this mode
411automatically for INI files whose names do not end in \".ini\".") 407automatically for INI files whose names do not end in \".ini\".")
@@ -432,10 +428,9 @@ like an INI file. You can add this hook to `find-file-hook'."
432 ("^\\([^\n\r]*\\)\\s-*=" 1 font-lock-variable-name-face)) 428 ("^\\([^\n\r]*\\)\\s-*=" 1 font-lock-variable-name-face))
433 '("\\.[rR][eE][gG]\\'") 429 '("\\.[rR][eE][gG]\\'")
434 (list 430 (list
435 (function 431 (lambda ()
436 (lambda () 432 (setq imenu-generic-expression
437 (setq imenu-generic-expression 433 '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
438 '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))))
439 "Generic mode for MS-Windows Registry files.")) 434 "Generic mode for MS-Windows Registry files."))
440 435
441(declare-function w32-shell-name "w32-fns" ()) 436(declare-function w32-shell-name "w32-fns" ())
@@ -456,10 +451,9 @@ like an INI file. You can add this hook to `find-file-hook'."
456 ("\\s-/\\([^/]+\\)/[i, \t\n]" 1 font-lock-constant-face)) 451 ("\\s-/\\([^/]+\\)/[i, \t\n]" 1 font-lock-constant-face))
457 '("\\.rules\\'") 452 '("\\.rules\\'")
458 (list 453 (list
459 (function 454 (lambda ()
460 (lambda () 455 (setq imenu-generic-expression
461 (setq imenu-generic-expression 456 '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
462 '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))))
463 "Generic mode for Mailagent rules files.")) 457 "Generic mode for Mailagent rules files."))
464 458
465;; Solaris/Sys V prototype files 459;; Solaris/Sys V prototype files
@@ -548,13 +542,12 @@ like an INI file. You can add this hook to `find-file-hook'."
548 (2 font-lock-variable-name-face))) 542 (2 font-lock-variable-name-face)))
549 '("\\.wrl\\'") 543 '("\\.wrl\\'")
550 (list 544 (list
551 (function 545 (lambda ()
552 (lambda () 546 (setq imenu-generic-expression
553 (setq imenu-generic-expression 547 '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1)
554 '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1) 548 ("*Definitions*"
555 ("*Definitions*" 549 "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
556 "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 550 1)))))
557 1))))))
558 "Generic Mode for VRML files.")) 551 "Generic Mode for VRML files."))
559 552
560;; Java Manifests 553;; Java Manifests
@@ -594,20 +587,18 @@ like an INI file. You can add this hook to `find-file-hook'."
594 ;; * an equal sign 587 ;; * an equal sign
595 ;; * a colon 588 ;; * a colon
596 (mapcar 589 (mapcar
597 (function 590 (lambda (elt)
598 (lambda (elt) 591 (list
599 (list 592 (concat "^" java-properties-key elt java-properties-value "$")
600 (concat "^" java-properties-key elt java-properties-value "$") 593 '(1 font-lock-constant-face)
601 '(1 font-lock-constant-face) 594 '(4 font-lock-variable-name-face)))
602 '(4 font-lock-variable-name-face))))
603 ;; These are the separators 595 ;; These are the separators
604 '(":\\s-*" "\\s-+" "\\s-*=\\s-*")))) 596 '(":\\s-*" "\\s-+" "\\s-*=\\s-*"))))
605 nil 597 nil
606 (list 598 (list
607 (function 599 (lambda ()
608 (lambda () 600 (setq imenu-generic-expression
609 (setq imenu-generic-expression 601 '((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
610 '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))))
611 "Generic mode for Java properties files.")) 602 "Generic mode for Java properties files."))
612 603
613;; C shell alias definitions 604;; C shell alias definitions
@@ -622,10 +613,9 @@ like an INI file. You can add this hook to `find-file-hook'."
622 (1 font-lock-variable-name-face))) 613 (1 font-lock-variable-name-face)))
623 '("alias\\'") 614 '("alias\\'")
624 (list 615 (list
625 (function 616 (lambda ()
626 (lambda () 617 (setq imenu-generic-expression
627 (setq imenu-generic-expression 618 '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
628 '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))))
629 "Generic mode for C Shell alias files.")) 619 "Generic mode for C Shell alias files."))
630 620
631;; Ansible inventory files 621;; Ansible inventory files
@@ -645,11 +635,10 @@ like an INI file. You can add this hook to `find-file-hook'."
645 (2 font-lock-keyword-face))) 635 (2 font-lock-keyword-face)))
646 '("inventory\\'") 636 '("inventory\\'")
647 (list 637 (list
648 (function 638 (lambda ()
649 (lambda () 639 (setq imenu-generic-expression
650 (setq imenu-generic-expression 640 '((nil "^\\s-*\\[\\(.*\\)\\]" 1)
651 '((nil "^\\s-*\\[\\(.*\\)\\]" 1) 641 ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
652 ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))))
653 "Generic mode for Ansible inventory files.")) 642 "Generic mode for Ansible inventory files."))
654 643
655;;; Windows RC files 644;;; Windows RC files
@@ -1432,10 +1421,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1432 '(("^\\([-A-Za-z0-9_]+\\)" 1 font-lock-type-face)) 1421 '(("^\\([-A-Za-z0-9_]+\\)" 1 font-lock-type-face))
1433 '("/etc/inetd\\.conf\\'") 1422 '("/etc/inetd\\.conf\\'")
1434 (list 1423 (list
1435 (function 1424 (lambda ()
1436 (lambda () 1425 (setq imenu-generic-expression
1437 (setq imenu-generic-expression 1426 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
1438 '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
1439 1427
1440;; Services 1428;; Services
1441(when (memq 'etc-services-generic-mode generic-extras-enable-list) 1429(when (memq 'etc-services-generic-mode generic-extras-enable-list)
@@ -1450,10 +1438,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1450 (2 font-lock-variable-name-face))) 1438 (2 font-lock-variable-name-face)))
1451 '("/etc/services\\'") 1439 '("/etc/services\\'")
1452 (list 1440 (list
1453 (function 1441 (lambda ()
1454 (lambda () 1442 (setq imenu-generic-expression
1455 (setq imenu-generic-expression 1443 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
1456 '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
1457 1444
1458;; Password and Group files 1445;; Password and Group files
1459(when (memq 'etc-passwd-generic-mode generic-extras-enable-list) 1446(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
@@ -1493,10 +1480,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1493 ;; /etc/passwd- is a backup file for /etc/passwd, so is group- and shadow- 1480 ;; /etc/passwd- is a backup file for /etc/passwd, so is group- and shadow-
1494 '("/etc/passwd-?\\'" "/etc/group-?\\'" "/etc/shadow-?\\'") 1481 '("/etc/passwd-?\\'" "/etc/group-?\\'" "/etc/shadow-?\\'")
1495 (list 1482 (list
1496 (function 1483 (lambda ()
1497 (lambda () 1484 (setq imenu-generic-expression
1498 (setq imenu-generic-expression 1485 '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
1499 '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))))
1500 1486
1501;; Fstab 1487;; Fstab
1502(when (memq 'etc-fstab-generic-mode generic-extras-enable-list) 1488(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
@@ -1547,10 +1533,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1547 (2 font-lock-variable-name-face t))) 1533 (2 font-lock-variable-name-face t)))
1548 '("/etc/[v]*fstab\\'") 1534 '("/etc/[v]*fstab\\'")
1549 (list 1535 (list
1550 (function 1536 (lambda ()
1551 (lambda () 1537 (setq imenu-generic-expression
1552 (setq imenu-generic-expression 1538 '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
1553 '((nil "^\\([^# \t]+\\)\\s-+" 1))))))))
1554 1539
1555;; /etc/sudoers 1540;; /etc/sudoers
1556(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list) 1541(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
@@ -1710,9 +1695,8 @@ like an INI file. You can add this hook to `find-file-hook'."
1710 (list 1695 (list
1711 'generic-bracket-support 1696 'generic-bracket-support
1712 ;; Make keywords case-insensitive 1697 ;; Make keywords case-insensitive
1713 (function 1698 (lambda ()
1714 (lambda() 1699 (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
1715 (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
1716 "Generic mode for SPICE circuit netlist files.")) 1700 "Generic mode for SPICE circuit netlist files."))
1717 1701
1718(when (memq 'ibis-generic-mode generic-extras-enable-list) 1702(when (memq 'ibis-generic-mode generic-extras-enable-list)
@@ -1758,9 +1742,8 @@ like an INI file. You can add this hook to `find-file-hook'."
1758 (list 1742 (list
1759 'generic-bracket-support 1743 'generic-bracket-support
1760 ;; Make keywords case-insensitive 1744 ;; Make keywords case-insensitive
1761 (function 1745 (lambda ()
1762 (lambda() 1746 (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
1763 (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
1764 "Generic mode for ASTAP circuit netlist files.")) 1747 "Generic mode for ASTAP circuit netlist files."))
1765 1748
1766(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list) 1749(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 76c2904eaf0..053e7ea1f6b 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -3567,22 +3567,21 @@ articles in every agentized group? "))
3567 (let* (delete-recursive 3567 (let* (delete-recursive
3568 files f 3568 files f
3569 (delete-recursive 3569 (delete-recursive
3570 (function 3570 (lambda (f-or-d)
3571 (lambda (f-or-d) 3571 (ignore-errors
3572 (ignore-errors 3572 (if (file-directory-p f-or-d)
3573 (if (file-directory-p f-or-d) 3573 (condition-case nil
3574 (condition-case nil 3574 (delete-directory f-or-d)
3575 (delete-directory f-or-d) 3575 (file-error
3576 (file-error 3576 (setq files (directory-files f-or-d))
3577 (setq files (directory-files f-or-d)) 3577 (while files
3578 (while files 3578 (setq f (pop files))
3579 (setq f (pop files)) 3579 (or (member f '("." ".."))
3580 (or (member f '("." "..")) 3580 (funcall delete-recursive
3581 (funcall delete-recursive 3581 (nnheader-concat
3582 (nnheader-concat 3582 f-or-d f))))
3583 f-or-d f)))) 3583 (delete-directory f-or-d)))
3584 (delete-directory f-or-d))) 3584 (delete-file f-or-d))))))
3585 (delete-file f-or-d)))))))
3586 (funcall delete-recursive dir))))))))) 3585 (funcall delete-recursive dir)))))))))
3587 3586
3588;;;###autoload 3587;;;###autoload
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 1efc1d6f7d9..8f4ca7eb3b9 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6175,7 +6175,6 @@ If nil, don't show those extra buttons."
6175 face ,gnus-article-button-face 6175 face ,gnus-article-button-face
6176 follow-link t 6176 follow-link t
6177 gnus-part ,id 6177 gnus-part ,id
6178 button t
6179 article-type multipart 6178 article-type multipart
6180 rear-nonsticky t)) 6179 rear-nonsticky t))
6181 ;; Do the handles 6180 ;; Do the handles
@@ -6200,6 +6199,7 @@ If nil, don't show those extra buttons."
6200 follow-link t 6199 follow-link t
6201 gnus-part ,id 6200 gnus-part ,id
6202 button t 6201 button t
6202 category t
6203 gnus-data ,handle 6203 gnus-data ,handle
6204 rear-nonsticky t)) 6204 rear-nonsticky t))
6205 (insert " ")) 6205 (insert " "))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 17f1108029c..498da200dab 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -2101,9 +2101,10 @@ article came from is also searched."
2101(defun gnus-search--complete-key-data () 2101(defun gnus-search--complete-key-data ()
2102 "Potentially return completion data for a search key or value." 2102 "Potentially return completion data for a search key or value."
2103 (let* ((key-start (save-excursion 2103 (let* ((key-start (save-excursion
2104 (if (re-search-backward " " (minibuffer-prompt-end) t) 2104 (or (re-search-backward " " (minibuffer-prompt-end) t)
2105 (1+ (point)) 2105 (goto-char (minibuffer-prompt-end)))
2106 (minibuffer-prompt-end)))) 2106 (skip-chars-forward " -")
2107 (point)))
2107 (after-colon (save-excursion 2108 (after-colon (save-excursion
2108 (when (re-search-backward ":" key-start t) 2109 (when (re-search-backward ":" key-start t)
2109 (1+ (point))))) 2110 (1+ (point)))))
@@ -2113,7 +2114,7 @@ article came from is also searched."
2113 ;; only handle in a contact-completion context. 2114 ;; only handle in a contact-completion context.
2114 (when (and gnus-search-contact-tables 2115 (when (and gnus-search-contact-tables
2115 (save-excursion 2116 (save-excursion
2116 (re-search-backward "\\<\\(\\w+\\):" key-start t) 2117 (re-search-backward "\\<-?\\(\\w+\\):" key-start t)
2117 (member (match-string 1) 2118 (member (match-string 1)
2118 '("from" "to" "cc" 2119 '("from" "to" "cc"
2119 "bcc" "recipient" "address")))) 2120 "bcc" "recipient" "address"))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 0782778fd43..5bdf53763a2 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -7651,7 +7651,7 @@ Optional DIGEST will use digest to forward."
7651 ;; Consider there is no illegible text. 7651 ;; Consider there is no illegible text.
7652 (add-text-properties 7652 (add-text-properties
7653 b (point) 7653 b (point)
7654 '(no-illegible-text t rear-nonsticky t start-open t)))) 7654 '(no-illegible-text t rear-nonsticky t))))
7655 7655
7656(defun message-forward-make-body-mml (forward-buffer) 7656(defun message-forward-make-body-mml (forward-buffer)
7657 (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") 7657 (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index dcecfcf6519..e53e000beae 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1548,9 +1548,8 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
1548(defun nnmairix-create-message-line-for-search () 1548(defun nnmairix-create-message-line-for-search ()
1549 "Create message line for interactive query in minibuffer." 1549 "Create message line for interactive query in minibuffer."
1550 (mapconcat 1550 (mapconcat
1551 (function 1551 (lambda (cur)
1552 (lambda (cur) 1552 (format "%c=%s" (car cur) (nth 3 cur)))
1553 (format "%c=%s" (car cur) (nth 3 cur))))
1554 nnmairix-interactive-query-parameters ",")) 1553 nnmairix-interactive-query-parameters ","))
1555 1554
1556(defun nnmairix-replace-illegal-chars (header) 1555(defun nnmairix-replace-illegal-chars (header)
@@ -1811,13 +1810,12 @@ If VERSION is a string: must be contained in mairix version output."
1811 (gnus-summary-toggle-header 1) 1810 (gnus-summary-toggle-header 1)
1812 (set-buffer gnus-article-buffer) 1811 (set-buffer gnus-article-buffer)
1813 (mapcar 1812 (mapcar
1814 (function 1813 (lambda (field)
1815 (lambda (field) 1814 (list (car (cddr field))
1816 (list (car (cddr field)) 1815 (if (car field)
1817 (if (car field) 1816 (nnmairix-replace-illegal-chars
1818 (nnmairix-replace-illegal-chars 1817 (gnus-fetch-field (car field)))
1819 (gnus-fetch-field (car field))) 1818 nil)))
1820 nil))))
1821 nnmairix-widget-fields-list)))) 1819 nnmairix-widget-fields-list))))
1822 1820
1823 1821
@@ -1911,14 +1909,13 @@ If WITHVALUES is t, query is based on current article."
1911 (when (member 'flags nnmairix-widget-other) 1909 (when (member 'flags nnmairix-widget-other)
1912 (setq flag 1910 (setq flag
1913 (mapconcat 1911 (mapconcat
1914 (function 1912 (lambda (flag)
1915 (lambda (flag) 1913 (setq temp
1916 (setq temp 1914 (widget-value (cadr (assoc (car flag) nnmairix-widgets))))
1917 (widget-value (cadr (assoc (car flag) nnmairix-widgets)))) 1915 (if (string= "yes" temp)
1918 (if (string= "yes" temp) 1916 (cadr flag)
1919 (cadr flag) 1917 (if (string= "no" temp)
1920 (if (string= "no" temp) 1918 (concat "-" (cadr flag)))))
1921 (concat "-" (cadr flag))))))
1922 '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) 1919 '(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
1923 (when (not (zerop (length flag))) 1920 (when (not (zerop (length flag)))
1924 (push (concat "F:" flag) query))) 1921 (push (concat "F:" flag) query)))
@@ -1968,32 +1965,31 @@ VALUES may contain values for editable fields from current article."
1968 ;; how can this be done less ugly? 1965 ;; how can this be done less ugly?
1969 (let ((ret)) 1966 (let ((ret))
1970 (mapc 1967 (mapc
1971 (function 1968 (lambda (field)
1972 (lambda (field) 1969 (setq field (car (cddr field)))
1973 (setq field (car (cddr field))) 1970 (setq ret
1974 (setq ret 1971 (nconc
1975 (nconc 1972 (list
1976 (list 1973 (list
1977 (list 1974 (concat "c" field)
1978 (concat "c" field) 1975 (widget-create 'checkbox
1979 (widget-create 'checkbox 1976 :tag field
1980 :tag field 1977 :notify (lambda (widget &rest ignore)
1981 :notify (lambda (widget &rest ignore) 1978 (nnmairix-widget-toggle-activate widget))
1982 (nnmairix-widget-toggle-activate widget)) 1979 nil)))
1983 nil))) 1980 (list
1984 (list 1981 (list
1985 (list 1982 (concat "e" field)
1986 (concat "e" field) 1983 (widget-create 'editable-field
1987 (widget-create 'editable-field 1984 :size 60
1988 :size 60 1985 :format (concat " " field ":"
1989 :format (concat " " field ":" 1986 (make-string (- 11 (length field)) ?\ )
1990 (make-string (- 11 (length field)) ?\ ) 1987 "%v")
1991 "%v") 1988 :value (or (cadr (assoc field values)) ""))))
1992 :value (or (cadr (assoc field values)) "")))) 1989 ret))
1993 ret)) 1990 (widget-insert "\n")
1994 (widget-insert "\n") 1991 ;; Deactivate editable field
1995 ;; Deactivate editable field 1992 (widget-apply (cadr (nth 1 ret)) :deactivate))
1996 (widget-apply (cadr (nth 1 ret)) :deactivate)))
1997 nnmairix-widget-fields-list) 1993 nnmairix-widget-fields-list)
1998 ret)) 1994 ret))
1999 1995
diff --git a/lisp/help.el b/lisp/help.el
index 7eb50fd5451..8dac6dcd332 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1310,6 +1310,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
1310 ((and mention-shadow (not (eq tem definition))) 1310 ((and mention-shadow (not (eq tem definition)))
1311 (setq this-shadowed t)) 1311 (setq this-shadowed t))
1312 (t nil)))) 1312 (t nil))))
1313 (eq definition (lookup-key tail (vector event) t))
1313 (push (list event definition this-shadowed) vect)))) 1314 (push (list event definition this-shadowed) vect))))
1314 ((eq (car tail) 'keymap) 1315 ((eq (car tail) 'keymap)
1315 ;; The same keymap might be in the structure twice, if 1316 ;; The same keymap might be in the structure twice, if
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 80c5b073985..79342976746 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -208,11 +208,9 @@ either clicking or hitting return "
208 'follow-link t 208 'follow-link t
209 'help-echo "Click or RET: save new value in customize" 209 'help-echo "Click or RET: save new value in customize"
210 'action (lambda (_) 210 'action (lambda (_)
211 (if (not (fboundp 'customize-save-variable)) 211 (customize-save-variable 'ibuffer-saved-filters
212 (message "Customize not available; value not saved") 212 ibuffer-saved-filters)
213 (customize-save-variable 'ibuffer-saved-filters 213 (message "Saved updated ibuffer-saved-filters.")))
214 ibuffer-saved-filters)
215 (message "Saved updated ibuffer-saved-filters."))))
216 ". See below for 214 ". See below for
217an explanation and alternative ways to save the repaired value. 215an explanation and alternative ways to save the repaired value.
218 216
@@ -1116,13 +1114,10 @@ filter into parts."
1116 1114
1117(defun ibuffer-maybe-save-stuff () 1115(defun ibuffer-maybe-save-stuff ()
1118 (when ibuffer-save-with-custom 1116 (when ibuffer-save-with-custom
1119 (if (fboundp 'customize-save-variable) 1117 (customize-save-variable 'ibuffer-saved-filters
1120 (progn 1118 ibuffer-saved-filters)
1121 (customize-save-variable 'ibuffer-saved-filters 1119 (customize-save-variable 'ibuffer-saved-filter-groups
1122 ibuffer-saved-filters) 1120 ibuffer-saved-filter-groups)))
1123 (customize-save-variable 'ibuffer-saved-filter-groups
1124 ibuffer-saved-filter-groups))
1125 (message "Not saved permanently: Customize not available"))))
1126 1121
1127;;;###autoload 1122;;;###autoload
1128(defun ibuffer-save-filters (name filters) 1123(defun ibuffer-save-filters (name filters)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 1e6fea8578c..d361971a1fc 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -441,56 +441,55 @@ non-nil, it is used to sort CODINGS instead."
441 (most-preferred (car from-priority)) 441 (most-preferred (car from-priority))
442 (lang-preferred (get-language-info current-language-environment 442 (lang-preferred (get-language-info current-language-environment
443 'coding-system)) 443 'coding-system))
444 (func (function 444 (func (lambda (x)
445 (lambda (x) 445 (let ((base (coding-system-base x)))
446 (let ((base (coding-system-base x))) 446 ;; We calculate the priority number 0..255 by
447 ;; We calculate the priority number 0..255 by 447 ;; using the 8 bits PMMLCEII as this:
448 ;; using the 8 bits PMMLCEII as this: 448 ;; P: 1 if most preferred.
449 ;; P: 1 if most preferred. 449 ;; MM: greater than 0 if mime-charset.
450 ;; MM: greater than 0 if mime-charset. 450 ;; L: 1 if one of the current lang. env.'s codings.
451 ;; L: 1 if one of the current lang. env.'s codings. 451 ;; C: 1 if one of codings listed in the category list.
452 ;; C: 1 if one of codings listed in the category list. 452 ;; E: 1 if not XXX-with-esc
453 ;; E: 1 if not XXX-with-esc 453 ;; II: if iso-2022 based, 0..3, else 1.
454 ;; II: if iso-2022 based, 0..3, else 1. 454 (logior
455 (logior 455 (ash (if (eq base most-preferred) 1 0) 7)
456 (ash (if (eq base most-preferred) 1 0) 7) 456 (ash
457 (ash 457 (let ((mime (coding-system-get base :mime-charset)))
458 (let ((mime (coding-system-get base :mime-charset))) 458 ;; Prefer coding systems corresponding to a
459 ;; Prefer coding systems corresponding to a 459 ;; MIME charset.
460 ;; MIME charset. 460 (if mime
461 (if mime 461 ;; Lower utf-16 priority so that we
462 ;; Lower utf-16 priority so that we 462 ;; normally prefer utf-8 to it, and put
463 ;; normally prefer utf-8 to it, and put 463 ;; x-ctext below that.
464 ;; x-ctext below that. 464 (cond ((string-match-p "utf-16"
465 (cond ((string-match-p "utf-16" 465 (symbol-name mime))
466 (symbol-name mime)) 466 2)
467 2) 467 ((string-match-p "^x-" (symbol-name mime))
468 ((string-match-p "^x-" (symbol-name mime)) 468 1)
469 1) 469 (t 3))
470 (t 3)) 470 0))
471 0)) 471 5)
472 5) 472 (ash (if (memq base lang-preferred) 1 0) 4)
473 (ash (if (memq base lang-preferred) 1 0) 4) 473 (ash (if (memq base from-priority) 1 0) 3)
474 (ash (if (memq base from-priority) 1 0) 3) 474 (ash (if (string-match-p "-with-esc\\'"
475 (ash (if (string-match-p "-with-esc\\'" 475 (symbol-name base))
476 (symbol-name base)) 476 0 1) 2)
477 0 1) 2) 477 (if (eq (coding-system-type base) 'iso-2022)
478 (if (eq (coding-system-type base) 'iso-2022) 478 (let ((category (coding-system-category base)))
479 (let ((category (coding-system-category base))) 479 ;; For ISO based coding systems, prefer
480 ;; For ISO based coding systems, prefer 480 ;; one that doesn't use designation nor
481 ;; one that doesn't use designation nor 481 ;; locking/single shifting.
482 ;; locking/single shifting. 482 (cond
483 (cond 483 ((or (eq category 'coding-category-iso-8-1)
484 ((or (eq category 'coding-category-iso-8-1) 484 (eq category 'coding-category-iso-8-2))
485 (eq category 'coding-category-iso-8-2)) 485 2)
486 2) 486 ((or (eq category 'coding-category-iso-7-tight)
487 ((or (eq category 'coding-category-iso-7-tight) 487 (eq category 'coding-category-iso-7))
488 (eq category 'coding-category-iso-7)) 488 1)
489 1) 489 (t
490 (t 490 0)))
491 0))) 491 1)
492 1) 492 )))))
493 ))))))
494 (sort codings (lambda (x y) 493 (sort codings (lambda (x y)
495 (> (funcall func x) (funcall func y))))))) 494 (> (funcall func x) (funcall func y)))))))
496 495
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index b13bde58ca1..57e568689e3 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -136,13 +136,12 @@ SORT-KEY should be `name' or `iso-spec' (default `name')."
136 136
137 ((eq sort-key 'iso-spec) 137 ((eq sort-key 'iso-spec)
138 ;; Sort by DIMENSION CHARS FINAL-CHAR 138 ;; Sort by DIMENSION CHARS FINAL-CHAR
139 (function 139 (lambda (x y)
140 (lambda (x y) 140 (or (< (nth 1 x) (nth 1 y))
141 (or (< (nth 1 x) (nth 1 y)) 141 (and (= (nth 1 x) (nth 1 y))
142 (and (= (nth 1 x) (nth 1 y)) 142 (or (< (nth 2 x) (nth 2 y))
143 (or (< (nth 2 x) (nth 2 y)) 143 (and (= (nth 2 x) (nth 2 y))
144 (and (= (nth 2 x) (nth 2 y)) 144 (< (nth 3 x) (nth 3 y))))))))
145 (< (nth 3 x) (nth 3 y)))))))))
146 (t 145 (t
147 (error "Invalid charset sort key: %s" sort-key)))) 146 (error "Invalid charset sort key: %s" sort-key))))
148 147
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 5abd668db89..39ef6d3bf01 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1330,7 +1330,8 @@ If STR has `advice' text property, append the following special event:
1330 1330
1331(defun quail-input-method (key) 1331(defun quail-input-method (key)
1332 (if (or (and (or buffer-read-only 1332 (if (or (and (or buffer-read-only
1333 (get-char-property (point) 'read-only)) 1333 (and (get-char-property (point) 'read-only)
1334 (get-char-property (point) 'front-sticky)))
1334 (not (or inhibit-read-only 1335 (not (or inhibit-read-only
1335 (get-char-property (point) 'inhibit-read-only)))) 1336 (get-char-property (point) 'inhibit-read-only))))
1336 (and overriding-terminal-local-map 1337 (and overriding-terminal-local-map
@@ -2477,14 +2478,13 @@ should be made by `quail-build-decode-map' (which see)."
2477 'face 'font-lock-comment-face)) 2478 'face 'font-lock-comment-face))
2478 (quail-indent-to max-key-width) 2479 (quail-indent-to max-key-width)
2479 (if (vectorp (cdr elt)) 2480 (if (vectorp (cdr elt))
2480 (mapc (function 2481 (mapc (lambda (x)
2481 (lambda (x) 2482 (let ((width (if (integerp x) (char-width x)
2482 (let ((width (if (integerp x) (char-width x) 2483 (string-width x))))
2483 (string-width x)))) 2484 (when (> (+ (current-column) 1 width) window-width)
2484 (when (> (+ (current-column) 1 width) window-width) 2485 (insert "\n")
2485 (insert "\n") 2486 (quail-indent-to max-key-width))
2486 (quail-indent-to max-key-width)) 2487 (insert " " x)))
2487 (insert " " x))))
2488 (cdr elt)) 2488 (cdr elt))
2489 (insert " " (cdr elt))) 2489 (insert " " (cdr elt)))
2490 (insert ?\n)) 2490 (insert ?\n))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 7de6baeb00a..0b3394080cc 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,7 +4,7 @@
4 4
5;; Author: João Távora <joaotavora@gmail.com> 5;; Author: João Távora <joaotavora@gmail.com>
6;; Keywords: processes, languages, extensions 6;; Keywords: processes, languages, extensions
7;; Version: 1.0.12 7;; Version: 1.0.14
8;; Package-Requires: ((emacs "25.2")) 8;; Package-Requires: ((emacs "25.2"))
9 9
10;; This is a GNU ELPA :core package. Avoid functionality that is not 10;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -271,7 +271,7 @@ it only exits locally (returning the JSONRPC result object) if
271the request is successful, otherwise it exits non-locally with an 271the request is successful, otherwise it exits non-locally with an
272error of type `jsonrpc-error'. 272error of type `jsonrpc-error'.
273 273
274DEFERRED is passed to `jsonrpc-async-request', which see. 274DEFERRED and TIMEOUT as in `jsonrpc-async-request', which see.
275 275
276If CANCEL-ON-INPUT is non-nil and the user inputs something while 276If CANCEL-ON-INPUT is non-nil and the user inputs something while
277the function is waiting, then it exits immediately, returning 277the function is waiting, then it exits immediately, returning
@@ -284,7 +284,8 @@ ignored."
284 (catch tag 284 (catch tag
285 (setq 285 (setq
286 id-and-timer 286 id-and-timer
287 (jsonrpc--async-request-1 287 (apply
288 #'jsonrpc--async-request-1
288 connection method params 289 connection method params
289 :success-fn (lambda (result) 290 :success-fn (lambda (result)
290 (unless cancelled 291 (unless cancelled
@@ -300,11 +301,12 @@ ignored."
300 (lambda () 301 (lambda ()
301 (unless cancelled 302 (unless cancelled
302 (throw tag '(error (jsonrpc-error-message . "Timed out"))))) 303 (throw tag '(error (jsonrpc-error-message . "Timed out")))))
303 :deferred deferred 304 `(,@(when deferred `(:deferred ,deferred))
304 :timeout timeout)) 305 ,@(when timeout `(:timeout ,timeout)))))
305 (cond (cancel-on-input 306 (cond (cancel-on-input
306 (while (sit-for 30)) 307 (unwind-protect
307 (setq cancelled t) 308 (let ((inhibit-quit t)) (while (sit-for 30)))
309 (setq cancelled t))
308 `(cancelled ,cancel-on-input-retval)) 310 `(cancelled ,cancel-on-input-retval))
309 (t (while t (accept-process-output nil 30))))) 311 (t (while t (accept-process-output nil 30)))))
310 ;; In normal operation, cancellation is handled by the 312 ;; In normal operation, cancellation is handled by the
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index 0c8b8d47a08..805dd12d3bd 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -250,14 +250,12 @@ dumped."
250 (insert "(setq\n") 250 (insert "(setq\n")
251 (lisp-indent-line) 251 (lisp-indent-line)
252 (mapc 252 (mapc
253 (function 253 (lambda (varsym-or-cons-cell)
254 (lambda (varsym-or-cons-cell) 254 (let ((varsym (or (car-safe varsym-or-cons-cell)
255 (let ((varsym (or (car-safe varsym-or-cons-cell) 255 varsym-or-cons-cell))
256 varsym-or-cons-cell)) 256 (printer (or (cdr-safe varsym-or-cons-cell)
257 (printer (or (cdr-safe varsym-or-cons-cell) 257 'reporter-dump-variable)))
258 'reporter-dump-variable))) 258 (funcall printer varsym mailbuf)))
259 (funcall printer varsym mailbuf)
260 )))
261 varlist) 259 varlist)
262 (lisp-indent-line) 260 (lisp-indent-line)
263 (insert ")\n")) 261 (insert ")\n"))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 986d0cf4074..9b7af0111e2 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -618,10 +618,7 @@ the list should be unique."
618 (lambda (elt) (char-to-string (cdr elt))) alist "/") 618 (lambda (elt) (char-to-string (cdr elt))) alist "/")
619 ") ")) 619 ") "))
620 (p prompt) 620 (p prompt)
621 (event 621 event)
622 (if (fboundp 'allocate-event)
623 (allocate-event)
624 nil)))
625 (while (stringp p) 622 (while (stringp p)
626 (if (let ((cursor-in-echo-area t) 623 (if (let ((cursor-in-echo-area t)
627 (inhibit-quit t)) 624 (inhibit-quit t))
@@ -630,8 +627,6 @@ the list should be unique."
630 (prog1 quit-flag (setq quit-flag nil))) 627 (prog1 quit-flag (setq quit-flag nil)))
631 (progn 628 (progn
632 (message "%s%s" p (single-key-description event)) 629 (message "%s%s" p (single-key-description event))
633 (if (fboundp 'deallocate-event)
634 (deallocate-event event))
635 (setq quit-flag nil) 630 (setq quit-flag nil)
636 (signal 'quit '()))) 631 (signal 'quit '())))
637 (let ((char event) 632 (let ((char event)
@@ -650,8 +645,6 @@ the list should be unique."
650 (discard-input) 645 (discard-input)
651 (if (eq p prompt) 646 (if (eq p prompt)
652 (setq p (concat "Try again. " prompt))))))) 647 (setq p (concat "Try again. " prompt)))))))
653 (if (fboundp 'deallocate-event)
654 (deallocate-event event))
655 p)) 648 p))
656 649
657(defun sc-scan-info-alist (alist) 650(defun sc-scan-info-alist (alist)
@@ -1028,17 +1021,16 @@ supplied, is used instead of the line point is on in the current buffer."
1028 (setq position (1+ position)) 1021 (setq position (1+ position))
1029 (let ((keep-p t)) 1022 (let ((keep-p t))
1030 (mapc 1023 (mapc
1031 (function 1024 (lambda (filter)
1032 (lambda (filter) 1025 (let ((regexp (car filter))
1033 (let ((regexp (car filter)) 1026 (pos (cdr filter)))
1034 (pos (cdr filter))) 1027 (if (and (string-match regexp name)
1035 (if (and (string-match regexp name) 1028 (or (and (numberp pos)
1036 (or (and (numberp pos) 1029 (= pos position))
1037 (= pos position)) 1030 (and (eq pos 'last)
1038 (and (eq pos 'last) 1031 (= position (1- elements)))
1039 (= position (1- elements))) 1032 (eq pos 'any)))
1040 (eq pos 'any))) 1033 (setq keep-p nil))))
1041 (setq keep-p nil)))))
1042 sc-name-filter-alist) 1034 sc-name-filter-alist)
1043 (if keep-p 1035 (if keep-p
1044 (setq keepers (cons position keepers))))) 1036 (setq keepers (cons position keepers)))))
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index cc437c3c49b..d037bdce887 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -73,12 +73,11 @@ If ARG is non-nil, set timestamp with the current time."
73 (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time)))) 73 (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
74 (let ((stamp)) 74 (let ((stamp))
75 (car (memq t (mapcar 75 (car (memq t (mapcar
76 (function 76 (lambda (file)
77 (lambda (file) 77 (when (and file (file-exists-p file))
78 (when (and file (file-exists-p file)) 78 (setq stamp (file-attribute-modification-time
79 (setq stamp (file-attribute-modification-time 79 (file-attributes file)))
80 (file-attributes file))) 80 (time-less-p mh-alias-tstamp stamp)))
81 (time-less-p mh-alias-tstamp stamp))))
82 (mh-alias-filenames t))))))) 81 (mh-alias-filenames t)))))))
83 82
84(defun mh-alias-filenames (arg) 83(defun mh-alias-filenames (arg)
@@ -93,11 +92,10 @@ appended."
93 (filelist (and filename (split-string filename "[ \t]+"))) 92 (filelist (and filename (split-string filename "[ \t]+")))
94 (userlist 93 (userlist
95 (mapcar 94 (mapcar
96 (function 95 (lambda (file)
97 (lambda (file) 96 (if (and mh-user-path file
98 (if (and mh-user-path file 97 (file-exists-p (expand-file-name file mh-user-path)))
99 (file-exists-p (expand-file-name file mh-user-path))) 98 (expand-file-name file mh-user-path)))
100 (expand-file-name file mh-user-path))))
101 filelist))) 99 filelist)))
102 (if arg 100 (if arg
103 (if (stringp mh-alias-system-aliases) 101 (if (stringp mh-alias-system-aliases)
@@ -466,12 +464,11 @@ set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
466 ;; Double-check that we have an individual alias. This means that the 464 ;; Double-check that we have an individual alias. This means that the
467 ;; alias doesn't expand into a list (of which this address is part). 465 ;; alias doesn't expand into a list (of which this address is part).
468 (car (delq nil (mapcar 466 (car (delq nil (mapcar
469 (function 467 (lambda (alias)
470 (lambda (alias) 468 (let ((recurse (mh-alias-ali alias nil)))
471 (let ((recurse (mh-alias-ali alias nil))) 469 (if (string-match ".*,.*" recurse)
472 (if (string-match ".*,.*" recurse) 470 nil
473 nil 471 alias)))
474 alias))))
475 (split-string aliases ", +"))))))) 472 (split-string aliases ", +")))))))
476 473
477;;;###mh-autoload 474;;;###mh-autoload
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 8a69adbb756..e766bca89d8 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -435,43 +435,42 @@ See also `mh-send'."
435 (mh-insert-header-separator) 435 (mh-insert-header-separator)
436 ;; Merge in components 436 ;; Merge in components
437 (mh-mapc 437 (mh-mapc
438 (function 438 (lambda (header-field)
439 (lambda (header-field) 439 (let ((field (car header-field))
440 (let ((field (car header-field)) 440 (value (cdr header-field))
441 (value (cdr header-field)) 441 (case-fold-search t))
442 (case-fold-search t)) 442 (cond
443 (cond 443 ;; Address field
444 ;; Address field 444 ((string-match field "^To$\\|^Cc$\\|^From$")
445 ((string-match field "^To$\\|^Cc$\\|^From$") 445 (cond
446 (cond 446 ((not (mh-goto-header-field (concat field ":")))
447 ((not (mh-goto-header-field (concat field ":"))) 447 ;; Header field does not exist, add it
448 ;; Header field does not exist, add it 448 (mh-goto-header-end 0)
449 (mh-goto-header-end 0) 449 (insert field ": " value "\n"))
450 (insert field ": " value "\n")) 450 ((string-equal value "")
451 ((string-equal value "") 451 ;; Header field already exists and no value
452 ;; Header field already exists and no value 452 )
453 ) 453 (t
454 (t 454 ;; Header field exists and we have a value
455 ;; Header field exists and we have a value 455 (let (address mailbox (alias (mh-alias-expand value)))
456 (let (address mailbox (alias (mh-alias-expand value))) 456 (and alias
457 (and alias 457 (setq address (ietf-drums-parse-address alias))
458 (setq address (ietf-drums-parse-address alias)) 458 (setq mailbox (car address)))
459 (setq mailbox (car address))) 459 ;; XXX - Need to parse all addresses out of field
460 ;; XXX - Need to parse all addresses out of field 460 (if (and
461 (if (and 461 (not (mh-regexp-in-field-p
462 (not (mh-regexp-in-field-p 462 (concat "\\b" (regexp-quote value) "\\b") field))
463 (concat "\\b" (regexp-quote value) "\\b") field)) 463 mailbox
464 mailbox 464 (not (mh-regexp-in-field-p
465 (not (mh-regexp-in-field-p 465 (concat "\\b" (regexp-quote mailbox) "\\b") field)))
466 (concat "\\b" (regexp-quote mailbox) "\\b") field))) 466 (insert " " value ","))
467 (insert " " value ",")) 467 ))))
468 )))) 468 ((string-match field "^Fcc$")
469 ((string-match field "^Fcc$") 469 ;; Folder reference
470 ;; Folder reference 470 (mh-modify-header-field field value))
471 (mh-modify-header-field field value)) 471 ;; Text field, that's an easy case
472 ;; Text field, that's an easy case 472 (t
473 (t 473 (mh-modify-header-field field value)))))
474 (mh-modify-header-field field value))))))
475 (mh-components-to-list components-file)) 474 (mh-components-to-list components-file))
476 (delete-file components-file) 475 (delete-file components-file)
477 (goto-char (point-min)) 476 (goto-char (point-min))
@@ -700,25 +699,24 @@ message and scan line."
700 ;; trumping anything in the distcomps file. 699 ;; trumping anything in the distcomps file.
701 (let ((components-file (mh-bare-components mh-dist-formfile))) 700 (let ((components-file (mh-bare-components mh-dist-formfile)))
702 (mh-mapc 701 (mh-mapc
703 (function 702 (lambda (header-field)
704 (lambda (header-field) 703 (let ((field (car header-field))
705 (let ((field (car header-field)) 704 (value (cdr header-field))
706 (value (cdr header-field)) 705 (case-fold-search t))
707 (case-fold-search t)) 706 (cond
708 (cond 707 ((string-match field "^Resent-Fcc$")
709 ((string-match field "^Resent-Fcc$") 708 (setq comp-fcc value))
710 (setq comp-fcc value)) 709 ((string-match field "^Resent-From$")
711 ((string-match field "^Resent-From$") 710 (or from
712 (or from 711 (setq from value)))
713 (setq from value))) 712 ((string-match field "^Resent-To$")
714 ((string-match field "^Resent-To$") 713 (setq comp-to value))
715 (setq comp-to value)) 714 ((string-match field "^Resent-Cc$")
716 ((string-match field "^Resent-Cc$") 715 (setq comp-cc value))
717 (setq comp-cc value)) 716 ((string-match field "^Resent-Bcc$")
718 ((string-match field "^Resent-Bcc$") 717 (setq comp-bcc value))
719 (setq comp-bcc value)) 718 ((string-match field "^Resent-.*$")
720 ((string-match field "^Resent-.*$") 719 (mh-insert-fields field value)))))
721 (mh-insert-fields field value))))))
722 (mh-components-to-list components-file)) 720 (mh-components-to-list components-file))
723 (delete-file components-file)) 721 (delete-file components-file))
724 (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ") 722 (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ")
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index ebc7d2a4fcb..ed239963391 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -71,10 +71,9 @@ See `mh-identity-add-menu'."
71 (mh-insert-auto-fields) mh-auto-fields-list] 71 (mh-insert-auto-fields) mh-auto-fields-list]
72 "--") 72 "--")
73 73
74 (mapcar (function 74 (mapcar (lambda (arg)
75 (lambda (arg) 75 `[,arg (mh-insert-identity ,arg) :style radio
76 `[,arg (mh-insert-identity ,arg) :style radio 76 :selected (equal mh-identity-local ,arg)])
77 :selected (equal mh-identity-local ,arg)]))
78 (mapcar 'car mh-identity-list)) 77 (mapcar 'car mh-identity-list))
79 '(["None" 78 '(["None"
80 (mh-insert-identity "None") :style radio 79 (mh-insert-identity "None") :style radio
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 44b4ef48795..28d3c7614ce 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -270,9 +270,8 @@ and displayed in a help buffer."
270 (cdr (assoc nil (assoc major-mode mh-help-messages))))) 270 (cdr (assoc nil (assoc major-mode mh-help-messages)))))
271 (text (substitute-command-keys (mapconcat 'identity help "")))) 271 (text (substitute-command-keys (mapconcat 'identity help ""))))
272 (with-electric-help 272 (with-electric-help
273 (function 273 (lambda ()
274 (lambda () 274 (insert text))
275 (insert text)))
276 mh-help-buffer))) 275 mh-help-buffer)))
277 276
278;;;###mh-autoload 277;;;###mh-autoload
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index f36999119f2..da4ea4050d8 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -127,10 +127,8 @@ Buffer should contain output generated by `dig-invoke'."
127 "Major mode for displaying dig output." 127 "Major mode for displaying dig output."
128 (buffer-disable-undo) 128 (buffer-disable-undo)
129 (setq-local font-lock-defaults '(dig-font-lock-keywords t)) 129 (setq-local font-lock-defaults '(dig-font-lock-keywords t))
130 (when (featurep 'font-lock) 130 ;; FIXME: what is this for?? --Stef M
131 ;; FIXME: what is this for?? --Stef 131 (font-lock-set-defaults))
132 (font-lock-set-defaults))
133 )
134 132
135(defun dig-exit () 133(defun dig-exit ()
136 "Quit dig output buffer." 134 "Quit dig output buffer."
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index bb6682520ae..b2069ed6ef8 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -153,9 +153,7 @@ display a button."
153 'end-glyph (if inline glyph) 153 'end-glyph (if inline glyph)
154 'duplicable t 154 'duplicable t
155 'invisible inline 155 'invisible inline
156 'start-open t 156 'object-data data))))
157 'end-open t
158 'object-data data))))
159 ((fboundp 'create-image) 157 ((fboundp 'create-image)
160 (let* ((image (create-image data nil t)) 158 (let* ((image (create-image data nil t))
161 (props (list 'object-data data 'eudc-image image))) 159 (props (list 'object-data data 'eudc-image image)))
@@ -192,9 +190,7 @@ display a button."
192 eudc-bob-sound-keymap 190 eudc-bob-sound-keymap
193 eudc-bob-sound-menu 191 eudc-bob-sound-menu
194 (list 'duplicable t 192 (list 'duplicable t
195 'start-open t 193 'object-data data)))
196 'end-open t
197 'object-data data)))
198 194
199(defun eudc-bob-display-generic-binary (data) 195(defun eudc-bob-display-generic-binary (data)
200 "Display a button for unidentified binary DATA." 196 "Display a button for unidentified binary DATA."
@@ -202,9 +198,7 @@ display a button."
202 eudc-bob-generic-keymap 198 eudc-bob-generic-keymap
203 eudc-bob-generic-menu 199 eudc-bob-generic-menu
204 (list 'duplicable t 200 (list 'duplicable t
205 'start-open t 201 'object-data data)))
206 'end-open t
207 'object-data data)))
208 202
209(defun eudc-bob-play-sound-at-point () 203(defun eudc-bob-play-sound-at-point ()
210 "Play the sound data contained in the button at point." 204 "Play the sound data contained in the button at point."
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index ba86958142c..5c966281499 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -78,12 +78,11 @@ If SILENT is non-nil then the created BBDB record is not displayed."
78 record t))) 78 record t)))
79 ;; BBDB custom fields 79 ;; BBDB custom fields
80 (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes))) 80 (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
81 (mapcar (function 81 (mapcar (lambda (mapping)
82 (lambda (mapping) 82 (if (and (not (memq (car mapping)
83 (if (and (not (memq (car mapping) 83 '(name company net address phone notes)))
84 '(name company net address phone notes))) 84 (setq value (eudc-parse-spec (cdr mapping) record nil)))
85 (setq value (eudc-parse-spec (cdr mapping) record nil))) 85 (cons (car mapping) value)))
86 (cons (car mapping) value))))
87 conversion-alist))) 86 conversion-alist)))
88 (setq bbdb-notes (delq nil bbdb-notes)) 87 (setq bbdb-notes (delq nil bbdb-notes))
89 (setq bbdb-record (bbdb-create-internal 88 (setq bbdb-record (bbdb-create-internal
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 08cab4f0470..f4e4c17d69e 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -414,10 +414,9 @@ if any, is called to print the value in cdr of FIELD."
414 (eval (list (cdr match) val)) 414 (eval (list (cdr match) val))
415 (insert "\n")) 415 (insert "\n"))
416 (mapc 416 (mapc
417 (function 417 (lambda (val-elem)
418 (lambda (val-elem) 418 (indent-to col)
419 (indent-to col) 419 (insert val-elem "\n"))
420 (insert val-elem "\n")))
421 (cond 420 (cond
422 ((listp val) val) 421 ((listp val) val)
423 ((stringp val) (split-string val "\n")) 422 ((stringp val) (split-string val "\n"))
@@ -464,37 +463,33 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
464 ;; Replace field names with user names, compute max width 463 ;; Replace field names with user names, compute max width
465 (setq precords 464 (setq precords
466 (mapcar 465 (mapcar
467 (function 466 (lambda (record)
468 (lambda (record) 467 (mapcar
469 (mapcar 468 (lambda (field)
470 (function 469 (setq attribute-name
471 (lambda (field) 470 (if raw-attr-names
472 (setq attribute-name 471 (symbol-name (car field))
473 (if raw-attr-names 472 (eudc-format-attribute-name-for-display (car field))))
474 (symbol-name (car field)) 473 (if (> (length attribute-name) width)
475 (eudc-format-attribute-name-for-display (car field)))) 474 (setq width (length attribute-name)))
476 (if (> (length attribute-name) width) 475 (cons attribute-name (cdr field)))
477 (setq width (length attribute-name))) 476 record))
478 (cons attribute-name (cdr field))))
479 record)))
480 records)) 477 records))
481 ;; Display the records 478 ;; Display the records
482 (setq first-record (point)) 479 (setq first-record (point))
483 (mapc 480 (mapc
484 (function 481 (lambda (record)
485 (lambda (record) 482 (setq beg (point))
486 (setq beg (point)) 483 ;; Map over the record fields to print the attribute/value pairs
487 ;; Map over the record fields to print the attribute/value pairs 484 (mapc (lambda (field)
488 (mapc (function 485 (eudc-print-record-field field width))
489 (lambda (field) 486 record)
490 (eudc-print-record-field field width))) 487 ;; Store the record internal format in some convenient place
491 record) 488 (overlay-put (make-overlay beg (point))
492 ;; Store the record internal format in some convenient place 489 'eudc-record
493 (overlay-put (make-overlay beg (point)) 490 (car records))
494 'eudc-record 491 (setq records (cdr records))
495 (car records)) 492 (insert "\n"))
496 (setq records (cdr records))
497 (insert "\n")))
498 precords)) 493 precords))
499 (insert "\n") 494 (insert "\n")
500 (widget-create 'push-button 495 (widget-create 'push-button
@@ -518,12 +513,11 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
518 (if (not (and (boundp 'eudc-form-widget-list) 513 (if (not (and (boundp 'eudc-form-widget-list)
519 eudc-form-widget-list)) 514 eudc-form-widget-list))
520 (error "Not in a directory query form buffer") 515 (error "Not in a directory query form buffer")
521 (mapc (function 516 (mapc (lambda (wid-field)
522 (lambda (wid-field) 517 (setq value (widget-value (cdr wid-field)))
523 (setq value (widget-value (cdr wid-field))) 518 (if (not (string= value ""))
524 (if (not (string= value "")) 519 (setq query-alist (cons (cons (car wid-field) value)
525 (setq query-alist (cons (cons (car wid-field) value) 520 query-alist))))
526 query-alist)))))
527 eudc-form-widget-list) 521 eudc-form-widget-list)
528 (kill-buffer (current-buffer)) 522 (kill-buffer (current-buffer))
529 (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names)))) 523 (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names))))
@@ -543,49 +537,47 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
543 537
544 (if (null (cdar rec)) 538 (if (null (cdar rec))
545 (list record) ; No duplicate attrs in this record 539 (list record) ; No duplicate attrs in this record
546 (mapc (function 540 (mapc (lambda (field)
547 (lambda (field) 541 (if (listp (cdr field))
548 (if (listp (cdr field)) 542 (setq duplicates (cons field duplicates))
549 (setq duplicates (cons field duplicates)) 543 (setq unique (cons field unique))))
550 (setq unique (cons field unique)))))
551 record) 544 record)
552 (setq result (list unique)) 545 (setq result (list unique))
553 ;; Map over the record fields that have multiple values 546 ;; Map over the record fields that have multiple values
554 (mapc 547 (mapc
555 (function 548 (lambda (field)
556 (lambda (field) 549 (let ((method (if (consp eudc-duplicate-attribute-handling-method)
557 (let ((method (if (consp eudc-duplicate-attribute-handling-method) 550 (cdr
558 (cdr 551 (assq
559 (assq 552 (or
560 (or 553 (car
561 (car 554 (rassq
562 (rassq 555 (car field)
563 (car field) 556 (symbol-value
564 (symbol-value 557 eudc-protocol-attributes-translation-alist)))
565 eudc-protocol-attributes-translation-alist))) 558 (car field))
566 (car field)) 559 eudc-duplicate-attribute-handling-method))
567 eudc-duplicate-attribute-handling-method)) 560 eudc-duplicate-attribute-handling-method)))
568 eudc-duplicate-attribute-handling-method))) 561 (cond
569 (cond 562 ((or (null method) (eq 'list method))
570 ((or (null method) (eq 'list method)) 563 (setq result
571 (setq result 564 (eudc-add-field-to-records field result)))
572 (eudc-add-field-to-records field result))) 565 ((eq 'first method)
573 ((eq 'first method) 566 (setq result
574 (setq result 567 (eudc-add-field-to-records (cons (car field)
575 (eudc-add-field-to-records (cons (car field) 568 (cadr field))
576 (cadr field)) 569 result)))
577 result))) 570 ((eq 'concat method)
578 ((eq 'concat method) 571 (setq result
579 (setq result 572 (eudc-add-field-to-records (cons (car field)
580 (eudc-add-field-to-records (cons (car field) 573 (mapconcat
581 (mapconcat 574 #'identity
582 #'identity 575 (cdr field)
583 (cdr field) 576 "\n"))
584 "\n")) 577 result)))
585 result))) 578 ((eq 'duplicate method)
586 ((eq 'duplicate method) 579 (setq result
587 (setq result 580 (eudc-distribute-field-on-records field result))))))
588 (eudc-distribute-field-on-records field result)))))))
589 duplicates) 581 duplicates)
590 result))) 582 result)))
591 583
@@ -593,19 +585,17 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
593 "Eliminate records that do not contain all ATTRS from RECORDS." 585 "Eliminate records that do not contain all ATTRS from RECORDS."
594 (delq nil 586 (delq nil
595 (mapcar 587 (mapcar
596 (function 588 (lambda (rec)
597 (lambda (rec) 589 (if (cl-every (lambda (attr)
598 (if (cl-every (lambda (attr) 590 (consp (assq attr rec)))
599 (consp (assq attr rec))) 591 attrs)
600 attrs) 592 rec))
601 rec)))
602 records))) 593 records)))
603 594
604(defun eudc-add-field-to-records (field records) 595(defun eudc-add-field-to-records (field records)
605 "Add FIELD to each individual record in RECORDS and return the resulting list." 596 "Add FIELD to each individual record in RECORDS and return the resulting list."
606 (mapcar (function 597 (mapcar (lambda (r)
607 (lambda (r) 598 (cons field r))
608 (cons field r)))
609 records)) 599 records))
610 600
611(defun eudc-distribute-field-on-records (field records) 601(defun eudc-distribute-field-on-records (field records)
@@ -886,10 +876,9 @@ see `eudc-inline-expansion-servers'."
886 (let ((response-string 876 (let ((response-string
887 (apply #'format 877 (apply #'format
888 (car eudc-inline-expansion-format) 878 (car eudc-inline-expansion-format)
889 (mapcar (function 879 (mapcar (lambda (field)
890 (lambda (field) 880 (or (cdr (assq field r))
891 (or (cdr (assq field r)) 881 ""))
892 "")))
893 (eudc-translate-attribute-list 882 (eudc-translate-attribute-list
894 (cdr eudc-inline-expansion-format)))))) 883 (cdr eudc-inline-expansion-format))))))
895 (if (> (length response-string) 0) 884 (if (> (length response-string) 0)
@@ -929,16 +918,14 @@ queries the server for the existing fields and displays a corresponding form."
929 ;; Build the list of prompts 918 ;; Build the list of prompts
930 (setq prompts (if eudc-use-raw-directory-names 919 (setq prompts (if eudc-use-raw-directory-names
931 (mapcar #'symbol-name (eudc-translate-attribute-list fields)) 920 (mapcar #'symbol-name (eudc-translate-attribute-list fields))
932 (mapcar (function 921 (mapcar (lambda (field)
933 (lambda (field) 922 (or (cdr (assq field eudc-user-attribute-names-alist))
934 (or (cdr (assq field eudc-user-attribute-names-alist)) 923 (capitalize (symbol-name field))))
935 (capitalize (symbol-name field)))))
936 fields))) 924 fields)))
937 ;; Loop over prompt strings to find the longest one 925 ;; Loop over prompt strings to find the longest one
938 (mapc (function 926 (mapc (lambda (prompt)
939 (lambda (prompt) 927 (if (> (length prompt) width)
940 (if (> (length prompt) width) 928 (setq width (length prompt))))
941 (setq width (length prompt)))))
942 prompts) 929 prompts)
943 ;; Insert the first widget out of the mapcar to leave the cursor 930 ;; Insert the first widget out of the mapcar to leave the cursor
944 ;; in the first field 931 ;; in the first field
@@ -949,14 +936,13 @@ queries the server for the existing fields and displays a corresponding form."
949 eudc-form-widget-list)) 936 eudc-form-widget-list))
950 (setq fields (cdr fields)) 937 (setq fields (cdr fields))
951 (setq prompts (cdr prompts)) 938 (setq prompts (cdr prompts))
952 (mapc (function 939 (mapc (lambda (field)
953 (lambda (field) 940 (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
954 (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts))) 941 (setq widget (widget-create 'editable-field
955 (setq widget (widget-create 'editable-field 942 :size 15))
956 :size 15)) 943 (setq eudc-form-widget-list (cons (cons field widget)
957 (setq eudc-form-widget-list (cons (cons field widget) 944 eudc-form-widget-list))
958 eudc-form-widget-list)) 945 (setq prompts (cdr prompts)))
959 (setq prompts (cdr prompts))))
960 fields) 946 fields)
961 (widget-insert "\n\n") 947 (widget-insert "\n\n")
962 (widget-create 'push-button 948 (widget-create 'push-button
@@ -1118,27 +1104,26 @@ queries the server for the existing fields and displays a corresponding form."
1118 (append 1104 (append
1119 '("Server") 1105 '("Server")
1120 (mapcar 1106 (mapcar
1121 (function 1107 (lambda (servspec)
1122 (lambda (servspec) 1108 (let* ((server (car servspec))
1123 (let* ((server (car servspec)) 1109 (protocol (cdr servspec))
1124 (protocol (cdr servspec)) 1110 (proto-name (symbol-name protocol)))
1125 (proto-name (symbol-name protocol))) 1111 (setq command (intern (concat "eudc-set-server-"
1126 (setq command (intern (concat "eudc-set-server-" 1112 server
1127 server 1113 "-"
1128 "-" 1114 proto-name)))
1129 proto-name))) 1115 (if (not (fboundp command))
1130 (if (not (fboundp command)) 1116 (fset command
1131 (fset command 1117 `(lambda ()
1132 `(lambda () 1118 (interactive)
1133 (interactive) 1119 (eudc-set-server ,server (quote ,protocol))
1134 (eudc-set-server ,server (quote ,protocol)) 1120 (message "Selected directory server is now %s (%s)"
1135 (message "Selected directory server is now %s (%s)" 1121 ,server
1136 ,server 1122 ,proto-name))))
1137 ,proto-name)))) 1123 (vector (format "%s (%s)" server proto-name)
1138 (vector (format "%s (%s)" server proto-name) 1124 command
1139 command 1125 :style 'radio
1140 :style 'radio 1126 :selected `(equal eudc-server ,server))))
1141 :selected `(equal eudc-server ,server)))))
1142 eudc-server-hotlist) 1127 eudc-server-hotlist)
1143 eudc-server-menu)) 1128 eudc-server-menu))
1144 eudc-tail-menu))) 1129 eudc-tail-menu)))
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 82e58c28336..5d6b52a19d2 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -137,18 +137,17 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
137 137
138(defun eudc-bbdb-extract-phones (record) 138(defun eudc-bbdb-extract-phones (record)
139 (require 'bbdb) 139 (require 'bbdb)
140 (mapcar (function 140 (mapcar (lambda (phone)
141 (lambda (phone) 141 (if eudc-bbdb-use-locations-as-attribute-names
142 (if eudc-bbdb-use-locations-as-attribute-names 142 (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
143 (cons (intern (if (eudc--using-bbdb-3-or-newer-p) 143 (bbdb-phone-label phone)
144 (bbdb-phone-label phone) 144 (bbdb-phone-location phone)))
145 (bbdb-phone-location phone))) 145 (bbdb-phone-string phone))
146 (bbdb-phone-string phone)) 146 (cons 'phones (format "%s: %s"
147 (cons 'phones (format "%s: %s" 147 (if (eudc--using-bbdb-3-or-newer-p)
148 (if (eudc--using-bbdb-3-or-newer-p) 148 (bbdb-phone-label phone)
149 (bbdb-phone-label phone) 149 (bbdb-phone-location phone))
150 (bbdb-phone-location phone)) 150 (bbdb-phone-string phone)))))
151 (bbdb-phone-string phone))))))
152 (if (eudc--using-bbdb-3-or-newer-p) 151 (if (eudc--using-bbdb-3-or-newer-p)
153 (bbdb-record-phone record) 152 (bbdb-record-phone record)
154 (bbdb-record-phones record)))) 153 (bbdb-record-phones record))))
@@ -243,17 +242,15 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
243 (if (car query-attrs) 242 (if (car query-attrs)
244 (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs)))) 243 (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
245 (setq query-attrs (cdr query-attrs))) 244 (setq query-attrs (cdr query-attrs)))
246 (mapc (function 245 (mapc (lambda (record)
247 (lambda (record) 246 (setq filtered (eudc-filter-duplicate-attributes record))
248 (setq filtered (eudc-filter-duplicate-attributes record)) 247 ;; If there were duplicate attributes reverse the order of the
249 ;; If there were duplicate attributes reverse the order of the 248 ;; record so the unique attributes appear first
250 ;; record so the unique attributes appear first 249 (if (> (length filtered) 1)
251 (if (> (length filtered) 1) 250 (setq filtered (mapcar (lambda (rec)
252 (setq filtered (mapcar (function 251 (reverse rec))
253 (lambda (rec) 252 filtered)))
254 (reverse rec))) 253 (setq result (append result filtered)))
255 filtered)))
256 (setq result (append result filtered))))
257 (delq nil 254 (delq nil
258 (mapcar 'eudc-bbdb-format-record-as-result 255 (mapcar 'eudc-bbdb-format-record-as-result
259 (delq nil 256 (delq nil
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 8218249ec18..5571b2ab81c 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -631,14 +631,13 @@ See %s for details" mairix-output-buffer)))
631 (when (member 'flags mairix-widget-other) 631 (when (member 'flags mairix-widget-other)
632 (setq flag 632 (setq flag
633 (mapconcat 633 (mapconcat
634 (function 634 (lambda (flag)
635 (lambda (flag) 635 (setq temp
636 (setq temp 636 (widget-value (cadr (assoc (car flag) mairix-widgets))))
637 (widget-value (cadr (assoc (car flag) mairix-widgets)))) 637 (if (string= "yes" temp)
638 (if (string= "yes" temp) 638 (cadr flag)
639 (cadr flag) 639 (if (string= "no" temp)
640 (if (string= "no" temp) 640 (concat "-" (cadr flag)))))
641 (concat "-" (cadr flag))))))
642 '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) 641 '(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
643 (when (not (zerop (length flag))) 642 (when (not (zerop (length flag)))
644 (push (concat "F:" flag) query))) 643 (push (concat "F:" flag) query)))
@@ -694,34 +693,33 @@ Fill in VALUES if based on an article."
694VALUES may contain values for editable fields from current article." 693VALUES may contain values for editable fields from current article."
695 (let ((ret)) 694 (let ((ret))
696 (mapc 695 (mapc
697 (function 696 (lambda (field)
698 (lambda (field) 697 (setq field (car (cddr field)))
699 (setq field (car (cddr field))) 698 (setq
700 (setq 699 ret
701 ret 700 (nconc
702 (nconc 701 (list
703 (list 702 (list
704 (list 703 (concat "c" field)
705 (concat "c" field) 704 (widget-create 'checkbox
706 (widget-create 'checkbox 705 :tag field
707 :tag field 706 :notify (lambda (widget &rest ignore)
708 :notify (lambda (widget &rest ignore) 707 (mairix-widget-toggle-activate widget))
709 (mairix-widget-toggle-activate widget)) 708 nil)))
710 nil))) 709 (list
711 (list 710 (list
712 (list 711 (concat "e" field)
713 (concat "e" field) 712 (widget-create 'editable-field
714 (widget-create 'editable-field 713 :size 60
715 :size 60 714 :format (concat " " field ":"
716 :format (concat " " field ":" 715 (make-string
717 (make-string 716 (- 11 (length field)) ?\ )
718 (- 11 (length field)) ?\ ) 717 "%v")
719 "%v") 718 :value (or (cadr (assoc field values)) ""))))
720 :value (or (cadr (assoc field values)) "")))) 719 ret))
721 ret)) 720 (widget-insert "\n")
722 (widget-insert "\n") 721 ;; Deactivate editable field
723 ;; Deactivate editable field 722 (widget-apply (cadr (nth 1 ret)) :deactivate))
724 (widget-apply (cadr (nth 1 ret)) :deactivate)))
725 mairix-widget-fields-list) 723 mairix-widget-fields-list)
726 ret)) 724 ret))
727 725
@@ -936,13 +934,12 @@ Use cursor keys or C-n,C-p to select next/previous search.\n\n")
936 (save-excursion 934 (save-excursion
937 (save-restriction 935 (save-restriction
938 (mapcar 936 (mapcar
939 (function 937 (lambda (field)
940 (lambda (field) 938 (list (car (cddr field))
941 (list (car (cddr field)) 939 (if (car field)
942 (if (car field) 940 (mairix-replace-invalid-chars
943 (mairix-replace-invalid-chars 941 (funcall get-mail-header (car field)))
944 (funcall get-mail-header (car field))) 942 nil)))
945 nil))))
946 mairix-widget-fields-list))) 943 mairix-widget-fields-list)))
947 (error "No function for obtaining mail header specified")))) 944 (error "No function for obtaining mail header specified"))))
948 945
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index c5f44917919..05e9747e74d 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -43,8 +43,6 @@
43 43
44(autoload 'sieve-manage "sieve") 44(autoload 'sieve-manage "sieve")
45(autoload 'sieve-upload "sieve") 45(autoload 'sieve-upload "sieve")
46(eval-when-compile
47 (require 'font-lock))
48 46
49(defgroup sieve nil 47(defgroup sieve nil
50 "Sieve." 48 "Sieve."
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 7cdb7ebf536..51cb316249d 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -363,7 +363,8 @@ ARGUMENTS to pass to the OPERATION."
363 ;; by GNU Coreutils. Force "ls" to print one column and set 363 ;; by GNU Coreutils. Force "ls" to print one column and set
364 ;; time-style to imitate other "ls" flavors. 364 ;; time-style to imitate other "ls" flavors.
365 ((tramp-adb-send-command-and-check 365 ((tramp-adb-send-command-and-check
366 vec "ls --time-style=long-iso /dev/null") 366 vec (concat "ls --time-style=long-iso "
367 (tramp-get-remote-null-device vec)))
367 "ls -1 --time-style=long-iso") 368 "ls -1 --time-style=long-iso")
368 ;; Can't disable coloring explicitly for toybox ls command. We 369 ;; Can't disable coloring explicitly for toybox ls command. We
369 ;; also must force "ls" to print just one column. 370 ;; also must force "ls" to print just one column.
@@ -371,7 +372,8 @@ ARGUMENTS to pass to the OPERATION."
371 ;; On CyanogenMod based system BusyBox is used and "ls" output 372 ;; On CyanogenMod based system BusyBox is used and "ls" output
372 ;; coloring is enabled by default. So we try to disable it when 373 ;; coloring is enabled by default. So we try to disable it when
373 ;; possible. 374 ;; possible.
374 ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null") 375 ((tramp-adb-send-command-and-check
376 vec (concat "ls --color=never -al " (tramp-get-remote-null-device vec)))
375 "ls --color=never") 377 "ls --color=never")
376 (t "ls")))) 378 (t "ls"))))
377 379
@@ -611,13 +613,13 @@ But handle the case, if the \"test\" command is not available."
611 ;; (introduced in POSIX.1-2008) fails. 613 ;; (introduced in POSIX.1-2008) fails.
612 (tramp-adb-send-command-and-check 614 (tramp-adb-send-command-and-check
613 v (format 615 v (format
614 (concat "touch -d %s %s %s 2>/dev/null || " 616 (concat "touch -d %s %s %s 2>%s || "
615 "touch -d %s %s %s 2>/dev/null || " 617 "touch -d %s %s %s 2>%s || "
616 "touch -t %s %s %s") 618 "touch -t %s %s %s")
617 (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) 619 (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
618 nofollow quoted-name 620 nofollow quoted-name (tramp-get-remote-null-device v)
619 (format-time-string "%Y-%m-%dT%H:%M:%S" time t) 621 (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
620 nofollow quoted-name 622 nofollow quoted-name (tramp-get-remote-null-device v)
621 (format-time-string "%Y%m%d%H%M.%S" time t) 623 (format-time-string "%Y%m%d%H%M.%S" time t)
622 nofollow quoted-name))))) 624 nofollow quoted-name)))))
623 625
@@ -791,7 +793,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
791 (cons program args) " ")) 793 (cons program args) " "))
792 ;; Determine input. 794 ;; Determine input.
793 (if (null infile) 795 (if (null infile)
794 (setq input "/dev/null") 796 (setq input (tramp-get-remote-null-device v))
795 (setq infile (expand-file-name infile)) 797 (setq infile (expand-file-name infile))
796 (if (tramp-equal-remote default-directory infile) 798 (if (tramp-equal-remote default-directory infile)
797 ;; INFILE is on the same remote host. 799 ;; INFILE is on the same remote host.
@@ -833,7 +835,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
833 tmpstderr (tramp-make-tramp-file-name v stderr)))) 835 tmpstderr (tramp-make-tramp-file-name v stderr))))
834 ;; stderr to be discarded. 836 ;; stderr to be discarded.
835 ((null (cadr destination)) 837 ((null (cadr destination))
836 (setq stderr "/dev/null")))) 838 (setq stderr (tramp-get-remote-null-device v)))))
837 ;; 't 839 ;; 't
838 (destination 840 (destination
839 (setq outbuf (current-buffer)))) 841 (setq outbuf (current-buffer))))
@@ -1316,23 +1318,24 @@ connection if a previous connection has died for some reason."
1316 ;; Mark it as connected. 1318 ;; Mark it as connected.
1317 (tramp-set-connection-property p "connected" t))))))) 1319 (tramp-set-connection-property p "connected" t)))))))
1318 1320
1319;; Default settings for connection-local variables. 1321;;; Default connection-local variables for Tramp:
1320(defconst tramp-adb-connection-local-default-profile 1322;; `connection-local-set-profile-variables' and
1323;; `connection-local-set-profiles' exists since Emacs 26.1.
1324(defconst tramp-adb-connection-local-default-shell-variables
1321 '((shell-file-name . "/system/bin/sh") 1325 '((shell-file-name . "/system/bin/sh")
1322 (shell-command-switch . "-c")) 1326 (shell-command-switch . "-c"))
1323 "Default connection-local variables for remote adb connections.") 1327 "Default connection-local shell variables for remote adb connections.")
1328
1329(tramp-compat-funcall
1330 'connection-local-set-profile-variables
1331 'tramp-adb-connection-local-default-shell-profile
1332 tramp-adb-connection-local-default-shell-variables)
1324 1333
1325;; `connection-local-set-profile-variables' and
1326;; `connection-local-set-profiles' exists since Emacs 26.1.
1327(with-eval-after-load 'shell 1334(with-eval-after-load 'shell
1328 (tramp-compat-funcall 1335 (tramp-compat-funcall
1329 'connection-local-set-profile-variables
1330 'tramp-adb-connection-local-default-profile
1331 tramp-adb-connection-local-default-profile)
1332 (tramp-compat-funcall
1333 'connection-local-set-profiles 1336 'connection-local-set-profiles
1334 `(:application tramp :protocol ,tramp-adb-method) 1337 `(:application tramp :protocol ,tramp-adb-method)
1335 'tramp-adb-connection-local-default-profile)) 1338 'tramp-adb-connection-local-default-shell-profile))
1336 1339
1337(add-hook 'tramp-unload-hook 1340(add-hook 'tramp-unload-hook
1338 (lambda () 1341 (lambda ()
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 9a4e16efe20..7fae9ba7e2f 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -43,6 +43,7 @@
43 43
44;; `temporary-file-directory' as function is introduced with Emacs 26.1. 44;; `temporary-file-directory' as function is introduced with Emacs 26.1.
45(declare-function tramp-handle-temporary-file-directory "tramp") 45(declare-function tramp-handle-temporary-file-directory "tramp")
46(declare-function tramp-tramp-file-p "tramp")
46(defvar tramp-temp-name-prefix) 47(defvar tramp-temp-name-prefix)
47 48
48(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version) 49(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version)
@@ -333,6 +334,13 @@ A nil value for either argument stands for the current time."
333 (null (tramp-compat-directory-files 334 (null (tramp-compat-directory-files
334 dir nil directory-files-no-dot-files-regexp t 1)))))) 335 dir nil directory-files-no-dot-files-regexp t 1))))))
335 336
337;; Function `null-device' is new in Emacs 28.1.
338(defalias 'tramp-compat-null-device
339 (if (fboundp 'null-device)
340 #'null-device
341 (lambda ()
342 (if (tramp-tramp-file-p default-directory) "/dev/null" null-device))))
343
336(add-hook 'tramp-unload-hook 344(add-hook 'tramp-unload-hook
337 (lambda () 345 (lambda ()
338 (unload-feature 'tramp-loaddefs 'force) 346 (unload-feature 'tramp-loaddefs 'force)
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 7e4a9bf05e5..566c673af16 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -262,23 +262,39 @@ NAME must be equal to `tramp-current-connection'."
262 (info-lookup->topic-cache 'symbol)))))))) 262 (info-lookup->topic-cache 'symbol))))))))
263 263
264;;; Default connection-local variables for Tramp: 264;;; Default connection-local variables for Tramp:
265;; `connection-local-set-profile-variables' and
266;; `connection-local-set-profiles' exists since Emacs 26.1.
267
268(defconst tramp-connection-local-default-system-variables
269 '((path-separator . ":")
270 (null-device . "/dev/null"))
271 "Default connection-local system variables for remote connections.")
272
273(tramp-compat-funcall
274 'connection-local-set-profile-variables
275 'tramp-connection-local-default-system-profile
276 tramp-connection-local-default-system-variables)
277
278(tramp-compat-funcall
279 'connection-local-set-profiles
280 `(:application tramp)
281 'tramp-connection-local-default-system-profile)
265 282
266(defconst tramp-connection-local-default-profile 283(defconst tramp-connection-local-default-shell-variables
267 '((shell-file-name . "/bin/sh") 284 '((shell-file-name . "/bin/sh")
268 (shell-command-switch . "-c")) 285 (shell-command-switch . "-c"))
269 "Default connection-local variables for remote connections.") 286 "Default connection-local shell variables for remote connections.")
287
288(tramp-compat-funcall
289 'connection-local-set-profile-variables
290 'tramp-connection-local-default-shell-profile
291 tramp-connection-local-default-shell-variables)
270 292
271;; `connection-local-set-profile-variables' and
272;; `connection-local-set-profiles' exists since Emacs 26.1.
273(with-eval-after-load 'shell 293(with-eval-after-load 'shell
274 (tramp-compat-funcall 294 (tramp-compat-funcall
275 'connection-local-set-profile-variables
276 'tramp-connection-local-default-profile
277 tramp-connection-local-default-profile)
278 (tramp-compat-funcall
279 'connection-local-set-profiles 295 'connection-local-set-profiles
280 `(:application tramp) 296 `(:application tramp)
281 'tramp-connection-local-default-profile)) 297 'tramp-connection-local-default-shell-profile))
282 298
283(add-hook 'tramp-unload-hook 299(add-hook 'tramp-unload-hook
284 (lambda () (unload-feature 'tramp-integration 'force))) 300 (lambda () (unload-feature 'tramp-integration 'force)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index ccf0c0d0e28..d2265ed1dfa 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -244,14 +244,14 @@ The string is used in `tramp-methods'.")
244 (add-to-list 'tramp-methods 244 (add-to-list 'tramp-methods
245 `("telnet" 245 `("telnet"
246 (tramp-login-program "telnet") 246 (tramp-login-program "telnet")
247 (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) 247 (tramp-login-args (("%h") ("%p") ("%n")))
248 (tramp-remote-shell ,tramp-default-remote-shell) 248 (tramp-remote-shell ,tramp-default-remote-shell)
249 (tramp-remote-shell-login ("-l")) 249 (tramp-remote-shell-login ("-l"))
250 (tramp-remote-shell-args ("-c")))) 250 (tramp-remote-shell-args ("-c"))))
251 (add-to-list 'tramp-methods 251 (add-to-list 'tramp-methods
252 `("nc" 252 `("nc"
253 (tramp-login-program "telnet") 253 (tramp-login-program "telnet")
254 (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) 254 (tramp-login-args (("%h") ("%p") ("%n")))
255 (tramp-remote-shell ,tramp-default-remote-shell) 255 (tramp-remote-shell ,tramp-default-remote-shell)
256 (tramp-remote-shell-login ("-l")) 256 (tramp-remote-shell-login ("-l"))
257 (tramp-remote-shell-args ("-c")) 257 (tramp-remote-shell-args ("-c"))
@@ -262,8 +262,7 @@ The string is used in `tramp-methods'.")
262 ;; We use "-p" as required for newer busyboxes. For older 262 ;; We use "-p" as required for newer busyboxes. For older
263 ;; busybox/nc versions, the value must be (("-l") ("%r")). This 263 ;; busybox/nc versions, the value must be (("-l") ("%r")). This
264 ;; can be achieved by tweaking `tramp-connection-properties'. 264 ;; can be achieved by tweaking `tramp-connection-properties'.
265 (tramp-remote-copy-args (("-l") ("-p" "%r") 265 (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n")))))
266 ("2>/dev/null")))))
267 (add-to-list 'tramp-methods 266 (add-to-list 'tramp-methods
268 `("su" 267 `("su"
269 (tramp-login-program "su") 268 (tramp-login-program "su")
@@ -763,7 +762,7 @@ This string is passed to `format', so percent characters need to be doubled.")
763 762
764;; These two use base64 encoding. 763;; These two use base64 encoding.
765(defconst tramp-perl-encode-with-module 764(defconst tramp-perl-encode-with-module
766 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null" 765 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
767 "Perl program to use for encoding a file. 766 "Perl program to use for encoding a file.
768Escape sequence %s is replaced with name of Perl binary. 767Escape sequence %s is replaced with name of Perl binary.
769This string is passed to `format', so percent characters need to be doubled. 768This string is passed to `format', so percent characters need to be doubled.
@@ -771,7 +770,7 @@ This implementation requires the MIME::Base64 Perl module to be installed
771on the remote host.") 770on the remote host.")
772 771
773(defconst tramp-perl-decode-with-module 772(defconst tramp-perl-decode-with-module
774 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null" 773 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' %n"
775 "Perl program to use for decoding a file. 774 "Perl program to use for decoding a file.
776Escape sequence %s is replaced with name of Perl binary. 775Escape sequence %s is replaced with name of Perl binary.
777This string is passed to `format', so percent characters need to be doubled. 776This string is passed to `format', so percent characters need to be doubled.
@@ -812,7 +811,7 @@ while (read STDIN, $data, 54) {
812 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)), 811 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
813 $pad, 812 $pad,
814 qq(\\n); 813 qq(\\n);
815}' 2>/dev/null" 814}' %n"
816 "Perl program to use for encoding a file. 815 "Perl program to use for encoding a file.
817Escape sequence %s is replaced with name of Perl binary. 816Escape sequence %s is replaced with name of Perl binary.
818This string is passed to `format', so percent characters need to be doubled.") 817This string is passed to `format', so percent characters need to be doubled.")
@@ -856,7 +855,7 @@ while (my $data = <STDIN>) {
856 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g); 855 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
857 856
858 last if $finished; 857 last if $finished;
859}' 2>/dev/null" 858}' %n"
860 "Perl program to use for decoding a file. 859 "Perl program to use for decoding a file.
861Escape sequence %s is replaced with name of Perl binary. 860Escape sequence %s is replaced with name of Perl binary.
862This string is passed to `format', so percent characters need to be doubled.") 861This string is passed to `format', so percent characters need to be doubled.")
@@ -938,7 +937,7 @@ BEGIN {
938 if (o) { 937 if (o) {
939 printf \"%%c\", o 938 printf \"%%c\", o
940 } else { 939 } else {
941 system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\") 940 system(\"dd if=/dev/zero bs=1 count=1 %n\")
942 } 941 }
943 obc=0; o=0 942 obc=0; o=0
944 } 943 }
@@ -1785,7 +1784,7 @@ ID-FORMAT valid values are `string' and `integer'."
1785 "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | " 1784 "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
1786 "xargs -0 %s -c " 1785 "xargs -0 %s -c "
1787 "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " 1786 "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
1788 "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") 1787 "-- 2>%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
1789 (tramp-shell-quote-argument localname) 1788 (tramp-shell-quote-argument localname)
1790 (tramp-get-ls-command vec) 1789 (tramp-get-ls-command vec)
1791 ;; On systems which have no quoting style, file names with special 1790 ;; On systems which have no quoting style, file names with special
@@ -1801,6 +1800,7 @@ ID-FORMAT valid values are `string' and `integer'."
1801 "%g" 1800 "%g"
1802 (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker))) 1801 (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
1803 tramp-stat-marker tramp-stat-marker 1802 tramp-stat-marker tramp-stat-marker
1803 (tramp-get-remote-null-device vec)
1804 tramp-stat-quoted-marker))) 1804 tramp-stat-quoted-marker)))
1805 1805
1806;; This function should return "foo/" for directories and "bar" for 1806;; This function should return "foo/" for directories and "bar" for
@@ -1827,14 +1827,16 @@ ID-FORMAT valid values are `string' and `integer'."
1827 (tramp-shell-quote-argument localname))) 1827 (tramp-shell-quote-argument localname)))
1828 1828
1829 (format (concat 1829 (format (concat
1830 "(cd %s 2>&1 && %s -a 2>/dev/null" 1830 "(cd %s 2>&1 && %s -a 2>%s"
1831 " | while IFS= read f; do" 1831 " | while IFS= read f; do"
1832 " if %s -d \"$f\" 2>/dev/null;" 1832 " if %s -d \"$f\" 2>%s;"
1833 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" 1833 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
1834 " && \\echo ok) || \\echo fail") 1834 " && \\echo ok) || \\echo fail")
1835 (tramp-shell-quote-argument localname) 1835 (tramp-shell-quote-argument localname)
1836 (tramp-get-ls-command v) 1836 (tramp-get-ls-command v)
1837 (tramp-get-test-command v)))) 1837 (tramp-get-remote-null-device v)
1838 (tramp-get-test-command v)
1839 (tramp-get-remote-null-device v))))
1838 1840
1839 ;; Now grab the output. 1841 ;; Now grab the output.
1840 (with-current-buffer (tramp-get-buffer v) 1842 (with-current-buffer (tramp-get-buffer v)
@@ -2362,7 +2364,8 @@ The method used must be an out-of-band method."
2362 options (format-spec (tramp-ssh-controlmaster-options v) spec) 2364 options (format-spec (tramp-ssh-controlmaster-options v) spec)
2363 spec (format-spec-make 2365 spec (format-spec-make
2364 ?h host ?u user ?p port ?r listener ?c options 2366 ?h host ?u user ?p port ?r listener ?c options
2365 ?k (if keep-date " " "")) 2367 ?k (if keep-date " " "")
2368 ?n (concat "2>" (tramp-get-remote-null-device v)))
2366 copy-program (tramp-get-method-parameter v 'tramp-copy-program) 2369 copy-program (tramp-get-method-parameter v 'tramp-copy-program)
2367 copy-keep-date (tramp-get-method-parameter 2370 copy-keep-date (tramp-get-method-parameter
2368 v 'tramp-copy-keep-date) 2371 v 'tramp-copy-keep-date)
@@ -2629,12 +2632,13 @@ The method used must be an out-of-band method."
2629 (if full-directory-p 2632 (if full-directory-p
2630 (tramp-send-command 2633 (tramp-send-command
2631 v 2634 v
2632 (format "%s %s %s 2>/dev/null" 2635 (format "%s %s %s 2>%s"
2633 (tramp-get-ls-command v) 2636 (tramp-get-ls-command v)
2634 switches 2637 switches
2635 (if wildcard 2638 (if wildcard
2636 localname 2639 localname
2637 (tramp-shell-quote-argument (concat localname "."))))) 2640 (tramp-shell-quote-argument (concat localname ".")))
2641 (tramp-get-remote-null-device v)))
2638 (tramp-barf-unless-okay 2642 (tramp-barf-unless-okay
2639 v 2643 v
2640 (format "cd %s" (tramp-shell-quote-argument 2644 (format "cd %s" (tramp-shell-quote-argument
@@ -2645,7 +2649,7 @@ The method used must be an out-of-band method."
2645 (tramp-run-real-handler #'file-name-directory (list localname)))) 2649 (tramp-run-real-handler #'file-name-directory (list localname))))
2646 (tramp-send-command 2650 (tramp-send-command
2647 v 2651 v
2648 (format "%s %s %s 2>/dev/null" 2652 (format "%s %s %s 2>%s"
2649 (tramp-get-ls-command v) 2653 (tramp-get-ls-command v)
2650 switches 2654 switches
2651 (if (or wildcard 2655 (if (or wildcard
@@ -2655,7 +2659,8 @@ The method used must be an out-of-band method."
2655 "" 2659 ""
2656 (tramp-shell-quote-argument 2660 (tramp-shell-quote-argument
2657 (tramp-run-real-handler 2661 (tramp-run-real-handler
2658 #'file-name-nondirectory (list localname))))))) 2662 #'file-name-nondirectory (list localname))))
2663 (tramp-get-remote-null-device v))))
2659 2664
2660 (save-restriction 2665 (save-restriction
2661 (let ((beg (point))) 2666 (let ((beg (point)))
@@ -2691,15 +2696,44 @@ The method used must be an out-of-band method."
2691 ;; Some busyboxes are reluctant to discard colors. 2696 ;; Some busyboxes are reluctant to discard colors.
2692 (unless 2697 (unless
2693 (string-match-p "color" (tramp-get-connection-property v "ls" "")) 2698 (string-match-p "color" (tramp-get-connection-property v "ls" ""))
2694 (goto-char beg) 2699 (save-excursion
2695 (while 2700 (goto-char beg)
2696 (re-search-forward tramp-display-escape-sequence-regexp nil t) 2701 (while
2697 (replace-match ""))) 2702 (re-search-forward tramp-display-escape-sequence-regexp nil t)
2698 2703 (replace-match ""))))
2699 ;; Decode the output, it could be multibyte. 2704
2700 (decode-coding-region 2705 ;; Now decode what read if necessary. Stolen from `insert-directory'.
2701 beg (point-max) 2706 (let ((coding (or coding-system-for-read
2702 (or file-name-coding-system default-file-name-coding-system)) 2707 file-name-coding-system
2708 default-file-name-coding-system
2709 'undecided))
2710 coding-no-eol
2711 val pos)
2712 (when (and enable-multibyte-characters
2713 (not (memq (coding-system-base coding)
2714 '(raw-text no-conversion))))
2715 ;; If no coding system is specified or detection is
2716 ;; requested, detect the coding.
2717 (if (eq (coding-system-base coding) 'undecided)
2718 (setq coding (detect-coding-region beg (point) t)))
2719 (if (not (eq (coding-system-base coding) 'undecided))
2720 (save-restriction
2721 (setq coding-no-eol
2722 (coding-system-change-eol-conversion coding 'unix))
2723 (narrow-to-region beg (point))
2724 (goto-char (point-min))
2725 (while (not (eobp))
2726 (setq pos (point)
2727 val (get-text-property (point) 'dired-filename))
2728 (goto-char (next-single-property-change
2729 (point) 'dired-filename nil (point-max)))
2730 ;; Force no eol conversion on a file name, so
2731 ;; that CR is preserved.
2732 (decode-coding-region pos (point)
2733 (if val coding-no-eol coding))
2734 (if val
2735 (put-text-property pos (point)
2736 'dired-filename t)))))))
2703 2737
2704 ;; The inserted file could be from somewhere else. 2738 ;; The inserted file could be from somewhere else.
2705 (when (and (not wildcard) (not full-directory-p)) 2739 (when (and (not wildcard) (not full-directory-p))
@@ -3117,7 +3151,7 @@ implementation will be used."
3117 (mapconcat #'tramp-shell-quote-argument uenv " ") command))) 3151 (mapconcat #'tramp-shell-quote-argument uenv " ") command)))
3118 ;; Determine input. 3152 ;; Determine input.
3119 (if (null infile) 3153 (if (null infile)
3120 (setq input "/dev/null") 3154 (setq input (tramp-get-remote-null-device v))
3121 (setq infile (expand-file-name infile)) 3155 (setq infile (expand-file-name infile))
3122 (if (tramp-equal-remote default-directory infile) 3156 (if (tramp-equal-remote default-directory infile)
3123 ;; INFILE is on the same remote host. 3157 ;; INFILE is on the same remote host.
@@ -3159,7 +3193,7 @@ implementation will be used."
3159 tmpstderr (tramp-make-tramp-file-name v stderr 'nohop)))) 3193 tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
3160 ;; stderr to be discarded. 3194 ;; stderr to be discarded.
3161 ((null (cadr destination)) 3195 ((null (cadr destination))
3162 (setq stderr "/dev/null")))) 3196 (setq stderr (tramp-get-remote-null-device v)))))
3163 ;; 't 3197 ;; 't
3164 (destination 3198 (destination
3165 (setq outbuf (current-buffer)))) 3199 (setq outbuf (current-buffer))))
@@ -4088,7 +4122,10 @@ variable PATH."
4088 (pipe-buf 4122 (pipe-buf
4089 (with-tramp-connection-property vec "pipe-buf" 4123 (with-tramp-connection-property vec "pipe-buf"
4090 (tramp-send-command-and-read 4124 (tramp-send-command-and-read
4091 vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror))) 4125 vec
4126 (format "getconf PIPE_BUF / 2>%s || echo 4096"
4127 (tramp-get-remote-null-device vec))
4128 'noerror)))
4092 tmpfile chunk chunksize) 4129 tmpfile chunk chunksize)
4093 (tramp-message vec 5 "Setting $PATH environment variable") 4130 (tramp-message vec 5 "Setting $PATH environment variable")
4094 (if (< (length command) pipe-buf) 4131 (if (< (length command) pipe-buf)
@@ -4410,7 +4447,12 @@ process to set up. VEC specifies the connection."
4410 (tramp-find-shell vec) 4447 (tramp-find-shell vec)
4411 4448
4412 ;; Disable unexpected output. 4449 ;; Disable unexpected output.
4413 (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t) 4450 (tramp-send-command
4451 vec
4452 (format "mesg n 2>%s; biff n 2>%s"
4453 (tramp-get-remote-null-device vec)
4454 (tramp-get-remote-null-device vec))
4455 t)
4414 4456
4415 ;; IRIX64 bash expands "!" even when in single quotes. This 4457 ;; IRIX64 bash expands "!" even when in single quotes. This
4416 ;; destroys our shell functions, we must disable it. See 4458 ;; destroys our shell functions, we must disable it. See
@@ -4425,7 +4467,8 @@ process to set up. VEC specifies the connection."
4425 4467
4426 ;; Set utf8 encoding. Needed for macOS, for example. This is 4468 ;; Set utf8 encoding. Needed for macOS, for example. This is
4427 ;; non-POSIX, so we must expect errors on some systems. 4469 ;; non-POSIX, so we must expect errors on some systems.
4428 (tramp-send-command vec "stty iutf8 2>/dev/null" t) 4470 (tramp-send-command
4471 vec (concat "stty iutf8 2>" (tramp-get-remote-null-device vec)) t)
4429 4472
4430 ;; Set `remote-tty' process property. 4473 ;; Set `remote-tty' process property.
4431 (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) 4474 (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror)))
@@ -4541,7 +4584,8 @@ program will be transferred to the remote host, and it is
4541available as shell function with the same name. A \"%t\" format 4584available as shell function with the same name. A \"%t\" format
4542specifier in the variable value denotes a temporary file. 4585specifier in the variable value denotes a temporary file.
4543\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the 4586\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the
4544respective `awk', `hexdump' and `od' commands. 4587respective `awk', `hexdump' and `od' commands. \"%n\" is
4588replaced by \"2>/dev/null\".
4545 4589
4546The optional TEST command can be used for further tests, whether 4590The optional TEST command can be used for further tests, whether
4547ENCODING and DECODING are applicable.") 4591ENCODING and DECODING are applicable.")
@@ -4628,6 +4672,8 @@ Goes through the list `tramp-local-coding-commands' and
4628 (format-spec-make 4672 (format-spec-make
4629 ?a (tramp-get-remote-awk vec) 4673 ?a (tramp-get-remote-awk vec)
4630 ?h (tramp-get-remote-hexdump vec) 4674 ?h (tramp-get-remote-hexdump vec)
4675 ?n (concat
4676 "2>" (tramp-get-remote-null-device vec))
4631 ?o (tramp-get-remote-od vec))) 4677 ?o (tramp-get-remote-od vec)))
4632 value (replace-regexp-in-string "%" "%%" value))) 4678 value (replace-regexp-in-string "%" "%%" value)))
4633 (tramp-maybe-send-script vec value name) 4679 (tramp-maybe-send-script vec value name)
@@ -4636,7 +4682,10 @@ Goes through the list `tramp-local-coding-commands' and
4636 vec 5 4682 vec 5
4637 "Checking remote encoding command `%s' for sanity" rem-enc) 4683 "Checking remote encoding command `%s' for sanity" rem-enc)
4638 (unless (tramp-send-command-and-check 4684 (unless (tramp-send-command-and-check
4639 vec (format "%s </dev/null" rem-enc) t) 4685 vec
4686 (format
4687 "%s <%s" rem-enc (tramp-get-remote-null-device vec))
4688 t)
4640 (throw 'wont-work-remote nil)) 4689 (throw 'wont-work-remote nil))
4641 4690
4642 (unless (stringp rem-dec) 4691 (unless (stringp rem-dec)
@@ -4652,6 +4701,8 @@ Goes through the list `tramp-local-coding-commands' and
4652 (format-spec-make 4701 (format-spec-make
4653 ?a (tramp-get-remote-awk vec) 4702 ?a (tramp-get-remote-awk vec)
4654 ?h (tramp-get-remote-hexdump vec) 4703 ?h (tramp-get-remote-hexdump vec)
4704 ?n (concat
4705 "2>" (tramp-get-remote-null-device vec))
4655 ?o (tramp-get-remote-od vec))) 4706 ?o (tramp-get-remote-od vec)))
4656 value (replace-regexp-in-string "%" "%%" value))) 4707 value (replace-regexp-in-string "%" "%%" value)))
4657 (when (string-match-p "\\(^\\|[^%]\\)%t" value) 4708 (when (string-match-p "\\(^\\|[^%]\\)%t" value)
@@ -4698,7 +4749,7 @@ Goes through the list `tramp-local-coding-commands' and
4698 "Call the local encoding or decoding command. 4749 "Call the local encoding or decoding command.
4699If CMD contains \"%s\", provide input file INPUT there in command. 4750If CMD contains \"%s\", provide input file INPUT there in command.
4700Otherwise, INPUT is passed via standard input. 4751Otherwise, INPUT is passed via standard input.
4701INPUT can also be nil which means `/dev/null'. 4752INPUT can also be nil which means `null-device'.
4702OUTPUT can be a string (which specifies a file name), or t (which 4753OUTPUT can be a string (which specifies a file name), or t (which
4703means standard output and thus the current buffer), or nil (which 4754means standard output and thus the current buffer), or nil (which
4704means discard it)." 4755means discard it)."
@@ -5170,14 +5221,17 @@ status is 0, and nil otherwise.
5170 5221
5171If the optional argument SUBSHELL is non-nil, the command is 5222If the optional argument SUBSHELL is non-nil, the command is
5172executed in a subshell, ie surrounded by parentheses. If 5223executed in a subshell, ie surrounded by parentheses. If
5173DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null. 5224DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to \"/dev/null\".
5174Optional argument EXIT-STATUS, if non-nil, triggers the return of 5225Optional argument EXIT-STATUS, if non-nil, triggers the return of
5175the exit status." 5226the exit status."
5176 (tramp-send-command 5227 (tramp-send-command
5177 vec 5228 vec
5178 (concat (if subshell "( " "") 5229 (concat (if subshell "( " "")
5179 command 5230 command
5180 (if command (if dont-suppress-err "; " " 2>/dev/null; ") "") 5231 (if command
5232 (if dont-suppress-err
5233 "; " (format " 2>%s; " (tramp-get-remote-null-device vec)))
5234 "")
5181 "echo tramp_exit_status $?" 5235 "echo tramp_exit_status $?"
5182 (if subshell " )" ""))) 5236 (if subshell " )" "")))
5183 (with-current-buffer (tramp-get-connection-buffer vec) 5237 (with-current-buffer (tramp-get-connection-buffer vec)
@@ -5387,7 +5441,11 @@ Nonexistent directories are removed from spec."
5387 (when elt1 5441 (when elt1
5388 (or 5442 (or
5389 (tramp-send-command-and-read 5443 (tramp-send-command-and-read
5390 vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror) 5444 vec
5445 (format
5446 "echo \\\"`getconf PATH 2>%s`\\\""
5447 (tramp-get-remote-null-device vec))
5448 'noerror)
5391 ;; Default if "getconf" is not available. 5449 ;; Default if "getconf" is not available.
5392 (progn 5450 (progn
5393 (tramp-message 5451 (tramp-message
@@ -5491,7 +5549,8 @@ Nonexistent directories are removed from spec."
5491 vec (format "%s -lnd /" result)) 5549 vec (format "%s -lnd /" result))
5492 (when (tramp-send-command-and-check 5550 (when (tramp-send-command-and-check
5493 vec (format 5551 vec (format
5494 "%s --color=never -al /dev/null" result)) 5552 "%s --color=never -al %s"
5553 result (tramp-get-remote-null-device vec)))
5495 (setq result (concat result " --color=never"))) 5554 (setq result (concat result " --color=never")))
5496 (throw 'ls-found result)) 5555 (throw 'ls-found result))
5497 (setq dl (cdr dl)))))) 5556 (setq dl (cdr dl))))))
@@ -5512,7 +5571,9 @@ Nonexistent directories are removed from spec."
5512 (format 5571 (format
5513 "%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec)))) 5572 "%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec))))
5514 (tramp-send-command-and-check 5573 (tramp-send-command-and-check
5515 vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option)) 5574 vec (format
5575 "%s %s -al %s"
5576 (tramp-get-ls-command vec) option (tramp-get-remote-null-device vec)))
5516 option))) 5577 option)))
5517 5578
5518(defun tramp-get-test-command (vec) 5579(defun tramp-get-test-command (vec)
@@ -5791,7 +5852,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
5791 (command (format "%s %s" busybox "awk"))) 5852 (command (format "%s %s" busybox "awk")))
5792 (and busybox 5853 (and busybox
5793 (tramp-send-command-and-check 5854 (tramp-send-command-and-check
5794 vec (concat command " {} </dev/null")) 5855 vec (concat command " {} <" (tramp-get-remote-null-device vec)))
5795 command))))) 5856 command)))))
5796 5857
5797(defun tramp-get-remote-hexdump (vec) 5858(defun tramp-get-remote-hexdump (vec)
@@ -5802,7 +5863,8 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
5802 (let* ((busybox (tramp-get-remote-busybox vec)) 5863 (let* ((busybox (tramp-get-remote-busybox vec))
5803 (command (format "%s %s" busybox "hexdump"))) 5864 (command (format "%s %s" busybox "hexdump")))
5804 (and busybox 5865 (and busybox
5805 (tramp-send-command-and-check vec (concat command " </dev/null")) 5866 (tramp-send-command-and-check
5867 vec (concat command " <" (tramp-get-remote-null-device vec)))
5806 command))))) 5868 command)))))
5807 5869
5808(defun tramp-get-remote-od (vec) 5870(defun tramp-get-remote-od (vec)
@@ -5814,7 +5876,8 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
5814 (command (format "%s %s" busybox "od"))) 5876 (command (format "%s %s" busybox "od")))
5815 (and busybox 5877 (and busybox
5816 (tramp-send-command-and-check 5878 (tramp-send-command-and-check
5817 vec (concat command " -A n </dev/null")) 5879 vec
5880 (concat command " -A n <" (tramp-get-remote-null-device vec)))
5818 command))))) 5881 command)))))
5819 5882
5820(defun tramp-get-remote-chmod-h (vec) 5883(defun tramp-get-remote-chmod-h (vec)
@@ -5836,7 +5899,9 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
5836 (tramp-message vec 5 "Checking, whether `env -u' works") 5899 (tramp-message vec 5 "Checking, whether `env -u' works")
5837 ;; Option "-u" is a GNU extension. 5900 ;; Option "-u" is a GNU extension.
5838 (tramp-send-command-and-check 5901 (tramp-send-command-and-check
5839 vec "env FOO=foo env -u FOO 2>/dev/null | grep -qv FOO" t))) 5902 vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO"
5903 (tramp-get-remote-null-device vec))
5904 t)))
5840 5905
5841;; Some predefined connection properties. 5906;; Some predefined connection properties.
5842(defun tramp-get-inline-compress (vec prop size) 5907(defun tramp-get-inline-compress (vec prop size)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 8a48ffc09b8..cafa97cec09 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -74,7 +74,7 @@
74 :version "24.4") 74 :version "24.4")
75 75
76;;;###tramp-autoload 76;;;###tramp-autoload
77(defcustom tramp-smb-conf "/dev/null" 77(defcustom tramp-smb-conf null-device
78 "Path of the \"smb.conf\" file. 78 "Path of the \"smb.conf\" file.
79If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program' 79If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program'
80call, letting the SMB client use the default one." 80call, letting the SMB client use the default one."
@@ -797,7 +797,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
797 (setq 797 (setq
798 args 798 args
799 (append args (list (tramp-unquote-shell-quote-argument localname) 799 (append args (list (tramp-unquote-shell-quote-argument localname)
800 "2>/dev/null"))) 800 (concat "2>" (tramp-get-remote-null-device v)))))
801 801
802 (unwind-protect 802 (unwind-protect
803 (with-temp-buffer 803 (with-temp-buffer
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index a98d478bc1a..d40f9a5927c 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -238,6 +238,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
238 - \"%k\" indicates the keep-date parameter of a program, if exists. 238 - \"%k\" indicates the keep-date parameter of a program, if exists.
239 - \"%c\" adds additional `tramp-ssh-controlmaster-options' 239 - \"%c\" adds additional `tramp-ssh-controlmaster-options'
240 options for the first hop. 240 options for the first hop.
241 - \"%n\" expands to \"2>/dev/null\".
241 242
242 The existence of `tramp-login-args', combined with the 243 The existence of `tramp-login-args', combined with the
243 absence of `tramp-copy-args', is an indication that the 244 absence of `tramp-copy-args', is an indication that the
@@ -5325,7 +5326,9 @@ name of a process or buffer, or nil to default to the current buffer."
5325 (tramp-compat-funcall 5326 (tramp-compat-funcall
5326 'tramp-send-command 5327 'tramp-send-command
5327 (process-get proc 'vector) 5328 (process-get proc 'vector)
5328 (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid)) 5329 (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s"
5330 pid pid
5331 (tramp-get-remote-null-device (process-get proc 'vector))))
5329 ;; Wait, until the process has disappeared. If it doesn't, 5332 ;; Wait, until the process has disappeared. If it doesn't,
5330 ;; fall back to the default implementation. 5333 ;; fall back to the default implementation.
5331 (while (tramp-accept-process-output proc 0)) 5334 (while (tramp-accept-process-output proc 0))
@@ -5339,6 +5342,15 @@ name of a process or buffer, or nil to default to the current buffer."
5339 (lambda () 5342 (lambda ()
5340 (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) 5343 (remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
5341 5344
5345(defun tramp-get-remote-null-device (vec)
5346 "Return null device on the remote host identified by VEC.
5347If VEC is nil, return local null device."
5348 (if (null vec)
5349 null-device
5350 (with-tramp-connection-property vec "null-device"
5351 (let ((default-directory (tramp-make-tramp-file-name vec)))
5352 (tramp-compat-null-device)))))
5353
5342(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) 5354(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body)
5343 "Skeleton for `tramp-*-handle-delete-directory'. 5355 "Skeleton for `tramp-*-handle-delete-directory'.
5344BODY is the backend specific code." 5356BODY is the backend specific code."
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index e111ae8e225..3eb158dc2c8 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -1292,7 +1292,15 @@ changed with `comment-style'."
1292 1292
1293(defun comment-region-default (beg end &optional arg) 1293(defun comment-region-default (beg end &optional arg)
1294 (if comment-combine-change-calls 1294 (if comment-combine-change-calls
1295 (combine-change-calls beg end (comment-region-default-1 beg end arg)) 1295 (combine-change-calls beg
1296 ;; A new line might get inserted and whitespace deleted
1297 ;; after END for line comments. Ensure the next argument is
1298 ;; after any and all changes.
1299 (save-excursion
1300 (goto-char end)
1301 (forward-line)
1302 (point))
1303 (comment-region-default-1 beg end arg))
1296 (comment-region-default-1 beg end arg))) 1304 (comment-region-default-1 beg end arg)))
1297 1305
1298;;;###autoload 1306;;;###autoload
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 1ab8ab68880..d2a36dd0bad 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -18535,8 +18535,7 @@ an argument, unconditionally call `org-insert-heading'."
18535 ("Customize" 18535 ("Customize"
18536 ["Browse Org Group" org-customize t] 18536 ["Browse Org Group" org-customize t]
18537 "--" 18537 "--"
18538 ["Expand This Menu" org-create-customize-menu 18538 ["Expand This Menu" org-create-customize-menu t])
18539 (fboundp 'customize-menu-create)])
18540 ["Send bug report" org-submit-bug-report t] 18539 ["Send bug report" org-submit-bug-report t]
18541 "--" 18540 "--"
18542 ("Refresh/Reload" 18541 ("Refresh/Reload"
@@ -18709,20 +18708,17 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
18709 (interactive) 18708 (interactive)
18710 (org-load-modules-maybe) 18709 (org-load-modules-maybe)
18711 (org-require-autoloaded-modules) 18710 (org-require-autoloaded-modules)
18712 (if (fboundp 'customize-menu-create) 18711 (easy-menu-change
18713 (progn 18712 '("Org") "Customize"
18714 (easy-menu-change 18713 `(["Browse Org group" org-customize t]
18715 '("Org") "Customize" 18714 "--"
18716 `(["Browse Org group" org-customize t] 18715 ,(customize-menu-create 'org)
18717 "--" 18716 ["Set" Custom-set t]
18718 ,(customize-menu-create 'org) 18717 ["Save" Custom-save t]
18719 ["Set" Custom-set t] 18718 ["Reset to Current" Custom-reset-current t]
18720 ["Save" Custom-save t] 18719 ["Reset to Saved" Custom-reset-saved t]
18721 ["Reset to Current" Custom-reset-current t] 18720 ["Reset to Standard Settings" Custom-reset-standard t]))
18722 ["Reset to Saved" Custom-reset-saved t] 18721 (message "\"Org\"-menu now contains full customization menu"))
18723 ["Reset to Standard Settings" Custom-reset-standard t]))
18724 (message "\"Org\"-menu now contains full customization menu"))
18725 (error "Cannot expand menu (outdated version of cus-edit.el)")))
18726 18722
18727;;;; Miscellaneous stuff 18723;;;; Miscellaneous stuff
18728 18724
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 2443f374a84..375d06c74fd 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -103,9 +103,7 @@ that a password is invalid, so that `password-read' query the
103user again." 103user again."
104 (let ((password (gethash key password-data))) 104 (let ((password (gethash key password-data)))
105 (when (stringp password) 105 (when (stringp password)
106 (if (fboundp 'clear-string) 106 (clear-string password))
107 (clear-string password)
108 (fillarray password ?_)))
109 (remhash key password-data))) 107 (remhash key password-data)))
110 108
111(defun password-cache-add (key password) 109(defun password-cache-add (key password)
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index fa84b31675e..c6050094498 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -65,15 +65,14 @@
65 "Find all zipped or unzipped files: the inverse of UNZIP-P." 65 "Find all zipped or unzipped files: the inverse of UNZIP-P."
66 (pcomplete-entries 66 (pcomplete-entries
67 nil 67 nil
68 (function 68 (lambda (entry)
69 (lambda (entry) 69 (or (file-directory-p entry)
70 (or (file-directory-p entry) 70 (when (and (file-readable-p entry)
71 (when (and (file-readable-p entry) 71 (file-regular-p entry))
72 (file-regular-p entry)) 72 (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
73 (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'" 73 entry)))
74 entry))) 74 (or (and unzip-p zipped)
75 (or (and unzip-p zipped) 75 (and (not unzip-p) (not zipped)))))))))
76 (and (not unzip-p) (not zipped))))))))))
77 76
78;;;###autoload 77;;;###autoload
79(defun pcomplete/bzip2 () 78(defun pcomplete/bzip2 ()
@@ -92,13 +91,12 @@
92 "Find all zipped or unzipped files: the inverse of UNZIP-P." 91 "Find all zipped or unzipped files: the inverse of UNZIP-P."
93 (pcomplete-entries 92 (pcomplete-entries
94 nil 93 nil
95 (function 94 (lambda (entry)
96 (lambda (entry) 95 (when (and (file-readable-p entry)
97 (when (and (file-readable-p entry) 96 (file-regular-p entry))
98 (file-regular-p entry)) 97 (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
99 (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry))) 98 (or (and unzip-p zipped)
100 (or (and unzip-p zipped) 99 (and (not unzip-p) (not zipped))))))))
101 (and (not unzip-p) (not zipped)))))))))
102 100
103;;;###autoload 101;;;###autoload
104(defun pcomplete/make () 102(defun pcomplete/make ()
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 1cf690a86db..06ea54cb473 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -233,7 +233,7 @@ Variables: `handwrite-linespace' (default 12)
233 )) 233 ))
234 (switch-to-buffer ps-buf-name) 234 (switch-to-buffer ps-buf-name)
235 (forward-line 1) 235 (forward-line 1)
236 (insert "showpage exec Hwsave restore\n\n") 236 (insert " showpage exec Hwsave restore\n\n")
237 (insert "%%Pages " (number-to-string ipage) " 0\n") 237 (insert "%%Pages " (number-to-string ipage) " 0\n")
238 (insert "%%EOF\n") 238 (insert "%%EOF\n")
239 ;;To avoid cumbersome code we simply ignore formfeeds 239 ;;To avoid cumbersome code we simply ignore formfeeds
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 7e36e1f2e3c..9a044fcef31 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -3684,7 +3684,7 @@ When \"(\" is present, that defun will attempt to parse a
3684parenthesized expression inside the template. When \")\" is 3684parenthesized expression inside the template. When \")\" is
3685present it will treat an unbalanced closing paren as a sign of 3685present it will treat an unbalanced closing paren as a sign of
3686the invalidity of the putative template construct." 3686the invalidity of the putative template construct."
3687 t "[<;{},|+&->)]" 3687 t "[<;{},|+&>)-]"
3688 c++ "[<;{},>()]") 3688 c++ "[<;{},>()]")
3689(c-lang-defvar c-<>-notable-chars-re (c-lang-const c-<>-notable-chars-re)) 3689(c-lang-defvar c-<>-notable-chars-re (c-lang-const c-<>-notable-chars-re))
3690 3690
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index e0dabed6a7a..de9c9a209d1 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -334,48 +334,44 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
334 ": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1) 334 ": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1)
335 335
336 (gnu 336 (gnu
337 ;; The first line matches the program name for
338
339 ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
340
341 ;; format, which is used for non-interactive programs other than
342 ;; compilers (e.g. the "jade:" entry in compilation.txt).
343
344 ;; This first line makes things ambiguous with output such as
345 ;; "foo:344:50:blabla" since the "foo" part can match this first
346 ;; line (in which case the file name as "344"). To avoid this,
347 ;; the second line disallows filenames exclusively composed of
348 ;; digits.
349
350 ;; Similarly, we get lots of false positives with messages including
351 ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
352 ;; the last line tries to rule out message where the info after the
353 ;; line number starts with "SS". --Stef
354
355 ;; The core of the regexp is the one with *?. It says that a file name
356 ;; can be composed of any non-newline char, but it also rules out some
357 ;; valid but unlikely cases, such as a trailing space or a space
358 ;; followed by a -, or a colon followed by a space.
359 ;;
360 ;; The "in \\|from " exception was added to handle messages from Ruby.
361 ,(rx 337 ,(rx
362 bol 338 bol
339 ;; Match an optional program name in the format
340 ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
341 ;; which is used for non-interactive programs other than
342 ;; compilers (e.g. the "jade:" entry in compilation.txt).
363 (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") 343 (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
344 ;; FIXME: This pattern was added for handling messages
345 ;; from Ruby, but it is unclear whether it is actually
346 ;; used since the gcc-include rule above seems to cover
347 ;; it.
364 (regexp "[ \t]+\\(?:in \\|from\\)"))) 348 (regexp "[ \t]+\\(?:in \\|from\\)")))
365 (group-n 1 (: (regexp "[0-9]*[^0-9\n]") 349
366 (*? (| (regexp "[^\n :]") 350 ;; File name group.
367 (regexp " [^-/\n]") 351 (group-n 1
368 (regexp ":[^ \n]"))))) 352 ;; Avoid matching the file name as a program in the pattern
353 ;; above by disallow file names entirely composed of digits.
354 (: (regexp "[0-9]*[^0-9\n]")
355 ;; This rule says that a file name can be composed
356 ;; of any non-newline char, but it also rules out
357 ;; some valid but unlikely cases, such as a
358 ;; trailing space or a space followed by a -, or a
359 ;; colon followed by a space.
360 (*? (| (regexp "[^\n :]")
361 (regexp " [^-/\n]")
362 (regexp ":[^ \n]")))))
369 (regexp ": ?") 363 (regexp ": ?")
364
365 ;; Line number group.
370 (group-n 2 (regexp "[0-9]+")) 366 (group-n 2 (regexp "[0-9]+"))
371 (? (| (: "-" 367 (? (| (: "-"
372 (group-n 4 (regexp "[0-9]+")) 368 (group-n 4 (regexp "[0-9]+")) ; ending line
373 (? "." (group-n 5 (regexp "[0-9]+")))) 369 (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column
374 (: (in ".:") 370 (: (in ".:")
375 (group-n 3 (regexp "[0-9]+")) 371 (group-n 3 (regexp "[0-9]+")) ; starting column
376 (? "-" 372 (? "-"
377 (? (group-n 4 (regexp "[0-9]+")) ".") 373 (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line
378 (group-n 5 (regexp "[0-9]+")))))) 374 (group-n 5 (regexp "[0-9]+")))))) ; ending column
379 ":" 375 ":"
380 (| (: (* " ") 376 (| (: (* " ")
381 (group-n 6 (| "FutureWarning" 377 (group-n 6 (| "FutureWarning"
@@ -392,6 +388,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
392 (regexp "[Nn]ote")))) 388 (regexp "[Nn]ote"))))
393 (: (* " ") 389 (: (* " ")
394 (regexp "[Ee]rror")) 390 (regexp "[Ee]rror"))
391
392 ;; Avoid matching time stamps on the form "HH:MM:SS" where
393 ;; MM is interpreted as a line number by trying to rule out
394 ;; messages where the text after the line number starts with
395 ;; a 2-digit number.
395 (: (regexp "[0-9]?") 396 (: (regexp "[0-9]?")
396 (| (regexp "[^0-9\n]") 397 (| (regexp "[^0-9\n]")
397 eol)) 398 eol))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index a42ace105aa..30a80ea8f22 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -54,8 +54,6 @@
54;; of other details. 54;; of other details.
55 55
56;; The mode information (on C-h m) provides some customization help. 56;; The mode information (on C-h m) provides some customization help.
57;; If you use font-lock feature of this mode, it is advisable to use
58;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock.
59 57
60;; Faces used now: three faces for first-class and second-class keywords 58;; Faces used now: three faces for first-class and second-class keywords
61;; and control flow words, one for each: comments, string, labels, 59;; and control flow words, one for each: comments, string, labels,
@@ -402,7 +400,7 @@ Font for POD headers."
402 :version "21.1" 400 :version "21.1"
403 :group 'cperl-faces) 401 :group 'cperl-faces)
404 402
405(defcustom cperl-pod-here-fontify '(featurep 'font-lock) 403(defcustom cperl-pod-here-fontify t
406 "Not-nil after evaluation means to highlight POD and here-docs sections." 404 "Not-nil after evaluation means to highlight POD and here-docs sections."
407 :type 'boolean 405 :type 'boolean
408 :group 'cperl-faces) 406 :group 'cperl-faces)
@@ -3959,7 +3957,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
3959 (not (memq (preceding-char) 3957 (not (memq (preceding-char)
3960 '(?$ ?@ ?& ?%))) 3958 '(?$ ?@ ?& ?%)))
3961 (looking-at 3959 (looking-at
3962 "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\)\\>"))))) 3960 "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))))
3963 (and (eq (preceding-char) ?.) 3961 (and (eq (preceding-char) ?.)
3964 (eq (char-after (- (point) 2)) ?.)) 3962 (eq (char-after (- (point) 2)) ?.))
3965 (bobp)) 3963 (bobp))
@@ -5442,11 +5440,10 @@ indentation and initial hashes. Behaves usually outside of comment."
5442 (cperl-init-faces)))) 5440 (cperl-init-faces))))
5443 ((not cperl-faces-init) 5441 ((not cperl-faces-init)
5444 (add-hook 'font-lock-mode-hook 5442 (add-hook 'font-lock-mode-hook
5445 (function 5443 (lambda ()
5446 (lambda () 5444 (if (memq major-mode '(perl-mode cperl-mode))
5447 (if (memq major-mode '(perl-mode cperl-mode)) 5445 (progn
5448 (progn 5446 (or cperl-faces-init (cperl-init-faces))))))
5449 (or cperl-faces-init (cperl-init-faces)))))))
5450 (eval-after-load 5447 (eval-after-load
5451 "ps-print" 5448 "ps-print"
5452 '(or cperl-faces-init (cperl-init-faces)))))) 5449 '(or cperl-faces-init (cperl-init-faces))))))
@@ -6073,9 +6070,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
6073 (list (completing-read "Enter style: " cperl-style-alist nil 'insist))) 6070 (list (completing-read "Enter style: " cperl-style-alist nil 'insist)))
6074 (or cperl-old-style 6071 (or cperl-old-style
6075 (setq cperl-old-style 6072 (setq cperl-old-style
6076 (mapcar (function 6073 (mapcar (lambda (name)
6077 (lambda (name) 6074 (cons name (eval name)))
6078 (cons name (eval name))))
6079 cperl-styles-entries))) 6075 cperl-styles-entries)))
6080 (let ((style (cdr (assoc style cperl-style-alist))) setting) 6076 (let ((style (cdr (assoc style cperl-style-alist))) setting)
6081 (while style 6077 (while style
@@ -6527,22 +6523,21 @@ Does not move point."
6527 (setq lst (cdr (assoc "+Unsorted List+..." ind)))) 6523 (setq lst (cdr (assoc "+Unsorted List+..." ind))))
6528 (setq lst 6524 (setq lst
6529 (mapcar 6525 (mapcar
6530 (function 6526 (lambda (elt)
6531 (lambda (elt) 6527 (cond ((string-match "^[_a-zA-Z]" (car elt))
6532 (cond ((string-match "^[_a-zA-Z]" (car elt)) 6528 (goto-char (cdr elt))
6533 (goto-char (cdr elt)) 6529 (beginning-of-line) ; pos should be of the start of the line
6534 (beginning-of-line) ; pos should be of the start of the line 6530 (list (car elt)
6535 (list (car elt) 6531 (point)
6536 (point) 6532 (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
6537 (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l 6533 (buffer-substring (progn
6538 (buffer-substring (progn 6534 (goto-char (cdr elt))
6539 (goto-char (cdr elt)) 6535 ;; After name now...
6540 ;; After name now... 6536 (or (eolp) (forward-char 1))
6541 (or (eolp) (forward-char 1)) 6537 (point))
6542 (point)) 6538 (progn
6543 (progn 6539 (beginning-of-line)
6544 (beginning-of-line) 6540 (point)))))))
6545 (point))))))))
6546 lst)) 6541 lst))
6547 (erase-buffer) 6542 (erase-buffer)
6548 (while lst 6543 (while lst
@@ -6607,6 +6602,9 @@ Use as
6607" 6602"
6608 (cperl-write-tags nil nil t t)) 6603 (cperl-write-tags nil nil t t))
6609 6604
6605(defvar cperl-tags-file-name "TAGS"
6606 "TAGS file name to use in `cperl-write-tags'.")
6607
6610(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir) 6608(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
6611 ;; If INBUFFER, do not select buffer, and do not save 6609 ;; If INBUFFER, do not select buffer, and do not save
6612 ;; If ERASE is `ignore', do not erase, and do not try to delete old info. 6610 ;; If ERASE is `ignore', do not erase, and do not try to delete old info.
@@ -6616,7 +6614,7 @@ Use as
6616 (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!"))) 6614 (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
6617 (or topdir 6615 (or topdir
6618 (setq topdir default-directory)) 6616 (setq topdir default-directory))
6619 (let ((tags-file-name "TAGS") 6617 (let ((tags-file-name cperl-tags-file-name)
6620 (inhibit-read-only t) 6618 (inhibit-read-only t)
6621 (case-fold-search nil) 6619 (case-fold-search nil)
6622 xs rel) 6620 xs rel)
@@ -6645,16 +6643,15 @@ Use as
6645 (setq cperl-unreadable-ok t) 6643 (setq cperl-unreadable-ok t)
6646 nil) ; Return empty list 6644 nil) ; Return empty list
6647 (error "Aborting: unreadable directory %s" file))))))) 6645 (error "Aborting: unreadable directory %s" file)))))))
6648 (mapc (function 6646 (mapc (lambda (file)
6649 (lambda (file) 6647 (cond
6650 (cond 6648 ((string-match cperl-noscan-files-regexp file)
6651 ((string-match cperl-noscan-files-regexp file) 6649 nil)
6652 nil) 6650 ((not (file-directory-p file))
6653 ((not (file-directory-p file)) 6651 (if (string-match cperl-scan-files-regexp file)
6654 (if (string-match cperl-scan-files-regexp file) 6652 (cperl-write-tags file erase recurse nil t noxs topdir)))
6655 (cperl-write-tags file erase recurse nil t noxs topdir))) 6653 ((not recurse) nil)
6656 ((not recurse) nil) 6654 (t (cperl-write-tags file erase recurse t t noxs topdir))))
6657 (t (cperl-write-tags file erase recurse t t noxs topdir)))))
6658 files))) 6655 files)))
6659 (t 6656 (t
6660 (setq xs (string-match "\\.xs$" file)) 6657 (setq xs (string-match "\\.xs$" file))
@@ -6768,11 +6765,10 @@ One may build such TAGS files from CPerl mode menu."
6768 (or tags-table-list 6765 (or tags-table-list
6769 (call-interactively 'visit-tags-table)) 6766 (call-interactively 'visit-tags-table))
6770 (mapc 6767 (mapc
6771 (function 6768 (lambda (tagsfile)
6772 (lambda (tagsfile) 6769 (message "Updating list of classes... %s" tagsfile)
6773 (message "Updating list of classes... %s" tagsfile) 6770 (set-buffer (get-file-buffer tagsfile))
6774 (set-buffer (get-file-buffer tagsfile)) 6771 (cperl-tags-hier-fill))
6775 (cperl-tags-hier-fill)))
6776 tags-table-list) 6772 tags-table-list)
6777 (message "Updating list of classes... postprocessing...") 6773 (message "Updating list of classes... postprocessing...")
6778 (mapc remover (car cperl-hierarchy)) 6774 (mapc remover (car cperl-hierarchy))
@@ -6816,24 +6812,23 @@ One may build such TAGS files from CPerl mode menu."
6816 l1 head cons1 cons2 ord writeto recurse 6812 l1 head cons1 cons2 ord writeto recurse
6817 root-packages root-functions 6813 root-packages root-functions
6818 (move-deeper 6814 (move-deeper
6819 (function 6815 (lambda (elt)
6820 (lambda (elt) 6816 (cond ((and (string-match regexp (car elt))
6821 (cond ((and (string-match regexp (car elt)) 6817 (or (eq ord 1) (match-end 2)))
6822 (or (eq ord 1) (match-end 2))) 6818 (setq head (substring (car elt) 0 (match-end 1))
6823 (setq head (substring (car elt) 0 (match-end 1)) 6819 recurse t)
6824 recurse t) 6820 (if (setq cons1 (assoc head writeto)) nil
6825 (if (setq cons1 (assoc head writeto)) nil 6821 ;; Need to init new head
6826 ;; Need to init new head 6822 (setcdr writeto (cons (list head (list "Packages: ")
6827 (setcdr writeto (cons (list head (list "Packages: ") 6823 (list "Methods: "))
6828 (list "Methods: ")) 6824 (cdr writeto)))
6829 (cdr writeto))) 6825 (setq cons1 (nth 1 writeto)))
6830 (setq cons1 (nth 1 writeto))) 6826 (setq cons2 (nth ord cons1)) ; Either packs or meths
6831 (setq cons2 (nth ord cons1)) ; Either packs or meths 6827 (setcdr cons2 (cons elt (cdr cons2))))
6832 (setcdr cons2 (cons elt (cdr cons2)))) 6828 ((eq ord 2)
6833 ((eq ord 2) 6829 (setq root-functions (cons elt root-functions)))
6834 (setq root-functions (cons elt root-functions))) 6830 (t
6835 (t 6831 (setq root-packages (cons elt root-packages)))))))
6836 (setq root-packages (cons elt root-packages))))))))
6837 (setcdr to l1) ; Init to dynamic space 6832 (setcdr to l1) ; Init to dynamic space
6838 (setq writeto to) 6833 (setq writeto to)
6839 (setq ord 1) 6834 (setq ord 1)
@@ -6903,16 +6898,15 @@ One may build such TAGS files from CPerl mode menu."
6903 (let (list) 6898 (let (list)
6904 (cons 'keymap 6899 (cons 'keymap
6905 (mapcar 6900 (mapcar
6906 (function 6901 (lambda (elt)
6907 (lambda (elt) 6902 (cond ((listp (cdr elt))
6908 (cond ((listp (cdr elt)) 6903 (setq list (cperl-list-fold
6909 (setq list (cperl-list-fold 6904 (cdr elt) (car elt) imenu-max-items))
6910 (cdr elt) (car elt) imenu-max-items)) 6905 (cons nil
6911 (cons nil 6906 (cons (car elt)
6912 (cons (car elt) 6907 (cperl-menu-to-keymap list))))
6913 (cperl-menu-to-keymap list)))) 6908 (t
6914 (t 6909 (list (cdr elt) (car elt) t)))) ; t is needed in 19.34
6915 (list (cdr elt) (car elt) t))))) ; t is needed in 19.34
6916 (cperl-list-fold menu "Root" imenu-max-items))))) 6910 (cperl-list-fold menu "Root" imenu-max-items)))))
6917 6911
6918 6912
@@ -8239,15 +8233,14 @@ If a region is highlighted, restricts to the region."
8239 end (max (mark) (point))) 8233 end (max (mark) (point)))
8240 (setq beg (point-min) 8234 (setq beg (point-min)
8241 end (point-max))) 8235 end (point-max)))
8242 (cperl-map-pods-heres (function 8236 (cperl-map-pods-heres (lambda (s e _p)
8243 (lambda (s e _p) 8237 (if do-heres
8244 (if do-heres 8238 (setq e (save-excursion
8245 (setq e (save-excursion 8239 (goto-char e)
8246 (goto-char e) 8240 (forward-line -1)
8247 (forward-line -1) 8241 (point))))
8248 (point)))) 8242 (ispell-region s e)
8249 (ispell-region s e) 8243 t)
8250 t))
8251 (if do-heres 'here-doc-group 'in-pod) 8244 (if do-heres 'here-doc-group 'in-pod)
8252 beg end)))) 8245 beg end))))
8253 8246
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 6e9b6830a01..903005610d7 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -373,19 +373,17 @@ were not yet received."
373 (dolist (handler gdb-handler-list) 373 (dolist (handler gdb-handler-list)
374 (setf (gdb-handler-pending-trigger handler) nil))) 374 (setf (gdb-handler-pending-trigger handler) nil)))
375 375
376(defmacro gdb-wait-for-pending (&rest body) 376(defun gdb-wait-for-pending (func)
377 "Wait for all pending GDB commands to finish and evaluate BODY. 377 "Wait for all pending GDB commands to finish and call FUNC.
378 378
379This function checks every 0.5 seconds if there are any pending 379This function checks every 0.5 seconds if there are any pending
380triggers in `gdb-handler-list'." 380triggers in `gdb-handler-list'."
381 `(run-with-timer 381 (run-with-timer
382 0.5 nil 382 0.5 nil
383 '(lambda () 383 (lambda ()
384 (if (not (cl-find-if (lambda (handler) 384 (if (cl-some #'gdb-handler-pending-trigger gdb-handler-list)
385 (gdb-handler-pending-trigger handler)) 385 (gdb-wait-for-pending func)
386 gdb-handler-list)) 386 (funcall func)))))
387 (progn ,@body)
388 (gdb-wait-for-pending ,@body)))))
389 387
390;; Publish-subscribe 388;; Publish-subscribe
391 389
@@ -1617,17 +1615,16 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
1617 ;; (if it has an associated update trigger) 1615 ;; (if it has an associated update trigger)
1618 (add-hook 1616 (add-hook
1619 'kill-buffer-hook 1617 'kill-buffer-hook
1620 (function 1618 (lambda ()
1621 (lambda () 1619 (let ((trigger (gdb-rules-update-trigger
1622 (let ((trigger (gdb-rules-update-trigger 1620 (gdb-current-buffer-rules))))
1623 (gdb-current-buffer-rules)))) 1621 (when trigger
1624 (when trigger 1622 (gdb-delete-subscriber
1625 (gdb-delete-subscriber 1623 gdb-buf-publisher
1626 gdb-buf-publisher 1624 ;; This should match gdb-add-subscriber done in
1627 ;; This should match gdb-add-subscriber done in 1625 ;; gdb-get-buffer-create
1628 ;; gdb-get-buffer-create 1626 (cons (current-buffer)
1629 (cons (current-buffer) 1627 (gdb-bind-function-to-buffer trigger (current-buffer)))))))
1630 (gdb-bind-function-to-buffer trigger (current-buffer))))))))
1631 nil t)) 1628 nil t))
1632 1629
1633;; Partial-output buffer : This accumulates output from a command executed on 1630;; Partial-output buffer : This accumulates output from a command executed on
@@ -2525,7 +2522,7 @@ Unset `gdb-thread-number' if current thread exited and update threads list."
2525 ;; disallow us to properly call -thread-info without --thread option. 2522 ;; disallow us to properly call -thread-info without --thread option.
2526 ;; Thus we need to use gdb-wait-for-pending. 2523 ;; Thus we need to use gdb-wait-for-pending.
2527 (gdb-wait-for-pending 2524 (gdb-wait-for-pending
2528 (gdb-emit-signal gdb-buf-publisher 'update-threads)))) 2525 (lambda () (gdb-emit-signal gdb-buf-publisher 'update-threads)))))
2529 2526
2530(defun gdb-thread-selected (_token output-field) 2527(defun gdb-thread-selected (_token output-field)
2531 "Handler for =thread-selected MI output record. 2528 "Handler for =thread-selected MI output record.
@@ -2539,11 +2536,10 @@ Sets `gdb-thread-number' to new id."
2539 ;; as usually. Things happen too fast and second call (from 2536 ;; as usually. Things happen too fast and second call (from
2540 ;; gdb-thread-selected handler) gets cut off by our beloved 2537 ;; gdb-thread-selected handler) gets cut off by our beloved
2541 ;; pending triggers. 2538 ;; pending triggers.
2542 ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its 2539 ;; Solution is `gdb-wait-for-pending': it guarantees that its
2543 ;; body will get executed when `gdb-handler-list' if free of 2540 ;; argument will get called when `gdb-handler-list' if free of
2544 ;; pending triggers. 2541 ;; pending triggers.
2545 (gdb-wait-for-pending 2542 (gdb-wait-for-pending #'gdb-update)))
2546 (gdb-update))))
2547 2543
2548(defun gdb-running (_token output-field) 2544(defun gdb-running (_token output-field)
2549 (let* ((thread-id 2545 (let* ((thread-id
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 96838269749..dafba22f777 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -296,8 +296,10 @@ See `compilation-error-screen-columns'."
296 :help "Kill the currently running grep process")) 296 :help "Kill the currently running grep process"))
297 (define-key map [menu-bar grep compilation-separator2] '("----")) 297 (define-key map [menu-bar grep compilation-separator2] '("----"))
298 (define-key map [menu-bar grep compilation-compile] 298 (define-key map [menu-bar grep compilation-compile]
299 '(menu-item "Compile..." compile 299 '(menu-item
300 :help "Compile the program including the current buffer. Default: run `make'")) 300 "Compile..." compile
301 :help
302 "Compile the program including the current buffer. Default: run `make'"))
301 (define-key map [menu-bar grep compilation-rgrep] 303 (define-key map [menu-bar grep compilation-rgrep]
302 '(menu-item "Recursive grep..." rgrep 304 '(menu-item "Recursive grep..." rgrep
303 :help "User-friendly recursive grep in directory tree")) 305 :help "User-friendly recursive grep in directory tree"))
@@ -308,15 +310,18 @@ See `compilation-error-screen-columns'."
308 '(menu-item "Grep via Find..." grep-find 310 '(menu-item "Grep via Find..." grep-find
309 :help "Run grep via find, with user-specified args")) 311 :help "Run grep via find, with user-specified args"))
310 (define-key map [menu-bar grep compilation-grep] 312 (define-key map [menu-bar grep compilation-grep]
311 '(menu-item "Another grep..." grep 313 '(menu-item
312 :help "Run grep, with user-specified args, and collect output in a buffer.")) 314 "Another grep..." grep
315 :help
316 "Run grep, with user-specified args, and collect output in a buffer."))
313 (define-key map [menu-bar grep compilation-recompile] 317 (define-key map [menu-bar grep compilation-recompile]
314 '(menu-item "Repeat grep" recompile 318 '(menu-item "Repeat grep" recompile
315 :help "Run grep again")) 319 :help "Run grep again"))
316 (define-key map [menu-bar grep compilation-separator1] '("----")) 320 (define-key map [menu-bar grep compilation-separator1] '("----"))
317 (define-key map [menu-bar grep compilation-first-error] 321 (define-key map [menu-bar grep compilation-first-error]
318 '(menu-item "First Match" first-error 322 '(menu-item
319 :help "Restart at the first match, visit corresponding location")) 323 "First Match" first-error
324 :help "Restart at the first match, visit corresponding location"))
320 (define-key map [menu-bar grep compilation-previous-error] 325 (define-key map [menu-bar grep compilation-previous-error]
321 '(menu-item "Previous Match" previous-error 326 '(menu-item "Previous Match" previous-error
322 :help "Visit the previous match and corresponding location")) 327 :help "Visit the previous match and corresponding location"))
@@ -389,7 +394,8 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
389 (when grep-highlight-matches 394 (when grep-highlight-matches
390 (let* ((beg (match-end 0)) 395 (let* ((beg (match-end 0))
391 (end (save-excursion (goto-char beg) (line-end-position))) 396 (end (save-excursion (goto-char beg) (line-end-position)))
392 (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) 397 (mbeg
398 (text-property-any beg end 'font-lock-face grep-match-face)))
393 (when mbeg 399 (when mbeg
394 (- mbeg beg))))) 400 (- mbeg beg)))))
395 . 401 .
@@ -397,8 +403,11 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
397 (when grep-highlight-matches 403 (when grep-highlight-matches
398 (let* ((beg (match-end 0)) 404 (let* ((beg (match-end 0))
399 (end (save-excursion (goto-char beg) (line-end-position))) 405 (end (save-excursion (goto-char beg) (line-end-position)))
400 (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) 406 (mbeg
401 (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) 407 (text-property-any beg end 'font-lock-face grep-match-face))
408 (mend
409 (and mbeg (next-single-property-change
410 mbeg 'font-lock-face nil end))))
402 (when mend 411 (when mend
403 (- mend beg)))))) 412 (- mend beg))))))
404 nil nil 413 nil nil
@@ -614,6 +623,15 @@ This function is called from `compilation-filter-hook'."
614 (error nil)) 623 (error nil))
615 (or result 0)))) 624 (or result 0))))
616 625
626(defun grep-hello-file ()
627 (let ((result
628 (if (file-remote-p default-directory)
629 (make-temp-file (file-name-as-directory (temporary-file-directory)))
630 (expand-file-name "HELLO" data-directory))))
631 (when (file-remote-p result)
632 (write-region "Copyright\n" nil result))
633 result))
634
617;;;###autoload 635;;;###autoload
618(defun grep-compute-defaults () 636(defun grep-compute-defaults ()
619 "Compute the defaults for the `grep' command. 637 "Compute the defaults for the `grep' command.
@@ -655,37 +673,46 @@ The value depends on `grep-command', `grep-template',
655 (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) 673 (unless (or (not grep-use-null-device) (eq grep-use-null-device t))
656 (setq grep-use-null-device 674 (setq grep-use-null-device
657 (with-temp-buffer 675 (with-temp-buffer
658 (let ((hello-file (expand-file-name "HELLO" data-directory))) 676 (let ((hello-file (grep-hello-file)))
659 (not 677 (prog1
660 (and (if grep-command 678 (not
661 ;; `grep-command' is already set, so 679 (and (if grep-command
662 ;; use that for testing. 680 ;; `grep-command' is already set, so
663 (grep-probe grep-command 681 ;; use that for testing.
664 `(nil t nil "^Copyright" ,hello-file) 682 (grep-probe
665 #'call-process-shell-command) 683 grep-command
666 ;; otherwise use `grep-program' 684 `(nil t nil "^Copyright"
667 (grep-probe grep-program 685 ,(file-local-name hello-file))
668 `(nil t nil "-nH" "^Copyright" ,hello-file))) 686 #'process-file-shell-command)
669 (progn 687 ;; otherwise use `grep-program'
670 (goto-char (point-min)) 688 (grep-probe
671 (looking-at 689 grep-program
672 (concat (regexp-quote hello-file) 690 `(nil t nil "-nH" "^Copyright"
673 ":[0-9]+:Copyright"))))))))) 691 ,(file-local-name hello-file))))
692 (progn
693 (goto-char (point-min))
694 (looking-at
695 (concat (regexp-quote (file-local-name hello-file))
696 ":[0-9]+:Copyright")))))
697 (when (file-remote-p hello-file) (delete-file hello-file)))))))
674 698
675 (when (eq grep-use-null-filename-separator 'auto-detect) 699 (when (eq grep-use-null-filename-separator 'auto-detect)
676 (setq grep-use-null-filename-separator 700 (setq grep-use-null-filename-separator
677 (with-temp-buffer 701 (with-temp-buffer
678 (let* ((hello-file (expand-file-name "HELLO" data-directory)) 702 (let* ((hello-file (grep-hello-file))
679 (args `("--null" "-ne" "^Copyright" ,hello-file))) 703 (args `("--null" "-ne" "^Copyright"
704 ,(file-local-name hello-file))))
680 (if grep-use-null-device 705 (if grep-use-null-device
681 (setq args (append args (list null-device))) 706 (setq args (append args (list (null-device))))
682 (push "-H" args)) 707 (push "-H" args))
683 (and (grep-probe grep-program `(nil t nil ,@args)) 708 (prog1
684 (progn 709 (and (grep-probe grep-program `(nil t nil ,@args))
685 (goto-char (point-min)) 710 (progn
686 (looking-at 711 (goto-char (point-min))
687 (concat (regexp-quote hello-file) 712 (looking-at
688 "\0[0-9]+:Copyright")))))))) 713 (concat (regexp-quote (file-local-name hello-file))
714 "\0[0-9]+:Copyright"))))
715 (when (file-remote-p hello-file) (delete-file hello-file)))))))
689 716
690 (when (eq grep-highlight-matches 'auto-detect) 717 (when (eq grep-highlight-matches 'auto-detect)
691 (setq grep-highlight-matches 718 (setq grep-highlight-matches
@@ -704,7 +731,7 @@ The value depends on `grep-command', `grep-template',
704 (concat (if grep-use-null-device "-n" "-nH") 731 (concat (if grep-use-null-device "-n" "-nH")
705 (if grep-use-null-filename-separator " --null") 732 (if grep-use-null-filename-separator " --null")
706 (when (grep-probe grep-program 733 (when (grep-probe grep-program
707 `(nil nil nil "-e" "foo" ,null-device) 734 `(nil nil nil "-e" "foo" ,(null-device))
708 nil 1) 735 nil 1)
709 " -e")))) 736 " -e"))))
710 (unless grep-command 737 (unless grep-command
@@ -712,13 +739,14 @@ The value depends on `grep-command', `grep-template',
712 (format "%s %s %s " grep-program 739 (format "%s %s %s " grep-program
713 (or 740 (or
714 (and grep-highlight-matches 741 (and grep-highlight-matches
715 (grep-probe grep-program 742 (grep-probe
716 `(nil nil nil "--color" "x" ,null-device) 743 grep-program
717 nil 1) 744 `(nil nil nil "--color" "x" ,(null-device))
745 nil 1)
718 (if (eq grep-highlight-matches 'always) 746 (if (eq grep-highlight-matches 'always)
719 "--color=always" "--color")) 747 "--color=always" "--color"))
720 "") 748 "")
721 grep-options))) 749 grep-options)))
722 (unless grep-template 750 (unless grep-template
723 (setq grep-template 751 (setq grep-template
724 (format "%s <X> <C> %s <R> <F>" grep-program grep-options))) 752 (format "%s <X> <C> %s <R> <F>" grep-program grep-options)))
@@ -726,11 +754,12 @@ The value depends on `grep-command', `grep-template',
726 (setq grep-find-use-xargs 754 (setq grep-find-use-xargs
727 (cond 755 (cond
728 ((grep-probe find-program 756 ((grep-probe find-program
729 `(nil nil nil ,null-device "-exec" "echo" 757 `(nil nil nil ,(null-device) "-exec" "echo"
730 "{}" "+")) 758 "{}" "+"))
731 'exec-plus) 759 'exec-plus)
732 ((and 760 ((and
733 (grep-probe find-program `(nil nil nil ,null-device "-print0")) 761 (grep-probe
762 find-program `(nil nil nil ,(null-device) "-print0"))
734 (grep-probe xargs-program '(nil nil nil "-0" "echo"))) 763 (grep-probe xargs-program '(nil nil nil "-0" "echo")))
735 'gnu) 764 'gnu)
736 (t 765 (t
@@ -750,12 +779,13 @@ The value depends on `grep-command', `grep-template',
750 (let ((cmd0 (format "%s . -type f -exec %s" 779 (let ((cmd0 (format "%s . -type f -exec %s"
751 find-program grep-command)) 780 find-program grep-command))
752 (null (if grep-use-null-device 781 (null (if grep-use-null-device
753 (format "%s " null-device) 782 (format "%s " (null-device))
754 ""))) 783 "")))
755 (cons 784 (cons
756 (if (eq grep-find-use-xargs 'exec-plus) 785 (if (eq grep-find-use-xargs 'exec-plus)
757 (format "%s %s%s +" cmd0 null quot-braces) 786 (format "%s %s%s +" cmd0 null quot-braces)
758 (format "%s %s %s%s" cmd0 quot-braces null quot-scolon)) 787 (format "%s %s %s%s"
788 cmd0 quot-braces null quot-scolon))
759 (1+ (length cmd0))))) 789 (1+ (length cmd0)))))
760 (t 790 (t
761 (format "%s . -type f -print | \"%s\" %s" 791 (format "%s . -type f -print | \"%s\" %s"
@@ -765,7 +795,7 @@ The value depends on `grep-command', `grep-template',
765 (let ((gcmd (format "%s <C> %s <R>" 795 (let ((gcmd (format "%s <C> %s <R>"
766 grep-program grep-options)) 796 grep-program grep-options))
767 (null (if grep-use-null-device 797 (null (if grep-use-null-device
768 (format "%s " null-device) 798 (format "%s " (null-device))
769 ""))) 799 "")))
770 (cond ((eq grep-find-use-xargs 'gnu) 800 (cond ((eq grep-find-use-xargs 'gnu)
771 (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s" 801 (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s"
@@ -814,7 +844,8 @@ The value depends on `grep-command', `grep-template',
814 (let ((tag-default (shell-quote-argument (grep-tag-default))) 844 (let ((tag-default (shell-quote-argument (grep-tag-default)))
815 ;; This a regexp to match single shell arguments. 845 ;; This a regexp to match single shell arguments.
816 ;; Could someone please add comments explaining it? 846 ;; Could someone please add comments explaining it?
817 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") 847 (sh-arg-re
848 "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
818 (grep-default (or (car grep-history) grep-command))) 849 (grep-default (or (car grep-history) grep-command)))
819 ;; In the default command, find the arg that specifies the pattern. 850 ;; In the default command, find the arg that specifies the pattern.
820 (when (or (string-match 851 (when (or (string-match
@@ -909,8 +940,8 @@ list is empty)."
909 (grep--save-buffers) 940 (grep--save-buffers)
910 ;; Setting process-setup-function makes exit-message-function work 941 ;; Setting process-setup-function makes exit-message-function work
911 ;; even when async processes aren't supported. 942 ;; even when async processes aren't supported.
912 (compilation-start (if (and grep-use-null-device null-device) 943 (compilation-start (if (and grep-use-null-device null-device (null-device))
913 (concat command-args " " null-device) 944 (concat command-args " " (null-device))
914 command-args) 945 command-args)
915 #'grep-mode)) 946 #'grep-mode))
916 947
@@ -948,7 +979,7 @@ easily repeat a find command."
948 '(("<C>" . (mapconcat #'identity opts " ")) 979 '(("<C>" . (mapconcat #'identity opts " "))
949 ("<D>" . (or dir ".")) 980 ("<D>" . (or dir "."))
950 ("<F>" . files) 981 ("<F>" . files)
951 ("<N>" . null-device) 982 ("<N>" . (null-device))
952 ("<X>" . excl) 983 ("<X>" . excl)
953 ("<R>" . (shell-quote-argument (or regexp "")))) 984 ("<R>" . (shell-quote-argument (or regexp ""))))
954 "List of substitutions performed by `grep-expand-template'. 985 "List of substitutions performed by `grep-expand-template'.
@@ -1052,8 +1083,9 @@ REGEXP is used as a string in the prompt."
1052 #'read-file-name-internal 1083 #'read-file-name-internal
1053 nil nil nil 'grep-files-history 1084 nil nil nil 'grep-files-history
1054 (delete-dups 1085 (delete-dups
1055 (delq nil (append (list default default-alias default-extension) 1086 (delq nil
1056 (mapcar #'car grep-files-aliases))))))) 1087 (append (list default default-alias default-extension)
1088 (mapcar #'car grep-files-aliases)))))))
1057 (and files 1089 (and files
1058 (or (cdr (assoc files grep-files-aliases)) 1090 (or (cdr (assoc files grep-files-aliases))
1059 files)))) 1091 files))))
@@ -1105,11 +1137,12 @@ command before it's run."
1105 (if (string= command grep-command) 1137 (if (string= command grep-command)
1106 (setq command nil)) 1138 (setq command nil))
1107 (setq dir (file-name-as-directory (expand-file-name dir))) 1139 (setq dir (file-name-as-directory (expand-file-name dir)))
1108 (unless (or (not grep-use-directories-skip) (eq grep-use-directories-skip t)) 1140 (unless (or (not grep-use-directories-skip)
1141 (eq grep-use-directories-skip t))
1109 (setq grep-use-directories-skip 1142 (setq grep-use-directories-skip
1110 (grep-probe grep-program 1143 (grep-probe grep-program
1111 `(nil nil nil "--directories=skip" "foo" 1144 `(nil nil nil "--directories=skip" "foo"
1112 ,null-device) 1145 ,(null-device))
1113 nil 1))) 1146 nil 1)))
1114 (setq command (grep-expand-template 1147 (setq command (grep-expand-template
1115 grep-template 1148 grep-template
@@ -1141,10 +1174,11 @@ command before it's run."
1141 ;; Setting process-setup-function makes exit-message-function work 1174 ;; Setting process-setup-function makes exit-message-function work
1142 ;; even when async processes aren't supported. 1175 ;; even when async processes aren't supported.
1143 (grep--save-buffers) 1176 (grep--save-buffers)
1144 (compilation-start (if (and grep-use-null-device null-device) 1177 (compilation-start
1145 (concat command " " null-device) 1178 (if (and grep-use-null-device null-device (null-device))
1146 command) 1179 (concat command " " (null-device))
1147 'grep-mode)) 1180 command)
1181 'grep-mode))
1148 ;; Set default-directory if we started lgrep in the *grep* buffer. 1182 ;; Set default-directory if we started lgrep in the *grep* buffer.
1149 (if (eq next-error-last-buffer (current-buffer)) 1183 (if (eq next-error-last-buffer (current-buffer))
1150 (setq default-directory dir)))))) 1184 (setq default-directory dir))))))
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 2d4ea465c42..89296ff5b50 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1173,17 +1173,16 @@ When DING is non-nil, ring the bell as well."
1173Useful when source code is displayed as help. See the option 1173Useful when source code is displayed as help. See the option
1174`idlwave-help-fontify-source-code'." 1174`idlwave-help-fontify-source-code'."
1175 (interactive) 1175 (interactive)
1176 (if (featurep 'font-lock) 1176 (let ((major-mode 'idlwave-mode)
1177 (let ((major-mode 'idlwave-mode) 1177 (font-lock-verbose
1178 (font-lock-verbose 1178 (if (called-interactively-p 'interactive) font-lock-verbose nil)))
1179 (if (called-interactively-p 'interactive) font-lock-verbose nil))) 1179 (with-syntax-table idlwave-mode-syntax-table
1180 (with-syntax-table idlwave-mode-syntax-table 1180 (set (make-local-variable 'font-lock-defaults)
1181 (set (make-local-variable 'font-lock-defaults) 1181 idlwave-font-lock-defaults)
1182 idlwave-font-lock-defaults) 1182 (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1
1183 (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1 1183 (font-lock-ensure)
1184 (font-lock-ensure) 1184 ;; Silence "interactive use only" warning on Emacs >= 25.1.
1185 ;; Silence "interactive use only" warning on Emacs >= 25.1. 1185 (with-no-warnings (font-lock-fontify-buffer))))))
1186 (with-no-warnings (font-lock-fontify-buffer)))))))
1187 1186
1188 1187
1189(defun idlwave-help-error (name type class keyword) 1188(defun idlwave-help-error (name type class keyword)
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 38127fccbc3..70b94596e10 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -26,8 +26,7 @@
26 26
27;;; Commentary: 27;;; Commentary:
28;; 28;;
29;; This mode is for IDL version 5 or later. It should work on 29;; This mode is for IDL version 5 or later.
30;; Emacs>20.3 or XEmacs>20.4.
31;; 30;;
32;; Runs IDL as an inferior process of Emacs, much like the Emacs 31;; Runs IDL as an inferior process of Emacs, much like the Emacs
33;; `shell' or `telnet' commands. Provides command history and 32;; `shell' or `telnet' commands. Provides command history and
@@ -68,15 +67,6 @@
68;; maintainers webpage (see under SOURCE) 67;; maintainers webpage (see under SOURCE)
69;; 68;;
70;; 69;;
71;; KNOWN PROBLEMS
72;; ==============
73;;
74;; Under XEmacs the Debug menu in the shell does not display the
75;; keybindings in the prefix map. There bindings are available anyway - so
76;; it is a bug in XEmacs.
77;; The Debug menu in source buffers *does* display the bindings correctly.
78;;
79;;
80;; CUSTOMIZATION VARIABLES 70;; CUSTOMIZATION VARIABLES
81;; ======================= 71;; =======================
82;; 72;;
@@ -166,7 +156,6 @@ t Arrows force the cursor back to the current command line and
166 "Non-nil means, use the debugging toolbar in all IDL related buffers. 156 "Non-nil means, use the debugging toolbar in all IDL related buffers.
167Starting the shell will then add the toolbar to all idlwave-mode buffers. 157Starting the shell will then add the toolbar to all idlwave-mode buffers.
168Exiting the shell will removed everywhere. 158Exiting the shell will removed everywhere.
169Available on XEmacs and on Emacs 21.x or later.
170At any time you can toggle the display of the toolbar with 159At any time you can toggle the display of the toolbar with
171`C-c C-d C-t' (`idlwave-shell-toggle-toolbar')." 160`C-c C-d C-t' (`idlwave-shell-toggle-toolbar')."
172 :group 'idlwave-shell-general-setup 161 :group 'idlwave-shell-general-setup
@@ -606,12 +595,6 @@ the directory stack.")
606(defvar idlwave-shell-last-save-and-action-file nil 595(defvar idlwave-shell-last-save-and-action-file nil
607 "The last file which was compiled with `idlwave-shell-save-and-...'.") 596 "The last file which was compiled with `idlwave-shell-save-and-...'.")
608 597
609;; Highlighting uses overlays. When necessary, require the emulation.
610(if (not (fboundp 'make-overlay))
611 (condition-case nil
612 (require 'overlay)
613 (error nil)))
614
615(defvar idlwave-shell-stop-line-overlay nil 598(defvar idlwave-shell-stop-line-overlay nil
616 "The overlay for where IDL is currently stopped.") 599 "The overlay for where IDL is currently stopped.")
617(defvar idlwave-shell-is-stopped nil) 600(defvar idlwave-shell-is-stopped nil)
@@ -967,8 +950,6 @@ IDL has currently stepped.")
967 (setq idlwave-shell-default-directory default-directory) 950 (setq idlwave-shell-default-directory default-directory)
968 (setq idlwave-shell-hide-output nil) 951 (setq idlwave-shell-hide-output nil)
969 952
970 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
971 ;; (make-local-hook 'kill-buffer-hook)
972 (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm 953 (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm
973 nil 'local) 954 nil 'local)
974 (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) 955 (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local)
@@ -1007,8 +988,6 @@ IDL has currently stepped.")
1007 (set (make-local-variable 'comment-start) ";") 988 (set (make-local-variable 'comment-start) ";")
1008 (setq abbrev-mode t) 989 (setq abbrev-mode t)
1009 990
1010 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
1011 ;; make-local-hook 'post-command-hook)
1012 (add-hook 'post-command-hook 'idlwave-command-hook nil t) 991 (add-hook 'post-command-hook 'idlwave-command-hook nil t)
1013 992
1014 ;; Read the command history? 993 ;; Read the command history?
@@ -2751,6 +2730,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command."
2751;; Begin terrible hack section -- XEmacs tests for button2 explicitly 2730;; Begin terrible hack section -- XEmacs tests for button2 explicitly
2752;; on drag events, calling drag-n-drop code if detected. Ughhh... 2731;; on drag events, calling drag-n-drop code if detected. Ughhh...
2753(defun idlwave-default-mouse-track-event-is-with-button (_event _n) 2732(defun idlwave-default-mouse-track-event-is-with-button (_event _n)
2733 (declare (obsolete nil "28.1"))
2754 t) 2734 t)
2755 2735
2756(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore "27.1") 2736(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore "27.1")
@@ -3612,10 +3592,8 @@ Existing overlays are recycled, in order to minimize consumption."
3612 (when use-glyph 3592 (when use-glyph
3613 (if old-buffers 3593 (if old-buffers
3614 (setq old-buffers (delq (current-buffer) old-buffers))) 3594 (setq old-buffers (delq (current-buffer) old-buffers)))
3615 (if (fboundp 'set-specifier) ;; XEmacs 3595 (if (< left-margin-width 2)
3616 (set-specifier left-margin-width (cons (current-buffer) 2)) 3596 (setq left-margin-width 2))
3617 (if (< left-margin-width 2)
3618 (setq left-margin-width 2)))
3619 (let ((window (get-buffer-window (current-buffer) 0))) 3597 (let ((window (get-buffer-window (current-buffer) 0)))
3620 (if window 3598 (if window
3621 (set-window-margins 3599 (set-window-margins
@@ -3623,9 +3601,7 @@ Existing overlays are recycled, in order to minimize consumption."
3623 (if use-glyph 3601 (if use-glyph
3624 (while (setq buf (pop old-buffers)) 3602 (while (setq buf (pop old-buffers))
3625 (with-current-buffer buf 3603 (with-current-buffer buf
3626 (if (fboundp 'set-specifier) ;; XEmacs 3604 (setq left-margin-width 0)
3627 (set-specifier left-margin-width (cons (current-buffer) 0))
3628 (setq left-margin-width 0))
3629 (let ((window (get-buffer-window buf 0))) 3605 (let ((window (get-buffer-window buf 0)))
3630 (if window 3606 (if window
3631 (set-window-margins 3607 (set-window-margins
@@ -4352,21 +4328,19 @@ Shell debugging commands are available as single key sequences."
4352 ["Toggle Toolbar" idlwave-shell-toggle-toolbar t] 4328 ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
4353 ["Exit IDL" idlwave-shell-quit t])) 4329 ["Exit IDL" idlwave-shell-quit t]))
4354 4330
4355(if (or (featurep 'easymenu) (load "easymenu" t)) 4331(easy-menu-define
4356 (progn 4332 idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
4357 (easy-menu-define 4333 idlwave-shell-menu-def)
4358 idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus" 4334(easy-menu-define
4359 idlwave-shell-menu-def) 4335 idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
4360 (easy-menu-define 4336 idlwave-shell-menu-def)
4361 idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus" 4337(save-current-buffer
4362 idlwave-shell-menu-def) 4338 (dolist (buf (buffer-list))
4363 (save-current-buffer 4339 (set-buffer buf)
4364 (dolist (buf (buffer-list)) 4340 (if (derived-mode-p 'idlwave-mode)
4365 (set-buffer buf) 4341 (progn
4366 (if (derived-mode-p 'idlwave-mode) 4342 (easy-menu-remove idlwave-mode-debug-menu)
4367 (progn 4343 (easy-menu-add idlwave-mode-debug-menu)))))
4368 (easy-menu-remove idlwave-mode-debug-menu)
4369 (easy-menu-add idlwave-mode-debug-menu)))))))
4370 4344
4371;; The Breakpoint Glyph ------------------------------------------------------- 4345;; The Breakpoint Glyph -------------------------------------------------------
4372 4346
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 86f9f336723..876c38da7e7 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1355,8 +1355,8 @@ Normally a space.")
1355 1355
1356(defmacro idlwave-keyword-abbrev (&rest args) 1356(defmacro idlwave-keyword-abbrev (&rest args)
1357 "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." 1357 "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args."
1358 `(quote (lambda () 1358 `(lambda ()
1359 ,(append '(idlwave-check-abbrev) args)))) 1359 ,(append '(idlwave-check-abbrev) args)))
1360 1360
1361;; If I take the time I can replace idlwave-keyword-abbrev with 1361;; If I take the time I can replace idlwave-keyword-abbrev with
1362;; idlwave-code-abbrev and remove the quoted abbrev check from 1362;; idlwave-code-abbrev and remove the quoted abbrev check from
@@ -1920,15 +1920,10 @@ The main features of this mode are
1920 'idlwave-forward-block nil)) 1920 'idlwave-forward-block nil))
1921 1921
1922 ;; Make a local post-command-hook and add our hook to it 1922 ;; Make a local post-command-hook and add our hook to it
1923 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
1924 ;; (make-local-hook 'post-command-hook)
1925 (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) 1923 (add-hook 'post-command-hook 'idlwave-command-hook nil 'local)
1926 1924
1927 ;; Make local hooks for buffer updates 1925 ;; Make local hooks for buffer updates
1928 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
1929 ;; (make-local-hook 'kill-buffer-hook)
1930 (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) 1926 (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local)
1931 ;; (make-local-hook 'after-save-hook)
1932 (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) 1927 (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)
1933 (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) 1928 (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)
1934 1929
@@ -2781,10 +2776,7 @@ If the optional argument EXPAND is non-nil then the actions in
2781 ;; Adjust parallel comment 2776 ;; Adjust parallel comment
2782 (end-of-line) 2777 (end-of-line)
2783 (if (idlwave-in-comment) 2778 (if (idlwave-in-comment)
2784 ;; Emacs 21 is too smart with fill-column on comment indent 2779 (let ((fill-column (1- (frame-width))))
2785 (let ((fill-column (if (fboundp 'comment-indent-new-line)
2786 (1- (frame-width))
2787 fill-column)))
2788 (indent-for-comment))))) 2780 (indent-for-comment)))))
2789 (goto-char mloc) 2781 (goto-char mloc)
2790 ;; Get rid of marker 2782 ;; Get rid of marker
@@ -3996,12 +3988,7 @@ blank lines."
3996 ;; skip blank lines 3988 ;; skip blank lines
3997 (skip-chars-forward " \t\n") 3989 (skip-chars-forward " \t\n")
3998 (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) 3990 (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)"))
3999 (if (fboundp 'uncomment-region) 3991 (uncomment-region beg end)
4000 (uncomment-region beg end)
4001 (comment-region beg end
4002 (- (length (buffer-substring
4003 (match-beginning 1)
4004 (match-end 1))))))
4005 (comment-region beg end))))) 3992 (comment-region beg end)))))
4006 3993
4007 3994
@@ -4047,11 +4034,6 @@ blank lines."
4047(defun idlwave-reset-sintern (&optional what) 4034(defun idlwave-reset-sintern (&optional what)
4048 "Reset all sintern hashes." 4035 "Reset all sintern hashes."
4049 ;; Make sure the hash functions are accessible. 4036 ;; Make sure the hash functions are accessible.
4050 (unless (and (fboundp 'gethash)
4051 (fboundp 'puthash))
4052 (require 'cl)
4053 (or (fboundp 'puthash)
4054 (defalias 'puthash 'cl-puthash)))
4055 (let ((entries '((idlwave-sint-routines 1000 10) 4037 (let ((entries '((idlwave-sint-routines 1000 10)
4056 (idlwave-sint-keywords 1000 10) 4038 (idlwave-sint-keywords 1000 10)
4057 (idlwave-sint-methods 100 10) 4039 (idlwave-sint-methods 100 10)
@@ -7642,14 +7624,13 @@ associated TAG, if any."
7642 7624
7643(defun idlwave-completion-fontify-classes () 7625(defun idlwave-completion-fontify-classes ()
7644 "Goto the *Completions* buffer and fontify the class info." 7626 "Goto the *Completions* buffer and fontify the class info."
7645 (when (featurep 'font-lock) 7627 (with-current-buffer "*Completions*"
7646 (with-current-buffer "*Completions*" 7628 (save-excursion
7647 (save-excursion 7629 (goto-char (point-min))
7648 (goto-char (point-min)) 7630 (let ((buffer-read-only nil))
7649 (let ((buffer-read-only nil)) 7631 (while (re-search-forward "\\.*<[^>]+>" nil t)
7650 (while (re-search-forward "\\.*<[^>]+>" nil t) 7632 (put-text-property (match-beginning 0) (match-end 0)
7651 (put-text-property (match-beginning 0) (match-end 0) 7633 'face 'font-lock-string-face))))))
7652 'face 'font-lock-string-face)))))))
7653 7634
7654(defun idlwave-uniquify (list) 7635(defun idlwave-uniquify (list)
7655 (let ((ht (make-hash-table :size (length list) :test 'equal))) 7636 (let ((ht (make-hash-table :size (length list) :test 'equal)))
@@ -8892,9 +8873,7 @@ Assumes that point is at the beginning of the unit as found by
8892 (let ((begin (point))) 8873 (let ((begin (point)))
8893 (re-search-forward 8874 (re-search-forward
8894 "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") 8875 "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")
8895 (if (fboundp 'buffer-substring-no-properties) 8876 (buffer-substring-no-properties begin (point))))
8896 (buffer-substring-no-properties begin (point))
8897 (buffer-substring begin (point)))))
8898 8877
8899(defalias 'idlwave-function-menu 8878(defalias 'idlwave-function-menu
8900 (condition-case nil 8879 (condition-case nil
@@ -9010,8 +8989,7 @@ Assumes that point is at the beginning of the unit as found by
9010 ("Customize" 8989 ("Customize"
9011 ["Browse IDLWAVE Group" idlwave-customize t] 8990 ["Browse IDLWAVE Group" idlwave-customize t]
9012 "--" 8991 "--"
9013 ["Build Full Customize Menu" idlwave-create-customize-menu 8992 ["Build Full Customize Menu" idlwave-create-customize-menu t])
9014 (fboundp 'customize-menu-create)])
9015 ("Documentation" 8993 ("Documentation"
9016 ["Describe Mode" describe-mode t] 8994 ["Describe Mode" describe-mode t]
9017 ["Abbreviation List" idlwave-list-abbrevs t] 8995 ["Abbreviation List" idlwave-list-abbrevs t]
@@ -9032,14 +9010,12 @@ Assumes that point is at the beginning of the unit as found by
9032 (and (boundp 'idlwave-shell-automatic-start) 9010 (and (boundp 'idlwave-shell-automatic-start)
9033 idlwave-shell-automatic-start)])) 9011 idlwave-shell-automatic-start)]))
9034 9012
9035(if (or (featurep 'easymenu) (load "easymenu" t)) 9013(easy-menu-define idlwave-mode-menu idlwave-mode-map
9036 (progn 9014 "IDL and WAVE CL editing menu"
9037 (easy-menu-define idlwave-mode-menu idlwave-mode-map 9015 idlwave-mode-menu-def)
9038 "IDL and WAVE CL editing menu" 9016(easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
9039 idlwave-mode-menu-def) 9017 "IDL and WAVE CL editing menu"
9040 (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map 9018 idlwave-mode-debug-menu-def)
9041 "IDL and WAVE CL editing menu"
9042 idlwave-mode-debug-menu-def)))
9043 9019
9044(defun idlwave-customize () 9020(defun idlwave-customize ()
9045 "Call the customize function with `idlwave' as argument." 9021 "Call the customize function with `idlwave' as argument."
@@ -9053,24 +9029,21 @@ Assumes that point is at the beginning of the unit as found by
9053(defun idlwave-create-customize-menu () 9029(defun idlwave-create-customize-menu ()
9054 "Create a full customization menu for IDLWAVE, insert it into the menu." 9030 "Create a full customization menu for IDLWAVE, insert it into the menu."
9055 (interactive) 9031 (interactive)
9056 (if (fboundp 'customize-menu-create) 9032 ;; Try to load the code for the shell, so that we can customize it
9057 (progn 9033 ;; as well.
9058 ;; Try to load the code for the shell, so that we can customize it 9034 (or (featurep 'idlw-shell)
9059 ;; as well. 9035 (load "idlw-shell" t))
9060 (or (featurep 'idlw-shell) 9036 (easy-menu-change
9061 (load "idlw-shell" t)) 9037 '("IDLWAVE") "Customize"
9062 (easy-menu-change 9038 `(["Browse IDLWAVE group" idlwave-customize t]
9063 '("IDLWAVE") "Customize" 9039 "--"
9064 `(["Browse IDLWAVE group" idlwave-customize t] 9040 ,(customize-menu-create 'idlwave)
9065 "--" 9041 ["Set" Custom-set t]
9066 ,(customize-menu-create 'idlwave) 9042 ["Save" Custom-save t]
9067 ["Set" Custom-set t] 9043 ["Reset to Current" Custom-reset-current t]
9068 ["Save" Custom-save t] 9044 ["Reset to Saved" Custom-reset-saved t]
9069 ["Reset to Current" Custom-reset-current t] 9045 ["Reset to Standard Settings" Custom-reset-standard t]))
9070 ["Reset to Saved" Custom-reset-saved t] 9046 (message "\"IDLWAVE\"-menu now contains full customization menu"))
9071 ["Reset to Standard Settings" Custom-reset-standard t]))
9072 (message "\"IDLWAVE\"-menu now contains full customization menu"))
9073 (error "Cannot expand menu (outdated version of cus-edit.el)")))
9074 9047
9075(defun idlwave-show-commentary () 9048(defun idlwave-show-commentary ()
9076 "Use the finder to view the file documentation from `idlwave.el'." 9049 "Use the finder to view the file documentation from `idlwave.el'."
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 8596d78a604..3e49f84dbce 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1370,13 +1370,11 @@ Fill comments, backslashed lines, and variable definitions specially."
1370 (goto-char (point-min)) 1370 (goto-char (point-min))
1371 (erase-buffer) 1371 (erase-buffer)
1372 (mapconcat 1372 (mapconcat
1373 (function 1373 (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n"))
1374 (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")))
1375 targets 1374 targets
1376 "") 1375 "")
1377 (mapconcat 1376 (mapconcat
1378 (function 1377 (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n"))
1379 (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")))
1380 macros 1378 macros
1381 "") 1379 "")
1382 (sort-lines nil (point-min) (point-max)) 1380 (sort-lines nil (point-min) (point-max))
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 7265aeee45d..bb19436cdad 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -209,7 +209,7 @@
209(eval-and-compile 209(eval-and-compile
210 (defconst perl--syntax-exp-intro-keywords 210 (defconst perl--syntax-exp-intro-keywords
211 '("split" "if" "unless" "until" "while" "print" 211 '("split" "if" "unless" "until" "while" "print"
212 "grep" "map" "not" "or" "and" "for" "foreach")) 212 "grep" "map" "not" "or" "and" "for" "foreach" "return"))
213 213
214 (defconst perl--syntax-exp-intro-regexp 214 (defconst perl--syntax-exp-intro-regexp
215 (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" 215 (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 124f652ed69..75e95d9b904 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -261,7 +261,6 @@
261(require 'comint) 261(require 'comint)
262 262
263(eval-when-compile 263(eval-when-compile
264 (require 'font-lock)
265 ;; We need imenu everywhere because of the predicate index! 264 ;; We need imenu everywhere because of the predicate index!
266 (require 'imenu) 265 (require 'imenu)
267 ;) 266 ;)
@@ -1883,8 +1882,6 @@ Argument BOUND is a buffer position limiting searching."
1883;; Set everything up 1882;; Set everything up
1884(defun prolog-font-lock-keywords () 1883(defun prolog-font-lock-keywords ()
1885 "Set up font lock keywords for the current Prolog system." 1884 "Set up font lock keywords for the current Prolog system."
1886 ;;(when window-system
1887 (require 'font-lock)
1888 1885
1889 ;; Define Prolog faces 1886 ;; Define Prolog faces
1890 (defface prolog-redo-face 1887 (defface prolog-redo-face
diff --git a/lisp/simple.el b/lisp/simple.el
index e96c7c9a6ea..bb28145502b 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5087,11 +5087,20 @@ visual feedback indicating the extent of the region being copied."
5087 (if (called-interactively-p 'interactive) 5087 (if (called-interactively-p 'interactive)
5088 (indicate-copied-region))) 5088 (indicate-copied-region)))
5089 5089
5090(defcustom copy-region-blink-delay 1
5091 "Time in seconds to delay after showing the other end of the region.
5092It's used by the command `kill-ring-save' and the function
5093`indicate-copied-region' to blink the cursor between point and mark.
5094The value 0 disables blinking."
5095 :type 'number
5096 :group 'killing
5097 :version "28.1")
5098
5090(defun indicate-copied-region (&optional message-len) 5099(defun indicate-copied-region (&optional message-len)
5091 "Indicate that the region text has been copied interactively. 5100 "Indicate that the region text has been copied interactively.
5092If the mark is visible in the selected window, blink the cursor 5101If the mark is visible in the selected window, blink the cursor between
5093between point and mark if there is currently no active region 5102point and mark if there is currently no active region highlighting.
5094highlighting. 5103The option `copy-region-blink-delay' can disable blinking.
5095 5104
5096If the mark lies outside the selected window, display an 5105If the mark lies outside the selected window, display an
5097informative message containing a sample of the copied text. The 5106informative message containing a sample of the copied text. The
@@ -5105,12 +5114,14 @@ of this sample text; it defaults to 40."
5105 (if (pos-visible-in-window-p mark (selected-window)) 5114 (if (pos-visible-in-window-p mark (selected-window))
5106 ;; Swap point-and-mark quickly so as to show the region that 5115 ;; Swap point-and-mark quickly so as to show the region that
5107 ;; was selected. Don't do it if the region is highlighted. 5116 ;; was selected. Don't do it if the region is highlighted.
5108 (unless (and (region-active-p) 5117 (when (and (numberp copy-region-blink-delay)
5109 (face-background 'region nil t)) 5118 (> copy-region-blink-delay 0)
5119 (or (not (region-active-p))
5120 (not (face-background 'region nil t))))
5110 ;; Swap point and mark. 5121 ;; Swap point and mark.
5111 (set-marker (mark-marker) (point) (current-buffer)) 5122 (set-marker (mark-marker) (point) (current-buffer))
5112 (goto-char mark) 5123 (goto-char mark)
5113 (sit-for blink-matching-delay) 5124 (sit-for copy-region-blink-delay)
5114 ;; Swap back. 5125 ;; Swap back.
5115 (set-marker (mark-marker) mark (current-buffer)) 5126 (set-marker (mark-marker) mark (current-buffer))
5116 (goto-char point) 5127 (goto-char point)
@@ -5121,11 +5132,14 @@ of this sample text; it defaults to 40."
5121 (let ((len (min (abs (- mark point)) 5132 (let ((len (min (abs (- mark point))
5122 (or message-len 40)))) 5133 (or message-len 40))))
5123 (if (< point mark) 5134 (if (< point mark)
5124 ;; Don't say "killed"; that is misleading. 5135 ;; Don't say "killed" or "saved"; that is misleading.
5125 (message "Saved text until \"%s\"" 5136 (message "Copied text until \"%s\""
5126 (buffer-substring-no-properties (- mark len) mark)) 5137 ;; Don't show newlines literally
5127 (message "Saved text from \"%s\"" 5138 (query-replace-descr
5128 (buffer-substring-no-properties mark (+ mark len)))))))) 5139 (buffer-substring-no-properties (- mark len) mark)))
5140 (message "Copied text from \"%s\""
5141 (query-replace-descr
5142 (buffer-substring-no-properties mark (+ mark len)))))))))
5129 5143
5130(defun append-next-kill (&optional interactive) 5144(defun append-next-kill (&optional interactive)
5131 "Cause following command, if it kills, to add to previous kill. 5145 "Cause following command, if it kills, to add to previous kill.
@@ -7421,18 +7435,17 @@ are interchanged."
7421With argument ARG, takes previous line and moves it past ARG lines. 7435With argument ARG, takes previous line and moves it past ARG lines.
7422With argument 0, interchanges line point is in with line mark is in." 7436With argument 0, interchanges line point is in with line mark is in."
7423 (interactive "*p") 7437 (interactive "*p")
7424 (transpose-subr (function 7438 (transpose-subr (lambda (arg)
7425 (lambda (arg) 7439 (if (> arg 0)
7426 (if (> arg 0) 7440 (progn
7427 (progn 7441 ;; Move forward over ARG lines,
7428 ;; Move forward over ARG lines, 7442 ;; but create newlines if necessary.
7429 ;; but create newlines if necessary. 7443 (setq arg (forward-line arg))
7430 (setq arg (forward-line arg)) 7444 (if (/= (preceding-char) ?\n)
7431 (if (/= (preceding-char) ?\n) 7445 (setq arg (1+ arg)))
7432 (setq arg (1+ arg))) 7446 (if (> arg 0)
7433 (if (> arg 0) 7447 (newline arg)))
7434 (newline arg))) 7448 (forward-line arg)))
7435 (forward-line arg))))
7436 arg)) 7449 arg))
7437 7450
7438;; FIXME seems to leave point BEFORE the current object when ARG = 0, 7451;; FIXME seems to leave point BEFORE the current object when ARG = 0,
diff --git a/lisp/subr.el b/lisp/subr.el
index 2f351654ab3..f9ca50f95ec 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2611,7 +2611,11 @@ This function is used by the `interactive' code letter `n'."
2611Any input that is not one of CHARS is ignored. 2611Any input that is not one of CHARS is ignored.
2612 2612
2613If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore 2613If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore
2614keyboard-quit events while waiting for a valid input." 2614keyboard-quit events while waiting for a valid input.
2615
2616If you bind the variable `help-form' to a non-nil value
2617while calling this function, then pressing `help-char'
2618causes it to evaluate `help-form' and display the result."
2615 (unless (consp chars) 2619 (unless (consp chars)
2616 (error "Called `read-char-choice' without valid char choices")) 2620 (error "Called `read-char-choice' without valid char choices"))
2617 (let (char done show-help (helpbuf " *Char Help*")) 2621 (let (char done show-help (helpbuf " *Char Help*"))
@@ -2772,8 +2776,11 @@ Optional argument HISTORY, if non-nil, should be a symbol that
2772specifies the history list variable to use for navigating in input 2776specifies the history list variable to use for navigating in input
2773history using `M-p' and `M-n', with `RET' to select a character from 2777history using `M-p' and `M-n', with `RET' to select a character from
2774history. 2778history.
2775If the caller has set `help-form', there is no need to explicitly add 2779If you bind the variable `help-form' to a non-nil value
2776`help-char' to chars. It's bound automatically to `help-form-show'." 2780while calling this function, then pressing `help-char'
2781causes it to evaluate `help-form' and display the result.
2782There is no need to explicitly add `help-char' to CHARS;
2783`help-char' is bound automatically to `help-form-show'."
2777 (let* ((empty-history '()) 2784 (let* ((empty-history '())
2778 (map (if (consp chars) 2785 (map (if (consp chars)
2779 (or (gethash (list help-form (cons help-char chars)) 2786 (or (gethash (list help-form (cons help-char chars))
@@ -2830,7 +2837,7 @@ If the caller has set `help-form', there is no need to explicitly add
2830 2837
2831 (define-key map [remap skip] 'y-or-n-p-insert-n) 2838 (define-key map [remap skip] 'y-or-n-p-insert-n)
2832 2839
2833 (dolist (symbol '(help backup undo undo-all edit edit-replacement 2840 (dolist (symbol '(backup undo undo-all edit edit-replacement
2834 delete-and-edit ignore self-insert-command)) 2841 delete-and-edit ignore self-insert-command))
2835 (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other)) 2842 (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other))
2836 2843
@@ -2885,6 +2892,12 @@ Return t if answer is \"y\" and nil if it is \"n\".
2885PROMPT is the string to display to ask the question. It should 2892PROMPT is the string to display to ask the question. It should
2886end in a space; `y-or-n-p' adds \"(y or n) \" to it. 2893end in a space; `y-or-n-p' adds \"(y or n) \" to it.
2887 2894
2895If you bind the variable `help-form' to a non-nil value
2896while calling this function, then pressing `help-char'
2897causes it to evaluate `help-form' and display the result.
2898PROMPT is also updated to show `help-char' like \"(y, n or C-h) \",
2899where `help-char' is automatically bound to `help-form-show'.
2900
2888No confirmation of the answer is requested; a single character is 2901No confirmation of the answer is requested; a single character is
2889enough. SPC also means yes, and DEL means no. 2902enough. SPC also means yes, and DEL means no.
2890 2903
@@ -2907,7 +2920,13 @@ is nil and `use-dialog-box' is non-nil."
2907 (concat prompt 2920 (concat prompt
2908 (if (or (zerop l) (eq ?\s (aref prompt (1- l)))) 2921 (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
2909 "" " ") 2922 "" " ")
2910 (if dialog "" "(y or n) ")))))) 2923 (if dialog ""
2924 (if help-form
2925 (format "(y, n or %s) "
2926 (key-description
2927 (vector help-char)))
2928 "(y or n) "
2929 )))))))
2911 (cond 2930 (cond
2912 (noninteractive 2931 (noninteractive
2913 (setq prompt (funcall padded prompt)) 2932 (setq prompt (funcall padded prompt))
@@ -2916,6 +2935,7 @@ is nil and `use-dialog-box' is non-nil."
2916 (let ((str (read-string temp-prompt))) 2935 (let ((str (read-string temp-prompt)))
2917 (cond ((member str '("y" "Y")) (setq answer 'act)) 2936 (cond ((member str '("y" "Y")) (setq answer 'act))
2918 ((member str '("n" "N")) (setq answer 'skip)) 2937 ((member str '("n" "N")) (setq answer 'skip))
2938 ((and (member str '("h" "H")) help-form) (print help-form))
2919 (t (setq temp-prompt (concat "Please answer y or n. " 2939 (t (setq temp-prompt (concat "Please answer y or n. "
2920 prompt)))))))) 2940 prompt))))))))
2921 ((and (display-popup-menus-p) 2941 ((and (display-popup-menus-p)
@@ -2928,10 +2948,20 @@ is nil and `use-dialog-box' is non-nil."
2928 (setq prompt (funcall padded prompt)) 2948 (setq prompt (funcall padded prompt))
2929 (let* ((empty-history '()) 2949 (let* ((empty-history '())
2930 (enable-recursive-minibuffers t) 2950 (enable-recursive-minibuffers t)
2951 (msg help-form)
2952 (keymap (let ((map (make-composed-keymap
2953 y-or-n-p-map query-replace-map)))
2954 (when help-form
2955 ;; Create a new map before modifying
2956 (setq map (copy-keymap map))
2957 (define-key map (vector help-char)
2958 (lambda ()
2959 (interactive)
2960 (let ((help-form msg)) ; lexically bound msg
2961 (help-form-show)))))
2962 map))
2931 (str (read-from-minibuffer 2963 (str (read-from-minibuffer
2932 prompt nil 2964 prompt nil keymap nil
2933 (make-composed-keymap y-or-n-p-map query-replace-map)
2934 nil
2935 (or y-or-n-p-history-variable 'empty-history)))) 2965 (or y-or-n-p-history-variable 'empty-history))))
2936 (setq answer (if (member str '("y" "Y")) 'act 'skip))))) 2966 (setq answer (if (member str '("y" "Y")) 'act 'skip)))))
2937 (let ((ret (eq answer 'act))) 2967 (let ((ret (eq answer 'act)))
diff --git a/lisp/term.el b/lisp/term.el
index 8cbbfff1b63..585232be6c3 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -123,13 +123,12 @@
123;; full advantage of this package 123;; full advantage of this package
124;; 124;;
125;; (add-hook 'term-mode-hook 125;; (add-hook 'term-mode-hook
126;; (function 126;; (lambda ()
127;; (lambda () 127;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
128;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *") 128;; (setq-local mouse-yank-at-point t)
129;; (setq-local mouse-yank-at-point t) 129;; (setq-local transient-mark-mode nil)
130;; (setq-local transient-mark-mode nil) 130;; (auto-fill-mode -1)
131;; (auto-fill-mode -1) 131;; (setq tab-width 8)))
132;; (setq tab-width 8 ))))
133;; 132;;
134;; ---------------------------------------- 133;; ----------------------------------------
135;; 134;;
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index f15337818b0..375a23e4b14 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -568,46 +568,45 @@ default font on FRAME, or its best approximation."
568 (x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1" 568 (x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1"
569 'default frame))) 569 'default frame)))
570 val) 570 val)
571 (mapc (function 571 (mapc (lambda (script-desc)
572 (lambda (script-desc) 572 (let* ((script (car script-desc))
573 (let* ((script (car script-desc)) 573 (script-chars (vconcat (cdr script-desc)))
574 (script-chars (vconcat (cdr script-desc))) 574 (nchars (length script-chars))
575 (nchars (length script-chars)) 575 (fntlist all-fonts)
576 (fntlist all-fonts) 576 (entry (list script))
577 (entry (list script)) 577 fspec ffont font-obj glyphs idx)
578 fspec ffont font-obj glyphs idx) 578 ;; For each font in FNTLIST, determine whether it
579 ;; For each font in FNTLIST, determine whether it 579 ;; supports the representative character(s) of any
580 ;; supports the representative character(s) of any 580 ;; scripts that have no USBs defined for it.
581 ;; scripts that have no USBs defined for it. 581 (dolist (fnt fntlist)
582 (dolist (fnt fntlist) 582 (setq fspec (ignore-errors (font-spec :name fnt)))
583 (setq fspec (ignore-errors (font-spec :name fnt))) 583 (if fspec
584 (if fspec 584 (setq ffont (find-font fspec frame)))
585 (setq ffont (find-font fspec frame))) 585 (when ffont
586 (when ffont 586 (setq font-obj
587 (setq font-obj 587 (open-font ffont size frame))
588 (open-font ffont size frame)) 588 ;; Ignore fonts for which open-font returns nil:
589 ;; Ignore fonts for which open-font returns nil: 589 ;; they are buggy fonts that we cannot use anyway.
590 ;; they are buggy fonts that we cannot use anyway. 590 (setq glyphs
591 (setq glyphs 591 (if font-obj
592 (if font-obj 592 (font-get-glyphs font-obj
593 (font-get-glyphs font-obj 593 0 nchars script-chars)
594 0 nchars script-chars) 594 '[nil]))
595 '[nil])) 595 ;; Does this font support ALL of the script's
596 ;; Does this font support ALL of the script's 596 ;; representative characters?
597 ;; representative characters? 597 (setq idx 0)
598 (setq idx 0) 598 (while (and (< idx nchars) (not (null (aref glyphs idx))))
599 (while (and (< idx nchars) (not (null (aref glyphs idx)))) 599 (setq idx (1+ idx)))
600 (setq idx (1+ idx))) 600 (if (= idx nchars)
601 (if (= idx nchars) 601 ;; It does; add this font to the script's entry in alist.
602 ;; It does; add this font to the script's entry in alist. 602 (let ((font-family (font-get font-obj :family)))
603 (let ((font-family (font-get font-obj :family))) 603 ;; Unifont is an ugly font, and it is already
604 ;; Unifont is an ugly font, and it is already 604 ;; present in the default fontset.
605 ;; present in the default fontset. 605 (unless (string= (downcase (symbol-name font-family))
606 (unless (string= (downcase (symbol-name font-family)) 606 "unifont")
607 "unifont") 607 (push font-family entry))))))
608 (push font-family entry)))))) 608 (if (> (length entry) 1)
609 (if (> (length entry) 1) 609 (push (nreverse entry) val))))
610 (push (nreverse entry) val)))))
611 (w32--filter-USB-scripts)) 610 (w32--filter-USB-scripts))
612 ;; We've opened a lot of fonts, so clear the font caches to free 611 ;; We've opened a lot of fonts, so clear the font caches to free
613 ;; some memory. 612 ;; some memory.
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index fcf63ed5ecf..c9e21e58f62 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -88,6 +88,16 @@ If this is a function, call it to generate the initial field text."
88 (const :tag "Default" t)) 88 (const :tag "Default" t))
89 :risky t) 89 :risky t)
90 90
91(defcustom bibtex-unify-case-convert #'identity
92 "Function called when unifying case on entry and field names.
93It is called with one argument, the entry or field name."
94 :version "28.1"
95 :type '(choice (const :tag "Same case as in `bibtex-field-alist'" identity)
96 (const :tag "Downcase" downcase)
97 (const :tag "Capitalize" capitalize)
98 (const :tag "Upcase" upcase)
99 (function :tag "Conversion function")))
100
91(defcustom bibtex-user-optional-fields 101(defcustom bibtex-user-optional-fields
92 '(("annote" "Personal annotation (ignored)")) 102 '(("annote" "Personal annotation (ignored)"))
93 "List of optional fields the user wants to have always present. 103 "List of optional fields the user wants to have always present.
@@ -122,7 +132,8 @@ last-comma Add or delete comma on end of last field in entry,
122 according to value of `bibtex-comma-after-last-field'. 132 according to value of `bibtex-comma-after-last-field'.
123delimiters Change delimiters according to variables 133delimiters Change delimiters according to variables
124 `bibtex-field-delimiters' and `bibtex-entry-delimiters'. 134 `bibtex-field-delimiters' and `bibtex-entry-delimiters'.
125unify-case Change case of entry types and field names. 135unify-case Change case of entry and field names according to
136 `bibtex-unify-case-convert'.
126braces Enclose parts of field entries by braces according to 137braces Enclose parts of field entries by braces according to
127 `bibtex-field-braces-alist'. 138 `bibtex-field-braces-alist'.
128strings Replace parts of field entries by string constants 139strings Replace parts of field entries by string constants
@@ -2346,7 +2357,7 @@ Formats current entry according to variable `bibtex-entry-format'."
2346 ;; unify case of entry type 2357 ;; unify case of entry type
2347 (when (memq 'unify-case format) 2358 (when (memq 'unify-case format)
2348 (delete-region beg-type end-type) 2359 (delete-region beg-type end-type)
2349 (insert (car entry-list))) 2360 (insert (funcall bibtex-unify-case-convert (car entry-list))))
2350 2361
2351 ;; update left entry delimiter 2362 ;; update left entry delimiter
2352 (when (memq 'delimiters format) 2363 (when (memq 'delimiters format)
@@ -2549,47 +2560,48 @@ Formats current entry according to variable `bibtex-entry-format'."
2549 (error "Mandatory field `%s' is empty" field-name)) 2560 (error "Mandatory field `%s' is empty" field-name))
2550 2561
2551 ;; unify case of field name 2562 ;; unify case of field name
2552 (if (memq 'unify-case format) 2563 (when (memq 'unify-case format)
2553 (let ((fname (car (assoc-string field-name 2564 (let ((fname (car (assoc-string field-name
2554 default-field-list t)))) 2565 default-field-list t)))
2555 (if fname 2566 (curname (buffer-substring beg-name end-name)))
2556 (progn 2567 (delete-region beg-name end-name)
2557 (delete-region beg-name end-name) 2568 (goto-char beg-name)
2558 (goto-char beg-name) 2569 (insert (funcall bibtex-unify-case-convert
2559 (insert fname)) 2570 (or fname curname)))))
2560 ;; there are no rules we could follow
2561 (downcase-region beg-name end-name))))
2562 2571
2563 ;; update point 2572 ;; update point
2564 (goto-char end-field)))) 2573 (goto-char end-field))))
2565 2574
2566 ;; check whether all required fields are present 2575 ;; check whether all required fields are present
2567 (if (memq 'required-fields format) 2576 (when (memq 'required-fields format)
2568 (let ((alt-expect (make-vector num-alt nil)) 2577 (let ((alt-expect (make-vector num-alt nil))
2569 (alt-found (make-vector num-alt 0))) 2578 (alt-found (make-vector num-alt 0)))
2570 (dolist (fname req-field-list) 2579 (dolist (fname req-field-list)
2571 (cond ((setq idx (nth 3 fname)) 2580 (cond ((setq idx (nth 3 fname))
2572 ;; t if field has alternative flag 2581 ;; t if field has alternative flag
2573 (bibtex-vec-push alt-expect idx (car fname)) 2582 (bibtex-vec-push alt-expect idx (car fname))
2574 (if (member-ignore-case (car fname) field-list) 2583 (if (member-ignore-case (car fname) field-list)
2575 (bibtex-vec-incr alt-found idx))) 2584 (bibtex-vec-incr alt-found idx)))
2576 ((not (member-ignore-case (car fname) field-list)) 2585 ((not (member-ignore-case (car fname) field-list))
2577 ;; If we use the crossref field, a required field 2586 ;; If we use the crossref field, a required field
2578 ;; can have the OPT prefix. So if it was empty, 2587 ;; can have the OPT prefix. So if it was empty,
2579 ;; we have deleted by now. Nonetheless we can 2588 ;; we have deleted by now. Nonetheless we can
2580 ;; move point on this empty field. 2589 ;; move point on this empty field.
2581 (setq error-field-name (car fname)) 2590 (setq error-field-name (car fname))
2582 (error "Mandatory field `%s' is missing" (car fname))))) 2591 (error "Mandatory field `%s' is missing"
2583 (dotimes (idx num-alt) 2592 (car fname)))))
2584 (cond ((= 0 (aref alt-found idx)) 2593 (dotimes (idx num-alt)
2585 (setq error-field-name (car (last (aref alt-fields idx)))) 2594 (cond ((= 0 (aref alt-found idx))
2586 (error "Alternative mandatory field `%s' is missing" 2595 (setq error-field-name
2587 (aref alt-expect idx))) 2596 (car (last (aref alt-fields idx))))
2588 ((< 1 (aref alt-found idx)) 2597 (error "Alternative mandatory field `%s' is missing"
2589 (setq error-field-name (car (last (aref alt-fields idx)))) 2598 (aref alt-expect idx)))
2590 (error "Alternative fields `%s' are defined %s times" 2599 ((< 1 (aref alt-found idx))
2591 (aref alt-expect idx) 2600 (setq error-field-name
2592 (length (aref alt-fields idx)))))))) 2601 (car (last (aref alt-fields idx))))
2602 (error "Alternative fields `%s' are defined %s times"
2603 (aref alt-expect idx)
2604 (length (aref alt-fields idx))))))))
2593 2605
2594 ;; update comma after last field 2606 ;; update comma after last field
2595 (if (memq 'last-comma format) 2607 (if (memq 'last-comma format)
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index adda28cb81b..7a7ac478b76 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -3578,8 +3578,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
3578;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3578;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3579;; Font lock 3579;; Font lock
3580 3580
3581(require 'font-lock)
3582
3583;; FIXME: The obsolete variables need to disappear. 3581;; FIXME: The obsolete variables need to disappear.
3584 3582
3585;; The following versions have been done inside Emacs and should not be 3583;; The following versions have been done inside Emacs and should not be
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 25aa58046f4..065fdd09ccb 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -3270,34 +3270,33 @@ Currently this method is for LaTeX only."
3270 (let* ((span 1) ;; spanning length 3270 (let* ((span 1) ;; spanning length
3271 (first-p t) ;; first in a row 3271 (first-p t) ;; first in a row
3272 (insert-column ;; a function that processes one column/multicolumn 3272 (insert-column ;; a function that processes one column/multicolumn
3273 (function 3273 (lambda (from to)
3274 (lambda (from to) 3274 (let ((line (table--buffer-substring-and-trim
3275 (let ((line (table--buffer-substring-and-trim 3275 (table--goto-coordinate (cons from y))
3276 (table--goto-coordinate (cons from y)) 3276 (table--goto-coordinate (cons to y)))))
3277 (table--goto-coordinate (cons to y))))) 3277 ;; escape special characters
3278 ;; escape special characters 3278 (with-temp-buffer
3279 (with-temp-buffer 3279 (insert line)
3280 (insert line) 3280 (goto-char (point-min))
3281 (goto-char (point-min)) 3281 (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
3282 (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t) 3282 (if (match-beginning 1)
3283 (if (match-beginning 1) 3283 (save-excursion
3284 (save-excursion 3284 (goto-char (match-beginning 1))
3285 (goto-char (match-beginning 1)) 3285 (insert "\\"))
3286 (insert "\\")) 3286 (if (match-beginning 2)
3287 (if (match-beginning 2) 3287 (replace-match "$\\backslash$" t t)
3288 (replace-match "$\\backslash$" t t) 3288 (replace-match (concat "$" (match-string 3) "$")) t t)))
3289 (replace-match (concat "$" (match-string 3) "$")) t t))) 3289 (setq line (buffer-substring (point-min) (point-max))))
3290 (setq line (buffer-substring (point-min) (point-max)))) 3290 ;; insert a column separator and column/multicolumn contents
3291 ;; insert a column separator and column/multicolumn contents 3291 (with-current-buffer dest-buffer
3292 (with-current-buffer dest-buffer 3292 (unless first-p
3293 (unless first-p 3293 (insert (if (eq (char-before) ?\s) "" " ") "& "))
3294 (insert (if (eq (char-before) ?\s) "" " ") "& ")) 3294 (if (> span 1)
3295 (if (> span 1) 3295 (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
3296 (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line)) 3296 (insert line)))
3297 (insert line))) 3297 (setq first-p nil)
3298 (setq first-p nil) 3298 (setq span 1)
3299 (setq span 1) 3299 (setq start (nth i col-list))))))
3300 (setq start (nth i col-list)))))))
3301 (setq start x0) 3300 (setq start x0)
3302 (setq i 1) 3301 (setq i 1)
3303 (while (setq c (nth i border-char-list)) 3302 (while (setq c (nth i border-char-list))
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index 7c64f2903be..c50d68b60af 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -1,4 +1,4 @@
1;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs 1;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1989, 1993-1995, 1997, 2000-2020 Free Software 3;; Copyright (C) 1989, 1993-1995, 1997, 2000-2020 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -87,7 +87,6 @@ transitional behavior (again, as shown).
87The behavior of `%5z' is new in Emacs 27. If your files might be 87The behavior of `%5z' is new in Emacs 27. If your files might be
88edited by older versions of Emacs also, do not use this format yet." 88edited by older versions of Emacs also, do not use this format yet."
89 :type 'string 89 :type 'string
90 :group 'time-stamp
91 :version "27.1") 90 :version "27.1")
92;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp) 91;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp)
93 92
@@ -102,8 +101,7 @@ when they are saved, either add this line to your init file:
102or customize option `before-save-hook'. 101or customize option `before-save-hook'.
103 102
104See also the variable `time-stamp-warn-inactive'." 103See also the variable `time-stamp-warn-inactive'."
105 :type 'boolean 104 :type 'boolean)
106 :group 'time-stamp)
107 105
108(defcustom time-stamp-warn-inactive t 106(defcustom time-stamp-warn-inactive t
109 "Have \\[time-stamp] warn if a buffer did not get time-stamped. 107 "Have \\[time-stamp] warn if a buffer did not get time-stamped.
@@ -111,7 +109,6 @@ If non-nil, a warning is displayed if `time-stamp-active' has
111deactivated time stamping and the buffer contains a template that 109deactivated time stamping and the buffer contains a template that
112otherwise would have been updated." 110otherwise would have been updated."
113 :type 'boolean 111 :type 'boolean
114 :group 'time-stamp
115 :version "19.29") 112 :version "19.29")
116 113
117(defcustom time-stamp-time-zone nil 114(defcustom time-stamp-time-zone nil
@@ -125,7 +122,6 @@ Its format is that of the ZONE argument of the `format-time-string' function."
125 (integer :tag "Offset (seconds east of UTC)") 122 (integer :tag "Offset (seconds east of UTC)")
126 (string :tag "Time zone abbreviation")) 123 (string :tag "Time zone abbreviation"))
127 (integer :tag "Offset (seconds east of UTC)")) 124 (integer :tag "Offset (seconds east of UTC)"))
128 :group 'time-stamp
129 :version "20.1") 125 :version "20.1")
130;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p) 126;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p)
131 127
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index fd800cd9782..bcb48aa455d 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -23,7 +23,6 @@
23 23
24(require 'url-vars) 24(require 'url-vars)
25(require 'url-parse) 25(require 'url-parse)
26(autoload 'url-warn "url")
27(autoload 'auth-source-search "auth-source") 26(autoload 'auth-source-search "auth-source")
28 27
29(defsubst url-auth-user-prompt (url realm) 28(defsubst url-auth-user-prompt (url realm)
@@ -540,7 +539,7 @@ RATING a rating between 1 and 10 of the strength of the authentication.
540 (t rating))) 539 (t rating)))
541 (node (assoc type url-registered-auth-schemes))) 540 (node (assoc type url-registered-auth-schemes)))
542 (if (not (fboundp function)) 541 (if (not (fboundp function))
543 (url-warn 542 (display-warning
544 'security 543 'security
545 (format-message 544 (format-message
546 "Tried to register `%s' as an auth scheme, but it is not a function!" 545 "Tried to register `%s' as an auth scheme, but it is not a function!"
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 8532da1d1fb..75330d33277 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1119,9 +1119,7 @@ the end of the document."
1119 (beginning-of-line) 1119 (beginning-of-line)
1120 (looking-at regexp)) 1120 (looking-at regexp))
1121 (add-text-properties (match-beginning 0) (match-end 0) 1121 (add-text-properties (match-beginning 0) (match-end 0)
1122 (list 'start-open t 1122 (list 'chunked-encoding t
1123 'end-open t
1124 'chunked-encoding t
1125 'face 'cursor 1123 'face 'cursor
1126 'invisible t)) 1124 'invisible t))
1127 (setq url-http-chunked-length (string-to-number (buffer-substring 1125 (setq url-http-chunked-length (string-to-number (buffer-substring
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 9ef17cccd77..78a6aa94839 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -25,7 +25,6 @@
25(require 'url-util) 25(require 'url-util)
26(require 'url-parse) 26(require 'url-parse)
27(require 'nntp) 27(require 'nntp)
28(autoload 'url-warn "url")
29(autoload 'gnus-group-read-ephemeral-group "gnus-group") 28(autoload 'gnus-group-read-ephemeral-group "gnus-group")
30 29
31;; Unused. 30;; Unused.
@@ -42,7 +41,7 @@
42 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user) 41 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
43 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass) 42 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
44 (if (not (nntp-server-opened host)) 43 (if (not (nntp-server-opened host))
45 (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed" 44 (display-warning 'url (format "NNTP authentication to `%s' as `%s' failed"
46 host user)))))) 45 host user))))))
47 46
48(defun url-news-fetch-message-id (host message-id) 47(defun url-news-fetch-message-id (host message-id)
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 9513c3973a1..698a87098ba 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -22,7 +22,6 @@
22;;; Code: 22;;; Code:
23 23
24(require 'url-parse) 24(require 'url-parse)
25(autoload 'url-warn "url")
26 25
27(defun url-default-find-proxy-for-url (urlobj host) 26(defun url-default-find-proxy-for-url (urlobj host)
28 (cond 27 (cond
@@ -60,7 +59,7 @@
60 ((string-match "^socks +" proxy) 59 ((string-match "^socks +" proxy)
61 (concat "socks://" (substring proxy (match-end 0)))) 60 (concat "socks://" (substring proxy (match-end 0))))
62 (t 61 (t
63 (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical) 62 (display-warning 'url (format "Unknown proxy directive: %s" proxy) 'critical)
64 nil)))) 63 nil))))
65 64
66(autoload 'url-http "url-http") 65(autoload 'url-http "url-http")
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 33a5ebcdccc..5188007a58b 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -365,19 +365,7 @@ how long to wait for a response before giving up."
365 (if (buffer-live-p buff) 365 (if (buffer-live-p buff)
366 (kill-buffer buff))))) 366 (kill-buffer buff)))))
367 367
368(cond 368(define-obsolete-function-alias 'url-warn #'display-warning "28.1")
369 ((fboundp 'display-warning)
370 (defalias 'url-warn 'display-warning))
371 ((fboundp 'warn)
372 (defun url-warn (class message &optional level)
373 (warn "(%s/%s) %s" class (or level 'warning) message)))
374 (t
375 (defun url-warn (class message &optional level)
376 (with-current-buffer (get-buffer-create "*URL-WARNINGS*")
377 (goto-char (point-max))
378 (save-excursion
379 (insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
380 (display-buffer (current-buffer))))))
381 369
382(provide 'url) 370(provide 'url)
383 371
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 5aeb8feb990..0a906136047 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -403,7 +403,8 @@ well."
403 '((((class color)) 403 '((((class color))
404 :foreground "red" :background "black" :weight bold) 404 :foreground "red" :background "black" :weight bold)
405 (t :weight bold)) 405 (t :weight bold))
406 "`diff-mode' face for error messages from diff.") 406 "`diff-mode' face for error messages from diff."
407 :version "28.1")
407 408
408(defconst diff-yank-handler '(diff-yank-function)) 409(defconst diff-yank-handler '(diff-yank-function))
409(defun diff-yank-function (text) 410(defun diff-yank-function (text)
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index a23d72070ab..c68dc718843 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -42,13 +42,6 @@
42(require 'ediff-help) 42(require 'ediff-help)
43;; end pacifier 43;; end pacifier
44 44
45
46;; be careful with ediff-tbar
47(eval-and-compile
48 (if (featurep 'xemacs)
49 (require 'ediff-tbar)
50 (defun ediff-compute-toolbar-width () 0)))
51
52(defgroup ediff-window nil 45(defgroup ediff-window nil
53 "Ediff window manipulation." 46 "Ediff window manipulation."
54 :prefix "ediff-" 47 :prefix "ediff-"
@@ -961,8 +954,7 @@ create a new splittable frame if none is found."
961 ;; 1 more line for the mode line 954 ;; 1 more line for the mode line
962 (setq lines (1+ (count-lines (point-min) (point-max))) 955 (setq lines (1+ (count-lines (point-min) (point-max)))
963 fheight lines 956 fheight lines
964 fwidth (max (+ (ediff-help-message-line-length) 2) 957 fwidth (max (+ (ediff-help-message-line-length) 2) 0)
965 (ediff-compute-toolbar-width))
966 adjusted-parameters 958 adjusted-parameters
967 (list 959 (list
968 ;; possibly change surrogate minibuffer 960 ;; possibly change surrogate minibuffer
@@ -1291,6 +1283,9 @@ It assumes that it is called from within the control buffer."
1291 (ediff-multiframe-setup-p) 1283 (ediff-multiframe-setup-p)
1292 ediff-wide-display-p))))))) 1284 ediff-wide-display-p)))))))
1293 1285
1286(defun ediff-compute-toolbar-width ()
1287 (declare (obsolete nil "28.1"))
1288 0)
1294 1289
1295(provide 'ediff-wind) 1290(provide 'ediff-wind)
1296;;; ediff-wind.el ends here 1291;;; ediff-wind.el ends here
diff --git a/nt/INSTALL b/nt/INSTALL
index 2fe2c8c2673..27fb5f096f7 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -502,11 +502,21 @@ build will run on Windows 9X and newer systems).
502 Does Emacs use -lgnutls? yes 502 Does Emacs use -lgnutls? yes
503 Does Emacs use -lxml2? yes 503 Does Emacs use -lxml2? yes
504 Does Emacs use -lfreetype? no 504 Does Emacs use -lfreetype? no
505 Does Emacs use HarfBuzz? yes
505 Does Emacs use -lm17n-flt? no 506 Does Emacs use -lm17n-flt? no
506 Does Emacs use -lotf? no 507 Does Emacs use -lotf? no
507 Does Emacs use -lxft? no 508 Does Emacs use -lxft? no
509 Does Emacs use -lsystemd? no
510 Does Emacs use -ljansson? yes
511 Does Emacs use the GMP library? yes
508 Does Emacs directly use zlib? yes 512 Does Emacs directly use zlib? yes
513 Does Emacs have dynamic modules support? yes
509 Does Emacs use toolkit scroll bars? yes 514 Does Emacs use toolkit scroll bars? yes
515 Does Emacs support Xwidgets? no
516 Does Emacs have threading support in lisp? yes
517 Does Emacs support the portable dumper? yes
518 Does Emacs support the legacy unexec dumping? no
519 Which dumping strategy does Emacs use? pdumper
510 520
511 You are almost there, hang on. 521 You are almost there, hang on.
512 522
@@ -815,6 +825,14 @@ build will run on Windows 9X and newer systems).
815 the libjansson DLL (for 32-bit builds of Emacs) are available from 825 the libjansson DLL (for 32-bit builds of Emacs) are available from
816 the ezwinports site and from the MSYS2 project. 826 the ezwinports site and from the MSYS2 project.
817 827
828* Optional support for HarfBuzzz shaping library
829
830 Emacs supports display of complex scripts and Arabic shaping. The
831 preferred library for that is HarfBuzz; prebuilt binaries are
832 available from the ezwinports site (for 32-bit builds of Emacs) and
833 from the MSYS2 project. If HarfBuzz is not available, Emacs will
834 use the Uniscribe shaping engine that is part of MS-Windows.
835
818 836
819This file is part of GNU Emacs. 837This file is part of GNU Emacs.
820 838
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index 0a0e0330a24..4724116ebcc 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -55,14 +55,16 @@ packages (you can copy and paste it into the shell with Shift + Insert):
55 mingw-w64-x86_64-jansson \ 55 mingw-w64-x86_64-jansson \
56 mingw-w64-x86_64-libxml2 \ 56 mingw-w64-x86_64-libxml2 \
57 mingw-w64-x86_64-gnutls \ 57 mingw-w64-x86_64-gnutls \
58 mingw-w64-x86_64-zlib 58 mingw-w64-x86_64-zlib \
59 mingw-w64-x86_64-harfbuzz
59 60
60The packages include the base developer tools (autoconf, grep, make, etc.), 61The packages include the base developer tools (autoconf, grep, make, etc.),
61the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML 62the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML
62library, the GnuTLS (transport layer security) library, and zlib for 63library, the GnuTLS (transport layer security) library, zlib for
63decompressing text. Only the first three packages are required (base-devel, 64decompressing text, and HarfBuzz for use as the shaping engine. Only the
64toolchain, xpm-nox); the rest are optional. You can select only part of the 65first three packages are required (base-devel, toolchain, xpm-nox); the
65libraries if you don't need them all. 66rest are optional. You can select only part of the libraries if you don't
67need them all.
66 68
67You now have a complete build environment for Emacs. 69You now have a complete build environment for Emacs.
68 70
diff --git a/src/buffer.c b/src/buffer.c
index 4fd2b0c8b17..360dd348e05 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -297,11 +297,6 @@ bset_mark (struct buffer *b, Lisp_Object val)
297 b->mark_ = val; 297 b->mark_ = val;
298} 298}
299static void 299static void
300bset_minor_modes (struct buffer *b, Lisp_Object val)
301{
302 b->minor_modes_ = val;
303}
304static void
305bset_mode_line_format (struct buffer *b, Lisp_Object val) 300bset_mode_line_format (struct buffer *b, Lisp_Object val)
306{ 301{
307 b->mode_line_format_ = val; 302 b->mode_line_format_ = val;
@@ -1004,7 +999,6 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
1004 bset_major_mode (b, Qfundamental_mode); 999 bset_major_mode (b, Qfundamental_mode);
1005 bset_keymap (b, Qnil); 1000 bset_keymap (b, Qnil);
1006 bset_mode_name (b, QSFundamental); 1001 bset_mode_name (b, QSFundamental);
1007 bset_minor_modes (b, Qnil);
1008 1002
1009 /* If the standard case table has been altered and invalidated, 1003 /* If the standard case table has been altered and invalidated,
1010 fix up its insides first. */ 1004 fix up its insides first. */
@@ -5180,7 +5174,6 @@ init_buffer_once (void)
5180 bset_upcase_table (&buffer_local_flags, make_fixnum (0)); 5174 bset_upcase_table (&buffer_local_flags, make_fixnum (0));
5181 bset_case_canon_table (&buffer_local_flags, make_fixnum (0)); 5175 bset_case_canon_table (&buffer_local_flags, make_fixnum (0));
5182 bset_case_eqv_table (&buffer_local_flags, make_fixnum (0)); 5176 bset_case_eqv_table (&buffer_local_flags, make_fixnum (0));
5183 bset_minor_modes (&buffer_local_flags, make_fixnum (0));
5184 bset_width_table (&buffer_local_flags, make_fixnum (0)); 5177 bset_width_table (&buffer_local_flags, make_fixnum (0));
5185 bset_pt_marker (&buffer_local_flags, make_fixnum (0)); 5178 bset_pt_marker (&buffer_local_flags, make_fixnum (0));
5186 bset_begv_marker (&buffer_local_flags, make_fixnum (0)); 5179 bset_begv_marker (&buffer_local_flags, make_fixnum (0));
diff --git a/src/buffer.h b/src/buffer.h
index 3da49414bb8..fe549c5dac1 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -419,9 +419,6 @@ struct buffer
419 /* Non-nil means show ... at end of line followed by invisible lines. */ 419 /* Non-nil means show ... at end of line followed by invisible lines. */
420 Lisp_Object selective_display_ellipses_; 420 Lisp_Object selective_display_ellipses_;
421 421
422 /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */
423 Lisp_Object minor_modes_;
424
425 /* t if "self-insertion" should overwrite; `binary' if it should also 422 /* t if "self-insertion" should overwrite; `binary' if it should also
426 overwrite newlines and tabs - for editing executables and the like. */ 423 overwrite newlines and tabs - for editing executables and the like. */
427 Lisp_Object overwrite_mode_; 424 Lisp_Object overwrite_mode_;
diff --git a/src/data.c b/src/data.c
index c6629dd5f29..1435cb03779 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1501,10 +1501,14 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1501 { 1501 {
1502 int offset = XBUFFER_OBJFWD (innercontents)->offset; 1502 int offset = XBUFFER_OBJFWD (innercontents)->offset;
1503 int idx = PER_BUFFER_IDX (offset); 1503 int idx = PER_BUFFER_IDX (offset);
1504 if (idx > 0 1504 if (idx > 0 && bindflag == SET_INTERNAL_SET
1505 && bindflag == SET_INTERNAL_SET 1505 && !PER_BUFFER_VALUE_P (buf, idx))
1506 && !let_shadows_buffer_binding_p (sym)) 1506 {
1507 SET_PER_BUFFER_VALUE_P (buf, idx, 1); 1507 if (let_shadows_buffer_binding_p (sym))
1508 set_default_internal (symbol, newval, bindflag);
1509 else
1510 SET_PER_BUFFER_VALUE_P (buf, idx, 1);
1511 }
1508 } 1512 }
1509 1513
1510 if (voide) 1514 if (voide)
diff --git a/src/dispnew.c b/src/dispnew.c
index 479fccb45e0..89dd32ad0fb 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -2558,11 +2558,15 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w
2558 the corresponding frame row to be updated. */ 2558 the corresponding frame row to be updated. */
2559 frame_row->enabled_p = true; 2559 frame_row->enabled_p = true;
2560 2560
2561 /* Maybe insert a vertical border between horizontally adjacent 2561 /* Maybe insert a vertical border between horizontally adjacent
2562 windows. */ 2562 windows. */
2563 if (GLYPH_CHAR (right_border_glyph) != 0) 2563 if (GLYPH_CHAR (right_border_glyph) != 0)
2564 { 2564 {
2565 struct glyph *border = window_row->glyphs[LAST_AREA] - 1; 2565 struct glyph *border = window_row->glyphs[LAST_AREA] - 1;
2566 /* It's a subtle bug if we are overwriting some non-char
2567 glyph with the vertical border glyph. */
2568 eassert (border->type == CHAR_GLYPH);
2569 border->type = CHAR_GLYPH;
2566 SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph); 2570 SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph);
2567 } 2571 }
2568 2572
diff --git a/src/fns.c b/src/fns.c
index f50bf8ecb77..e4c9acc3163 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5502,25 +5502,32 @@ Case is always significant and text properties are ignored. */)
5502 haybytes = SBYTES (haystack) - start_byte; 5502 haybytes = SBYTES (haystack) - start_byte;
5503 5503
5504 /* We can do a direct byte-string search if both strings have the 5504 /* We can do a direct byte-string search if both strings have the
5505 same multibyteness, or if at least one of them consists of ASCII 5505 same multibyteness, or if the needle consists of ASCII characters only. */
5506 characters only. */
5507 if (STRING_MULTIBYTE (haystack) 5506 if (STRING_MULTIBYTE (haystack)
5508 ? (STRING_MULTIBYTE (needle) 5507 ? (STRING_MULTIBYTE (needle)
5509 || SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle)) 5508 || SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle))
5510 : (!STRING_MULTIBYTE (needle) 5509 : (!STRING_MULTIBYTE (needle)
5511 || SCHARS (needle) == SBYTES (needle) || string_ascii_p (haystack))) 5510 || SCHARS (needle) == SBYTES (needle)))
5512 res = memmem (haystart, haybytes, 5511 {
5513 SSDATA (needle), SBYTES (needle)); 5512 if (STRING_MULTIBYTE (haystack) && STRING_MULTIBYTE (needle)
5514 else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */ 5513 && SCHARS (haystack) == SBYTES (haystack)
5514 && SCHARS (needle) != SBYTES (needle))
5515 /* Multibyte non-ASCII needle, multibyte ASCII haystack: impossible. */
5516 return Qnil;
5517 else
5518 res = memmem (haystart, haybytes,
5519 SSDATA (needle), SBYTES (needle));
5520 }
5521 else if (STRING_MULTIBYTE (haystack)) /* unibyte non-ASCII needle */
5515 { 5522 {
5516 Lisp_Object multi_needle = string_to_multibyte (needle); 5523 Lisp_Object multi_needle = string_to_multibyte (needle);
5517 res = memmem (haystart, haybytes, 5524 res = memmem (haystart, haybytes,
5518 SSDATA (multi_needle), SBYTES (multi_needle)); 5525 SSDATA (multi_needle), SBYTES (multi_needle));
5519 } 5526 }
5520 else /* unibyte haystack, multibyte needle */ 5527 else /* unibyte haystack, multibyte non-ASCII needle */
5521 { 5528 {
5522 /* The only possible way we can find the multibyte needle in the 5529 /* The only possible way we can find the multibyte needle in the
5523 unibyte stack (since we know that neither are pure-ASCII) is 5530 unibyte stack (since we know that the needle is non-ASCII) is
5524 if they contain "raw bytes" (and no other non-ASCII chars.) */ 5531 if they contain "raw bytes" (and no other non-ASCII chars.) */
5525 ptrdiff_t nbytes = SBYTES (needle); 5532 ptrdiff_t nbytes = SBYTES (needle);
5526 for (ptrdiff_t i = 0; i < nbytes; i++) 5533 for (ptrdiff_t i = 0; i < nbytes; i++)
diff --git a/src/image.c b/src/image.c
index 3858f3c41f3..5eb41322950 100644
--- a/src/image.c
+++ b/src/image.c
@@ -9551,10 +9551,9 @@ DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions,
9551DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer, 9551DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer,
9552 (RsvgHandle *, const char *, const RsvgRectangle *, 9552 (RsvgHandle *, const char *, const RsvgRectangle *,
9553 RsvgRectangle *, RsvgRectangle *, GError **)); 9553 RsvgRectangle *, RsvgRectangle *, GError **));
9554# else 9554# endif
9555DEF_DLL_FN (void, rsvg_handle_get_dimensions, 9555DEF_DLL_FN (void, rsvg_handle_get_dimensions,
9556 (RsvgHandle *, RsvgDimensionData *)); 9556 (RsvgHandle *, RsvgDimensionData *));
9557# endif
9558DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *)); 9557DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *));
9559DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *)); 9558DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *));
9560DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *)); 9559DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *));
@@ -9604,9 +9603,8 @@ init_svg_functions (void)
9604#if LIBRSVG_CHECK_VERSION (2, 46, 0) 9603#if LIBRSVG_CHECK_VERSION (2, 46, 0)
9605 LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions); 9604 LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions);
9606 LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); 9605 LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer);
9607#else
9608 LOAD_DLL_FN (library, rsvg_handle_get_dimensions);
9609#endif 9606#endif
9607 LOAD_DLL_FN (library, rsvg_handle_get_dimensions);
9610 LOAD_DLL_FN (library, rsvg_handle_get_pixbuf); 9608 LOAD_DLL_FN (library, rsvg_handle_get_pixbuf);
9611 9609
9612 LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width); 9610 LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width);
@@ -9644,9 +9642,8 @@ init_svg_functions (void)
9644# if LIBRSVG_CHECK_VERSION (2, 46, 0) 9642# if LIBRSVG_CHECK_VERSION (2, 46, 0)
9645# undef rsvg_handle_get_intrinsic_dimensions 9643# undef rsvg_handle_get_intrinsic_dimensions
9646# undef rsvg_handle_get_geometry_for_layer 9644# undef rsvg_handle_get_geometry_for_layer
9647# else
9648# undef rsvg_handle_get_dimensions
9649# endif 9645# endif
9646# undef rsvg_handle_get_dimensions
9650# undef rsvg_handle_get_pixbuf 9647# undef rsvg_handle_get_pixbuf
9651# if LIBRSVG_CHECK_VERSION (2, 32, 0) 9648# if LIBRSVG_CHECK_VERSION (2, 32, 0)
9652# undef g_file_new_for_path 9649# undef g_file_new_for_path
@@ -9677,9 +9674,8 @@ init_svg_functions (void)
9677 fn_rsvg_handle_get_intrinsic_dimensions 9674 fn_rsvg_handle_get_intrinsic_dimensions
9678# define rsvg_handle_get_geometry_for_layer \ 9675# define rsvg_handle_get_geometry_for_layer \
9679 fn_rsvg_handle_get_geometry_for_layer 9676 fn_rsvg_handle_get_geometry_for_layer
9680# else
9681# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
9682# endif 9677# endif
9678# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
9683# define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf 9679# define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf
9684# if LIBRSVG_CHECK_VERSION (2, 32, 0) 9680# if LIBRSVG_CHECK_VERSION (2, 32, 0)
9685# define g_file_new_for_path fn_g_file_new_for_path 9681# define g_file_new_for_path fn_g_file_new_for_path
@@ -9903,30 +9899,21 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
9903 viewbox_width = viewbox.x + viewbox.width; 9899 viewbox_width = viewbox.x + viewbox.width;
9904 viewbox_height = viewbox.y + viewbox.height; 9900 viewbox_height = viewbox.y + viewbox.height;
9905 } 9901 }
9906#else
9907 /* The function used above to get the geometry of the visible area
9908 of the SVG are only available in librsvg 2.46 and above, so in
9909 certain circumstances this code path can result in some parts of
9910 the SVG being cropped. */
9911 RsvgDimensionData dimension_data;
9912 9902
9913 rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); 9903 if (viewbox_width == 0 || viewbox_height == 0)
9914
9915 viewbox_width = dimension_data.width;
9916 viewbox_height = dimension_data.height;
9917#endif 9904#endif
9905 {
9906 /* The functions used above to get the geometry of the visible
9907 area of the SVG are only available in librsvg 2.46 and above,
9908 so in certain circumstances this code path can result in some
9909 parts of the SVG being cropped. */
9910 RsvgDimensionData dimension_data;
9918 9911
9919 if (viewbox_width == 0 || viewbox_height == 0) 9912 rsvg_handle_get_dimensions (rsvg_handle, &dimension_data);
9920 { 9913
9921 /* We do not have any usable dimensions, so make some up. The 9914 viewbox_width = dimension_data.width;
9922 values below are supposedly the default values most web 9915 viewbox_height = dimension_data.height;
9923 browsers use for SVGs with no set size. */ 9916 }
9924 /* FIXME: At this stage we should perhaps consider rendering the
9925 image out to a bitmap and getting the dimensions from
9926 that. */
9927 viewbox_width = 300;
9928 viewbox_height = 150;
9929 }
9930 9917
9931 compute_image_size (viewbox_width, viewbox_height, img->spec, 9918 compute_image_size (viewbox_width, viewbox_height, img->spec,
9932 &width, &height); 9919 &width, &height);
diff --git a/src/keyboard.c b/src/keyboard.c
index 49a0a8bd236..49261fcc3e8 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2122,7 +2122,7 @@ read_char_help_form_unwind (void)
2122 Lisp_Object window_config = XCAR (help_form_saved_window_configs); 2122 Lisp_Object window_config = XCAR (help_form_saved_window_configs);
2123 help_form_saved_window_configs = XCDR (help_form_saved_window_configs); 2123 help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
2124 if (!NILP (window_config)) 2124 if (!NILP (window_config))
2125 Fset_window_configuration (window_config); 2125 Fset_window_configuration (window_config, Qnil);
2126} 2126}
2127 2127
2128#define STOP_POLLING \ 2128#define STOP_POLLING \
@@ -3736,9 +3736,6 @@ discard_mouse_events (void)
3736 if (sp->kind == MOUSE_CLICK_EVENT 3736 if (sp->kind == MOUSE_CLICK_EVENT
3737 || sp->kind == WHEEL_EVENT 3737 || sp->kind == WHEEL_EVENT
3738 || sp->kind == HORIZ_WHEEL_EVENT 3738 || sp->kind == HORIZ_WHEEL_EVENT
3739#ifdef HAVE_GPM
3740 || sp->kind == GPM_CLICK_EVENT
3741#endif
3742 || sp->kind == SCROLL_BAR_CLICK_EVENT 3739 || sp->kind == SCROLL_BAR_CLICK_EVENT
3743 || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT) 3740 || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3744 { 3741 {
@@ -5542,9 +5539,6 @@ make_lispy_event (struct input_event *event)
5542 /* A mouse click. Figure out where it is, decide whether it's 5539 /* A mouse click. Figure out where it is, decide whether it's
5543 a press, click or drag, and build the appropriate structure. */ 5540 a press, click or drag, and build the appropriate structure. */
5544 case MOUSE_CLICK_EVENT: 5541 case MOUSE_CLICK_EVENT:
5545#ifdef HAVE_GPM
5546 case GPM_CLICK_EVENT:
5547#endif
5548#ifndef USE_TOOLKIT_SCROLL_BARS 5542#ifndef USE_TOOLKIT_SCROLL_BARS
5549 case SCROLL_BAR_CLICK_EVENT: 5543 case SCROLL_BAR_CLICK_EVENT:
5550 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT: 5544 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
@@ -5559,11 +5553,7 @@ make_lispy_event (struct input_event *event)
5559 position = Qnil; 5553 position = Qnil;
5560 5554
5561 /* Build the position as appropriate for this mouse click. */ 5555 /* Build the position as appropriate for this mouse click. */
5562 if (event->kind == MOUSE_CLICK_EVENT 5556 if (event->kind == MOUSE_CLICK_EVENT)
5563#ifdef HAVE_GPM
5564 || event->kind == GPM_CLICK_EVENT
5565#endif
5566 )
5567 { 5557 {
5568 struct frame *f = XFRAME (event->frame_or_window); 5558 struct frame *f = XFRAME (event->frame_or_window);
5569 int row, column; 5559 int row, column;
diff --git a/src/keymap.c b/src/keymap.c
index 181dcdad3ad..e22eb411f63 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3085,6 +3085,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3085 for (i = from; ; i++) 3085 for (i = from; ; i++)
3086 { 3086 {
3087 bool this_shadowed = 0; 3087 bool this_shadowed = 0;
3088 Lisp_Object shadowed_by = Qnil;
3088 int range_beg, range_end; 3089 int range_beg, range_end;
3089 Lisp_Object val; 3090 Lisp_Object val;
3090 3091
@@ -3127,11 +3128,9 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3127 /* If this binding is shadowed by some other map, ignore it. */ 3128 /* If this binding is shadowed by some other map, ignore it. */
3128 if (!NILP (shadow)) 3129 if (!NILP (shadow))
3129 { 3130 {
3130 Lisp_Object tem; 3131 shadowed_by = shadow_lookup (shadow, kludge, Qt, 0);
3131
3132 tem = shadow_lookup (shadow, kludge, Qt, 0);
3133 3132
3134 if (!NILP (tem)) 3133 if (!NILP (shadowed_by) && !EQ (shadowed_by, definition))
3135 { 3134 {
3136 if (mention_shadow) 3135 if (mention_shadow)
3137 this_shadowed = 1; 3136 this_shadowed = 1;
@@ -3186,6 +3185,21 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3186 && !NILP (Fequal (tem2, definition))) 3185 && !NILP (Fequal (tem2, definition)))
3187 i++; 3186 i++;
3188 3187
3188 /* Make sure found consecutive keys are either not shadowed or,
3189 if they are, that they are shadowed by the same command. */
3190 if (CHAR_TABLE_P (vector) && i != starting_i)
3191 {
3192 Lisp_Object tem;
3193 Lisp_Object key = make_nil_vector (1);
3194 for (int j = starting_i + 1; j <= i; j++)
3195 {
3196 ASET (key, 0, make_fixnum (j));
3197 tem = shadow_lookup (shadow, key, Qt, 0);
3198 if (NILP (Fequal (tem, shadowed_by)))
3199 i = j - 1;
3200 }
3201 }
3202
3189 /* If we have a range of more than one character, 3203 /* If we have a range of more than one character,
3190 print where the range reaches to. */ 3204 print where the range reaches to. */
3191 3205
@@ -3209,7 +3223,13 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3209 if (this_shadowed) 3223 if (this_shadowed)
3210 { 3224 {
3211 SET_PT (PT - 1); 3225 SET_PT (PT - 1);
3212 insert_string (" (binding currently shadowed)"); 3226 static char const fmt[] = " (currently shadowed by `%s')";
3227 USE_SAFE_ALLOCA;
3228 char *buffer = SAFE_ALLOCA (sizeof fmt +
3229 SBYTES (SYMBOL_NAME (shadowed_by)));
3230 esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by)));
3231 insert_string (buffer);
3232 SAFE_FREE();
3213 SET_PT (PT + 1); 3233 SET_PT (PT + 1);
3214 } 3234 }
3215 } 3235 }
diff --git a/src/minibuf.c b/src/minibuf.c
index c4adca15365..464e3018f7d 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -501,14 +501,15 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
501 record_unwind_protect_void (choose_minibuf_frame); 501 record_unwind_protect_void (choose_minibuf_frame);
502 502
503 record_unwind_protect (restore_window_configuration, 503 record_unwind_protect (restore_window_configuration,
504 Fcurrent_window_configuration (Qnil)); 504 Fcons (Qt, Fcurrent_window_configuration (Qnil)));
505 505
506 /* If the minibuffer window is on a different frame, save that 506 /* If the minibuffer window is on a different frame, save that
507 frame's configuration too. */ 507 frame's configuration too. */
508 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); 508 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
509 if (!EQ (mini_frame, selected_frame)) 509 if (!EQ (mini_frame, selected_frame))
510 record_unwind_protect (restore_window_configuration, 510 record_unwind_protect (restore_window_configuration,
511 Fcurrent_window_configuration (mini_frame)); 511 Fcons (Qt,
512 Fcurrent_window_configuration (mini_frame)));
512 513
513 /* If the minibuffer is on an iconified or invisible frame, 514 /* If the minibuffer is on an iconified or invisible frame,
514 make it visible now. */ 515 make it visible now. */
diff --git a/src/term.c b/src/term.c
index a0738594bfc..fee3b555751 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2481,7 +2481,7 @@ term_mouse_click (struct input_event *result, Gpm_Event *event,
2481{ 2481{
2482 int i, j; 2482 int i, j;
2483 2483
2484 result->kind = GPM_CLICK_EVENT; 2484 result->kind = MOUSE_CLICK_EVENT;
2485 for (i = 0, j = GPM_B_LEFT; i < 3; i++, j >>= 1 ) 2485 for (i = 0, j = GPM_B_LEFT; i < 3; i++, j >>= 1 )
2486 { 2486 {
2487 if (event->buttons & j) { 2487 if (event->buttons & j) {
@@ -2567,11 +2567,11 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event)
2567 { 2567 {
2568 f->mouse_moved = 0; 2568 f->mouse_moved = 0;
2569 term_mouse_click (&ie, event, f); 2569 term_mouse_click (&ie, event, f);
2570 /* eassert (ie.kind == GPM_CLICK_EVENT); */ 2570 /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
2571 if (tty_handle_tab_bar_click (f, event->x, event->y, 2571 if (tty_handle_tab_bar_click (f, event->x, event->y,
2572 (ie.modifiers & down_modifier) != 0, &ie)) 2572 (ie.modifiers & down_modifier) != 0, &ie))
2573 { 2573 {
2574 /* eassert (ie.kind == GPM_CLICK_EVENT 2574 /* eassert (ie.kind == MOUSE_CLICK_EVENT
2575 * || ie.kind == TAB_BAR_EVENT); */ 2575 * || ie.kind == TAB_BAR_EVENT); */
2576 /* tty_handle_tab_bar_click stores 2 events in the event 2576 /* tty_handle_tab_bar_click stores 2 events in the event
2577 queue, so we are done here. */ 2577 queue, so we are done here. */
@@ -2581,7 +2581,7 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event)
2581 count += 2; 2581 count += 2;
2582 return count; 2582 return count;
2583 } 2583 }
2584 /* eassert (ie.kind == GPM_CLICK_EVENT); */ 2584 /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
2585 kbd_buffer_store_event (&ie); 2585 kbd_buffer_store_event (&ie);
2586 count++; 2586 count++;
2587 } 2587 }
diff --git a/src/termhooks.h b/src/termhooks.h
index 6ab06ceff94..44ab14225fd 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -220,10 +220,6 @@ enum event_kind
220 save yourself before shutdown. */ 220 save yourself before shutdown. */
221 SAVE_SESSION_EVENT 221 SAVE_SESSION_EVENT
222 222
223#ifdef HAVE_GPM
224 , GPM_CLICK_EVENT
225#endif
226
227#ifdef HAVE_DBUS 223#ifdef HAVE_DBUS
228 , DBUS_EVENT 224 , DBUS_EVENT
229#endif 225#endif
diff --git a/src/w32term.c b/src/w32term.c
index e0618e4f52d..23cb380040b 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -7165,15 +7165,21 @@ w32_initialize_display_info (Lisp_Object display_name)
7165 memset (dpyinfo, 0, sizeof (*dpyinfo)); 7165 memset (dpyinfo, 0, sizeof (*dpyinfo));
7166 7166
7167 dpyinfo->name_list_element = Fcons (display_name, Qnil); 7167 dpyinfo->name_list_element = Fcons (display_name, Qnil);
7168 static char const title[] = "GNU Emacs";
7168 if (STRINGP (Vsystem_name)) 7169 if (STRINGP (Vsystem_name))
7169 { 7170 {
7170 dpyinfo->w32_id_name = xmalloc (SCHARS (Vinvocation_name) 7171 static char const at[] = " at ";
7171 + SCHARS (Vsystem_name) + 2); 7172 ptrdiff_t nbytes = sizeof (title) + sizeof (at);
7172 sprintf (dpyinfo->w32_id_name, "%s@%s", 7173 if (INT_ADD_WRAPV (nbytes, SCHARS (Vsystem_name), &nbytes))
7173 SDATA (Vinvocation_name), SDATA (Vsystem_name)); 7174 memory_full (SIZE_MAX);
7175 dpyinfo->w32_id_name = xmalloc (nbytes);
7176 sprintf (dpyinfo->w32_id_name, "%s%s%s", title, at, SDATA (Vsystem_name));
7174 } 7177 }
7175 else 7178 else
7176 dpyinfo->w32_id_name = xlispstrdup (Vinvocation_name); 7179 {
7180 dpyinfo->w32_id_name = xmalloc (sizeof (title));
7181 strcpy (dpyinfo->w32_id_name, title);
7182 }
7177 7183
7178 /* Default Console mode values - overridden when running in GUI mode 7184 /* Default Console mode values - overridden when running in GUI mode
7179 with values obtained from system metrics. */ 7185 with values obtained from system metrics. */
diff --git a/src/window.c b/src/window.c
index a6de34f3db6..6cd3122b43b 100644
--- a/src/window.c
+++ b/src/window.c
@@ -6824,19 +6824,25 @@ DEFUN ("window-configuration-frame", Fwindow_configuration_frame, Swindow_config
6824} 6824}
6825 6825
6826DEFUN ("set-window-configuration", Fset_window_configuration, 6826DEFUN ("set-window-configuration", Fset_window_configuration,
6827 Sset_window_configuration, 1, 1, 0, 6827 Sset_window_configuration, 1, 2, 0,
6828 doc: /* Set the configuration of windows and buffers as specified by CONFIGURATION. 6828 doc: /* Set the configuration of windows and buffers as specified by CONFIGURATION.
6829CONFIGURATION must be a value previously returned 6829CONFIGURATION must be a value previously returned
6830by `current-window-configuration' (which see). 6830by `current-window-configuration' (which see).
6831
6832Normally, this function selects the frame of the CONFIGURATION, but if
6833DONT-SET-FRAME is non-nil, it leaves selected the frame which was
6834current at the start of the function.
6835
6831If CONFIGURATION was made from a frame that is now deleted, 6836If CONFIGURATION was made from a frame that is now deleted,
6832only frame-independent values can be restored. In this case, 6837only frame-independent values can be restored. In this case,
6833the return value is nil. Otherwise the value is t. */) 6838the return value is nil. Otherwise the value is t. */)
6834 (Lisp_Object configuration) 6839 (Lisp_Object configuration, Lisp_Object dont_set_frame)
6835{ 6840{
6836 register struct save_window_data *data; 6841 register struct save_window_data *data;
6837 struct Lisp_Vector *saved_windows; 6842 struct Lisp_Vector *saved_windows;
6838 Lisp_Object new_current_buffer; 6843 Lisp_Object new_current_buffer;
6839 Lisp_Object frame; 6844 Lisp_Object frame;
6845 Lisp_Object old_frame = selected_frame;
6840 struct frame *f; 6846 struct frame *f;
6841 ptrdiff_t old_point = -1; 6847 ptrdiff_t old_point = -1;
6842 USE_SAFE_ALLOCA; 6848 USE_SAFE_ALLOCA;
@@ -7153,7 +7159,10 @@ the return value is nil. Otherwise the value is t. */)
7153 select_window above totally superfluous; it still sets f's 7159 select_window above totally superfluous; it still sets f's
7154 selected window. */ 7160 selected window. */
7155 if (FRAME_LIVE_P (XFRAME (data->selected_frame))) 7161 if (FRAME_LIVE_P (XFRAME (data->selected_frame)))
7156 do_switch_frame (data->selected_frame, 0, 0, Qnil); 7162 do_switch_frame (NILP (dont_set_frame)
7163 ? data->selected_frame
7164 : old_frame
7165 , 0, 0, Qnil);
7157 } 7166 }
7158 7167
7159 FRAME_WINDOW_CHANGE (f) = true; 7168 FRAME_WINDOW_CHANGE (f) = true;
@@ -7187,11 +7196,13 @@ the return value is nil. Otherwise the value is t. */)
7187 return FRAME_LIVE_P (f) ? Qt : Qnil; 7196 return FRAME_LIVE_P (f) ? Qt : Qnil;
7188} 7197}
7189 7198
7190
7191void 7199void
7192restore_window_configuration (Lisp_Object configuration) 7200restore_window_configuration (Lisp_Object configuration)
7193{ 7201{
7194 Fset_window_configuration (configuration); 7202 if (CONSP (configuration))
7203 Fset_window_configuration (XCDR (configuration), XCAR (configuration));
7204 else
7205 Fset_window_configuration (configuration, Qnil);
7195} 7206}
7196 7207
7197 7208
diff --git a/src/xdisp.c b/src/xdisp.c
index 2344fe70601..e49cc433308 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -22272,14 +22272,15 @@ extend_face_to_end_of_line (struct it *it)
22272 default_face->id : face->id); 22272 default_face->id : face->id);
22273 22273
22274 /* Display fill-column indicator if needed. */ 22274 /* Display fill-column indicator if needed. */
22275 /* We need to subtract 1 to the indicator_column here because we 22275 const int indicator_column = fill_column_indicator_column (it, 1);
22276 will add the indicator IN the column indicator number, not 22276
22277 after it. We compare the variable it->current_x before 22277 /* Make sure our idea of current_x is in sync with the glyphs
22278 producing the glyph. When FRAME_WINDOW_P we subtract 22278 actually in the glyph row. They might differ because
22279 CHAR_WIDTH calculating STRETCH_WIDTH for the same reason. */ 22279 append_space_for_newline can insert one glyph without
22280 const int indicator_column = 22280 updating current_x. */
22281 fill_column_indicator_column (it, 1) - 1; 22281 it->current_x = it->glyph_row->used[TEXT_AREA];
22282 do 22282
22283 while (it->current_x <= it->last_visible_x)
22283 { 22284 {
22284 if (it->current_x != indicator_column) 22285 if (it->current_x != indicator_column)
22285 PRODUCE_GLYPHS (it); 22286 PRODUCE_GLYPHS (it);
@@ -22297,7 +22298,6 @@ extend_face_to_end_of_line (struct it *it)
22297 it->c = it->char_to_display = ' '; 22298 it->c = it->char_to_display = ' ';
22298 } 22299 }
22299 } 22300 }
22300 while (it->current_x <= it->last_visible_x);
22301 22301
22302 if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0 22302 if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0
22303 && (it->glyph_row->used[RIGHT_MARGIN_AREA] 22303 && (it->glyph_row->used[RIGHT_MARGIN_AREA]
diff --git a/src/xterm.c b/src/xterm.c
index 98bb0ea8917..0d2452de929 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -12928,19 +12928,23 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
12928#endif 12928#endif
12929 12929
12930 Lisp_Object system_name = Fsystem_name (); 12930 Lisp_Object system_name = Fsystem_name ();
12931 12931 static char const title[] = "GNU Emacs";
12932 ptrdiff_t nbytes = SBYTES (Vinvocation_name) + 1;
12933 if (STRINGP (system_name)
12934 && INT_ADD_WRAPV (nbytes, SBYTES (system_name) + 1, &nbytes))
12935 memory_full (SIZE_MAX);
12936 dpyinfo->x_id = ++x_display_id;
12937 dpyinfo->x_id_name = xmalloc (nbytes);
12938 char *nametail = lispstpcpy (dpyinfo->x_id_name, Vinvocation_name);
12939 if (STRINGP (system_name)) 12932 if (STRINGP (system_name))
12940 { 12933 {
12941 *nametail++ = '@'; 12934 static char const at[] = " at ";
12942 lispstpcpy (nametail, system_name); 12935 ptrdiff_t nbytes = sizeof (title) + sizeof (at);
12936 if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes))
12937 memory_full (SIZE_MAX);
12938 dpyinfo->x_id_name = xmalloc (nbytes);
12939 sprintf (dpyinfo->x_id_name, "%s%s%s", title, at, SDATA (system_name));
12943 } 12940 }
12941 else
12942 {
12943 dpyinfo->x_id_name = xmalloc (sizeof (title));
12944 strcpy (dpyinfo->x_id_name, title);
12945 }
12946
12947 dpyinfo->x_id = ++x_display_id;
12944 12948
12945 /* Figure out which modifier bits mean what. */ 12949 /* Figure out which modifier bits mean what. */
12946 x_find_modifier_meanings (dpyinfo); 12950 x_find_modifier_meanings (dpyinfo);
diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el
index e537871528c..bcbd7d686e3 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -38,14 +38,9 @@
38(defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory) 38(defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory)
39 "Location of test files.") 39 "Location of test files.")
40 40
41(defvar semantic-utest-temp-directory (if (fboundp 'temp-directory)
42 (temp-directory)
43 temporary-file-directory)
44 "Temporary directory to use when creating files.")
45
46(defun semantic-utest-fname (name) 41(defun semantic-utest-fname (name)
47 "Create a filename for NAME in /tmp." 42 "Create a filename for NAME in /tmp."
48 (expand-file-name name semantic-utest-temp-directory)) 43 (expand-file-name name temporary-file-directory))
49 44
50;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51;; Data for C tests 46;; Data for C tests
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el
new file mode 100644
index 00000000000..bb88b8dd9fa
--- /dev/null
+++ b/test/lisp/cus-edit-tests.el
@@ -0,0 +1,80 @@
1;;; cus-edit-tests.el --- Tests for cus-edit.el -*- lexical-binding: t -*-
2
3;; Copyright (C) 2020 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 'ert-x)
26(eval-when-compile (require 'cl-lib))
27(require 'cus-edit)
28
29(defmacro with-cus-edit-test (buffer &rest body)
30 (declare (indent 1))
31 `(save-window-excursion
32 (unwind-protect
33 (progn ,@body)
34 (when-let ((buf (get-buffer ,buffer)))
35 (kill-buffer buf)))))
36
37
38;;;; showing/hiding obsolete options
39
40(defgroup cus-edit-tests nil "test"
41 :group 'test-group)
42
43(defcustom cus-edit-tests--obsolete-option-tag nil
44 "This should never be removed; it is obsolete for testing purposes."
45 :type 'boolean
46 :version "917.10") ; a super high version number
47(make-obsolete-variable 'cus-edit-tests--obsolete-option-tag nil "X.X-test")
48(defconst cus-edit-tests--obsolete-option-tag
49 (custom-unlispify-tag-name 'cus-edit-tests--obsolete-option-tag))
50
51(ert-deftest cus-edit-tests-customize-apropos/hide-obsolete ()
52 (with-cus-edit-test "*Customize Apropos*"
53 (customize-apropos "cus-edit-tests")
54 (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
55
56(ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete ()
57 (with-cus-edit-test "*Customize Changed Options*"
58 (customize-changed-options "917.2") ; some future version
59 (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
60
61(ert-deftest cus-edit-tests-customize-group/hide-obsolete ()
62 "Check that obsolete variables do not show up."
63 (with-cus-edit-test "*Customize Group: Cus Edit Tests*"
64 (customize-group 'cus-edit-tests)
65 (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
66
67(ert-deftest cus-edit-tests-customize-option/show-obsolete ()
68 (with-cus-edit-test "*Customize Option: Cus Edit Tests Obsolete Option Tag*"
69 (customize-option 'cus-edit-tests--obsolete-option-tag)
70 (goto-char (point-min))
71 (should (search-forward cus-edit-tests--obsolete-option-tag nil t))))
72
73(ert-deftest cus-edit-tests-customize-saved/show-obsolete ()
74 (with-cus-edit-test "*Customize Saved*"
75 (cl-letf (((get 'cus-edit-tests--obsolete-option-tag 'saved-value) '(t)))
76 (customize-saved)
77 (should (search-forward cus-edit-tests--obsolete-option-tag nil t)))))
78
79(provide 'cus-edit-tests)
80;;; cus-edit-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 13cbedfe1f7..680aa514a27 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -516,19 +516,25 @@ Subtests signal errors if something goes wrong."
516 ;; Should not warn that mt--test2 is not known to be defined. 516 ;; Should not warn that mt--test2 is not known to be defined.
517 (should-not (re-search-forward "my--test2" nil t)))) 517 (should-not (re-search-forward "my--test2" nil t))))
518 518
519(defmacro bytecomp--with-warning-test (re-warning &rest form)
520 (declare (indent 1))
521 `(with-current-buffer (get-buffer-create "*Compile-Log*")
522 (let ((inhibit-read-only t)) (erase-buffer))
523 (byte-compile ,@form)
524 (ert-info ((buffer-string) :prefix "buffer: ")
525 (should (re-search-forward ,re-warning)))))
526
519(ert-deftest bytecomp-warn-wrong-args () 527(ert-deftest bytecomp-warn-wrong-args ()
520 (with-current-buffer (get-buffer-create "*Compile-Log*") 528 (bytecomp--with-warning-test "remq.*3.*2"
521 (let ((inhibit-read-only t)) (erase-buffer)) 529 '(remq 1 2 3)))
522 (byte-compile '(remq 1 2 3))
523 (ert-info ((buffer-string) :prefix "buffer: ")
524 (should (re-search-forward "remq.*3.*2")))))
525 530
526(ert-deftest bytecomp-warn-wrong-args-subr () 531(ert-deftest bytecomp-warn-wrong-args-subr ()
527 (with-current-buffer (get-buffer-create "*Compile-Log*") 532 (bytecomp--with-warning-test "safe-length.*3.*1"
528 (let ((inhibit-read-only t)) (erase-buffer)) 533 '(safe-length 1 2 3)))
529 (byte-compile '(safe-length 1 2 3)) 534
530 (ert-info ((buffer-string) :prefix "buffer: ") 535(ert-deftest bytecomp-warn-variable-lacks-prefix ()
531 (should (re-search-forward "safe-length.*3.*1"))))) 536 (bytecomp--with-warning-test "foo.*lacks a prefix"
537 '(defvar foo nil)))
532 538
533(ert-deftest test-eager-load-macro-expansion () 539(ert-deftest test-eager-load-macro-expansion ()
534 (test-byte-comp-compile-and-load nil 540 (test-byte-comp-compile-and-load nil
@@ -810,6 +816,12 @@ literals (Bug#20852)."
810 816
811 (test-suppression 817 (test-suppression
812 '(defun zot () 818 '(defun zot ()
819 (next-line))
820 '((interactive-only next-line))
821 "interactive use only")
822
823 (test-suppression
824 '(defun zot ()
813 (mapcar #'list '(1 2 3)) 825 (mapcar #'list '(1 2 3))
814 nil) 826 nil)
815 '((mapcar mapcar)) 827 '((mapcar mapcar))
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 42be0296c4f..49cb40b29d9 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -392,6 +392,12 @@ C-b undefined
392 (define-key global-map (kbd "C-c C-l r") nil) 392 (define-key global-map (kbd "C-c C-l r") nil)
393 (define-key global-map (kbd "C-c C-l") nil))) 393 (define-key global-map (kbd "C-c C-l") nil)))
394 394
395(ert-deftest help-substitute-command-keys/preserves-text-properties ()
396 "Check that we preserve text properties (Bug#17052)."
397 (should (equal (substitute-command-keys
398 (propertize "foo \\[save-buffer]" 'face 'bold))
399 (propertize "foo C-x C-s" 'face 'bold))))
400
395(provide 'help-tests) 401(provide 'help-tests)
396 402
397;;; help-tests.el ends here 403;;; help-tests.el ends here
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl
new file mode 100644
index 00000000000..a02ea29fe9d
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl
@@ -0,0 +1,16 @@
1sub interesting {
2 $_ = shift;
3 return
4 />Today is .+\'s birthday\.</
5 || / like[ds]? your post in </
6 || /like[ds] your new subscription\. </
7 || / likes? that you're interested in </
8 || /> likes? your comment: /
9 || /&amp;birthdays=.*birthdays?\.<\/a>/;
10}
11
12sub boring {
13 return
14 / likes? your post in </
15 || / likes? that you're interested in </
16}
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index a0dd391840f..896160bb883 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -228,6 +228,21 @@ documentation it does the right thing anyway."
228 (cperl-indent-command) 228 (cperl-indent-command)
229 (forward-line 1)))) 229 (forward-line 1))))
230 230
231(ert-deftest cperl-test-bug-28650 ()
232 "Verify that regular expressions are recognized after 'return'.
233The test uses the syntax property \"inside a string\" for the
234text in regular expressions, which is non-nil for both cperl-mode
235and perl-mode."
236 (with-temp-buffer
237 (insert-file-contents (ert-resource-file "cperl-bug-26850.pl"))
238 (goto-char (point-min))
239 (re-search-forward "sub interesting {[^}]*}")
240 (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "Today"))
241 nil))
242 (re-search-forward "sub boring {[^}]*}")
243 (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "likes\\?"))
244 nil))))
245
231(ert-deftest cperl-test-bug-30393 () 246(ert-deftest cperl-test-bug-30393 ()
232 "Verify that indentation is not disturbed by an open paren in col 0. 247 "Verify that indentation is not disturbed by an open paren in col 0.
233Perl is not Lisp: An open paren in column 0 does not start a function." 248Perl is not Lisp: An open paren in column 0 does not start a function."
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 5451a79efaa..3de15514e79 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -3153,13 +3153,13 @@ tex-src/gzip.texi,303
3153@node Top,62,2139 3153@node Top,62,2139
3154@node Copying,80,2652 3154@node Copying,80,2652
3155@node Overview,83,2705 3155@node Overview,83,2705
3156@node Sample,166,7272 3156@node Sample,166,7273
3157@node Invoking gzip,Invoking gzip210,8828 3157@node Invoking gzip,Invoking gzip210,8829
3158@node Advanced usage,Advanced usage357,13496 3158@node Advanced usage,Advanced usage357,13497
3159@node Environment,420,15208 3159@node Environment,420,15209
3160@node Tapes,437,15769 3160@node Tapes,437,15770
3161@node Problems,460,16768 3161@node Problems,460,16769
3162@node Concept Index,Concept Index473,17288 3162@node Concept Index,Concept Index473,17289
3163 3163
3164tex-src/texinfo.tex,30627 3164tex-src/texinfo.tex,30627
3165\def\texinfoversion{\texinfoversion26,1035 3165\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2
index ab2111eafb2..ddb8d19540b 100644
--- a/test/manual/etags/ETAGS.good_2
+++ b/test/manual/etags/ETAGS.good_2
@@ -3726,13 +3726,13 @@ tex-src/gzip.texi,303
3726@node Top,62,2139 3726@node Top,62,2139
3727@node Copying,80,2652 3727@node Copying,80,2652
3728@node Overview,83,2705 3728@node Overview,83,2705
3729@node Sample,166,7272 3729@node Sample,166,7273
3730@node Invoking gzip,Invoking gzip210,8828 3730@node Invoking gzip,Invoking gzip210,8829
3731@node Advanced usage,Advanced usage357,13496 3731@node Advanced usage,Advanced usage357,13497
3732@node Environment,420,15208 3732@node Environment,420,15209
3733@node Tapes,437,15769 3733@node Tapes,437,15770
3734@node Problems,460,16768 3734@node Problems,460,16769
3735@node Concept Index,Concept Index473,17288 3735@node Concept Index,Concept Index473,17289
3736 3736
3737tex-src/texinfo.tex,30627 3737tex-src/texinfo.tex,30627
3738\def\texinfoversion{\texinfoversion26,1035 3738\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3
index e53fb9629c5..40be768aacb 100644
--- a/test/manual/etags/ETAGS.good_3
+++ b/test/manual/etags/ETAGS.good_3
@@ -3560,13 +3560,13 @@ tex-src/gzip.texi,303
3560@node Top,62,2139 3560@node Top,62,2139
3561@node Copying,80,2652 3561@node Copying,80,2652
3562@node Overview,83,2705 3562@node Overview,83,2705
3563@node Sample,166,7272 3563@node Sample,166,7273
3564@node Invoking gzip,Invoking gzip210,8828 3564@node Invoking gzip,Invoking gzip210,8829
3565@node Advanced usage,Advanced usage357,13496 3565@node Advanced usage,Advanced usage357,13497
3566@node Environment,420,15208 3566@node Environment,420,15209
3567@node Tapes,437,15769 3567@node Tapes,437,15770
3568@node Problems,460,16768 3568@node Problems,460,16769
3569@node Concept Index,Concept Index473,17288 3569@node Concept Index,Concept Index473,17289
3570 3570
3571tex-src/texinfo.tex,30627 3571tex-src/texinfo.tex,30627
3572\def\texinfoversion{\texinfoversion26,1035 3572\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4
index 5a4b5b4b8ba..15f67c5d28a 100644
--- a/test/manual/etags/ETAGS.good_4
+++ b/test/manual/etags/ETAGS.good_4
@@ -3317,13 +3317,13 @@ tex-src/gzip.texi,303
3317@node Top,62,2139 3317@node Top,62,2139
3318@node Copying,80,2652 3318@node Copying,80,2652
3319@node Overview,83,2705 3319@node Overview,83,2705
3320@node Sample,166,7272 3320@node Sample,166,7273
3321@node Invoking gzip,Invoking gzip210,8828 3321@node Invoking gzip,Invoking gzip210,8829
3322@node Advanced usage,Advanced usage357,13496 3322@node Advanced usage,Advanced usage357,13497
3323@node Environment,420,15208 3323@node Environment,420,15209
3324@node Tapes,437,15769 3324@node Tapes,437,15770
3325@node Problems,460,16768 3325@node Problems,460,16769
3326@node Concept Index,Concept Index473,17288 3326@node Concept Index,Concept Index473,17289
3327 3327
3328tex-src/texinfo.tex,30627 3328tex-src/texinfo.tex,30627
3329\def\texinfoversion{\texinfoversion26,1035 3329\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5
index f89cfefc388..583de5cbe22 100644
--- a/test/manual/etags/ETAGS.good_5
+++ b/test/manual/etags/ETAGS.good_5
@@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303
4297@node Top,62,2139 4297@node Top,62,2139
4298@node Copying,80,2652 4298@node Copying,80,2652
4299@node Overview,83,2705 4299@node Overview,83,2705
4300@node Sample,166,7272 4300@node Sample,166,7273
4301@node Invoking gzip,Invoking gzip210,8828 4301@node Invoking gzip,Invoking gzip210,8829
4302@node Advanced usage,Advanced usage357,13496 4302@node Advanced usage,Advanced usage357,13497
4303@node Environment,420,15208 4303@node Environment,420,15209
4304@node Tapes,437,15769 4304@node Tapes,437,15770
4305@node Problems,460,16768 4305@node Problems,460,16769
4306@node Concept Index,Concept Index473,17288 4306@node Concept Index,Concept Index473,17289
4307 4307
4308tex-src/texinfo.tex,30627 4308tex-src/texinfo.tex,30627
4309\def\texinfoversion{\texinfoversion26,1035 4309\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6
index 0a31ed078e8..86df93afab1 100644
--- a/test/manual/etags/ETAGS.good_6
+++ b/test/manual/etags/ETAGS.good_6
@@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303
4297@node Top,62,2139 4297@node Top,62,2139
4298@node Copying,80,2652 4298@node Copying,80,2652
4299@node Overview,83,2705 4299@node Overview,83,2705
4300@node Sample,166,7272 4300@node Sample,166,7273
4301@node Invoking gzip,Invoking gzip210,8828 4301@node Invoking gzip,Invoking gzip210,8829
4302@node Advanced usage,Advanced usage357,13496 4302@node Advanced usage,Advanced usage357,13497
4303@node Environment,420,15208 4303@node Environment,420,15209
4304@node Tapes,437,15769 4304@node Tapes,437,15770
4305@node Problems,460,16768 4305@node Problems,460,16769
4306@node Concept Index,Concept Index473,17288 4306@node Concept Index,Concept Index473,17289
4307 4307
4308tex-src/texinfo.tex,30627 4308tex-src/texinfo.tex,30627
4309\def\texinfoversion{\texinfoversion26,1035 4309\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/indent/tcl.tcl b/test/manual/indent/tcl.tcl
index c3781533ca4..f055be19663 100644
--- a/test/manual/indent/tcl.tcl
+++ b/test/manual/indent/tcl.tcl
@@ -20,3 +20,7 @@ proc foo3 {} {
20 puts a""b"; # And that won't either! 20 puts a""b"; # And that won't either!
21 puts "a""b"; # But this will! 21 puts "a""b"; # But this will!
22} 22}
23
24# FIXME: The [..] interpolation within "..." strings is not properly
25# handled by the current `syntax-propertize-function`!
26set a "Testing: [split "192.168.1.1/24" "/"] address";
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index ed092039078..1312683c848 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -345,6 +345,25 @@ comparing the subr with a much slower lisp implementation."
345 (setq-default binding-test-some-local 'new-default)) 345 (setq-default binding-test-some-local 'new-default))
346 (should (eq binding-test-some-local 'some)))) 346 (should (eq binding-test-some-local 'some))))
347 347
348(ert-deftest data-tests--let-buffer-local ()
349 (let ((blvar (make-symbol "blvar")))
350 (set-default blvar nil)
351 (make-variable-buffer-local blvar)
352
353 (dolist (var (list blvar 'left-margin))
354 (let ((def (default-value var)))
355 (with-temp-buffer
356 (should (equal def (symbol-value var)))
357 (cl-progv (list var) (list 42)
358 (should (equal (symbol-value var) 42))
359 (should (equal (default-value var) (symbol-value var)))
360 (set var 123)
361 (should (equal (symbol-value var) 123))
362 (should (equal (default-value var) (symbol-value var)))) ;bug#44733
363 (should (equal (symbol-value var) def))
364 (should (equal (default-value var) (symbol-value var))))
365 (should (equal (default-value var) def))))))
366
348(ert-deftest binding-test-makunbound () 367(ert-deftest binding-test-makunbound ()
349 "Tests of makunbound, from the manual." 368 "Tests of makunbound, from the manual."
350 (with-current-buffer binding-test-buffer-B 369 (with-current-buffer binding-test-buffer-B
@@ -381,6 +400,37 @@ comparing the subr with a much slower lisp implementation."
381 "Test setting a keyword to itself" 400 "Test setting a keyword to itself"
382 (with-no-warnings (should (setq :keyword :keyword)))) 401 (with-no-warnings (should (setq :keyword :keyword))))
383 402
403(ert-deftest data-tests--set-default-per-buffer ()
404 :expected-result t ;; Not fixed yet!
405 ;; FIXME: Performance tests are inherently unreliable.
406 ;; Using wall-clock time makes it even worse, so don't bother unless
407 ;; we have the primitive to measure cpu-time.
408 (skip-unless (fboundp 'current-cpu-time))
409 ;; Test performance of set-default on DEFVAR_PER_BUFFER variables.
410 ;; More specifically, test the problem seen in bug#41029 where setting
411 ;; the default value of a variable takes time proportional to the
412 ;; number of buffers.
413 (let* ((fun #'error)
414 (test (lambda ()
415 (with-temp-buffer
416 (let ((st (car (current-cpu-time))))
417 (dotimes (_ 1000)
418 (let ((case-fold-search 'data-test))
419 ;; Use an indirection through a mutable var
420 ;; to try and make sure the byte-compiler
421 ;; doesn't optimize away the let bindings.
422 (funcall fun)))
423 ;; FIXME: Handle the wraparound, if any.
424 (- (car (current-cpu-time)) st)))))
425 (_ (setq fun #'ignore))
426 (time1 (funcall test))
427 (bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
428 (make-list 1000 nil)))
429 (time2 (funcall test)))
430 (mapc #'kill-buffer bufs)
431 ;; Don't divide one time by the other since they may be 0.
432 (should (< time2 (* time1 5)))))
433
384;; More tests to write - 434;; More tests to write -
385;; kill-local-variable 435;; kill-local-variable
386;; defconst; can modify 436;; defconst; can modify
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index d3c22f966e6..86b8d655d26 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -938,6 +938,13 @@
938 (should (equal (string-search "\303" "aøb") nil)) 938 (should (equal (string-search "\303" "aøb") nil))
939 (should (equal (string-search "\270" "aøb") nil)) 939 (should (equal (string-search "\270" "aøb") nil))
940 (should (equal (string-search "ø" "\303\270") nil)) 940 (should (equal (string-search "ø" "\303\270") nil))
941 (should (equal (string-search "ø" (make-string 32 ?a)) nil))
942 (should (equal (string-search "ø" (string-to-multibyte (make-string 32 ?a)))
943 nil))
944 (should (equal (string-search "o" (string-to-multibyte
945 (apply #'string
946 (number-sequence ?a ?z))))
947 14))
941 948
942 (should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2)) 949 (should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2))
943 950
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index e3dd8420d7b..6411cd1f0d4 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -54,6 +54,15 @@
54(ert-deftest keymap-copy-keymap/is-not-eq () 54(ert-deftest keymap-copy-keymap/is-not-eq ()
55 (should-not (eq (copy-keymap help-mode-map) help-mode-map))) 55 (should-not (eq (copy-keymap help-mode-map) help-mode-map)))
56 56
57(ert-deftest keymap---get-keyelt/runs-menu-item-filter ()
58 (let* (menu-item-filter-ran
59 (object `(menu-item "2" identity
60 :filter ,(lambda (cmd)
61 (setq menu-item-filter-ran t)
62 cmd))))
63 (keymap--get-keyelt object t)
64 (should menu-item-filter-ran)))
65
57(ert-deftest keymap-lookup-key () 66(ert-deftest keymap-lookup-key ()
58 (let ((map (make-keymap))) 67 (let ((map (make-keymap)))
59 (define-key map [?a] 'foo) 68 (define-key map [?a] 'foo)
@@ -72,6 +81,26 @@ https://debbugs.gnu.org/39149#31"
72 (with-temp-buffer 81 (with-temp-buffer
73 (should (eq (describe-buffer-bindings (current-buffer)) nil)))) 82 (should (eq (describe-buffer-bindings (current-buffer)) nil))))
74 83
84(defun keymap-tests--test-menu-item-filter (show filter-fun)
85 (unwind-protect
86 (progn
87 (define-key global-map (kbd "C-c C-l r")
88 `(menu-item "2" identity :filter ,filter-fun))
89 (with-temp-buffer
90 (describe-buffer-bindings (current-buffer))
91 (goto-char (point-min))
92 (if (eq show 'show)
93 (should (search-forward "C-c C-l r" nil t))
94 (should-not (search-forward "C-c C-l r" nil t)))))
95 (define-key global-map (kbd "C-c C-l r") nil)
96 (define-key global-map (kbd "C-c C-l") nil)))
97
98(ert-deftest describe-buffer-bindings/menu-item-filter-show-binding ()
99 (keymap-tests--test-menu-item-filter 'show (lambda (cmd) cmd)))
100
101(ert-deftest describe-buffer-bindings/menu-item-filter-hide-binding ()
102 (keymap-tests--test-menu-item-filter 'hide (lambda (_) nil)))
103
75(ert-deftest keymap-store_in_keymap-XFASTINT-on-non-characters () 104(ert-deftest keymap-store_in_keymap-XFASTINT-on-non-characters ()
76 "Check for bug fixed in \"Fix assertion violation in define-key\", 105 "Check for bug fixed in \"Fix assertion violation in define-key\",
77commit 86c19714b097aa477d339ed99ffb5136c755a046." 106commit 86c19714b097aa477d339ed99ffb5136c755a046."
@@ -170,6 +199,58 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
170 (where-is-internal 'execute-extended-command global-map t)) 199 (where-is-internal 'execute-extended-command global-map t))
171 [#x8000078]))) 200 [#x8000078])))
172 201
202
203;;;; describe_vector
204
205(ert-deftest help--describe-vector/bug-9293-one-shadowed-in-range ()
206 "Check that we only show a range if shadowed by the same command."
207 (let ((orig-map (let ((map (make-keymap)))
208 (define-key map "e" 'foo)
209 (define-key map "f" 'foo)
210 (define-key map "g" 'foo)
211 (define-key map "h" 'foo)
212 map))
213 (shadow-map (let ((map (make-keymap)))
214 (define-key map "f" 'bar)
215 map))
216 (text-quoting-style 'grave))
217 (with-temp-buffer
218 (help--describe-vector (cadr orig-map) nil #'help--describe-command
219 t shadow-map orig-map t)
220 (should (equal (buffer-string)
221 "
222e foo
223f foo (currently shadowed by `bar')
224g .. h foo
225")))))
226
227(ert-deftest help--describe-vector/bug-9293-same-command-does-not-shadow ()
228 "Check that a command can't be shadowed by the same command."
229 (let ((range-map
230 (let ((map (make-keymap)))
231 (define-key map "0" 'foo)
232 (define-key map "1" 'foo)
233 (define-key map "2" 'foo)
234 (define-key map "3" 'foo)
235 map))
236 (shadow-map
237 (let ((map (make-keymap)))
238 (define-key map "0" 'foo)
239 (define-key map "1" 'foo)
240 (define-key map "2" 'foo)
241 (define-key map "3" 'foo)
242 map)))
243 (with-temp-buffer
244 (help--describe-vector (cadr range-map) nil #'help--describe-command
245 t shadow-map range-map t)
246 (should (equal (buffer-string)
247 "
2480 .. 3 foo
249")))))
250
251
252;;;; apropos-internal
253
173(ert-deftest keymap-apropos-internal () 254(ert-deftest keymap-apropos-internal ()
174 (should (equal (apropos-internal "^next-line$") '(next-line))) 255 (should (equal (apropos-internal "^next-line$") '(next-line)))
175 (should (>= (length (apropos-internal "^help")) 100)) 256 (should (>= (length (apropos-internal "^help")) 100))
diff --git a/test/src/syntax-resources/syntax-comments.txt b/test/src/syntax-resources/syntax-comments.txt
index 6f595e4d8dc..a292d816b9d 100644
--- a/test/src/syntax-resources/syntax-comments.txt
+++ b/test/src/syntax-resources/syntax-comments.txt
@@ -62,7 +62,33 @@
6233; \ 6233; \
6333 6333
64 64
65/* Lisp comments within lists */
6640)40
6741(;90 comment
6891)41
6942(;92\
7093)42
7143( ;94
7295
73
74/* Nested Lisp comments */
75100|#100
76101#|#
77102#||#102
78103#| Comment |#103
79104#| Comment
80|#104
81105#|#|#105
82106#| #| Comment |# |#106
83107#|#|#|#|#|#|#|#|#| Comment |#|#|#|#|#|#|#|#|#107
84
85/* Mixed Lisp comments */
86110; #|
87110
88111#| ; |#111
89
65Local Variables: 90Local Variables:
66mode: fundamental 91mode: fundamental
67eval: (set-syntax-table (make-syntax-table)) 92eval: (set-syntax-table (make-syntax-table))
68End: 93End:
94999 \ No newline at end of file
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index 4b9c3f277aa..edee01ec585 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -220,7 +220,7 @@ missing or nil, the value of -START- is assumed for it."
220 (cond 220 (cond
221 ((eq -dir- 'forward) t) 221 ((eq -dir- 'forward) t)
222 ((eq -dir- 'backward) nil) 222 ((eq -dir- 'backward) nil)
223 (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-)))) 223 (t (error "Invalid -dir- argument \"%s\" to `syntax-br-comments'" -dir-))))
224 (start -start-) 224 (start -start-)
225 (start-str (format "%d" (abs start))) 225 (start-str (format "%d" (abs start)))
226 (type -type-)) 226 (type -type-))
@@ -338,10 +338,14 @@ the `parse-partial-sexp's are expected to stop. See
338 (setq parse-sexp-ignore-comments t) 338 (setq parse-sexp-ignore-comments t)
339 (setq comment-end-can-be-escaped nil) 339 (setq comment-end-can-be-escaped nil)
340 (modify-syntax-entry ?\n ">") 340 (modify-syntax-entry ?\n ">")
341 (modify-syntax-entry ?\; "<")) 341 (modify-syntax-entry ?\; "<")
342 (modify-syntax-entry ?{ ".")
343 (modify-syntax-entry ?} "."))
342(defun \;-out () 344(defun \;-out ()
343 (modify-syntax-entry ?\n " ") 345 (modify-syntax-entry ?\n " ")
344 (modify-syntax-entry ?\; ".")) 346 (modify-syntax-entry ?\; ".")
347 (modify-syntax-entry ?{ "(}")
348 (modify-syntax-entry ?} "){"))
345(eval-and-compile 349(eval-and-compile
346 (setq syntax-comments-section "lisp")) 350 (setq syntax-comments-section "lisp"))
347 351
@@ -353,6 +357,62 @@ the `parse-partial-sexp's are expected to stop. See
353(syntax-comments \; forward t 33) 357(syntax-comments \; forward t 33)
354(syntax-comments \; backward t 33) 358(syntax-comments \; backward t 33)
355 359
360;; "Lisp" style comments inside lists.
361(syntax-br-comments \; backward nil 40)
362(syntax-br-comments \; forward t 41)
363(syntax-br-comments \; backward t 41)
364(syntax-br-comments \; forward t 42)
365(syntax-br-comments \; backward t 42)
366(syntax-br-comments \; forward nil 43)
367
368;; "Lisp" style comments parsed by `parse-partial-sexp'.
369(syntax-pps-comments \; 41 90 91)
370(syntax-pps-comments \; 42 92 93)
371(syntax-pps-comments \; 43 94 95 -999)
372
373;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
374;; "Lisp" style nested comments: between delimiters #| |#.
375;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376(defun \#|-in ()
377 (setq parse-sexp-ignore-comments t)
378 (modify-syntax-entry ?# ". 14")
379 (modify-syntax-entry ?| ". 23n")
380 (modify-syntax-entry ?\; "< b")
381 (modify-syntax-entry ?\n "> b"))
382(defun \#|-out ()
383 (modify-syntax-entry ?# ".")
384 (modify-syntax-entry ?| ".")
385 (modify-syntax-entry ?\; ".")
386 (modify-syntax-entry ?\n " "))
387(eval-and-compile
388 (setq syntax-comments-section "lisp-n"))
389
390(syntax-comments \#| forward nil 100 0)
391(syntax-comments \#| backward nil 100 0)
392(syntax-comments \#| forward nil 101 -999)
393(syntax-comments \#| forward t 102)
394(syntax-comments \#| backward t 102)
395
396(syntax-comments \#| forward t 103)
397(syntax-comments \#| backward t 103)
398(syntax-comments \#| forward t 104)
399(syntax-comments \#| backward t 104)
400
401(syntax-comments \#| forward nil 105 -999)
402(syntax-comments \#| backward t 105)
403(syntax-comments \#| forward t 106)
404(syntax-comments \#| backward t 106)
405(syntax-comments \#| forward t 107)
406(syntax-comments \#| backward t 107)
407
408;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
409;; Mixed "Lisp" style (nested and unnested) comments.
410;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
411(syntax-comments \#| forward t 110)
412(syntax-comments \#| backward t 110)
413(syntax-comments \#| forward t 111)
414(syntax-comments \#| backward t 111)
415
356;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 416;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
357;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil. 417;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil.
358;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 418;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;